R 宽数据在事件之前和事件中得分

Question

我拥有的样本数据。

DF <- data.frame(
ID =c(1,2,3,4,5,6),
YEAR1 =c(2003,2005,2007,2008,2011,NA),
TEST1 =c(0,0,0,0,0,NA),
DROP1 =c(0,0,0,0,0,NA),
YEAR2 =c(2005,2007,2009,2010,2013,2011),
TEST2 =c(1,0,0,0,0,NA),
DROP2 =c(1,0,0,1,0,0),
YEAR3 =c(2007,2009,2011,2012,2015,2014),
TEST3 =c(NA,1,1,NA,1,0),
DROP3 =c(NA,0,0,NA,0,0),
YEAR4 =c(2009,2012,2013,2014,2017,2016),
TEST4 =c(NA,NA,1,NA,0,0),
DROP4 =c(NA,1,0,NA,0,0))

我想要相同的数据

DF_NEW <- data.frame(
A=c(1,2,3,4,5,6),
B=c(1,1,1,0,1,0),
C=c(1,1,1,1,0,0),
D=c(2003,2005,2007,2008,2011,2011),
E=c(2003,2007,2009,2010,2013,2016),
F=c(2005,2009,2011,2010,2015,2016),
G=c(2005,2012,2013,2010,2017,2016))

对于这个数据：

A = 学生证

如果学生的“TEST”分数为 1，则 B = 1。如果没有，则为 0。

如果学生的“DROP”分数为 1，则 C = 1。如果没有，则为 0。

D = 报告的学生第一年。

E = 如果学生在第 N 年获得“TEST”的第一个分数 = 1，则 E 等于 年[N-1]。实际上不是从 YEAR 中减去 1，而是取学生获得第一个“TEST”= 1 分数之前报告的年份。如果学生从未获得“TEST”= 1 的分数，则 E 等于最近（最后一个）YEAR报告。

F = 年级学生的第一个分数'TEST' = 1。如果学生从未获得'TEST' = 1 的分数，那么它是最近（最后）一年。

G = 年级学生的第一个分数“DROP”= 1。如果学生从未获得“DROP”= 1 的分数，那么它是最近（最后一个）YEAR。

我做了很多尝试，包括 dplyr 包，但我想知道如何正确有效地进行这项工作。专门创建'E'

这是我目前所拥有的：

DF$A <- DF$ID DF$B <- apply(DF[,c("TEST1","TEST2","TEST3","TEST4")],1,max) 
DF$B[is.na(DF$B)] <- 0 
DF$C <-apply(DF[,c("DROP1","DROP2","DROP3","DROP4")],1,max)
DF$C[is.na(DF$C)] <- 0 
DF$D <- apply(DF[,c("YEAR1","YEAR2","YEAR3","YEAR4")],1,min) 

Answer 1

这是一个带有data.table包的方法

library(data.table)
library(stringi)
dt <- as.data.table(DF)
# convert from wide to long
ldt <- melt(dt, id.vars = "ID")
# split out variable from time indication
ldt[, time_id := as.integer(stringi::stri_extract_first_regex(variable, "\\d*$"))]
ldt[, variable2 := stringi::stri_replace_all_regex(variable, "\\d*$", "")]

# functions for E,F,G
getE <- function(var, val, time){
  w <- time[var=="TEST"][which(val[var == "TEST"] == 1)]
  if(length(w) > 0){
    t <- max(1, min(w)-1)
  }else{
    t <- max(time[var=="TEST" & !is.na(val)])
  }
  out <- val[time == t & var == "YEAR"]
  out
}
getFG <- function(var, val, col="TEST"){
  x <- val[var=="YEAR"]
  y <- val[var==col]
  w <- which(y==1)
  if(length(w)==0){
    w <- which(x == max(x[!is.na(y)]))
  }else{
    w <- min(w, na.rm=TRUE)
  }
  out <- x[w]
  out
}

# data.table aggreggation method
out <- ldt[, .(
  B = as.integer(any(value[variable2 == "TEST"] == 1, na.rm=TRUE))
  , C = as.integer(any(value[variable2 == "DROP"] == 1, na.rm=TRUE))
  , D = min(value[variable2 == "YEAR"], na.rm=TRUE)
  , E = getE(variable2, value, time_id)
  , F = getFG(variable2, value, "TEST")
  , G = getFG(variable2, value, "DROP")
), by = .(A=ID)]

# back to data.frame
out <- as.data.frame(out)
out

# test
# is C[3] correct?
out == DF_NEW