在 ddply/dlply 内嵌套 nlm 函数
Nesting nlm function inside ddply/dlply
我需要使用 nlm
函数对大型数据帧进行分组插值。
我在单个组的 df 上使用它没有任何问题:
#example data
df <- data.frame(var= cumsum(sort(rnorm(100, mean=20, sd=4))),
time= seq(from=0,to=550,length.out=100))
#create function
my_function <- function(Cini, time, theta,var){
fy <- (theta[1]-(theta[1]- Cini)*exp((-theta[2]/100000)*(time-theta[3])))
ssq<-sum((var-fy)^2)
return(ssq)
}
th.start <- c(77, 148, 5) #set starting parameters
#run nlm
my_fitt <- nlm(f=my_function, Cini=400, var = df$var,
time=df$time, p=th.start)
然后,我尝试使用 dlply
函数在具有多个组的 df 中应用该函数:
#data with groups
df.2 <- data.frame(var= cumsum(sort(rnorm(300, mean=20, sd=4))),
time= rep(seq(from=0,to=1200,length.out=100),3),
groups=rep(c(1:3),each=100))
#run nlm
library(plyr)
my_fitt.2 <- dlply(df.2, .(groups),
nlm(f=my_function, Cini=400, var = df.2$var,time=df.2$time, p=th.start))
但是我收到消息:Error in fs[[i]](x, ...) : attempt to apply non-function
。
我还尝试删除df.2$
,在这个例子中获得Error in time - theta[3] : non-numeric argument to binary operator
,并在我原来的df中获得Error in f(x, ...) : object 'time.clos' not found
(time.clos
是变量之一)。
此外,我想使用 dplyr 库
library(dplyr)
df.2 %>%
group_by(groups) %>%
nlm(f=my_function, Cini=400, v= var,
time=time, p=th.start)
获得Error in f(x, ...) : unused argument (.)
。可能是什么问题?
我对 tidyverse
环境帮不上什么忙,因为我更像是一个基础 R 类型的人。我认为你上次调用的问题是你将一个组 data.frame
传递给一个以 function
对象作为第一个参数的函数。那行不通。
让我向您推荐一种基本的 R 方法:
df.2 %>%
split(.$groups) %>%
lapply(function(xx) nlm(f=my_function, Cini=400, var = xx$var, time=xx$time, p=th.start))
这会生成一个 list
长度为 3(对于三个组)的三个结果。
考虑基础 R 的 by
(tapply
的面向对象包装器),它可以按因子对数据帧进行子集化,并将子集化的数据帧传递给方法,例如您的 nlm
调用,全部到 return 个对象列表:
run_nlm <- function(sub_df) nlm(f=my_function, Cini=400, var=sub_df$var,
time=sub_df$time, p=th.start)
# LIST OF nlm OUTPUTS (EQUAL TO NUMBER OF DISTINCT df$groups)
my_fitt_list <- by(df, df$groups, run_nlm)
我需要使用 nlm
函数对大型数据帧进行分组插值。
我在单个组的 df 上使用它没有任何问题:
#example data
df <- data.frame(var= cumsum(sort(rnorm(100, mean=20, sd=4))),
time= seq(from=0,to=550,length.out=100))
#create function
my_function <- function(Cini, time, theta,var){
fy <- (theta[1]-(theta[1]- Cini)*exp((-theta[2]/100000)*(time-theta[3])))
ssq<-sum((var-fy)^2)
return(ssq)
}
th.start <- c(77, 148, 5) #set starting parameters
#run nlm
my_fitt <- nlm(f=my_function, Cini=400, var = df$var,
time=df$time, p=th.start)
然后,我尝试使用 dlply
函数在具有多个组的 df 中应用该函数:
#data with groups
df.2 <- data.frame(var= cumsum(sort(rnorm(300, mean=20, sd=4))),
time= rep(seq(from=0,to=1200,length.out=100),3),
groups=rep(c(1:3),each=100))
#run nlm
library(plyr)
my_fitt.2 <- dlply(df.2, .(groups),
nlm(f=my_function, Cini=400, var = df.2$var,time=df.2$time, p=th.start))
但是我收到消息:Error in fs[[i]](x, ...) : attempt to apply non-function
。
我还尝试删除df.2$
,在这个例子中获得Error in time - theta[3] : non-numeric argument to binary operator
,并在我原来的df中获得Error in f(x, ...) : object 'time.clos' not found
(time.clos
是变量之一)。
此外,我想使用 dplyr 库
library(dplyr)
df.2 %>%
group_by(groups) %>%
nlm(f=my_function, Cini=400, v= var,
time=time, p=th.start)
获得Error in f(x, ...) : unused argument (.)
。可能是什么问题?
我对 tidyverse
环境帮不上什么忙,因为我更像是一个基础 R 类型的人。我认为你上次调用的问题是你将一个组 data.frame
传递给一个以 function
对象作为第一个参数的函数。那行不通。
让我向您推荐一种基本的 R 方法:
df.2 %>%
split(.$groups) %>%
lapply(function(xx) nlm(f=my_function, Cini=400, var = xx$var, time=xx$time, p=th.start))
这会生成一个 list
长度为 3(对于三个组)的三个结果。
考虑基础 R 的 by
(tapply
的面向对象包装器),它可以按因子对数据帧进行子集化,并将子集化的数据帧传递给方法,例如您的 nlm
调用,全部到 return 个对象列表:
run_nlm <- function(sub_df) nlm(f=my_function, Cini=400, var=sub_df$var,
time=sub_df$time, p=th.start)
# LIST OF nlm OUTPUTS (EQUAL TO NUMBER OF DISTINCT df$groups)
my_fitt_list <- by(df, df$groups, run_nlm)