# example data
data(DxHx.df)
# taper curve parameters based on all measured trees
data(SK.par.lme)
#select data of first tree
Idi <- (DxHx.df[,"Id"] == unique(DxHx.df$Id)[1])
(tree1 <- DxHx.df[Idi,])
## Predict the taper curve based on the diameter measurement in 2 m
## height and known height
tc.tree1 <- E_DHx_HmDm_HT.f(Hx=1:tree1$Ht[1],
Hm=tree1$Hx[3],
Dm=tree1$Dx[3],
mHt = tree1$Ht[1],
sHt = 0,
par.lme = SK.par.lme)
#plot the predicted taper curve
plot(tc.tree1$Hx, tc.tree1$DHx, type="l", las=1)
#lower CI
lines(tc.tree1$Hx, tc.tree1$CI_Mean[,1], lty=2)
#upper CI
lines(tc.tree1$Hx, tc.tree1$CI_Mean[,3], lty=2)
#lower prediction interval
lines(tc.tree1$Hx, tc.tree1$CI_Pred[,1], lty=3)
#upper prediction interval
lines(tc.tree1$Hx, tc.tree1$CI_Pred[,3], lty=3)
#add measured diameter used for calibration
points(tree1$Hx[3], tree1$Dx[3], pch=3, col=2)
#add the observations
points(tree1$Hx, tree1$Dx)
## feature of forcing taper curve through measured diameters
i <- c(3, 6)
tc.tree1 <- E_DHx_HmDm_HT.f(Hx=seq(0, tree1$Ht[1], 0.1),
Hm=tree1$Hx[i],
Dm=tree1$Dx[i],
mHt = tree1$Ht[1],
sHt = 0,
par.lme = SK.par.lme,
Rfn=list(fn="sig2"))
tc.tree2 <- E_DHx_HmDm_HT.f(Hx=seq(0, tree1$Ht[1], 0.1),
Hm=tree1$Hx[i],
Dm=tree1$Dx[i],
mHt = tree1$Ht[1],
sHt = 0,
par.lme = SK.par.lme,
Rfn=list(fn="zero"))
# plot the predicted taper curve
plot(tc.tree1$Hx, tc.tree1$DHx, type="l", las=1)
# added taper curve through measurement
points(x=tc.tree2$Hx, y=tc.tree2$DHx, type="l", lty=2)
# closer window
plot(tc.tree1$Hx, tc.tree1$DHx, type="l", las=1, xlim=c(0, 8), ylim=c(24, 30))
# added taper curve through measurement
points(x=tc.tree2$Hx, y=tc.tree2$DHx, type="l", lty=2)
# add measured diameter used for calibration
points(tree1$Hx[i], tree1$Dx[i], pch=3, col=2)
# add the observations
points(tree1$Hx, tree1$Dx)
## apply yet another residual variance function
i <- c(1, 2, 3) # calibrating with 0.5, 1m and 2m, assuming no error in 0.5m
zrv <- tree1$Hx[1] / tree1$Ht[1] # assumed zero resiudal variance
# assumed residual variance per measurement
TapeR:::resVar(relH = tree1$Hx[i] / tree1$Ht[1], fn = "dlnorm",
sig2 = SK.par.lme$sig2_eps, par = list(zrv=zrv))
tc.tree3 <- E_DHx_HmDm_HT.f(Hx=seq(0, tree1$Ht[1], 0.1),
Hm=tree1$Hx[i],
Dm=tree1$Dx[i],
mHt = tree1$Ht[1],
sHt = 0,
par.lme = SK.par.lme,
Rfn=list(fn="dlnorm", par=list(zrv=zrv)))
plot(tc.tree1$Hx, tc.tree1$DHx, type="l", las=1, xlim=c(0, 4))
points(x=tc.tree3$Hx, y=tc.tree3$DHx, type="l", lty=2)
points(tree1$Hx[i], tree1$Dx[i], pch=3, col=2)
points(tree1$Hx, tree1$Dx)
Run the code above in your browser using DataLab