【R语言】基于nls函数的非线性拟合

2024-08-24 15:36

本文主要是介绍【R语言】基于nls函数的非线性拟合,希望对大家解决编程问题提供一定的参考价值,需要的开发者们随着小编来一起学习吧!

非线性拟合

  • 1.写在前面
  • 2.实现代码

1.写在前面

以下代码记录了立地指数的计算过程,包括了优势树筛选、误差清理、非线性拟合以及结果成图。
优势树木确定以及数据清理过程:
在这里插入图片描述

相关导向函数:
在这里插入图片描述

2.实现代码

##*******************************************************************************----
##*******************************************************************************
## @ author:JAckson Zhao
#  @ time: 2024年8月23日17:34:07
# @ description:立地指数数据拟合
library(tidyverse)
library(mgcv)
library(dplyr)setwd("C:\\Users\\YP\\Desktop\\Site index")data <- read.csv("Final_data.csv", sep = ",", fileEncoding = "GBK")# 获取前431行数据
data <- head(data, 430)
nrow(data)
# nihe <- data %>%
#   select(Hight, Age) %>%
#   rename(height = Hight, age = Age)
# nrow(nihe)## 样地优势树高获取------------------------------------------------------------
# 处理数据
result <- data %>%group_by(Long, Lat, Site, PlotsID) %>%  # 根据 site 和 PlotsID 进行分组arrange(desc(height)) %>%    # 根据 height 降序排列slice(1:5) %>%              # 选取每组中最大的三个 height 值ungroup() %>%                # 取消分组group_by(Long, Lat, Site, PlotsID) %>%  # 再次分组summarise(avg_height = mean(height, na.rm = TRUE),  # 计算高度的均值avg_age = mean(Age, na.rm = TRUE),        # 计算对应的年龄的均值.groups = "drop"                        # 汇总后取消分组)# 查看结果
head(result)
summary(result)# 如果存在负值或零值,可能需要进行数据过滤
nihe <- result %>% filter(avg_height > 0 & avg_height < 23, avg_age > 0 & avg_age < 200) %>%rename(height = avg_height, age = avg_age)
head(nihe)
nrow(nihe)
summary(nihe)# 对每个age组计算高度的均值和3倍标准差,并过滤掉超出这个范围的数据
nihe_clean <- nihe %>%group_by(age) %>%mutate(mean_height = mean(height, na.rm = TRUE),sd_height = sd(height, na.rm = TRUE)) %>%filter(height > (mean_height - 3 * sd_height), height < (mean_height + 3 * sd_height)) %>%ungroup()  # 移除分组,以便进行后续操作# 查看清理后的数据
nrow(nihe_clean)
head(nihe_clean)
summary(nihe_clean)# 绘制散点图,并添加拟合线
ggplot(nihe, aes(x = age, y = height)) + geom_point() +  # 添加散点图层geom_smooth(method = "gam", formula = y ~ s(x),method.args = list(family = "gaussian"),color = "blue") + # 添加GAM拟合线labs(x = "林龄(年)", y = "群落高度(m)", title = "林龄与群落高度的关系") + theme_minimal()  # 使用简洁主题# 定义不同的非线性模型方程和初始参数---------------------------------------------
# 定义不同的非线性模型方程和初始参数
models <- list(list(formula = log(height) ~ a + b / log(age), start = list(a = 0.01, b = 1)),list(formula = log(height) ~ a + b / age, start = list(a = 0.01, b = 1)),list(formula = height ~ a * (1 - b * exp(-c * age)) ^ (1 / (1-d)), start = list(a = 15.618, b = 13.312, k = 1.255, d = 1)),list(formula = height ~ a * (1 - exp(-b * age)), start = list(a = 13.934, b = 0.114)),list(formula = height ~ a * (1 - exp(-b * age)^c), start = list(a = 14.531, b = 0.056, c = 1.304)),list(formula = height ~ a + b * age + I(age^2), start = list(a = 0.01, b = 1)),list(formula = height ~ a * exp(-b * exp( -c * age)), start = list(a = 13.668, b = 1.785, c = 0.182)),list(formula = height ~ a + b / log(age), start = list(a = 0.01, b = 1)),list(formula = height ~ a / (1 + b * exp(-c * age)), start = list(a = 16.848, b = 8.068, c = 0.182))
)# 定义计算拟合优度的函数
calculate_fit_metrics <- function(fit, actual_values) {fitted_values <- fitted(fit)  # 计算预测值# 1、计算 MAEMAE <- mean(abs(actual_values - fitted_values))# 2、计算 RMSERMSE <- sqrt(mean((actual_values - fitted_values)^2))# 3、计算普通的 R²SST <- sum((actual_values - mean(actual_values))^2)SSE <- sum((actual_values - fitted_values)^2)R_squared <- 1 - (SSE / SST)# 4、计算 Adjusted R²n <- length(actual_values)p <- length(coef(fit))Adjusted_R_squared <- 1 - ((1 - R_squared) * (n - 1) / (n - p - 1))return(list(MAE = MAE, RMSE = RMSE, R_squared = R_squared, Adjusted_R_squared = Adjusted_R_squared))
}# 拟合每个模型并计算拟合优度
results <- lapply(models, function(model) {tryCatch({fit <- nls(model$formula,data = nihe,start = model$start,control = nls.control(maxiter = 100, minFactor = 1e-3))actual_values <- if (grepl("log", deparse(model$formula))) log(nihe$height) else nihe$heightmetrics <- calculate_fit_metrics(fit, actual_values)list(fit = fit, metrics = metrics)}, error = function(e) {message("Error in fitting model: ", deparse(model$formula))NULL})
})# 绘制模型拟合曲线的函数,并在图上显示 R2、MAE 和 RMSE
plot_model_fit <- function(model, data, actual_values, fitted_values, metrics, model_name) {p <- ggplot(data, aes(x = age)) +geom_point(aes(y = actual_values), color = "blue", size = 1.5) +geom_line(aes(y = fitted_values), color = "red", size = 1) +labs(title = paste("Model:", model_name),x = "Age",y = "Height") +theme_minimal() +theme(plot.title = element_text(size = 14, family = "Times New Roman", face = "bold"),  # 修改标题的字体大小和字体样式axis.title.x = element_text(size = 12, family = "Times New Roman"),  # 修改 x 轴标签的字体大小和字体样式axis.title.y = element_text(size = 12, family = "Times New Roman")  # 修改 y 轴标签的字体大小和字体样式)# 添加 R², MAE, RMSE 到图上p <- p + annotate("text", x = Inf, y = Inf, label = sprintf("R²: %.2f\nMAE: %.2f\nRMSE: %.2f", metrics$R_squared, metrics$MAE, metrics$RMSE),hjust = 1, vjust = 1, size = 3.5, color = "black", fontface = "bold")return(p)
}# 遍历results列表,绘制每个成功拟合的模型,并显示指标
for (i in 1:length(results)) {if (!is.null(results[[i]])) {fit <- results[[i]]$fitmetrics <- results[[i]]$metrics# 提取拟合值fitted_values <- fitted(fit)actual_values <- if (grepl("log", deparse(models[[i]]$formula))) log(nihe$height) else nihe$height# 绘制图形并显示指标p <- plot_model_fit(fit, nihe, actual_values, fitted_values, metrics, deparse(models[[i]]$formula))print(p)}
}

这篇关于【R语言】基于nls函数的非线性拟合的文章就介绍到这儿,希望我们推荐的文章对编程师们有所帮助!



http://www.chinasem.cn/article/1102889

相关文章

Python正则表达式语法及re模块中的常用函数详解

《Python正则表达式语法及re模块中的常用函数详解》这篇文章主要给大家介绍了关于Python正则表达式语法及re模块中常用函数的相关资料,正则表达式是一种强大的字符串处理工具,可以用于匹配、切分、... 目录概念、作用和步骤语法re模块中的常用函数总结 概念、作用和步骤概念: 本身也是一个字符串,其中

C 语言中enum枚举的定义和使用小结

《C语言中enum枚举的定义和使用小结》在C语言里,enum(枚举)是一种用户自定义的数据类型,它能够让你创建一组具名的整数常量,下面我会从定义、使用、特性等方面详细介绍enum,感兴趣的朋友一起看... 目录1、引言2、基本定义3、定义枚举变量4、自定义枚举常量的值5、枚举与switch语句结合使用6、枚

shell编程之函数与数组的使用详解

《shell编程之函数与数组的使用详解》:本文主要介绍shell编程之函数与数组的使用,具有很好的参考价值,希望对大家有所帮助,如有错误或未考虑完全的地方,望不吝赐教... 目录shell函数函数的用法俩个数求和系统资源监控并报警函数函数变量的作用范围函数的参数递归函数shell数组获取数组的长度读取某下的

MySQL高级查询之JOIN、子查询、窗口函数实际案例

《MySQL高级查询之JOIN、子查询、窗口函数实际案例》:本文主要介绍MySQL高级查询之JOIN、子查询、窗口函数实际案例的相关资料,JOIN用于多表关联查询,子查询用于数据筛选和过滤,窗口函... 目录前言1. JOIN(连接查询)1.1 内连接(INNER JOIN)1.2 左连接(LEFT JOI

MySQL中FIND_IN_SET函数与INSTR函数用法解析

《MySQL中FIND_IN_SET函数与INSTR函数用法解析》:本文主要介绍MySQL中FIND_IN_SET函数与INSTR函数用法解析,本文通过实例代码给大家介绍的非常详细,感兴趣的朋友一... 目录一、功能定义与语法1、FIND_IN_SET函数2、INSTR函数二、本质区别对比三、实际场景案例分

Go 语言中的select语句详解及工作原理

《Go语言中的select语句详解及工作原理》在Go语言中,select语句是用于处理多个通道(channel)操作的一种控制结构,它类似于switch语句,本文给大家介绍Go语言中的select语... 目录Go 语言中的 select 是做什么的基本功能语法工作原理示例示例 1:监听多个通道示例 2:带

C++ Sort函数使用场景分析

《C++Sort函数使用场景分析》sort函数是algorithm库下的一个函数,sort函数是不稳定的,即大小相同的元素在排序后相对顺序可能发生改变,如果某些场景需要保持相同元素间的相对顺序,可使... 目录C++ Sort函数详解一、sort函数调用的两种方式二、sort函数使用场景三、sort函数排序

C语言函数递归实际应用举例详解

《C语言函数递归实际应用举例详解》程序调用自身的编程技巧称为递归,递归做为一种算法在程序设计语言中广泛应用,:本文主要介绍C语言函数递归实际应用举例的相关资料,文中通过代码介绍的非常详细,需要的朋... 目录前言一、递归的概念与思想二、递归的限制条件 三、递归的实际应用举例(一)求 n 的阶乘(二)顺序打印

C/C++错误信息处理的常见方法及函数

《C/C++错误信息处理的常见方法及函数》C/C++是两种广泛使用的编程语言,特别是在系统编程、嵌入式开发以及高性能计算领域,:本文主要介绍C/C++错误信息处理的常见方法及函数,文中通过代码介绍... 目录前言1. errno 和 perror()示例:2. strerror()示例:3. perror(

Kotlin 作用域函数apply、let、run、with、also使用指南

《Kotlin作用域函数apply、let、run、with、also使用指南》在Kotlin开发中,作用域函数(ScopeFunctions)是一组能让代码更简洁、更函数式的高阶函数,本文将... 目录一、引言:为什么需要作用域函数?二、作用域函China编程数详解1. apply:对象配置的 “流式构建器”最