Ottimizzazione: splitting dataframe in un elenco di dataframes, trasformazione dati per riga

Question

Preliminari: questa domanda è per lo più di valore educativo, il compito effettivo è completato, anche se l'approccio non è del tutto ottimale. La mia domanda è se il codice qui sotto può essere ottimizzato per la velocità e/o implementato in modo più elegante. Forse usando pacchetti aggiuntivi, come plyr o reshape. Esegui sui dati effettivi ci vogliono circa 140 secondi, molto più alti dei dati simulati, poiché alcune delle righe originali non contengono nient'altro che NA, e devono essere fatti ulteriori controlli. Per confrontare, i dati simulati vengono elaborati in circa 30 secondi.

Condizioni: l'insieme di dati contiene 360 ​​variabili, 30 volte il set di 12. Diamo un nome loro V1_1, V1_2 ... (prima serie), V2_1, V2_2 ... (secondo set) e così via. Ogni set di 12 variabili contiene risposte dicotomiche (sì/no), in pratica corrispondenti a uno stato di carriera. Ad esempio: lavoro (sì/no), studio (sì/no) e così via, in totale 12 stati, ripetuti 30 volte.

Compito: il compito è quello di ricodificare ogni set di 12 variabili dicotomiche in una singola variabile con 12 categorie di risposta (ad esempio lavoro, studio ...). In definitiva dovremmo ottenere 30 variabili, ciascuna con 12 categorie di risposta.

dati: non posso postare il set di dati reali, ma qui è una buona approssimazione simulato:

randomRow <- function() { 
    # make a row with a single 1 and some NA's 
    sample(x=c(rep(0,9),1,NA,NA),size=12,replace=F) 
} 

# create a data frame with 12 variables and 1500 cases 
makeDf <- function() { 
    data <- matrix(NA,ncol=12,nrow=1500) 
    for (i in 1:1500) { 
    data[i,] <- randomRow() 
    } 
    return(data) 
} 

mydata <- NULL 

# combine 30 of these dataframes horizontally 
for (i in 1:30) { 
    mydata <- cbind(mydata,makeDf()) 
} 
mydata <- as.data.frame(mydata) # example data ready 

mia soluzione:

# Divide the dataset into a list with 30 dataframes, each with 12 variables 
S1 <- lapply(1:30,function(i) { 
    Z <- rep(1:30,each=12) # define selection vector 
    mydata[Z==i]   # use selection vector to get groups of variables (x12) 
}) 

recodeDf <- function(df) { 
    result <- as.numeric(apply(df,1,function(x) { 
    if (any(!is.na(df))) which(x == 1) else NA # return the position of "1" per row 
    }))           # the if/else check is for the real data 
    return(result) 
} 
# Combine individual position vectors into a dataframe 
final.df <- as.data.frame(do.call(cbind,lapply(S1,recodeDf))) 

Tutto sommato, c'è un doppio * applica la funzione, una attraverso l'elenco, l'altra attraverso le righe del dataframe. Questo lo rende un po 'lento. Eventuali suggerimenti? Grazie in anticipo.

Answer 1

Mi piace molto l'idea di moltiplicazione di matrice di Arun @. È interessante notare che, se si compila R contro alcune librerie OpenBLAS, è possibile farlo funzionare in parallelo.

Tuttavia, ho voluto fornire con un'altra, forse più lento di moltiplicazione di matrici, una soluzione che utilizza il modello originale, ma è molto più veloce l'implementazione:

# Match is usually faster than which, because it only returns the first match 
# (and therefore won't fail on multiple matches) 
# It also neatly handles your *all NA* case 
recodeDf2 <- function(df) apply(df,1,match,x=1) 
# You can split your data.frame by column with split.default 
# (Using split on data.frame will split-by-row) 
S2<-split.default(mydata,rep(1:30,each=12)) 
final.df2<-lapply(S2,recodeDf2) 

Se si ha una grande cornice di dati e molti processori, si può considerare parallelizzazione questa operazione con:

library(parallel) 
final.df2<-mclapply(S2,recodeDf2,mc.cores=numcores) 
# Where numcores is your number of processors. 

---

letta @Arun e @mnel, ho imparato molto su come migliorare Thi s, evitando la coercizione su un array, elaborando lo data.frame per colonna anziché per riga. Non intendo "rubare" una risposta qui; OP dovrebbe prendere in considerazione il passaggio dalla casella di controllo alla risposta di @ mnel.

Volevo, tuttavia, condividere una soluzione che non utilizza data.table ed evita for. Tuttavia, è ancora più lento della soluzione di @ mnel, anche se leggermente.

nograpes2<-function(mydata) { 
    test<-function(df) { 
    l<-lapply(df,function(x) which(x==1)) 
    lens<-lapply(l,length) 
    rep.int(seq.int(l),times=lens)[order(unlist(l))] 
    } 
    S2<-split.default(mydata,rep(1:30,each=12)) 
    data.frame(lapply(S2,test)) 
} 

Vorrei anche aggiungere che l'approccio di @ Aaron, utilizzando which con arr.ind=TRUE sarebbe anche molto veloce ed elegante, se mydata iniziato come un matrix, piuttosto che un data.frame. La coercizione su un matrix è più lenta del resto della funzione. Se la velocità fosse un problema, varrebbe la pena considerare la lettura dei dati come matrice in primo luogo.

Answer 2

IIUC, hai solo uno 1 per 12 colonne. Hai il resto con 0 o NA. Se è così, l'operazione può essere eseguita molto più velocemente da questa idea.

L'idea: Invece di passare attraverso ogni riga e chiedere la posizione di 1, si potrebbe usare una matrice di dimensioni 1500 * 12 cui ogni riga è solo 1:12. Cioè:

mul.mat <- matrix(rep(1:12, nrow(DT)), ncol = 12, byrow=TRUE) 

Ora, è possibile moltiplicare questa matrice con ciascuno dei vostri subset'd data.frame (di stesse dimensioni, 1500 * 12 qui) e portarli loro "rowSums" (che è Vectorised) con na.rm = TRUE. Questo darà direttamente la riga in cui si ha 1 (perché quel 1 sarà stato moltiplicato per il corrispondente valore compreso tra 1 e 12).

---

data.table implementazione: Qui, userò data.table per illustrare l'idea. Dal momento che crea colonne per riferimento, mi aspetto che la stessa idea utilizzata su un data.frame sia un po 'più lenta, anche se dovrebbe velocizzare drasticamente il codice corrente.

require(data.table) 
DT <- data.table(mydata) 
ids <- seq(1, ncol(DT), by=12) 

# for multiplying with each subset and taking rowSums to get position of 1 
mul.mat <- matrix(rep(1:12, nrow(DT)), ncol = 12, byrow=TRUE) 

for (i in ids) { 
    sdcols <- i:(i+12-1) 
    # keep appending the new columns by reference to the original data 
    DT[, paste0("R", i %/% 12 + 1) := rowSums(.SD * mul.mat, 
        na.rm = TRUE), .SDcols = sdcols] 
} 
# delete all original 360 columns by reference from the original data 
DT[, grep("V", names(DT), value=TRUE) := NULL] 

Ora resterete con 30 colonne che corrispondono alla posizione di 1. Sul mio sistema, questo richiede circa 0,4 secondi.

all(unlist(final.df) == unlist(DT)) # not a fan of `identical` 
# [1] TRUE 

Answer 3

Ecco un approccio che è fondamentalmente istantaneo. (system.time = 0,1 secondi)

se set. Il componente columnMatch dipenderà dai tuoi dati, ma se sono 12 colonne, funzionerà il seguente.

MYD <- data.table(mydata) 
# a new data.table (changed to numeric : Arun) 
newDT <- as.data.table(replicate(30, numeric(nrow(MYD)),simplify = FALSE)) 
# for each column, which values equal 1 
whiches <- lapply(MYD, function(x) which(x == 1)) 
# create a list of column matches (those you wish to aggregate) 
columnMatch <- split(names(mydata), rep(1:30,each = 12)) 
setattr(columnMatch, 'names', names(newDT)) 

# cycle through all new columns 
# and assign the the rows in the new data.table 
## Arun: had to generate numeric indices for 
## cycling through 1:12, 13:24 in whiches[[.]]. That was the problem. 
for(jj in seq_along(columnMatch)) { 
for(ii in seq_along(columnMatch[[jj]])) { 
    set(newDT, j = jj, i = whiches[[ii + 12 * (jj-1)]], value = ii) 
} 
} 

Ciò funzionerebbe altrettanto bene aggiungendo colonne facendo riferimento all'originale.

Nota set opere data.frames così ....

Answer 4

Un altro modo questo potrebbe essere fatto con base R è semplicemente ottenere con i valori che si desidera inserire nella nuova matrice e li compilando direttamente con matrice di indicizzazione .

idx <- which(mydata==1, arr.ind=TRUE) # get indices of 1's 
i <- idx[,2] %% 12      # get column that was 1 
idx[,2] <- ((idx[,2] - 1) %/% 12) + 1 # get "group" and put in "col" of idx 
out <- array(NA, dim=c(1500,30))  # make empty matrix 
out[idx] <- i       # and fill it in!