Мурлыкает несколько методов регрессии на графике [данные включены] - PullRequest
Новая
       90

Мурлыкает несколько методов регрессии на графике [данные включены]

1 голос
/ 21 апреля 2020

TL; DR [

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

x nls находит несколько возможных data и не может вычислить geom_smooth - ошибка tidyeval?

x Я не уверен, как использовать пользовательскую функцию с map2.

]

Пример моего фрейма данных, train.data, прикрепляется в виде dput вывода в конце сообщения.

Я разделил свои данные на тестовый набор (20%) и тренировочный набор (80%). Ранее я вычислял сводки для линейных и нелинейных моделей и строил график с прогнозируемыми значениями в сравнении с расчетными значениями. Но мне нужен график с кривой для оценочных моделей (линейных и нелинейных), и если я правильно понял, ggplot2 должен прийти к тому же выводу, что и nls и lm? Тидверсивный способ включить смещение (то же самое для всех наблюдений) в таблицу, а не в data.frame, будет очень кстати.

Во-первых, создание функции построения графика для сопоставления. NLS красный, LM синий. 

double_mapper <- function(x, colname) {
  ggplot(data = x, aes(x=dia, y=Height)) + 
  geom_point(shape=1) + 
  ggtitle(label = colname)+
  theme_bw() +
  theme(legend.title=element_blank(), axis.title = element_blank())+
  geom_smooth(method="nls",
              formula= Height ~ -1 +I(dia^2)/I((a+b*dia)^2),
              method.args = list(offset=offset, 
                                 start = list(a=10, b=0.2), #Earlier study solution
                                 se=F),
              color="red")+
  geom_smooth(method="lm",
              formula= Height ~ -1 + dia,
              method.args= list(offset=offset),
              color="blue"
  )
}

Создайте столбик с вложенными видами и создайте график для каждого. 

mixed_df_test <- train.data %>%
  group_by(SPP) %>%
  nest() %>% 
  mutate(graphs=map2(.x = data,.y = SPP, partial(double_mapper,
                                                 x= .x,
                                                 colname=.y)))

plots_model_mixed <- ggpubr::ggarrange(plotlist = mixed_df_test$graphs, common.legend=TRUE,legend = "top",ncol = 2,nrow = 4)

Сообщения об ошибках :

от map2

Error in (function (x, colname)  : unused arguments (.x[[1]], .y[[1]])

от nls

Warning messages:
1: Computation failed in `stat_smooth()`:
parameters without starting value in 'data': Height, dia

dpt для train.data : 

structure(list(SPP = c("Abies sibirica", "Abies sibirica", "Abies sibirica", 
"Abies sibirica", "Abies sibirica", "Pinus sylvestris", "Pinus sylvestris", 
"Pinus sylvestris", "Pinus sylvestris", "Pinus sylvestris"), 
    Height = c(6, 7.6, 9.9, 6.2, 8.1, 8.3, 7.7, 8.2, 7.8, 9.6
    ), dia = c(74.4580418759451, 96.2808392152873, 115.995689575087, 
    84.4985206971104, 104.498803820905, 141.492049246592, 151.459565561241, 
    177.997190989072, 190.499343830891, 152), offset = c(1.3, 
    1.3, 1.3, 1.3, 1.3, 1.3, 1.3, 1.3, 1.3, 1.3)), row.names = c(NA, 
-10L), class = c("grouped_df", "tbl_df", "tbl", "data.frame"), groups = structure(list(
    SPP = c("Abies sibirica", "Pinus sylvestris"), .rows = list(
        1:5, 6:10)), row.names = c(NA, -2L), class = c("tbl_df", 
"tbl", "data.frame"), .drop = TRUE))

1 Ответ

2 голосов
/ 21 апреля 2020

В исходном коде было несколько проблем.

1) Вам потребовалось ~ перед partial. На самом деле, вам не нужно частичное в этом примере.

2) В формуле geom_smooth вы должны использовать x и y вместо имен исходных переменных.

3) Вы должны указать ggplot, куда найти offset

4) se - аргумент для geom_smooth, а не одного из method.args

double_mapper <- function(x, colname) {
  ggplot(data = x, aes(x=dia, y=Height)) + 
    geom_point(shape=1) + 
    ggtitle(label = colname)+
    theme_bw() +
    theme(legend.title=element_blank(), axis.title = element_blank())+
     geom_smooth(method="nls",
                 formula = y ~ -1 +I(x^2)/I((a+b*x)^2),
                 method.args = list(offset=x$offset, 
                                    start = list(a=10, b=0.2)), #Earlier study solution
                se = FALSE,
                color="red") +
    geom_smooth(method="lm",
                formula= y ~ -1 + x,
                method.args= list(offset=x$offset),
                color="blue"
    )
}


mixed_df_test <- train.data %>%
  group_by(SPP) %>%
  nest() %>% 
  mutate(graphs=map2(.x = data,.y = SPP, ~double_mapper(
                                                 x= .x,
                                                 colname=.y)))

plots_model_mixed <- ggpubr::ggarrange(plotlist = mixed_df_test$graphs, common.legend=TRUE,legend = "top",ncol = 2,nrow = 4)
plots_model_mixed

Я совершенно уверен, что вы могли бы использовать фасеты, а не несколько графиков - это сделает код намного проще. Хотя я не уверен, как указать смещение (может быть, лучше подгонять модели вне графика и предоставлять подогнанные значения в data.frame.

Если фасеты не работают, посмотрите в пакете patchwork для простого объединения участков.

...