Оптимизация комплексного преобразования данных в R

Question

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

Данные, которые у меня есть, выглядят так:

scores<-as.data.frame(cbind(c(1,2,3,3,1,2,3,1,2,1,2,3),c(5,5,5,5,6,6,6,7,7,8,8,8),
c(0,1,1,1,1,0,1,.5,"fickle",1,2.2,1),c(1,1,1,2,1,1,1,1,1,1,1,1)))
names(dat)<-c("name","question_id","correct","attempt")
ids<-c(5,7,8)

Я хочу создать матрица studentXquestion, которая показывает их итоговую оценку за попытку по каждому вопросу, включенному в вектор идентификаторов. Также будет указано NA, если учащийся не завершил этот вопрос, или 99, если в «правильном» столбце появится какое-либо значение, отличное от 0 или 1, поскольку некоторые данные немного уродливы.

Ниже приведен код До сих пор у меня есть.

students<-unique(scores$name)
finaldat<-data.frame(matrix(ncol=length(ids),nrow=length(unique(students))))

for(i in 1:length(students)){
  for(j in 1:length(ids)){
    attempts<-which(scores$question_id==ids[j] &
                        scores$name==students[i])
    if(length(attempts)==0){finaldat[i,j]<-NA}
    else{
    last.score<-as.numeric(scores$correct[attempts[which(attempts==length(attempts))]])
     finaldat[i,j]<-99
      if(length(last.score)==0){finaldat[i,j]<-NA}
      else{if(last.score==0 | last.score==1){
        finaldat[i,j]<-last.score
      }
      }
    }
  }
}        

finaldat 

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

Таким образом, выходные данные будут:

cbind(c(0,1,1),c(99,99,NA),c(1,99,1))

Мы можем видеть, что вопрос 6 был исключен, и все недвоичные данные были преобразованы в 99, пропущенные значения являются НС, и только последние попытки были сохранены.

Answer 1

Вот версия с использованием dplyr и tidyr.

library(dplyr)
library(tidyr)

scores <- data.frame(name        = c(1, 2, 3, 3, 1, 2, 3, 1, 2, 1, 2, 3),
                     question_id = c(5, 5, 5, 5, 6, 6, 6, 7, 7, 8, 8, 8),
                     correct     = c(0, 1, 1, 1, 1, 0, 1, .5 , "fickle", 1, 2.2, 1),
                     attempt     = c(1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1),
                     stringsAsFactors = FALSE)

result <- scores %>%
  group_by(name, question_id) %>% 
  filter(attempt == max(as.numeric(as.character(attempt)))) %>% 
  mutate(correct = if(correct != "1" && correct != "0") "99" else correct) %>%
  select(name, question_id, correct) %>%
  ungroup() %>%
  pivot_wider(names_from = question_id, values_from = correct)

result
#> # A tibble: 3 x 5
#>    name `5`   `6`   `7`   `8`  
#>   <dbl> <chr> <chr> <chr> <chr>
#> 1     1 0     1     99    1    
#> 2     2 1     0     99    99   
#> 3     3 1     1     <NA>  1  

Answer 2

Просто чтобы добавить другое решение, я уже работал над

library(data.table)
library(dplyr)
library(forcats)

dt.scores <- data.table(scores)

dt.scores[, correct := as.integer(as.character(fct_other(correct, keep = c("0", "1"), other_level = "99"))) ]
dt.scores[, attempt := as.integer(as.character(attempt)) ]

dt.scores[,.(name, question_id, correct)] %>% pivot_wider(data = . , names_from = question_id, values_from = correct, values_fn = list(correct = max))