Запустите `dlply` с другой функцией для некоторых подмножеств данных в` R` - PullRequest
Новая
       4

Запустите `dlply` с другой функцией для некоторых подмножеств данных в` R`

1 голос
/ 24 января 2020

У меня есть большие данные, некоторые из которых соответствуют модели роста логистики c, а некоторые - модели экспоненциального роста. Мне удалось успешно рассчитать параметры регрессии NLS на основе моего кода dlply, чтобы рассчитать параметры для каждого подмножества моих данных на основе трех факторов, которые могут принимать несколько значений. Однако я хотел бы добавить ограничение на использование одной формы nls для некоторых наборов факторов, определенных другой переменной, а другой - для остальных. Я думал, что смогу использовать форму if … else, но она, похоже, не работает.

Мне бы очень хотелось получить ответ, используя конкретно dlply. Если невозможно использовать dlply, это было бы полезно знать.

Вот фиктивный набор для иллюстрации того, что я хотел бы сделать: 

> library(plyr)
> data(iris) iris$form<-"b" iris[iris$Species=="setosa",]$form<-"a"
> diris<-dlply(iris, as.quoted(.(Species)),
>         function(x){
>           if(x$form=="a"){
>           mean(x$Sepal.Length)
>           }else{
>             median(x$Sepal.Length)
>           }
>         })

, разбив его на две разные функции dlply работают, но я бы предпочел все это аккуратно: 

diris_mean<-dlply(iris[iris$form=="a",], as.quoted(.(Species)),
             function(x){
                 mean(x$Sepal.Length)
               }
             )

diris_med<-dlply(iris[iris$form!="a",], as.quoted(.(Species)),
                  function(x){
                    median(x$Sepal.Length)
                  }
)

ОБНОВЛЕНИЕ: Кажется, мой фиктивный пример был слишком прост, чтобы передать то, что мне нужно. Я не понимаю, как summarise или mutate работает (из опубликованного ответа), чтобы иметь возможность переводить на мою функцию. Вот функция, которую я использую: 

NLmodels <- dlply(cum[form=="logistic growth",], as.quoted(.(region, climate, size)), 
                  function(x)   {
                    essai=try(logis<-nls(freq~1/(1+b*exp(-(c*mid_point))),
                                         start=list(b=170,c=0.1),data=x,control=list(maxiter=200),trace=FALSE))

                    #if the nls was successful, then calculate values
                    if(class(essai)!="try-error"){
                      nls_values<-summary(nls(x$freq~1/(1+b*exp(-(c*mid_point))),
                                              start=list(b=170,c=0.1),
                                              data=x, control=list(maxiter=200)))$parameters
                    }else {
                      print("error")
                    }
                  }
                  )

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

data(mtcars)
mtcars$a_cat<-rep(c("a", "b", "c", "d"), each=8)
mtcars$b_cat<-rep(c("a", "b"), each=16)


mtcars_A<-dlply(mtcars[mtcars$b_cat=="a",], as.quoted(.(a_cat)),
                  function(x){
                    values<-summary(lm(mpg~hp, data=x))$coefficients[,1]
                  }
                  )

1 Ответ

1 голос
/ 24 января 2020

Мы можем использовать dplyr. После разбиения по видам «form» на list data.frame, от l oop до list с map, проверьте, что if first элемент столбца 'form' равен 'a ', затем создайте новый столбец как mean из Sepal.Length или else, возвращающий median (map_dfr - возвращает один элемент data.frame для привязки строки) 

library(dplyr)
library(purrr)
iris %>% 
  group_split(Species, form) %>% 
  map_dfr(~ if(first(.x$form) == 'a') {
    .x %>% mutate(new = mean(Sepal.Length)) }
  else {.x %>% mutate(new = median(Sepal.Length))})

Для нового примера на основе регрессии, 

map_dfr(c('a_cat', 'b_cat'), ~
     mtcars %>% 
         group_by_at(.x) %>% 
         summarise(Coef = lm(mpg  ~hp)$coefficients[1]))

Или 

map_dfr(c('a_cat', 'b_cat'), ~ 
        mtcars %>% 
           group_by_at(.x) %>% 
           do(data.frame(Coef = lm(mpg ~ hp, data = .)$coefficients[1])))
...