Как запустить код glm для разных подмножеств в фрейме данных и создать новый столбец с извлеченными значениями? - PullRequest
Новая
       71

Как запустить код glm для разных подмножеств в фрейме данных и создать новый столбец с извлеченными значениями?

0 голосов
/ 19 июня 2020

У меня есть этот фрагмент кода, который запускает glm, который используется для генерации «средней точки» ответов субъекта [закодированных как trochiac / iambi c, 0 или 1] на список числовых c стимулов , сохраняет среднюю точку как значение и выводит значение в консоль. 

glm.1 <- glm(coderesponse~stimulus, family = binomial(link="logit"), data=data)
midpoint <- -glm.1$coefficients[1]/glm.1$coefficients[2]
cat(sprintf("file : %s\nmidpoint : %.2f",datafile,midpoint))

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

например, для каждого предмета я хотел бы сгенерировать значение средней точки для каждого блока (1-8) внутри каждого типа стимула «bd», «nm» и «nm». Это значение средней точки будет новым значением во вновь созданном столбце для всех строк для каждого блока в пределах каждого типа стимулятора. значение (вместо того, чтобы сохранять все строки с одним и тем же значением).

небольшая фиктивная версия моего основного фрейма данных (включает только одну тему и стимулы до 6): 

subject <- c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2)
stimulus <- c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 1, 1, 1, 1, 1, 1)
block <- c(3, 3, 3, 7, 7, 7, 4, 4, 4, 8, 8, 8, 1, 1, 1, 5, 5, 5, 2, 2, 2, 6, 6, 6, 3, 3, 3, 7, 7, 7, 4, 4, 4, 8, 8, 8, 2, 2, 2, 6, 6, 6)
blockprocedure <- c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1)
stimtype <- c('bd', 'nd', 'nm', 'bd', 'nd', 'nm', 'bd', 'nd', 'nm', 'bd', 'nd', 'nm', 'bd', 'nd', 'nm', 'bd', 'nd', 'nm', 'bd', 'nd', 'nm', 'bd', 'nd', 'nm', 'bd', 'nd', 'nm', 'bd', 'nd', 'nm', 'bd', 'nd', 'nm', 'bd', 'nd', 'nm', 'bd', 'nd', 'nm', 'bd', 'nd', 'nm')
blocktype <- c('mouth', 'mouth', 'mouth', 'nose', 'nose', 'nose', 'mouth', 'mouth', 'mouth', 'nose', 'nose', 'nose', 'mouth', 'mouth', 'mouth', 'nose', 'nose', 'nose', 'mouth', 'mouth', 'mouth', 'nose', 'nose', 'nose', 'mouth', 'mouth', 'mouth', 'nose', 'nose', 'nose', 'mouth', 'mouth', 'mouth', 'nose', 'nose', 'nose', 'mouth', 'mouth', 'mouth', 'nose', 'nose', 'nose')
coderesponse <- c(1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1)

dummy = data.frame(subject, stimulus, block, stimtype, blockprocedure, blocktype, coderesponse)

Сначала я попробовал, но, очевидно, это не способ go ...: 

dummy <- data %>% 
  group_by(subject, stimtype, block)
dummy$test <- NA

glm.1 <- glm(coderesponse~stimulus, family = binomial(link="logit"), data=dummy)
midpoint <- -glm.1$coefficients[1]/glm.1$coefficients[2]
dummy$test <- midpoint

Я новичок в программировании, поэтому надеюсь, что все это имеет смысл! Спасибо за любую помощь / понимание!

1 Ответ

1 голос
/ 19 июня 2020

Я думаю, что это хорошее место для использования комбинации tidyr::nest и purrr::map.

Действительно, как говорит ?nest: «Вложенность часто бывает полезна для создания групповых моделей».

Вот код: 

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

get_midpoint = function(data){
  glm.1 = glm(coderesponse~stimulus, family = binomial(link="logit"), data=data)
  rtn = -glm.1$coefficients[1]/glm.1$coefficients[2]
  rtn
}

dummy %>% 
  nest(data=-c(subject, stimtype, block)) %>%
  mutate(midpoint=map_dbl(data, get_midpoint))

# A tibble: 30 x 5
   subject block stimtype data             midpoint
     <dbl> <dbl> <fct>    <list>              <dbl>
 1       1     3 bd       <tibble [2 x 4]> -1.69e11
 2       1     3 nd       <tibble [2 x 4]> -1.69e11
 3       1     3 nm       <tibble [2 x 4]> -1.69e11
 4       1     7 bd       <tibble [2 x 4]>  3.00e 0
 5       1     7 nd       <tibble [2 x 4]> -1.69e11
 6       1     7 nm       <tibble [2 x 4]> -1.69e11
 7       1     4 bd       <tibble [2 x 4]>  4.00e 0
 8       1     4 nd       <tibble [2 x 4]>  4.00e 0
 9       1     4 nm       <tibble [2 x 4]> -1.96e11
10       1     8 bd       <tibble [2 x 4]>  4.00e 0

Здесь вы можете nest все столбцы, кроме c(subject, stimtype, block), в столбце с именем data. Затем вы можете map вокруг этого столбца, чтобы применить пользовательскую функцию. Поскольку ваша функция возвращает double, я использовал map_dbl.

EDIT

Вы также можете использовать summarize: 

dummy %>% 
  group_by(subject, stimtype, block) %>% 
  summarise(midpoint = get_midpoint(tibble(coderesponse, stimulus)))

Это выводит тот же результат (в другом порядке хотя).

...