【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

相关文章

Android Kotlin 高阶函数详解及其在协程中的应用小结

《AndroidKotlin高阶函数详解及其在协程中的应用小结》高阶函数是Kotlin中的一个重要特性,它能够将函数作为一等公民(First-ClassCitizen),使得代码更加简洁、灵活和可... 目录1. 引言2. 什么是高阶函数?3. 高阶函数的基础用法3.1 传递函数作为参数3.2 Lambda

C语言中的数据类型强制转换

《C语言中的数据类型强制转换》:本文主要介绍C语言中的数据类型强制转换方式,具有很好的参考价值,希望对大家有所帮助,如有错误或未考虑完全的地方,望不吝赐教... 目录C语言数据类型强制转换自动转换强制转换类型总结C语言数据类型强制转换强制类型转换:是通过类型转换运算来实现的,主要的数据类型转换分为自动转换

利用Go语言开发文件操作工具轻松处理所有文件

《利用Go语言开发文件操作工具轻松处理所有文件》在后端开发中,文件操作是一个非常常见但又容易出错的场景,本文小编要向大家介绍一个强大的Go语言文件操作工具库,它能帮你轻松处理各种文件操作场景... 目录为什么需要这个工具?核心功能详解1. 文件/目录存javascript在性检查2. 批量创建目录3. 文件

C语言实现两个变量值交换的三种方式

《C语言实现两个变量值交换的三种方式》两个变量值的交换是编程中最常见的问题之一,以下将介绍三种变量的交换方式,其中第一种方式是最常用也是最实用的,后两种方式一般只在特殊限制下使用,需要的朋友可以参考下... 目录1.使用临时变量(推荐)2.相加和相减的方式(值较大时可能丢失数据)3.按位异或运算1.使用临时

使用C语言实现交换整数的奇数位和偶数位

《使用C语言实现交换整数的奇数位和偶数位》在C语言中,要交换一个整数的二进制位中的奇数位和偶数位,重点需要理解位操作,当我们谈论二进制位的奇数位和偶数位时,我们是指从右到左数的位置,本文给大家介绍了使... 目录一、问题描述二、解决思路三、函数实现四、宏实现五、总结一、问题描述使用C语言代码实现:将一个整

C++中::SHCreateDirectoryEx函数使用方法

《C++中::SHCreateDirectoryEx函数使用方法》::SHCreateDirectoryEx用于创建多级目录,类似于mkdir-p命令,本文主要介绍了C++中::SHCreateDir... 目录1. 函数原型与依赖项2. 基本使用示例示例 1:创建单层目录示例 2:创建多级目录3. 关键注

C++中函数模板与类模板的简单使用及区别介绍

《C++中函数模板与类模板的简单使用及区别介绍》这篇文章介绍了C++中的模板机制,包括函数模板和类模板的概念、语法和实际应用,函数模板通过类型参数实现泛型操作,而类模板允许创建可处理多种数据类型的类,... 目录一、函数模板定义语法真实示例二、类模板三、关键区别四、注意事项 ‌在C++中,模板是实现泛型编程

kotlin的函数forEach示例详解

《kotlin的函数forEach示例详解》在Kotlin中,forEach是一个高阶函数,用于遍历集合中的每个元素并对其执行指定的操作,它的核心特点是简洁、函数式,适用于需要遍历集合且无需返回值的场... 目录一、基本用法1️⃣ 遍历集合2️⃣ 遍历数组3️⃣ 遍历 Map二、与 for 循环的区别三、高

C语言字符函数和字符串函数示例详解

《C语言字符函数和字符串函数示例详解》本文详细介绍了C语言中字符分类函数、字符转换函数及字符串操作函数的使用方法,并通过示例代码展示了如何实现这些功能,通过这些内容,读者可以深入理解并掌握C语言中的字... 目录一、字符分类函数二、字符转换函数三、strlen的使用和模拟实现3.1strlen函数3.2st

Go语言中最便捷的http请求包resty的使用详解

《Go语言中最便捷的http请求包resty的使用详解》go语言虽然自身就有net/http包,但是说实话用起来没那么好用,resty包是go语言中一个非常受欢迎的http请求处理包,下面我们一起来学... 目录安装一、一个简单的get二、带查询参数三、设置请求头、body四、设置表单数据五、处理响应六、超