I try to analyze the linear fitting relationship of different couples, but I can't set the automatic adjustment of the nonlinear curve and the corresponding formula according to the situation of each couple.
The original data is below:
Blancas<-structure(list(Variete = c("Blancas", "Blancas", "Blancas", "Blancas",
"Blancas", "Blancas", "Blancas", "Blancas", "Blancas", "Blancas",
"Blancas", "Blancas", "Blancas", "Blancas", "Blancas", "Blancas",
"Blancas", "Blancas", "Blancas", "Blancas", "Blancas", "Blancas"
), FTSW_apres_arros = c(0.900083501645054, 0.594624492388504,
0.69639114581838, 0.670802547958754, 0.323422568282221, 0.504033763027188,
0.465607723592238, 0.147855006887101, 0.344692945938962, 0.278127560322112,
0.0251004517653103, 0.146593551721168, 0.0685040706814978, 0.0079719091901767,
0.112141483161551, 0.033074748488718, -0.00573092486993021, 0.0798426688869111,
0.00355031332806817, 0.0317533231891131, -0.0348314523807766,
0.0102207803393529), NLE = c(0.929274770173646, 0.945085636834107,
0.993449008498584, 0.86299292214358, 0.913573635427395, 0.923204256577003,
1.0129538638249, 0.47619892640078, 0.770480315963817, 0.818202836004931,
0, 0.693885448916409, 0.533765227800859, 0, 0.217324185248712,
0.020340846619022, 0, 0, 0.139929850470739, 0, 0, 0), Couples = c("W16-W17",
"W16-W17", "W37-W36", "X02-X03", "W16-W17", "W37-W36", "X02-X03",
"W16-W17", "W37-W36", "X02-X03", "W16-W17", "W37-W36", "X02-X03",
"W16-W17", "W37-W36", "X02-X03", "W16-W17", "W37-W36", "X02-X03",
"W37-W36", "X02-X03", "W37-W36")), class = c("tbl_df", "tbl",
"data.frame"), row.names = c(NA, -22L))
And here is my code:
library(ggplot2)
library(dplyr)
library("RColorBrewer")
library(modelr)
pred_df <- data.frame(FTSW_apres_arros = seq(min(Blancas$FTSW_apres_arros),
max(Blancas$FTSW_apres_arros),
length.out = 100))
pred_df$NLE <- predict(mod, newdata = pred_df)
mod = nls(NLE ~ 2/(1+exp(a*FTSW_apres_arros))-1,start = list(a=1),data = Blancas)
Blancas$pred = predict(mod,Blancas)
a = coef(mod)
RMSE = rmse(Blancas$NLE, Blancas$pred)
MSE = mse(Blancas$NLE, Blancas$pred)
Rsquared = summary(lm(Blancas$NLE~ Blancas$pred))$r.squared
p1<- ggplot(Blancas, aes(FTSW_apres_arros, NLE)) +
geom_point(aes(color = Couples), pch = 19, cex = 3) +
geom_line(data = pred_df,lwd=1.2) +
scale_color_manual(values = c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3", "#FF7F00", "#FFFF33", "#A65628", "#F781BF","#999999"))+
scale_x_continuous(limits = c(0, 1)) +
labs(title = "Blancas-Remove outliers",
y = "Expansion folliaire totale relative",
x = "FTSW",
subtitle = paste0("y = 2/(1 + exp(", round(a, 3), "* x)) -1)","\n",
"R^2 = ", round(Rsquared, 3)," RMSE = ",
round(RMSE, 3), " MSE = ", round(MSE, 3)))+
theme(plot.title = element_text(hjust = 0, size = 14, face = "bold",
colour = "black"),
plot.subtitle = element_text(hjust = 0,size=10, face = "italic",
colour = "black"))+
facet_wrap(~Couples)
p1
Here is the figure I got. The purple-circled formula and error metrics are calculated for the whole couples, but I want to calculate them for each couple and present them for each couple in the graph.
Could anyone give me some suggestions? Thank you in advance!
