创建主体中具有可变数量的变量的功能

时间:2019-06-06 20:05:45

标签: r

我正在尝试创建一个具有设置参数的函数,并且在函数主体中它具有一个设置公式,但该公式中的变量数量是随机的,仅当接收到数据时才确定。如何编写函数主体,以便可以针对未知数量的变量进行自我调整?

这是背景故事:我正在使用nls.lm包针对函数中的一组参数优化函数。 nls.lm需要一个返回残差向量的函数。该函数非常简单:观察到的预测值。但是,我还需要创建一个函数来实际获取预测值。这是棘手的地方,因为预测值公式包含需要回归和优化的参数。

这是我要对以下项执行非线性回归的一般公式:

Y=A+(B-A)/(1+(10^(X-C-N))

其中A和B是在整个数据集中共享的全局参数,而N是一个常数。 C可以是1到8个参数中的任意一个,具体取决于与每个参数相关的数据集。

现在我的工作函数包含公式和8个要估算的参数。

getPredictors<- function(params, xvalues) {
(params$B) + ((params$A-params$B)/(1+(10^(xvalues-
params$1*Indicator[1,]-params$2*Indicator[2,]-
params$3*Indicator[3,]-params$4*Indicator[4,]-
params$5*Indicator[5,]-params$6*Indicator[6,]-
params$7*Indicator[7,]-params$8*Indicator[8,]-
constant))))
}

params是带有初始值的参数列表。指标是一个表格,其中每行包含1和0,它们充当指标变量,以正确地将每个参数与其关联的数据点配对。以其最简单的形式,如果每个参数只有一个数据点,它将看起来像一个平方的单位矩阵。

当我将此函数与nls.lm()配对时,我的回归成功了:

residFun<- function(p, observed, xx) {
  observed - getPredictors(p,xx)
}
nls.out<- nls.lm(parameterslist, fn = residFun, observed = Yavg, xx = Xavg)
> summary(nls.out)
Parameters:
       Estimate Std. Error t value Pr(>|t|)    
1      -6.1279     0.1857 -32.997   <2e-16 ***
2      -6.5514     0.1863 -35.174   <2e-16 ***
3      -6.2077     0.1860 -33.380   <2e-16 ***
4      -6.4275     0.1863 -34.495   <2e-16 ***
5      -6.4805     0.1863 -34.783   <2e-16 ***
6      -6.1777     0.1859 -33.235   <2e-16 ***
7      -6.3098     0.1862 -33.882   <2e-16 ***
8      -7.7044     0.1865 -41.303   <2e-16 ***
A      549.7203    11.5413  47.631   <2e-16 ***
B      5.9515    25.4343   0.234    0.816    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 82.5 on 86 degrees of freedom
Number of iterations to termination: 7 
Reason for termination: Relative error in the sum of squares is at most `ftol'.

现在,当我收到的数据不包含8个参数时,就会出现问题。我不能只用0代替这些值,因为我确定自由度会随着参数的减少而变化。因此,我将需要某种方式来动态创建getPredictors函数,具体取决于我收到的数据。

我尝试了几件事。我尝试将所有参数组合成一个字符串列表,如下所示:(出于比较的原因,它仍然是8个参数,但它可以是1-7个参数中的任何一个。)

for (i in 1:length(data$subjects)){
  paramsandindics[i]<-c(paste0("params$",i,"*","Indicator[",i,",]"))
}
combined<-paste0(paramsandindics, collapse="-")
> combined
[1] "params$1*Indicator[1,]-params$2*Indicator[2,]-
params$3*Indicator[3,]-params$4*Indicator[4,]-
params$5*Indicator[5,]-params$6*Indicator[6,]-
params$7*Indicator[7,]-params$8*Indicator[8,]"

似乎能为我带来所需的东西。所以我尝试将其放入一个新的方程式

getPredictors2<- function(params, xvalues) {
  (params$B) + ((params$A-params$B)/
                       (1+(10^(xvalues-parse(text=combined)-constant))))
}

但是我得到一个错误“二进制运算符的非数字参数”。很有道理,它可能试图减去不起作用的字符串。所以我切换到:

getPredictors2<- function(params, xvalues) {
  (params$B) + ((params$A-params$B)/
                       (1+(10^(xvalues-eval(parse(text=combined))-constant))))
}

哪个立即评估整个结果,仅生成1个参数,这破坏了我的回归。

最终,我希望编写一个函数以接受要在函数主体中填充的变量或动态数量的变量。这些变量需要按原样编写,而不是立即进行评估,因为nls.lm(minpack.lm软件包的一部分)中使用的Levenberg-Marquardt算法除了初始参数猜测和残差之外还需要一个方程,以最大程度地减少这些变量。

一个简单的例子就足够了。很抱歉,如果我的东西都无法复制-数据集非常具体且太大而无法正确上传。

很抱歉,如果这已经long绕了。这是我第一次尝试任何一种方法(编码,非线性回归,stackoverflow),所以我有点迷路。我不确定我是否在问正确的问题。谢谢您的时间和考虑。

EDIT 我以一个包含2个参数的较小示例为例。希望对您有所帮助。

Subjects<-c("K1","K2")
#Xvalues
Xvals<-c(-11, -10, -9, -11, -10, -9)
#YValues, Observed
Yobs<-c(467,330,220,567,345,210)
#Indicator matrix for individual parameters
Indicators<-matrix(nrow = 2, ncol = 6)
Indicators[1,]<-c(1,1,1,0,0,0)
Indicators[2,]<-c(0,0,0,1,1,1)
#Setting up the parameters and functions needed for nls.lm
parameternames<-c("K1","K2","A","B")
#Starting values that nls.lm will iterate on
startingestimates<-c(-7,-7,0,500)
C<-.45
parameterlist<-as.list(setNames(startingestimates, parameternames))
getPredictors<- function(params, xx){
  (params$A) + ((params$B-params$A)/
                  (1+(10^(xx-params$K1*Indicators[1,]-params$K2*Indicators[2,]-C))))}
residFunc<- function(p, observed, xx) {
  observed - getPredictors(p,xx)
}
nls.output<- nls.lm(parameterlist, fn = residFunc, observed = Yobs, xx = Xvals)


#Latest attempt at creating a dynamic getPredictor function
combinationtext<-c()
combination<-c()
for (i in 1:length(Subjects)){
  combinationtext[i]<-c(paste0("params$K",i,"*","Indicators[",i,",]"))
}
combination<-paste0(combinationtext, collapse="-")

getPredictorsDynamic<-function(params, xx){
  (params$A) + ((params$B-params$A)/
                  (1+(10^(xx-(parse(text=combination))-C))))}
residFunc2<- function(p, observed, xx) {
  observed - getPredictorsDynamic(p,xx)
}
nls.output2<-nls.lm(parameterlist, fn = residFunc2, observed = Yobs, xx = Xvals)
#Does not work

0 个答案:

没有答案