Genişden uzun biçime dönme ve ardından sütunları iç içe yerleştirme
Geniş formatta gelen veriler bana verildi. Her satır, geçerli tablonun dışındaki bir değişkenle ve bu değişkenle ilgili olası değerlerle ilgilidir. Şunları yapmaya çalışıyorum: (1) uzun biçime dönme ve (2) özetlenmiş değerleri iç içe yerleştirme.
Misal
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
Bu örnekte, genderya female = 0.5ve male = 0.5. Öte yandan, ageyalnızca tek bir değere sahip olabilir 50. 3. satırdan color, red = TRUEve green = FALSE, ve değerlerine sahip olabileceğini öğreniyoruz time_of_day = noon.
Bu nedenle, özetlenmiş bir tablonun iç içe geçmiş biçimini alması gerekir:
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]>
Bunu çözme girişimim
İle ilgili birkaç sorun var df_1. İlk olarak, sütunların şu anki isimlendirilmesi uygun değildir. Gibi başlıklar valueideal değildir çünkü pivot_longer()'ın ".value"mekanizması ile çelişirler. İkincisi, df_1sahip valuesolduğunda (çoğul) keybirden fazla seçeneği vardır (örneğin, "kırmızı" ve "yeşil" color), ancak valuesadece tek bir seçenek olduğu zaman (tekil) key(örneğin olduğu gibi age). Aşağıda bu cevaptan ilham alan başarısız kodum var .
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
Bunu çözmek için bazı tartışmalı numaralarım yok.
Yanıtlar
İstediğiniz sonucu elde etmek için düzenli bir yaklaşım şöyle görünebilir:
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]>
DÜZENLE İstenen sonuç hakkındaki yorumlarınızdaki açıklamayı takiben, son olarak harita ifadesinden kurtulabiliriz (temelde, seviyesiz kategoriler için tibble'ları bir vektöre dönüştürmek için) ve iç içe geçmeden önce bir mutat ifadesi ekleyerek NA düzeyine sahip olmayan kategoriler için 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
Sağlanan girişle aynı tür çıktıyı döndürecek bir seçenek:
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]>
Çıktının yapısı:
$ 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"
İşte bir data.tableben daha rahatım çünkü çözüm meltve dcastfakat kolayca aktarılabilmesi olmalıdır dplyr:
library(data.table)
df <- setDT(df_1)
plouf <- melt(df,measure.vars = patterns("value")) %>%
.[!is.na(value),.(key,level = gsub("values.","",variable),value)]
bu şunu verir:
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
Artık keyistediğinizi çıkarmak için benzersiz değerlerin üzerinden geçebilirsiniz :
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]
}
})
)
Burada iç içe geçmiş tibble'ınızı elde edersiniz (data.tables ve içindeki karakterler ile)