Создание функции с переменным количеством переменных в теле - PullRequest
0 голосов
/ 06 июня 2019

Я пытаюсь создать функцию с установленными аргументами, и в теле функции она имеет формулу набора, но случайное число переменных в формуле, определяемое только при получении данных.Как мне написать тело функции, чтобы оно могло настраиваться на неизвестное количество переменных?

Вот предыстория: я использую пакет 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), требует уравнения в дополнение к исходным предположениям параметров и остаткам для минимизации.

Достаточно простого примера.Извините, если ни один из моих материалов не может быть воспроизведен - набор данных достаточно специфичен и слишком велик для правильной загрузки.

Извините, если это слишком долго.Я впервые пробую все это (кодирование, нелинейная регрессия, переполнение стека), поэтому я немного растерялся.Я не уверен, что даже задаю правильный вопрос.Спасибо за ваше время и внимание.

РЕДАКТИРОВАТЬ В качестве примера я включил меньшую выборку, включающую 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...