Используйте purrr::map для применения нескольких аргументов к функции.

У меня есть такой фрейм данных

   df <- data.frame(tiny = rep(letters[1:3], 20), 
                  block = rnorm(60), tray = runif(60, min=0.4, max=2),
                  indent = sample(0.5:2.0, 60, replace = TRUE))

Я вложил этот фрейм данных

nm <- df%>%
       group_by(tiny)%>%
       nest()

затем написал эти функции

library(dplyr)
library(purrr)
library(tidyr)

model <- function(dfr, x, y){
             lm(y~x, data = dfr)
         }

model1 <- function(dfr){
           lm(block~tray, data = dfr)
          }

Я хочу запустить эту модель для всех крошечных классов, поэтому я сделал

 nm%>%
   mutate(
     mod = data %>% map(model1)
   )

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

 nm%>%
    mutate(mod = data %>% map(model(x=tray, y=block)))

Я продолжаю получать ошибку Error in mode(x = tray, y = block) : unused argument (y = block).

Также я попытался построить их, используя ggplot2

plot <- function(dfr, i){
    dfr %>%
    ggplot(., aes(x=tray, y=block))+
geom_point()+
xlab("Soil Properties")+ylab("Slope Coefficient")+
ggtitle(nm$tiny[i])

nm%>%
 mutate(put = data %>% map(plot))

идея состоит в том, что я хочу, чтобы ggplot поместил заголовки a, b и c для каждого из графиков, которые будут созданы. Любая помощь будет принята с благодарностью. Спасибо


r ggplot2 dplyr purrr magrittr
person Kay    schedule 28.02.2017    source источник
comment
не похоже, что model1() определено для любых параметров   -  person Nate    schedule 28.02.2017
comment
@PierreLafortune, это не сработало. У меня ошибка Error: is.data.frame(.data) || is.list(.data) || is.environment(.data) is not TRUE   -  person Kay    schedule 01.03.2017
comment
однажды вы, детишки, перестанете пытаться все продублировать   -  person Pierre L    schedule 01.03.2017

Ответы (2)


arrow_upward
7
arrow_downward

используйте базовую функцию split для разделения данных на список групп.

library( purrr )
library( ggplot2 )
df %>% 
  split( .$tiny) %>%
  map(~ lm( block ~ tray, data = .))

df %>% 
  split( .$tiny) %>%
  map(~ ggplot( data = ., aes( x = tray, y = block ) ) +
        geom_point( ) +
        xlab("Soil Properties") + 
        ylab("Slope Coefficient") +
        ggtitle( as.character( unique(.$tiny) ) ) )

Использование функций:

lm_model <- function( data ) 
{
  return( lm( block ~ tray, data = data ) )
}

plot_fun <- function( data )
{
  p <- ggplot( data = data, aes( x = tray, y = block ) ) +
    geom_point( ) +
    xlab("Soil Properties") + 
    ylab("Slope Coefficient") +
    ggtitle( as.character( unique(data$tiny) ) )

  return( p )
}

df %>% 
  split( .$tiny) %>%
  map(~ lm_model( data = . ) )

df %>% 
  split( .$tiny) %>%
  map(~ plot_fun( data = . ) )

Создание формулы внутри функции

lm_model <- function( data, x, y ) 
{
  form <- reformulate( y, x )

  return( lm( formula = form, data = data ) )
}

df %>% 
  split( .$tiny) %>%
  map(~ lm_model( data = ., x = 'tray', y = 'block' ) )

Ваше решение сработало бы, если бы ваша функция была сформулирована, как показано ниже.

model <- function(dfr, x, y){
  lm( formula = eval(parse(text = paste('as.formula( ', y, ' ~ ', x, ')', sep = ''))),
      data = dfr)
}
person Sathish    schedule 28.02.2017
comment
это работает как пример модели, который я дал в своем вопросе. Я получаю, чтобы узнать другой способ сделать это, и это потрясающе. тем не менее, я хочу иметь возможность использовать функцию и предоставлять любые аргументы, которые я хочу использовать для функции, используя map. - person Kay; 01.03.2017
comment
Вы ответили на часть. Могу ли я в вашей функции lm_model изменить block и tray и предоставить их в качестве аргументов функции? Как это сделать? - person Kay; 01.03.2017
comment
Да. поэтому в этом случае я бы передал кадр данных, переменную x и переменные y в функцию lm_model и оценил с помощью функции map - person Kay; 01.03.2017
comment
Ваше решение работает отлично. Я не понимаю, почему df%>%group_by(tiny)%>%mutate(mod = data %>%map(lm_model(x='tray', y='block', data=.))) не работает. - person Kay; 01.03.2017
comment
внутри функции lm_model во второй строке поставьте print(form). Вы увидите волшебство. Для получения дополнительной информации, пожалуйста, прочитайте ?reformulate - person Sathish; 01.03.2017
comment
см. в конце, я добавил модификации к вашей функции, описанной в вопросе. Надеюсь это поможет - person Sathish; 01.03.2017
comment
используйте mutate, чтобы он добавил вывод модели в виде столбца в существующий df, и это ответило бы на мой вопрос. Хорошая работа, однако. - person Kay; 01.03.2017
comment
мне бы понравилось это - person Kay; 01.03.2017
comment
лучше вести его в виде списка, чтобы можно было получить сводку и другую статистику - person Sathish; 01.03.2017
comment
Если вы хотите прикрепить его к вашему фрейму данных, в R такая операция называется параметризацией фрейма данных. По сути, вы будете создавать pframes. Вместо присоединения выходных данных присоедините созданные вами функции, чтобы вы могли вызывать функции для своих данных для получения выходных данных, когда это необходимо. - person Sathish; 01.03.2017
comment
но это выходит за рамки этого вопроса - person Sathish; 01.03.2017
comment
Какое из этих решений вы имеете в виду df%>%group_by(tiny)%>%mutate(mod = data%>%map(model(x='tray', y='block', dfr=.))) или как вы использовали функцию мутации, пожалуйста - person Kay; 01.03.2017
comment
см., после применения модели карта вернет список. Вам просто нужна одна ячейка для ее хранения, а не весь столбец фрейма данных. - person Sathish; 01.03.2017
comment
что вы хотите сделать с выводом? - person Sathish; 01.03.2017
comment
Я хочу сохранить вывод в виде кадра данных, добавить модель в качестве нового столбца, извлечь оценки и затем использовать их на своих графиках. - person Kay; 01.03.2017

arrow_upward
3
arrow_downward

Если вы хотите использовать mutate с map, вам нужно также использовать tidyr для nest. Вы будете использовать таблички для хранения вывода (или фреймы данных со списками-столбцами фреймов данных).

Я использовал функции из подробного ответа @Sathish (с некоторыми изменениями).

library(purrr)
library(dplyr)
library(tidyr) 

df <- data.frame(tiny = rep(letters[1:3], 20), 
                 block = rnorm(60), tray = runif(60, min=0.4, max=2),
                 indent = sample(0.5:2.0, 60, replace = TRUE))

lm_model <- function( data ) 
{
  return( lm( block ~ tray, data = data ) )
}

# Altered function to include title parameter with purrr::map2
plot_fun <- function( data, title )
{
  p <- ggplot( data = data, aes( x = tray, y = block ) ) +
    geom_point( ) +
    xlab("Soil Properties") + 
    ylab("Slope Coefficient") +
    ggtitle( as.character( title ) )

  return( p )
}


results <- df %>% 
  group_by(tiny) %>% 
  nest() %>% 
  mutate(model = map(data, lm_model),
         plot = map2(data, tiny, plot_fun))

В итоге вы получите:

> results

# A tibble: 3 × 4
    tiny              data    model     plot
  <fctr>            <list>   <list>   <list>
1      a <tibble [20 × 3]> <S3: lm> <S3: gg>
2      b <tibble [20 × 3]> <S3: lm> <S3: gg>
3      c <tibble [20 × 3]> <S3: lm> <S3: gg>

И вы можете получить доступ к тому, что вам нужно, используя unnest или через извлечение ([ и [[)

> results$model[[1]]

Call:
lm(formula = block ~ tray, data = data)

Coefficients:
(Intercept)         tray  
    -0.3461       0.3998
person Jake Kaupp    schedule 01.03.2017
comment
Теперь я смог добавить заголовок к своим графикам. Спасибо - person Kay; 04.03.2017