Erstellen einer binären Matrix in R mit einem großen Datensatz

Question

Ich arbeite mit R-Version 3.2.3 auf einem Linux-Rechner.

Ich habe einen Datensatz mit 1.374.439 Beobachtungen von 145 Variablen. Ich muss diesen Datenrahmen in eine binäre Matrix umwandeln.

Ich habe verschiedene Foren angeschaut und ich fand eine Lösung mit dem Paket reshape2 und den Funktionen melt() und dcast(). Dies funktioniert perfekt mit einem kleinen Dataset (Ich habe immer zuerst meine Codes auf einem kleinen Teil versucht, um zu überprüfen, ob es tut, was ich will). Wenn ich diesen Code für das gesamte Dataset verwenden möchte, funktioniert es nicht mehr.

Ich habe in anderen Foren geschaut und ich habe versucht (ohne Erfolg), die folgenden Funktionen:

• table()
• sparseMatrix() und as.Matrix()
• xtabs()

Ich habe auch fand die Verwendung der Pakete dplyr und tidyr für größere Datensätze. Aber es ist mir nicht gelungen. Ehrlich gesagt, kämpfte ich auch mit dem Verständnis. Aber es scheint, dass die Größe meines Datensatzes ist das Hauptproblem ...

Die Daten sieht so aus (dies ist eine Version Kurzfassung):

Code_1 Code_2 Code_3 Code_4 Code_5 Code_6 Code_7 
1 M201   M2187 M670 
2 O682   O097 Z370    O48 O759 
3 S7211 Z966   Z501 

Und ich möchte diese haben (a binäre Matrix):

M201 M2187 M670 O682 O097 Z370 O48 0759 S7211 Z966 Z501 
1 1   1  1  0  0  0  0  0  0  0  0 
2 0   0  0  1  1  1  1  1  0  0  0 
3 0   0  0  0  0  0  0  0  1  1  1 

Ich möchte auch genau sein, dass die Leerzeichen nicht NAs sind. Es sind wirklich Leerzeichen.

Answer 1

Was brauchen Sie eigentlich - Matrix::sparse.model.matrix() Funktion ist. Die unten stehenden Antworten erstellen dichte Matrizen, die schnell alle Ihre Widgets in diesem Datensatz auffressen. Hier

ist einfaches Beispiel:

M = sparse.model.matrix(~ ., data=data.frame(x = letters , y = LETTERS)) 

Wenn Sie nicht brauchen, Intercept, Verwendung folgende Formel

M = sparse.model.matrix(~ -1 + ., data=data.frame(x = letters , y = LETTERS)) 

Answer 2

Wir können table nach melt Daten in long Format and remove the blank ( '') Elemente anwenden.

library(reshape2) 
table(droplevels(subset(melt(as.matrix(df1)), value!='', select = -2))) 
# value 
# Var1 M201 M2187 M670 O097 O48 O682 O759 S7211 Z370 Z501 Z966 
# 1 1  1 1 0 0 0 0  0 0 0 0 
# 2 0  0 0 1 1 1 1  0 1 0 0 
# 3 0  0 0 0 0 0 0  1 0 1 1 

---

Oder mit dplyr/tidyr

library(dplyr) 
library(tidyr) 
data_frame(rn = rep(1:nrow(df1), ncol(df1)), v1 = unlist(df1)) %>% 
     filter(v1!="") %>% 
     group_by(rn, v1) %>% 
     summarise(n = n()) %>% 
     spread(v1, n, fill = 0) 
# rn M201 M2187 M670 O097 O48 O682 O759 S7211 Z370 Z501 Z966 
# <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> 
#1  1  1  1  1  0  0  0  0  0  0  0  0 
#2  2  0  0  0  1  1  1  1  0  1  0  0 
#3  3  0  0  0  0  0  0  0  1  0  1  1 

---

Oder mit dcast von data.table

library(data.table) 
dcast(data.table(rn = rep(1:nrow(df1), ncol(df1)), 
        v1 = unlist(df1))[v1!=''], rn~v1, length) 
# rn M201 M2187 M670 O097 O48 O682 O759 S7211 Z370 Z501 Z966 
#1: 1 1  1 1 0 0 0 0  0 0 0 0 
#2: 2 0  0 0 1 1 1 1  0 1 0 0 
#3: 3 0  0 0 0 0 0 0  1 0 1 1 

Answer 3

Hier ist eine Basis R-Ansatz:

## define input data.frame 
data <- data.frame(Code_1=c('M201','O682','S7211'),Code_2=c('','','Z966'),Code_3=c('M2187', 
'O097',''),Code_4=c('M670','Z370','Z501'),Code_5=c('','',''),Code_6=c('','O48',''),Code_7=c(
'','O759',''),stringsAsFactors=F); 

## coerce to a matrix to speed up subsequent operations 
data <- as.matrix(data); 

## solution 
im <- which(arr.ind=T,data!=''); 
u <- unique(data[im[order(im[,'row'],im[,'col']),]]); 
res <- matrix(0L,nrow(data),length(u),dimnames=list(NULL,u)); 
res[cbind(im[,'row'],match(data[im],u))] <- 1L; 
res; 
##  M201 M2187 M670 O682 O097 Z370 O48 O759 S7211 Z966 Z501 
## [1,] 1  1 1 0 0 0 0 0  0 0 0 
## [2,] 0  0 0 1 1 1 1 1  0 0 0 
## [3,] 0  0 0 0 0 0 0 0  1 1 1 

---

Benchmarking

library(microbenchmark); 
library(reshape2); 
library(dplyr); 
library(tidyr); 
library(data.table); 

akrun1 <- function(df1) table(droplevels(subset(melt(as.matrix(df1)),value!='',select=-2))); 
akrun2 <- function(df1) data_frame(rn=rep(1:nrow(df1),ncol(df1)),v1=unlist(df1)) %>% filter(v1!="") %>% group_by(rn,v1) %>% summarise(n=n()) %>% spread(v1,n,fill=0) %>% ungroup() %>% select(-rn); 
akrun3 <- function(df1) dcast(data.table(rn=rep(1:nrow(df1),ncol(df1)),v1=unlist(df1))[v1!=''],rn~v1,length,value.var='v1')[,!'rn',with=FALSE]; 
bgoldst <- function(data) { data <- as.matrix(data); im <- which(arr.ind=T,data!=''); u <- unique(data[im[order(im[,'row'],im[,'col']),]]); res <- matrix(0L,nrow(data),length(u),dimnames=list(NULL,u)); res[cbind(im[,'row'],match(data[im],u))] <- 1L; res; }; 

harmonize <- function(res) { 
    res <- as.matrix(if ('table'%in%class(res)) unclass(res) else res); 
    res <- res[,order(colnames(res))]; 
    res <- res[do.call(order,as.data.frame(res)),]; 
    res; 
}; ## end harmonize() 

---

## OP's example 
data <- data.frame(Code_1=c('M201','O682','S7211'),Code_2=c('','','Z966'),Code_3=c('M2187','O097',''),Code_4=c('M670','Z370','Z501'),Code_5=c('','',''),Code_6=c('','O48',''),Code_7=c('','O759',''),stringsAsFactors=F); 

ex <- harmonize(akrun1(data)); 
all.equal(ex,harmonize(akrun2(data)),check.attributes=F); 
## [1] TRUE 
all.equal(ex,harmonize(akrun3(data)),check.attributes=F); 
## [1] TRUE 
all.equal(ex,harmonize(bgoldst(data)),check.attributes=F); 
## [1] TRUE 

microbenchmark(akrun1(data),akrun2(data),akrun3(data),bgoldst(data)); 
## Unit: microseconds 
##   expr  min  lq  mean median  uq  max neval 
## akrun1(data) 1155.945 1287.2345 1356.0013 1356.301 1396.072 1745.678 100 
## akrun2(data) 4053.292 4313.7315 4639.1197 4544.664 4763.408 6839.875 100 
## akrun3(data) 5866.965 6115.4320 6542.8618 6353.848 6601.886 11951.178 100 
## bgoldst(data) 108.197 144.1195 162.6198 162.936 180.684 240.769 100 

---

## scale test 
set.seed(1L); 
NR <- 1374439L; NC <- 145L; NU <- as.integer(11/7*NC); probBlank <- 10/21; 
repeat { u <- paste0(sample(LETTERS,NU,T),sprintf('%03d',sample(0:999,NU,T))); if (length(u)==NU) break; }; 
data <- setNames(nm=paste0('Code_',seq_len(NC)),as.data.frame(matrix(sample(c('',u),NR*NC,T,c(probBlank,rep((1-probBlank)/NU,NU))),NR))); 

ex <- harmonize(akrun1(data)); 
all.equal(ex,harmonize(akrun2(data)),check.attributes=F); 
## Error: cannot allocate vector of size 1.5 Gb 
all.equal(ex,harmonize(akrun3(data)),check.attributes=F); 
## Error: cannot allocate vector of size 1.5 Gb 
all.equal(ex,harmonize(bgoldst(data)),check.attributes=F); 
## [1] "Mean relative difference: 1.70387" 

microbenchmark(akrun1(data),bgoldst(data),times=1L); 
## Unit: seconds 
##   expr  min  lq  mean median  uq  max neval 
## akrun1(data) 101.81215 101.81215 101.81215 101.81215 101.81215 101.81215  1 
## bgoldst(data) 30.82899 30.82899 30.82899 30.82899 30.82899 30.82899  1 

ich nicht genau wissen, warum mein Ergebnis zu akrun1() nicht identisch ist, aber es scheint, sein Ergebnis ist falsch, sinc e, das er hat nicht binäre Werte in es:

unique(c(ex)); 
## [1] 0 1 2 3 4 5 6 7 8