如何对每个数据子集进行拟合并绘制其拟合曲线?
How to do fitting for each subsets of data and plot their fitting curves?
其实在我问这里之前我已经做了很多事情并且做了很多搜索但是到目前为止找不到解决方案。
我有一个数据子集,需要适合每个子集。另一方面,当我尝试绘制每个子集的回归线时,图中只显示一条回归线。这是目前的主要问题。
总之一步步来吧;
这是一个 data.frame
xx <- rep(rep(seq(0,800,200),each=10),times=2)
yy<-c(replicate(2,sort(10^runif(10,-1,0),decreasing=TRUE)),replicate(2,sort(10^runif(10,-1,0),decreasing=TRUE)), replicate(2,sort(10^runif(10,-2,0),decreasing=TRUE)),replicate(2,sort(10^runif(10,-3,0),decreasing=TRUE)), replicate(2,sort(10^runif(10,-4,0), decreasing=TRUE)))
V <- rep(seq(100,2500,length.out=10),times=2)
No <- rep(1:10,each=10)
df <- data.frame(V,xx,yy,No)
从宽格式到长格式
library(reshape2)
df_new <- melt(df,id=c("No","xx","V"))
**拟合模型
As <- 220
Ax <- 1500
model <- function(data){
nlsLM(value~ifelse(V<Vs, 1-exp(-D*(1-(xx-As)/Ax)^2*(1-V/Vs)^2),1),
data=data, start=c(D=1.21,Vs=1951),trace=T,control = nls.lm.control(maxiter=50))
}
library(plyr)
library(minpack.lm)
fit<- dlply(df_new, "No", .fun = model)
用于预测拟合值的函数 ##from Adding Fitted Lines from an Existing Model
predictvals <- function(model, xvar, yvar, xrange=NULL, samples=10, ...) {
# If xrange isn't passed in, determine xrange from the models.
# Different ways of extracting the x range, depending on model type
if (is.null(xrange)) {
if (any(class(model) %in% c("nls", "glm")))
xrange <- range(model$model[[xvar]])
else if (any(class(model) %in% "loess"))
xrange <- range(model$x)
}
newdata <- data.frame(x = seq(xrange[1],xrange[2], length.out = samples))
names(newdata) <- xvar
newdata[[yvar]] <- predict(model, newdata = newdata, ...)
newdata
}
形成在所有组中具有相同 x 范围的预测线
predvals<- ldply(fit, .fun=predictvals, xvar="V", yvar="value",xrange=range(df_new$V))
predvals$xx <- rep(rep(unique(df_new$xx),each=1),each=10)
最后用 facet_wrap~xx
绘制
ggplot(df_new,aes(y=value,x=V, col=factor(xx)))+
geom_point(size=3,alpha=.4)+
geom_line(data=predvals,aes(col=factor(xx)))+
scale_y_log10(breaks=c(1e-6,1e-5,1e-4,1e-3,1e-2,1e-1,1),limits = c(1e-6,1))+
facet_wrap(~xx,scales="free_x")
为什么只有一根拟合线。我希望有两条拟合线,因为每个 xx
值都有两个数据子集。我缺少哪一部分?任何指导将不胜感激。
尝试向 geom_line
中的 aes
调用添加另一个分组因子。
... +
geom_line(data=predvals,aes(col=factor(xx), group=interaction(xx, No))) +
...
我没有查看您的代码的详细信息,如果这不是您要找的,请告诉我。
其实在我问这里之前我已经做了很多事情并且做了很多搜索但是到目前为止找不到解决方案。
我有一个数据子集,需要适合每个子集。另一方面,当我尝试绘制每个子集的回归线时,图中只显示一条回归线。这是目前的主要问题。
总之一步步来吧;
这是一个 data.frame
xx <- rep(rep(seq(0,800,200),each=10),times=2)
yy<-c(replicate(2,sort(10^runif(10,-1,0),decreasing=TRUE)),replicate(2,sort(10^runif(10,-1,0),decreasing=TRUE)), replicate(2,sort(10^runif(10,-2,0),decreasing=TRUE)),replicate(2,sort(10^runif(10,-3,0),decreasing=TRUE)), replicate(2,sort(10^runif(10,-4,0), decreasing=TRUE)))
V <- rep(seq(100,2500,length.out=10),times=2)
No <- rep(1:10,each=10)
df <- data.frame(V,xx,yy,No)
从宽格式到长格式
library(reshape2)
df_new <- melt(df,id=c("No","xx","V"))
**拟合模型
As <- 220
Ax <- 1500
model <- function(data){
nlsLM(value~ifelse(V<Vs, 1-exp(-D*(1-(xx-As)/Ax)^2*(1-V/Vs)^2),1),
data=data, start=c(D=1.21,Vs=1951),trace=T,control = nls.lm.control(maxiter=50))
}
library(plyr)
library(minpack.lm)
fit<- dlply(df_new, "No", .fun = model)
用于预测拟合值的函数 ##from Adding Fitted Lines from an Existing Model
predictvals <- function(model, xvar, yvar, xrange=NULL, samples=10, ...) {
# If xrange isn't passed in, determine xrange from the models.
# Different ways of extracting the x range, depending on model type
if (is.null(xrange)) {
if (any(class(model) %in% c("nls", "glm")))
xrange <- range(model$model[[xvar]])
else if (any(class(model) %in% "loess"))
xrange <- range(model$x)
}
newdata <- data.frame(x = seq(xrange[1],xrange[2], length.out = samples))
names(newdata) <- xvar
newdata[[yvar]] <- predict(model, newdata = newdata, ...)
newdata
}
形成在所有组中具有相同 x 范围的预测线
predvals<- ldply(fit, .fun=predictvals, xvar="V", yvar="value",xrange=range(df_new$V))
predvals$xx <- rep(rep(unique(df_new$xx),each=1),each=10)
最后用 facet_wrap~xx
ggplot(df_new,aes(y=value,x=V, col=factor(xx)))+
geom_point(size=3,alpha=.4)+
geom_line(data=predvals,aes(col=factor(xx)))+
scale_y_log10(breaks=c(1e-6,1e-5,1e-4,1e-3,1e-2,1e-1,1),limits = c(1e-6,1))+
facet_wrap(~xx,scales="free_x")
为什么只有一根拟合线。我希望有两条拟合线,因为每个 xx
值都有两个数据子集。我缺少哪一部分?任何指导将不胜感激。
尝试向 geom_line
中的 aes
调用添加另一个分组因子。
... +
geom_line(data=predvals,aes(col=factor(xx), group=interaction(xx, No))) +
...
我没有查看您的代码的详细信息,如果这不是您要找的,请告诉我。