Creare nuove variabili binarie da una singola stringa di livelli registrati per ciascuna osservazione

Mi sono divertito con lo Kaggle West-Nile Virus competition data come metodo per esercitarsi nell'adattamento di una GAM spazio-temporale. Le prime poche righe (un po 'elaborate dal CSV originale) dei dati weather sono sotto (più le prime 20 righe a dput() output alla fine della domanda).Creare nuove variabili binarie da una singola stringa di livelli registrati per ciascuna osservazione

> head(weather) 
    Station  Date Tmax Tmin Tavg Depart DewPoint WetBulb Heat Cool Sunrise 
1  1 2007-05-01 83 50 67  14  51  56 0 2  448 
2  2 2007-05-01 84 52 68  NA  51  57 0 3  NA 
3  1 2007-05-02 59 42 51  -3  42  47 14 0  447 
4  2 2007-05-02 60 43 52  NA  42  47 13 0  NA 
5  1 2007-05-03 66 46 56  2  40  48 9 0  446 
6  2 2007-05-03 67 48 58  NA  40  50 7 0  NA 
    Sunset CodeSum Depth Water1 SnowFall PrecipTotal StnPressure SeaLevel 
1 1849 <NA>  0  NA  0   0  29.10 29.82 
2  NA <NA> NA  NA  NA   0  29.18 29.82 
3 1850  BR  0  NA  0   0  29.38 30.09 
4  NA BR HZ NA  NA  NA   0  29.44 30.08 
5 1851 <NA>  0  NA  0   0  29.39 30.12 
6  NA  HZ NA  NA  NA   0  29.46 30.12 
    ResultSpeed ResultDir AvgSpeed 
1   1.7  27  9.2 
2   2.7  25  9.6 
3  13.0   4  13.4 
4  13.3   2  13.4 
5  11.7   7  11.9 
6  12.9   6  13.2

Nota la variabile CodeSum. Ogni elemento di CodeSum è un'osservazione su fenomeni meteorologici significativi. Mancano alcune osservazioni (NA), alcuni non hanno dati ma sono non mancanti, alcuni hanno un singolo tipo di tempo significativo e altri hanno diverse osservazioni meteorologiche significative per lo stesso giorno.

Quello che voglio è quello di creare una nuova cornice di dati con n nuove variabili binarie (n sarebbe il numero di valori univoci in CodeSum) con un NA se mancante, un 1 è indicatore di tempo osservato, e un 0 se non osservato.

Inizialmente ho provato tidyr::separate() ma questo aveva bisogno che tutti gli indicatori fossero presenti per tutte le osservazioni o li trattava in ordine; il primo indicatore indipendentemente da che cosa fosse quell'indicatore, veniva sempre assegnato alla prima variabile binaria.

io ho una soluzione:

expandLevs <- function(x, set) { 
    m <- matrix(0, ncol = length(set), nrow = 1L) 
    colnames(m) <- set 
    nax <- is.na(x) 
    m[, nax] <- NA 
    if (!all(nax)) { 
     idx <- x[!nax] 
     m[, idx] <- 1 
    } 
    m 
} 
cs <- with(weather, strsplit(as.character(CodeSum), " ")) 
levs <- with(weather, 
      sort(unique(unlist(strsplit(levels(CodeSum), " "))))) 
cs <- lapply(cs, expandLevs, set = levs) 
cs <- do.call("rbind", cs) 
cs <- data.frame(cs, check.names = FALSE) 
cs <- lapply(cs, factor, levels = c(0,1)) 
cs <- data.frame(cs, check.names = FALSE)

che dà

> cs 
    BR HZ RA 
1 <NA> <NA> <NA> 
2 <NA> <NA> <NA> 
3  1 0 0 
4  1 1 0 
5 <NA> <NA> <NA> 
6  0 1 0 
7  0 0 1 
8 <NA> <NA> <NA> 
9 <NA> <NA> <NA> 
10 <NA> <NA> <NA> 
11 <NA> <NA> <NA> 
12 <NA> <NA> <NA> 
13 0 0 1 
14 <NA> <NA> <NA> 
15 1 0 0 
16 0 1 0 
17 1 1 0 
18 1 1 0 
19 1 0 0 
20 1 1 0

per le 20 righe di dati in weather (qui di seguito).

Ma questo sembra al massimo clunky.

Sto trascurando un modo più semplice per creare le variabili binarie?

L'output previsto è incluso anche come codice dput()ed alla fine.

weather <- structure(list(Station = c(1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 
2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L), Date = structure(c(13634, 
13634, 13635, 13635, 13636, 13636, 13637, 13637, 13638, 13638, 
13639, 13639, 13640, 13640, 13641, 13641, 13642, 13642, 13643, 
13643), class = "Date"), Tmax = c(83L, 84L, 59L, 60L, 66L, 67L, 
66L, 78L, 66L, 66L, 68L, 68L, 83L, 84L, 82L, 80L, 77L, 76L, 84L, 
83L), Tmin = c(50L, 52L, 42L, 43L, 46L, 48L, 49L, 51L, 53L, 54L, 
49L, 52L, 47L, 50L, 54L, 60L, 61L, 63L, 56L, 59L), Tavg = c(67, 
68, 51, 52, 56, 58, 58, NA, 60, 60, 59, 60, 65, 67, 68, 70, 69, 
70, 70, 71), Depart = c(14, NA, -3, NA, 2, NA, 4, NA, 5, NA, 
4, NA, 10, NA, 12, NA, 13, NA, 14, NA), DewPoint = c(51L, 51L, 
42L, 42L, 40L, 40L, 41L, 42L, 38L, 39L, 30L, 30L, 41L, 39L, 58L, 
57L, 59L, 60L, 52L, 52L), WetBulb = c(56, 57, 47, 47, 48, 50, 
50, 50, 49, 50, 46, 46, 54, 53, 62, 63, 63, 63, 60, 61), Heat = c(0, 
0, 14, 13, 9, 7, 7, NA, 5, 5, 6, 5, 0, 0, 0, 0, 0, 0, 0, 0), 
    Cool = c(2, 3, 0, 0, 0, 0, 0, NA, 0, 0, 0, 0, 0, 2, 3, 5, 
    4, 5, 5, 6), Sunrise = c(448, NA, 447, NA, 446, NA, 444, 
    NA, 443, NA, 442, NA, 441, NA, 439, NA, 438, NA, 437, NA), 
    Sunset = c(1849, NA, 1850, NA, 1851, NA, 1852, NA, 1853, 
    NA, 1855, NA, 1856, NA, 1857, NA, 1858, NA, 1859, NA), CodeSum = structure(c(NA, 
    NA, 2L, 3L, NA, 19L, 23L, NA, NA, NA, NA, NA, 23L, NA, 2L, 
    19L, 3L, 3L, 2L, 3L), .Label = c("BCFG BR", "BR", "BR HZ", 
    "BR HZ FU", "BR HZ VCFG", "BR VCTS", "DZ", "DZ BR", "DZ BR HZ", 
    "FG BR HZ", "FG+", "FG+ BCFG BR", "FG+ BR", "FG+ BR HZ", 
    "FG+ FG BR", "FG+ FG BR HZ", "FG+ MIFG BR", "FU", "HZ", "HZ FU", 
    "HZ VCTS", "MIFG BCFG BR", "RA", "RA BCFG BR", "RA BR", "RA BR FU", 
    "RA BR HZ", "RA BR HZ FU", "RA BR HZ VCFG", "RA BR HZ VCTS", 
    "RA BR SQ", "RA BR VCFG", "RA BR VCTS", "RA DZ", "RA DZ BR", 
    "RA DZ BR HZ", "RA DZ FG+ BCFG BR", "RA DZ FG+ BR", "RA DZ FG+ BR HZ", 
    "RA DZ FG+ FG BR", "RA DZ SN", "RA FG BR", "RA FG+ BR", "RA FG+ MIFG BR", 
    "RA HZ", "RA SN", "RA SN BR", "RA VCTS", "TS", "TS BR", "TS BR HZ", 
    "TS HZ", "TS RA", "TS RA BR", "TS RA BR HZ", "TS RA FG+ FG BR", 
    "TS TSRA", "TS TSRA BR", "TS TSRA BR HZ", "TS TSRA GR RA BR", 
    "TS TSRA HZ", "TS TSRA RA", "TS TSRA RA BR", "TS TSRA RA BR HZ", 
    "TS TSRA RA BR HZ VCTS", "TS TSRA RA BR VCTS", "TS TSRA RA FG BR", 
    "TS TSRA RA FG BR HZ", "TS TSRA RA HZ", "TS TSRA RA VCTS", 
    "TS TSRA VCFG", "TSRA", "TSRA BR", "TSRA BR HZ", "TSRA BR HZ FU", 
    "TSRA BR HZ VCTS", "TSRA BR SQ", "TSRA DZ BR HZ", "TSRA DZ FG+ FG BR HZ", 
    "TSRA FG+ BR", "TSRA FG+ BR HZ", "TSRA HZ", "TSRA RA", "TSRA RA BR", 
    "TSRA RA BR HZ", "TSRA RA BR HZ VCTS", "TSRA RA BR VCTS", 
    "TSRA RA DZ BR", "TSRA RA DZ BR HZ", "TSRA RA FG BR", "TSRA RA FG+ BR", 
    "TSRA RA FG+ FG BR", "TSRA RA FG+ FG BR HZ", "TSRA RA HZ", 
    "TSRA RA HZ FU", "TSRA RA VCTS", "VCTS"), class = "factor"), 
    Depth = c(0, NA, 0, NA, 0, NA, 0, NA, 0, NA, 0, NA, 0, NA, 
    0, NA, 0, NA, 0, NA), Water1 = c(NA_real_, NA_real_, NA_real_, 
    NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, 
    NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, 
    NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), SnowFall = c(0, 
    NA, 0, NA, 0, NA, 0, NA, 0, NA, 0, NA, 0, NA, 0, NA, 0, NA, 
    0, NA), PrecipTotal = c(0, 0, 0, 0, 0, 0, 0.005, 0, 0.005, 
    0.005, 0, 0, 0.005, 0, 0, 0.005, 0.13, 0.02, 0, 0), StnPressure = c(29.1, 
    29.18, 29.38, 29.44, 29.39, 29.46, 29.31, 29.36, 29.4, 29.46, 
    29.57, 29.62, 29.38, 29.44, 29.29, 29.36, 29.21, 29.28, 29.2, 
    29.26), SeaLevel = c(29.82, 29.82, 30.09, 30.08, 30.12, 30.12, 
    30.05, 30.04, 30.1, 30.09, 30.29, 30.28, 30.12, 30.12, 30.03, 
    30.02, 29.94, 29.93, 29.92, 29.91), ResultSpeed = c(1.7, 
    2.7, 13, 13.3, 11.7, 12.9, 10.4, 10.1, 11.7, 11.2, 14.4, 
    13.8, 8.6, 8.5, 2.7, 2.5, 3.9, 3.9, 0.7, 2), ResultDir = c(27L, 
    25L, 4L, 2L, 7L, 6L, 8L, 7L, 7L, 7L, 11L, 10L, 18L, 17L, 
    11L, 8L, 9L, 7L, 17L, 9L), AvgSpeed = c(9.2, 9.6, 13.4, 13.4, 
    11.9, 13.2, 10.8, 10.4, 12, 11.5, 15, 14.5, 10.5, 9.9, 5.8, 
    5.4, 6.2, 5.9, 4.1, 3.9)), .Names = c("Station", "Date", 
"Tmax", "Tmin", "Tavg", "Depart", "DewPoint", "WetBulb", "Heat", 
"Cool", "Sunrise", "Sunset", "CodeSum", "Depth", "Water1", "SnowFall", 
"PrecipTotal", "StnPressure", "SeaLevel", "ResultSpeed", "ResultDir", 
"AvgSpeed"), row.names = c(NA, 20L), class = "data.frame") 

output <- structure(list(BR = structure(c(NA, NA, 2L, 2L, NA, 1L, 1L, NA, 
NA, NA, NA, NA, 1L, NA, 2L, 1L, 2L, 2L, 2L, 2L), .Label = c("0", 
"1"), class = "factor"), HZ = structure(c(NA, NA, 1L, 2L, NA, 
2L, 1L, NA, NA, NA, NA, NA, 1L, NA, 1L, 2L, 2L, 2L, 1L, 2L), .Label = c("0", 
"1"), class = "factor"), RA = structure(c(NA, NA, 1L, 1L, NA, 
1L, 2L, NA, NA, NA, NA, NA, 2L, NA, 1L, 1L, 1L, 1L, 1L, 1L), .Label = c("0", 
"1"), class = "factor")), .Names = c("BR", "HZ", "RA"), row.names = c(NA, 
-20L), class = "data.frame")

fonte

2015-06-11 Gavin Simpson

Si desidera creare variabili dummy, giusto? Hai provato qualcosa del genere ... http://stackoverflow.com/questions/11952706/generate-a-dummy-variable-in-r – cory

@cory Sì, e sarebbe facile se ho un singolo fattore da far esplodere alle variabili binarie, ma qui 'CodeSum' contiene informazioni su tutte le variabili che devo creare ma in forma compatta (sono presenti solo i tipi osservati, non tutti i tipi possibili). Non è sufficiente creare una serie di variabili dummy dai livelli del fattore 'CodeSum'. Scusa se non era abbastanza chiaro. –

Per la parte di suddivisione attuale, si trovano alcune alternative [** qui **] (http://stackoverflow.com/questions/29988256/how-can-i-split-a-character-string-into-column -vettori-con-un-1-0-valore-bandiera-in). Tuttavia, le "linee all-'NA" non vengono considerate lì. – Henrik

Prova

library(qdapTools) 
res <- mtabulate(strsplit(as.character(weather$CodeSum), ' ')) * 
       NA^is.na(weather$CodeSum) 
res 
    BR HZ RA 
1 NA NA NA 
2 NA NA NA 
3 1 0 0 
4 1 1 0 
5 NA NA NA 
6 0 1 0 
7 0 0 1 
8 NA NA NA 
9 NA NA NA 
10 NA NA NA 
11 NA NA NA 
12 NA NA NA 
13 0 0 1 
14 NA NA NA 
15 1 0 0 
16 0 1 0 
17 1 1 0 
18 1 1 0 
19 1 0 0 
20 1 1 0

fonte

2015-06-11 20:27:51 akrun

ha rubato il tuo NA^na, carino (anche se discutibilmente dispari) +1 – BrodieG

@BrodieG Grazie, la mia prima versione era 2 codice di riga 'res [is.na (meteo $ CodeSum),] <- NA', ma l'ho cambiato in fallo in una riga. – akrun

Cosa succede ad usare dummies::dummy?

library(dummies) 
dummy(weather$CodeSum) 
#  CodeSumBR CodeSumBR HZ CodeSumHZ CodeSumRA CodeSumNA 
# [1,]   0   0   0   0   1 
# [2,]   0   0   0   0   1 
# [3,]   1   0   0   0   0 
# [4,]   0   1   0   0   0 
# [5,]   0   0   0   0   1 
# [6,]   0   0   1   0   0 
# [7,]   0   0   0   1   0 
# [8,]   0   0   0   0   1 
# [9,]   0   0   0   0   1 
# [10,]   0   0   0   0   1 
# [11,]   0   0   0   0   1 
# [12,]   0   0   0   0   1 
# [13,]   0   0   0   1   0 
# [14,]   0   0   0   0   1 
# [15,]   1   0   0   0   0 
# [16,]   0   0   1   0   0 
# [17,]   0   1   0   0   0 
# [18,]   0   1   0   0   0 
# [19,]   1   0   0   0   0 
# [20,]   0   1   0   0   0

fonte

2015-06-11 20:38:54 JasonAizkalns

genererei cs e lev, come fatto, ma voglio creare la matrice pre-allocare una matrice di NA e riempiendo le righe non-NA in un ciclo.

cs <- with(weather, strsplit(as.character(CodeSum), " ")) 
levs <- with(weather, unique(unlist(strsplit(levels(CodeSum), " ")))) 
# pre-allocate the integer matrix to store the indicator values 
ind <- matrix(NA_integer_, length(cs), length(levs), , list(NULL,levs)) 
# loop over each row 
for (i in seq_along(cs)) { 
    if (is.na(cs[[i]][1])) # skip this row if cs[[i]] is NA 
    next 
    ind[i,] <- 0   # not NA, so set all columns to 0 
    ind[i,cs[[i]]] <- 1  # set columns in cs[[i]] to 1 
}

ind deve corrispondere al output, con l'eccezione che output è una data.frame di fattori e ind è una matrice numero intero.

fonte

2015-06-11 20:40:23

a volte un ciclo for è appena più semplice +1 – BrodieG

Si noti che ho rimosso tutti i tubi dalla mia soluzione originale. Questo si sovrappone molto a quello dell'OP, ma utilizza la conversione esplicita al fattore, una chiamata a table() e plyr::ldply() per rimetterlo insieme.

x <- strsplit(as.character(weather$CodeSum), "\\s+") 
x_is_na <- is.na(x) 
levs <- sort(unique(unlist(x))) 
x_out <- plyr::ldply(x, function(x) table(factor(x, levels = levs))) 
x_out[x_is_na, ] <- NA 
x_out 
# BR HZ RA 
# NA NA NA 
# NA NA NA 
# 1 0 0 
# 1 1 0 
# NA NA NA 
# 0 1 0 
# 0 0 1 
# NA NA NA 
# NA NA NA 
# NA NA NA 
# NA NA NA 
# NA NA NA 
# 0 0 1 
# NA NA NA 
# 1 0 0 
# 0 1 0 
# 1 1 0 
# 1 1 0 
# 1 0 0 
# 1 1 0

fonte

2015-06-11 21:00:53 jennybryan

ecco la versione con solo le colonne rappresentate:

dat <- setNames(strsplit(as.character(weather$CodeSum), " "), format(seq(nrow(weather)))) 
na <- is.na(weather$CodeSum) 

t(table(stack(dat))) * NA^na  # Credit Akrun for NA^na

produce:

values 
ind BR HZ RA 
    1   
    2   
    3 1 0 0 
    4 1 1 0 
    5   
    6 0 1 0 
    7 0 0 1 
    8   
    9   
    10   
    11   
    12   
    13 0 0 1 
    14   
    15 1 0 0 
    16 0 1 0 
    17 1 1 0 
    18 1 1 0 
    19 1 0 0 
    20 1 1 0

Personalmente preferisco i valori mancanti piuttosto che la <NA> roba brutta, ma questo è solo me .

vecchia versione, tavolo pieno

Non credo che questo finisce per essere molto più semplice, ma è in punto di partenza per qualsiasi cosa vale la pena:

levs <- sort(unique(unlist(strsplit(levels(weather$CodeSum), " ")))) 
dat <- setNames(strsplit(as.character(weather$CodeSum), " "), format(seq(nrow(weather)))) 
na <- is.na(weather$CodeSum) 

`[<-`(t(table(transform(stack(dat), values=factor(values, levs)))), na, NA)

produce:

values 
ind BCFG BR DZ FG FG+ FU GR HZ MIFG RA SN SQ TS TSRA VCFG VCTS 
    1               
    2               
    3 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
    4 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 
    5               
    6 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 
    7 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 
    8               
    9               
    10               
    11               
    12               
    13 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 
    14               
    15 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
    16 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 
    17 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 
    18 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 
    19 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
    20 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0

fonte

2015-06-11 21:14:57 BrodieG

Creare nuove variabili binarie da una singola stringa di livelli registrati per ciascuna osservazione

risposta

Problemi correlati