Нелинейные модели смешанных эффектов с функцией самозапуска и мурлыканьем

Question

В прошлом я использовал nlme для подбора и сравнения нелинейных моделей. Теперь я хотел бы использовать его для сопоставления моделей с данными, сгруппированными более чем по одному идентификатору. Было бы здорово, если бы я мог интегрировать dplyr, purrr и nlme. Одной из приятных вещей было бы использование самозапускаемых функций из пакета nlme. У меня также есть много моделей для запуска. Я просто не уверен, что все это подойдет.

Текущая ситуация. Это работает, но ограничивается только одной группирующей переменной:

library(tidyverse)
library(nlme)
diamonds_grouped <- groupedData(price ~ carat | cut, data = diamonds)
nlsList(price ~ SSlogis(carat, Asym, xmid, scal), data = diamonds_grouped)  

Желаемый вид рабочего процесса. Не работает, как далеко я зашел:

fit_mod <- function(df) {  ### Not much faith in how I wrote this function
  nlsList(price ~ SSlogis(carat, Asym, xmid, scal), data = .)
} 

diamonds %>%
group_by(cut, color) %>%
nest() %>%
mutate(
  model = map(data, fit_mod),
  tidied = map(model, tidy)
)

Не должно быть, или я просто не знаю, как это сделать?

Answer 1

Один из вариантов - ввести новую переменную, которая фиксирует все возможные группировки нескольких переменных. Используя ваш пример:

diamonds2 <- diamonds %>% mutate( grp = str_c(cut, "_", color) )
diamonds2_grp  <- groupedData( price ~ carat | grp, data = diamonds2 )
nlsList(price ~ SSlogis(carat, Asym, xmid, scal), data = diamonds2_grp )

# Call:
#   Model: price ~ SSlogis(carat, Asym, xmid, scal) | grp 
#    Data: diamonds2_grp 
# 
# Coefficients:
#                 Asym     xmid      scal
# Fair_E      16565.84 1.409934 0.3833443
# Fair_D      16928.32 1.410986 0.4113035
# Fair_F      13905.28 1.335952 0.3877184
# Good_E      15894.55 1.253196 0.3245564
# Fair_I      17427.69 1.783398 0.5071487
# Good_J      17233.34 1.676204 0.4604250
# ...

Answer 2

Вы можете изменить свою функцию, чтобы включить сгруппированные данные для каждого подмножества

library(tidyverse)
library(nlme)

fit_mod <- function(df) {  
  diamonds_grouped <- groupedData(price ~ carat | cut, data = df)
  nlsList(price ~ SSlogis(carat, Asym, xmid, scal), data = diamonds_grouped)
} 

а затем разделите данные и примените fit_mod для каждого подмножества

diamonds %>% group_split(cut, color) %>%  map(fit_mod)

#[[1]]
#Call:
#  Model: price ~ SSlogis(carat, Asym, xmid, scal) | cut 
#   Data: diamonds_grouped 

#Coefficients:
#         Asym     xmid      scal
#Fair 16928.32 1.410986 0.4113035

#Degrees of freedom: 163 total; 160 residual
#Residual standard error: 1449.725

#[[2]]
#Call:
#  Model: price ~ SSlogis(carat, Asym, xmid, scal) | cut 
#   Data: diamonds_grouped 

#Coefficients:
#         Asym     xmid      scal
#Fair 16565.84 1.409934 0.3833443

#Degrees of freedom: 224 total; 221 residual
#Residual standard error: 1175.058
#.....
#.....

Также я думаю, вы не можете подать заявку tidy функция модели класса nlsList.