Ошибка использования 'сегментированного' с извлечением lm из вывода tidyverse 'map' в R

Question

Я использую пакет 'segmented', чтобы найти точки разрыва в линейных регрессиях в R

library(tidyverse)
library(segmented)

df <- data.frame(x = c(1:10), y = c(1,1,1,1,1,6:10))
lm_model <- lm(y ~ x, data = df)
seg_model <- segmented(obj = lm_model, seg.Z = ~ x)

Но если я запускаю ту же модель в рамках системы purrr: map, сегментированная ошибка завершается.

map_test <- df %>% 
  nest() %>%
  mutate(map_lm = map(data, ~lm(y ~ x, data = .)),
         param_map_lm = map(map_lm, tidy))

map_lm_model <- map_test[[2]][[1]]

map_seg_model <- segmented(obj = map_lm_model, seg.Z = ~ x)

"Ошибка в is.data.frame (data): объект '.'not found "

При получении lm obj из lm, извлеченного из выходных данных карты, сегментированным не удается найти базовые данные.

Однако два объекта линейной модели выглядят идентичными.

Что мне на самом деле нужно, так это более полезная карта для запуска lm на нескольких подмножествах фрейма данных, а затем запускается «сегментированный» для полученного lm.

Answer 1

Это, в основном, та же проблема, что и взаимодействие между glm () и purrr :: map () .

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

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

# Composes a custom lm() expression and evaluates it
lm2 <- function(data, ...)
    eval( rlang::expr(lm(data=!!rlang::enexpr(data), !!!list(...))) )

# Now mapping using lm2, instead of lm
map_test <- nest(df, data=everything()) %>% 
    mutate(map_lm       = map(data, lm2, y ~ x),
           param_map_lm = map(map_lm, broom::tidy))

# The data is stored directly inside the lm object
# segmented() now has no problems accessing it
map_lm_model <- map_test[[2]][[1]]
map_seg_model <- segmented(obj = map_lm_model, seg.Z = ~ x)
# Call: segmented.lm(obj = map_lm_model, seg.Z = ~x)
# 
# Meaningful coefficients of the linear terms:
# (Intercept)            x         U1.x  
#   1.000e+00    6.344e-15    1.607e+00  
# 
# Estimated Break-Point(s):
# psi1.x  
#  3.889  

или как один mutate() цепь:

map_test <- nest(df, data=everything()) %>% 
    mutate(map_lm       = map(data, lm2, y ~ x),
           param_map_lm = map(map_lm, broom::tidy),
           seg_lm       = map(map_lm, segmented, seg.Z=~x))
# # A tibble: 1 x 4
#             data map_lm param_map_lm     seg_lm    
#   <list<df[,2]>> <list> <list>           <list>    
# 1       [10 × 2] <lm>   <tibble [2 × 5]> <segmentd>