Применение функций к списку векторов в R

Question

У меня есть список значений, сохраненных в 'SurvieF.csv', как показано ниже: Первая строка содержит время в годах (1 год, 3 года, 5 лет и 10 лет), а вторая строка содержит имя переменнойв первом столбце и коэффициент выживания в оставшихся 4 столбцах.

         1      3    5    10
 var1   0.9   0.85  0.83  0.81
 var2   0.87  0.86  0.84  0.81
 var3   0.79  0.77  0.75  0.72

survieF<-read.csv("SurvieF.csv", sep=";", dec=".", header=TRUE)

В приведенном ниже коде, например,

S<-survieF[3,2:5]
x<-c(1,3,5,10)

Функция:

f <- function(ab){
a <- ab[1]
b <- ab[2]
return(sum((exp(a*x**b)-S)**2))
} 

Поиск параметров, минимизирующих мою сумму, с помощью функции nlm:

minim <- nlm(f,p=c(1,0))

ab <- minim$estimate

a_opt <- ab[1]
b_opt <- ab[2]

Использование оптимальных параметров для получения значений:

prediction_exp <- function(x){
return(exp(a_opt*x**b_opt))}

Затем я использую параметры для оценки выживаемости от 1 до 20лет.

survieFcan<-prediction_exp(1:20)

Тем не менее, я хочу иметь возможность автоматически запускать код в каждой строке моего фрейма данных «SurvieF», а затем экспортировать все значения, оцененные в период с 1 по 20 год, в Excel.Как я могу это сделать?

Answer 1

Хитрость для запуска nlm() в каждой строке survieF заключается в использовании apply() с встроенной функцией в качестве третьего аргумента, принимающего подходящие параметры и вызывающего nlm().

Следующий пример иллюстрирует это:

#--- 1) Read the data
# Note:
# - the use of row.names=1 so that 'var1', 'var2', ... are stored as row names
# instead of being read as data values.
# - the computation of the independent variable 'years'
# (used as x in the function to optimize) from the column names read
# (so that we do not hardcode its values, but read them from the input data instead)
survieF <- read.csv("SurvieF.csv", sep=";", dec=".", header=TRUE), row.names=1)
years <- as.numeric( substring( names(survieF), 2 ) )

#--- 2) Define the function to optimize that also defines the model to fit
# Note that two parameters were added, 'S' and 'x', so that:
# - we can pass the value of S as every row of survieF via apply() below
# - the function is fully self-contained (in the previous version,
# one needs to "magically" know that object x needs to be defined
# already in order for the function to work properly)
f <- function(ab,S,x){
  a <- ab[1]
  b <- ab[2]
  return(sum((exp(a*x**b)-S)**2))
}

#--- 3) Obtain the estimated parameters for each row of survieF
opt_params <- apply(survieF, 1, function(S,years) { 
                                    nlm(f,p=c(1,0),S,years)$estimate
                                }, years)

, чей результат:

          var1      var2      var3
[1,] -39.68255 -39.73691 -41.63971
[2,] -51.56907 -51.42185 -53.87351

Затем можно использовать аналогичную стратегию для получения прогнозных значений для лет с 1 по 20 для каждогопеременная var1, var2, var3.