Pivot da formato largo a lungo e quindi nidificazione delle colonne
Mi vengono forniti dati in un formato ampio. Ogni riga riguarda una variabile esterna alla tabella corrente e i possibili valori rilevanti per quella variabile. Sto cercando di: (1) eseguire il pivot nel formato lungo e (2) annidare i valori pivot.
Esempio
library(tibble)
df_1 <-
tribble(~key, ~values.male, ~values.female, ~values.red, ~values.green, ~value,
"gender", 0.5, 0.5, NA, NA, NA,
"age", NA, NA, NA, NA, "50",
"color", NA, NA, TRUE, FALSE, NA,
"time_of_day", NA, NA, NA, NA, "noon")
## # A tibble: 4 x 6
## key values.male values.female values.red values.green value
## <chr> <dbl> <dbl> <lgl> <lgl> <chr>
## 1 gender 0.5 0.5 NA NA NA
## 2 age NA NA NA NA 50
## 3 color NA NA TRUE FALSE NA
## 4 time_of_day NA NA NA NA noon
In questo esempio, vediamo che genderpuò avere uno female = 0.5e male = 0.5. D'altra parte, agepuò avere un solo valore di 50. Dalla riga # 3 apprendiamo che colorpuò avere valori di red = TRUEe green = FALSE, e time_of_day = noon.
Pertanto, una tabella pivot dovrebbe assumere la forma nidificata di:
my_pivoted_df <-
structure(
list(
var_name = c("gender", "age", "color", "time_of_day"),
vals = list(
structure(
list(
level = c("male", "female"),
value = c(0.5,
0.5)
),
row.names = c(NA, -2L),
class = c("tbl_df", "tbl", "data.frame")
),
"50",
structure(
list(
level = c("red", "green"),
value = c(TRUE,
FALSE)
),
row.names = c(NA, -2L),
class = c("tbl_df", "tbl", "data.frame")
),
"noon"
)
),
row.names = c(NA, -4L),
class = c("tbl_df", "tbl",
"data.frame")
)
## # A tibble: 4 x 2
## var_name vals
## <chr> <list>
## 1 gender <tibble [2 x 2]>
## 2 age <chr [1]>
## 3 color <tibble [2 x 2]>
## 4 time_of_day <chr [1]>
Il mio tentativo di risolverlo
Ci sono un paio di problemi con df_1. Innanzitutto, l'attuale denominazione delle colonne è scomoda. Intestazioni come valuenon sono ideali perché sono in conflitto con pivot_longer()il ".value"meccanismo di. Secondo, df_1ha values(al plurale) quando keyha più di un'opzione (ad esempio, "rosso" e "verde" per color), ma value(singolare) quando c'è solo un'opzione per key(come con age). Di seguito è riportato il mio codice non riuscito, ispirato a questa risposta .
library(tidyr)
library(dplyr)
df_1 %>%
rename_with( ~ paste(.x, "single", sep = "."), .cols = value) %>% ## changed the header because otherwise it breaks
pivot_longer(cols = starts_with("val"),
names_to = c("whatevs", ".value"), names_sep = "\\.")
## # A tibble: 8 x 7
## key whatevs male female red green single
## <chr> <chr> <dbl> <dbl> <lgl> <lgl> <chr>
## 1 gender values 0.5 0.5 NA NA NA
## 2 gender value NA NA NA NA NA
## 3 age values NA NA NA NA NA
## 4 age value NA NA NA NA 50
## 5 color values NA NA TRUE FALSE NA
## 6 color value NA NA NA NA NA
## 7 time_of_day values NA NA NA NA NA
## 8 time_of_day value NA NA NA NA noon
Mi mancano alcuni trucchi per risolvere il problema.
Risposte
Un approccio ordinato per ottenere il risultato desiderato può assomigliare a questo:
library(tibble)
df_1 <-
tribble(~key, ~values.male, ~values.female, ~values.red, ~values.green, ~value,
"gender", 0.5, 0.5, NA, NA, NA,
"age", NA, NA, NA, NA, "50",
"color", NA, NA, TRUE, FALSE, NA,
"time_of_day", NA, NA, NA, NA, "noon")
library(tidyr)
library(dplyr)
library(purrr)
df_pivoted <- df_1 %>%
mutate(across(everything(), as.character)) %>%
pivot_longer(-key, names_to = "level", names_prefix = "^values\\.", values_drop_na = TRUE) %>%
group_by(key) %>%
nest() %>%
mutate(data = map(data, ~ if (all(.x$level == "value")) deframe(.x) else .x))
df_pivoted
#> # A tibble: 4 x 2
#> # Groups: key [4]
#> key data
#> <chr> <list>
#> 1 gender <tibble [2 × 2]>
#> 2 age <chr [1]>
#> 3 color <tibble [2 × 2]>
#> 4 time_of_day <chr [1]>
MODIFICA A seguito del chiarimento nei tuoi commenti sul risultato desiderato, potremmo semplicemente sbarazzarci dell'istruzione map come fine (che fondamentalmente era intesa per convertire le tabelle per le categorie senza livelli in un vettore) e aggiungere un'istruzione mutate prima di annidare per sostituire il livello con NA per le categorie senza level:
pivot_nest <- function(x) {
mutate(x, across(everything(), as.character)) %>%
pivot_longer(-key, names_to = "level", names_prefix = "^values\\.", values_drop_na = TRUE) %>%
group_by(key) %>%
mutate(level = ifelse(all(level == "value"), NA_character_, level)) %>%
nest()
}
df_pivoted <- df_1 %>%
pivot_nest()
df_pivoted
#> # A tibble: 4 x 2
#> # Groups: key [4]
#> key data
#> <chr> <list>
#> 1 gender <tibble [2 × 2]>
#> 2 age <tibble [1 × 2]>
#> 3 color <tibble [2 × 2]>
#> 4 time_of_day <tibble [1 × 2]>
df_pivoted$data
#> [[1]]
#> # A tibble: 2 x 2
#> level value
#> <chr> <chr>
#> 1 male 0.5
#> 2 male 0.5
#>
#> [[2]]
#> # A tibble: 1 x 2
#> level value
#> <chr> <chr>
#> 1 <NA> 50
#>
#> [[3]]
#> # A tibble: 2 x 2
#> level value
#> <chr> <chr>
#> 1 red TRUE
#> 2 red FALSE
#>
#> [[4]]
#> # A tibble: 1 x 2
#> level value
#> <chr> <chr>
#> 1 <NA> noon
df_2 <- tribble(~key, ~value, "age", "50", "income", "100000", "time_of_day", "noon")
df_pivoted2 <- df_2 %>%
pivot_nest()
df_pivoted2
#> # A tibble: 3 x 2
#> # Groups: key [3]
#> key data
#> <chr> <list>
#> 1 age <tibble [1 × 2]>
#> 2 income <tibble [1 × 2]>
#> 3 time_of_day <tibble [1 × 2]>
df_pivoted2$data
#> [[1]]
#> # A tibble: 1 x 2
#> level value
#> <chr> <chr>
#> 1 <NA> 50
#>
#> [[2]]
#> # A tibble: 1 x 2
#> level value
#> <chr> <chr>
#> 1 <NA> 100000
#>
#> [[3]]
#> # A tibble: 1 x 2
#> level value
#> <chr> <chr>
#> 1 <NA> noon
Un'opzione che restituirà lo stesso tipo di output dell'input fornito:
df_1 %>%
group_split(key) %>%
map_dfr(~ select(., where(~ !all(is.na(.)))) %>%
pivot_longer(-key, names_to = "level", names_prefix = "^values\\.") %>%
summarise(key = first(key),
vals = if(n() == 1) list(value) else list(tibble(level, value))))
key vals
<chr> <list>
1 age <chr [1]>
2 color <tibble [2 × 2]>
3 gender <tibble [2 × 2]>
4 time_of_day <chr [1]>
La struttura dell'output:
$ key : chr [1:4] "age" "color" "gender" "time_of_day" $ vals:List of 4
..$ : chr "50" ..$ : tibble [2 × 2] (S3: tbl_df/tbl/data.frame)
.. ..$ level: chr [1:2] "red" "green" .. ..$ value: logi [1:2] TRUE FALSE
..$ : tibble [2 × 2] (S3: tbl_df/tbl/data.frame) .. ..$ level: chr [1:2] "male" "female"
.. ..$ value: num [1:2] 0.5 0.5 ..$ : chr "noon"
Ecco una data.tablesoluzione, perché sono più a mio agio con melte dcast, ma dovrebbe essere facilmente trasferibile a dplyr:
library(data.table)
df <- setDT(df_1)
plouf <- melt(df,measure.vars = patterns("value")) %>%
.[!is.na(value),.(key,level = gsub("values.","",variable),value)]
questo da:
key level value
1: gender male 0.5
2: gender female 0.5
3: color red TRUE
4: color green FALSE
5: age value 50
6: time_of_day value noon
Ora puoi semplicemente scorrere i keyvalori univoci per produrre ciò che desideri:
keylist <- unique(plouf$key)
result <- tibble(varname = keylist,
vals = lapply(keylist,function(x){
if(plouf[x == key,level[1]] != "value"){
plouf[x == key,.(level,value)]
}else{
plouf[x == key,value]
}
})
)
Qui ottieni la tua tabella nidificata (con data.tables e caratteri all'interno)