Trang chủ / Tài liệu miễn phí / Luận Án Tiến Sĩ Lâm Nghiệp

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 - 23


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!

Xem toàn bộ 207 trang tài liệu này.


################################

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 - 23

# 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)))

Xem tất cả 207 trang.

Ngày đăng: 14/07/2022
Trang chủ Tài liệu miễn phí