2017-08-30 5 views
1

Je cherche à transformer une liste d'événements de début et fin des jours à un vecteur d'états, où tous les jours entre le début et la fin est un 1, et est à l'extérieur 0 (par exemple 2,4 -> c (0,1,1,1,0,0))Transformer début de l'événement et se termine à des vecteurs d'état dans R

Chaque sujet (par id calée) peut potentiellement avoir plusieurs dates de début et de fin, dans des lignes différentes, qui doivent être combinés . J'ai une solution qui s'appuie lourdement sur lapplication (j'ai accès à un superordinateur si nécessaire, donc je pourrais passer à mclapply), mais je préférerais que les choses soient vectorisées autant que possible, car les données d'entrée sont potentiellement grand (~ 250 Mo).

Quelqu'un peut-il voir un moyen pour réduire les étapes ici?

require(data.table) 

#The days that will be assessed for state 
period = as.integer(1:8) 
#Indices for days (they are not necessarily sequential) 
dayInds = as.integer(1:length(period)) 

#Events for same ID will never overlap 
dt = data.table(id = c("a","a","b","c","d","d","e"), 
       start = c(1,6,3,3,3,5,5), 
       end = c(4,7,6,7,4,6,5)) 

# setkeyv(dt,colnames(dt)) 
setkeyv(dt,c("start","end")) 

#Setup output table 
stateData = data.table(id = dt$id) 
#Remove "-" from days before index, they could get confusing, and initialise 
#columns with zero 
dayStrings = paste("d",gsub("-", "m", period),sep="") 
stateData[,(dayStrings) := 0L] 

#Find whether there is an overlap between a specified day in period and a 
#subject's events 
getStateOnDay = function(dayInd) { 
    #Get day 
    day = period[dayInd] 
    #Create a table with the same number of rows as input dt, with a one day long 
    #event on the input day 
    overlapDays = unlist(foverlaps(data.table(start = day,end = day), 
           dt, 
           which=TRUE, 
           nomatch = 0L)$yid) 
    #Set those days to 1 in the state table 
    set(stateData,overlapDays,dayInd+1L,1L) 

} 

#Get states for each row 
lapply(dayInds,getStateOnDay) 


#Create table for data with one row for each unique ID 
reducedStateData = data.table(id = unique(stateData$id)) 
reducedStateData[,(dayStrings) := 0L] 

#Sum a vector of logicals using OR 
orSum = function(inputVec) { 
    return(Reduce("|", c(inputVec))) 
} 

#Function for finding for each ID if they were in the state on a given day 
reduceStatesByID = function(dayInd) { 
    set(reducedStateData, 
     NULL, 
     dayInd+1L, 
     stateData[,c(1,dayInd+1),with=FALSE][,as.integer(lapply(.SD, orSum)), by=id][,V1]) 
    return(NA) 
} 

#Apply reduction and sort 
lapply(dayInds,reduceStatesByID) 
setkey(reducedStateData,id) 
+0

Donc, pour couper à la chasse ici, vous avez '' dt' et reducedStateData' est votre résultat final que vous voulez? – thelatemail

+0

@thelatemail oui, désolé aurait dû faire clair – Matt

Répondre

4

est ici une tentative en utilisant Map et une séquence, puis dcast -El à un grand format:

dcast(
    dt[, .(d=unlist(Map(seq, start, end)), val=1), by=id], 
    id ~ d, value.var="val", fun.aggregate=sum, na.rm=TRUE 
) 

# id 1 2 3 4 5 6 7 
#1: a 1 1 1 1 0 1 1 
#2: b 0 0 1 1 1 1 0 
#3: c 0 0 1 1 1 1 1 
#4: d 0 0 1 1 1 1 0 
#5: e 0 0 0 0 1 0 0 

@ suggestion de Frank dans les commentaires semble plus rapide, probablement en raison principalement d'éviter la by=:

dt[ 
    , .(t = unlist(L <- Map(seq, start, end)), id = rep(id, lengths(L))) 
    ][, dcast(.SD, id ~ t, fun.agg = length)] 
+2

Ou 'dt [,. (T = unlist (L <- Map (seq, début, fin)), id = rep (id, longueurs (L)))] [ , dcast (.SD, id ~ t, fun.agg = longueur)] ', omettant le groupement. Puis, de nouveau, OP dit que «lapply» les ralentit, donc c'est peut-être une pire idée. – Frank

+2

@Frank - il est certainement code plus court si rien d'autre! Il y a probablement une variation plus efficace, sans aucun doute. – thelatemail

+1

@Frank Wow, c'est ridicule! Merci à tous les deux, on dirait que j'ai un peu de travail à faire pour comprendre comment tout cela fonctionne! – Matt

2

Voici une méthode utilisant la fonction set extrêmement efficace de data.table après la construction d'une date vide a.table avec les dimensions correctes (res), ainsi que la correspondance entre les lignes de la matrice d'origine et la lignes de la nouvelle matrice (resRows).

# construct empty data.table (ids and appropriate number of variables with 0s) 
res <- data.table(id=unique(dt$id), matrix(0L, dt[, uniqueN(id)], max(dt$end))) 

# get values for rows from id variable for placement into final data.table 
resRows <- dt[, cumsum(rowid(id) == 1L)] 

# fill in appropriate elements in data.table with 1s using set 
for(i in seq_along(resRows)) set(res, resRows[i], dt[i, seq(start, end)] + 1L, 1L) 

Ce retour

res 
    id V1 V2 V3 V4 V5 V6 V7 
1: a 1 1 1 1 0 1 1 
2: b 0 0 1 1 1 1 0 
3: c 0 0 1 1 1 1 1 
4: d 0 0 1 1 1 1 0 
5: e 0 0 0 0 1 0 0