Phụ lục 6: Codes để thiết lập và thẩm định chéo K=Fold mô hình phi tuyến có trọng số có xét ảnh hưởng của các nhân tố sinh thái môi trường, lâm phần theo phương pháp Maximum Likelihood
# Erase memory rm(list=ls())
# Clean plot window dev.off()
# Define the working directory (change with / using Edit>Find) setwd("C:/Users/baohu/OneDrive/PhD Master/PhD Tinh/1. Huong dan Tinh sau cung/Data")
# Import data
t <- read.table("tAll.txt", header=T,sep="t",stringsAsFactors = FALSE)
# Install.packages("ggplot2") library(ggplot2) library(nlme) library(cowplot) library(gridExtra)
Có thể bạn quan tâm!
- Thiết lập và thẩm định chéo hệ thống mô hình ước tính sinh khối trên mặt đất cây rừng khộp ở Việt Nam - 20
- Codes Thực Hiện Trong R Để Thẩm Định Chéo Theo Phương Pháp Loocv Mô Hình: Agb = A×D 2 Hwd B
- Thiết lập và thẩm định chéo hệ thống mô hình ước tính sinh khối trên mặt đất cây rừng khộp ở Việt Nam - 22
- Thiết lập và thẩm định chéo hệ thống mô hình ước tính sinh khối trên mặt đất cây rừng khộp ở Việt Nam - 24
- Thiết lập và thẩm định chéo hệ thống mô hình ước tính sinh khối trên mặt đất cây rừng khộp ở Việt Nam - 25
Xem toàn bộ 207 trang tài liệu này.
################################
# K-Fold Cross validation
# Create 10 equally size folds t <- t[sample(nrow(t)),]
folds <- cut(seq(1,nrow(t)),breaks=10,labels=FALSE)
AIC = rep(0, 10)
R2adj = rep(0, 10) Bias = rep(0, 10) RMSE = rep(0, 10) MAPE = rep(0, 10)
# Perform 10 fold cross validation: for(i in 1:10){
# Segement the data by fold using the which() function testIndexes <- which(folds==i,arr.ind=TRUE)
n_va <- t[testIndexes, ]
t_eq <- t[-testIndexes, ]
# Non-Linear Mixed Models with random effects:
start <- coefficients(lm(log(AGB)~log(D)+log(H)+log(WD), data=t_eq)) names(start) <- c("a","b","c","d")
start[1]<-exp(start[1])
Max_like <- nlme(AGB~a*D^b*H^c*WD^d, data=t_eq, fixed=a+b+c+d~1, random=a+b+c+d~1,
start=start, groups=~Region_simple , weights=varPower(form=~D))
# Estimated and Predicted Values:
k <- summary(Max_like)$modelStruct$varStruct[1] t_eq$Max_like.fit <- fitted.values(Max_like) t_eq$Max_like.res <- residuals(Max_like) t_eq$Max_like.res.weigh <- residuals(Max_like)/t_eq$D^k
# Calcul of AIC, R2 AIC[i] <- AIC(Max_like)
R2 <- 1- sum((t_eq$AGB - t_eq$Max_like.fit)^2)/sum((t_eq$AGB - mean(t_eq$AGB))^2)
R2.adjusted <- 1 - (1-R2)*(length(t_eq$AGB)-1)/(length(t_eq$AGB)-5-1) R2adj[i] <- R2.adjusted
# Prediction for validation
n_va$Pred <- predict(Max_like, newdata=n_va)
# Calcul of RMSE, Bias, MAPE%:
Bias[i] = 100*mean((n_va$AGB - n_va$Pred)/n_va$AGB)
RMSE[i] = 100*sqrt(mean(((n_va$AGB - n_va$Pred)/n_va$AGB)^2)) MAPE[i] = 100*mean(abs(n_va$AGB - n_va$Pred)/n_va$AGB)
}
i
# Parameters on random effects: fixef( Max_like )
ranef( Max_like ) coef(( Max_like ))
coef(summary( Max_like ))
# Output last model: summary(Max_like)
# Mean of AIC, R2adj.: mean(AIC) mean(R2adj)
# Mean of RMSE, Bias, MAPE%: mean(Bias)
mean(RMSE) mean(MAPE)
# The end
Phụ lục 7: Codes để thiết lập và thẩm định chéo K=Fold mô hình phi tuyến có trọng số có xét ảnh hưởng tổng hợp các nhân tố sinh thái môi trường, lâm phần theo phương pháp Maximum Likelihood
# Erase memory rm(list=ls())
# Clean plot window dev.off()
# Define the working directory (change with / using Edit>Find) setwd("C:/Users/baohu/OneDrive/PhD Master/PhD Tinh/1. Huong dan Tinh sau cung/Data")
# Import data
t <- read.table("tAll.txt", header=T,sep="t",stringsAsFactors = FALSE)
# install.packages("ggplot2") library(ggplot2) library(nlme) library(cowplot) library(gridExtra)
################################
# K-Fold Cross validation
# Create 10 equally size folds t <- t[sample(nrow(t)),]
folds <- cut(seq(1,nrow(t)),breaks=10,labels=FALSE) AIC = rep(0, 10)
R2adj = rep(0, 10) Bias = rep(0, 10) RMSE = rep(0, 10) MAPE = rep(0, 10)
# Perform 10 fold cross validation: for(i in 1:10){
# Segement the data by fold using the which() function testIndexes <- which(folds==i,arr.ind=TRUE)
n_va <- t[testIndexes, ] t_eq <- t[-testIndexes, ]
# Model = Average * Modifier:
start = c(-2.12, 2.39, 1.10,-0.008, -0.023)
names(start) <- c("a","b","d","b2","b3")
Max_like <- nlme(AGB ~ a*D^b*WD^d* exp( b2* (Rain_annual - 1502) + b3*(BA - 12.62) ), data=cbind(t_eq, g="a"), fixed=a+b+d+b2+b3~1, start=start, groups=~g, weights=varPower(form=~D))
# Estimated values:
k <- summary(Max_like)$modelStruct$varStruct[1] t_eq$Max_like.fit <- fitted.values(Max_like) t_eq$Max_like.res <- residuals(Max_like) t_eq$Max_like.res.weigh <- residuals(Max_like)/t_eq$D^k
# Calculating of AIC, R2 AIC[i] <- AIC(Max_like)
R2 <- 1- sum((t_eq$AGB - t_eq$Max_like.fit)^2)/sum((t_eq$AGB - mean(t_eq$AGB))^2)
R2.adjusted <- 1 - (1-R2)*(length(t_eq$AGB)-1)/(length(t_eq$AGB)-6-1) R2adj[i] <- R2.adjusted
# Prediction of the model for validation
n_va$Pred <- predict(Max_like, newdata=cbind(n_va,g="a"))
# Calculating RMSE, Bias, MAPE%:
Bias[i] = 100*mean((n_va$AGB - n_va$Pred)/n_va$AGB)
RMSE[i] = 100*sqrt(mean(((n_va$AGB - n_va$Pred)/n_va$AGB)^2))
MAPE[i] = 100*mean(abs(n_va$AGB - n_va$Pred)/n_va$AGB)
}
i
# Mean of AIC, R2 adj.: mean(AIC) mean(R2adj)
# Mean of RMSE, Bias, MAPE%: mean(Bias)
mean(RMSE) mean(MAPE)
# Output model: summary(Max_like)
#####################
# Estimating parameters with the entire dataset
# Erase memory rm(list=ls())
# Clean plot window dev.off()
# Define the working directory (change with / using Edit>Find) setwd("C:/Users/baohu/OneDrive/PhD Master/PhD Tinh/1. Huong dan Tinh sau cung/Data")
# Import data
t_eq <- read.table("tAll.txt", header=T,sep="t",stringsAsFactors = FALSE)
# install.packages("ggplot2") library(ggplot2) library(nlme) library(cowplot) library(gridExtra)
# Modeling:
start = c(-2.12, 2.39, 1.10,-0.008, -0.023)
names(start) <- c("a","b", "d","b2","b3")
Max_like <- nlme(AGB ~ a*D^b*WD^d* exp( b2* (Rain_annual - 1502) + b3*(BA - 12.62) ),
data=cbind(t_eq, g="a"), fixed=a+b+d+b2+b3~1, start=start, groups=~g, weights=varPower(form=~D))
# Estimated values:
k <- summary(Max_like)$modelStruct$varStruct[1] t_eq$Max_like.fit <- fitted.values(Max_like) t_eq$Max_like.res <- residuals(Max_like) t_eq$Max_like.res.weigh <- residuals(Max_like)/t_eq$D^k
# Calculation of AIC, R2 AIC <- AIC(Max_like)
R2 <- 1- sum((t_eq$AGB - t_eq$Max_like.fit)^2)/sum((t_eq$AGB - mean(t_eq$AGB))^2)
R2.adjusted <- 1 - (1-R2)*(length(t_eq$AGB)-1)/(length(t_eq$AGB)-6-1) R2adj <- R2.adjusted
# Calculation of RMSE, Bias, MAPE%:
Bias = 100*mean((t_eq$AGB - t_eq$Max_like.fit)/t_eq$AGB)
RMSE = 100*sqrt(mean(((t_eq$AGB - t_eq$Max_like.fit)/t_eq$AGB)^2)) MAPE = 100*mean(abs(t_eq$AGB - t_eq$Max_like.fit)/t_eq$AGB)
# AIC, R2 adj.: AIC
R2adj
# RMSE, Bias, MAPE%:
Bias RMSE MAPE
# Output last model: summary(Max_like)
# Plot of observed/Fitted summary(t_eq$AGB) p1 <- ggplot(t_eq)
p1 <- p1 + geom_point(aes(y=Max_like.fit, x=AGB), cex = 2)
p1 <- p1 + geom_abline(intercept = 0, slope = 1, col="black", cex=1.5)
p1 <- p1 + xlab("AGB quan sát (kg)") + ylab("AGB ước tính qua mô hình (kg)")
+ theme_bw()
p1 <- p1 + labs(title ="")
p1 = p1 + theme(axis.title.y = element_text(size = rel(1.7))) p1 = p1 + theme(axis.title.x = element_text(size = rel(1.7))) p1 <- p1 + theme(plot.title = element_text(size = rel(1.7))) p1 = p1 + theme(axis.text.x = element_text(size=15))
p1 = p1 + theme(axis.text.y = element_text(size=15)) p1 = p1 + ylim(0,1500)
p1 = p1 + xlim(0,1500) p1
# Plot of Weighted Residuals / Fitted summary(t_eq$Max_like.res.weigh) p2 <- ggplot(t_eq)
p2 <- p2 + geom_point(aes(x=Max_like.fit, y=Max_like.res.weigh), cex = 2) p2 <- p2 + geom_line(cex = 1.5, aes(x=Max_like.fit, y=0))
p2 <- p2 + xlab("AGB ước tính qua mô hình (kg)") + ylab("Sai số có trọng số (kg)") + theme_bw()
p2 <- p2 + labs(title ="")
p2 = p2 + theme(axis.title.y = element_text(size = rel(1.5)))