การหมุนรูปแบบกว้างไปยาวแล้วซ้อนคอลัมน์
ฉันได้รับข้อมูลที่มาในรูปแบบกว้าง แต่ละแถวเกี่ยวข้องกับตัวแปรภายนอกตารางปัจจุบันและค่าที่เป็นไปได้ที่เกี่ยวข้องกับตัวแปรนั้น ฉันกำลังพยายาม: (1) pivot to long format และ (2) ซ้อนค่า pivoted
ตัวอย่าง
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
ในตัวอย่างนี้เราจะเห็นว่าgenderจะมีอย่างใดอย่างหนึ่งและfemale = 0.5 male = 0.5ในทางกลับกันageสามารถมีได้เพียงค่าเดียว50เท่านั้น จากแถวที่ 3 ที่เราได้เรียนรู้ว่าcolorจะมีค่าของred = TRUEและและgreen = FALSEtime_of_day = noon
ดังนั้นตารางหมุนควรอยู่ในรูปแบบที่ซ้อนกันของ:
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]>
ความพยายามของฉันในการแก้ปัญหานี้
มีปัญหาสองสามอย่างเกี่ยวกับdf_1. ประการแรกการตั้งชื่อคอลัมน์ในปัจจุบันไม่สะดวก ส่วนหัวเช่นvalueจะไม่เหมาะเพราะพวกเขามีความขัดแย้งกับpivot_longer()'s ".value"กลไก ประการที่สองdf_1มีvalues(เป็นพหูพจน์) เมื่อkeyตัวเลือกมีมากกว่าหนึ่งตัวเลือก (เช่น "สีแดง" และ "สีเขียว" สำหรับcolor) แต่value(เอกพจน์) เมื่อมีเพียงตัวเลือกเดียวสำหรับkey(เช่นมีage) ด้านล่างนี้คือรหัสที่ไม่สำเร็จของฉันซึ่งได้รับแรงบันดาลใจจากคำตอบนี้
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
ฉันขาดเทคนิคการโต้เถียงเพื่อแก้ปัญหานี้
คำตอบ
แนวทางที่เป็นระเบียบเรียบร้อยเพื่อให้ได้ผลลัพธ์ที่คุณต้องการอาจมีลักษณะดังนี้:
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]>
แก้ไขหลังจากการชี้แจงในความคิดเห็นของคุณเกี่ยวกับผลลัพธ์ที่ต้องการเราก็สามารถกำจัดคำสั่งแผนที่ในตอนท้าย (ซึ่งโดยทั่วไปมีไว้สำหรับการแปลง tibbles สำหรับหมวดหมู่ที่ไม่มีระดับเป็นเวกเตอร์) และเพิ่มคำสั่งกลายพันธุ์ก่อนที่จะซ้อนกันเพื่อแทนที่ ระดับกับ NA สำหรับหมวดหมู่ที่ไม่มี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
ทางเลือกหนึ่งที่จะส่งคืนเอาต์พุตประเภทเดียวกันกับอินพุตที่ให้มา:
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]>
โครงสร้างของผลลัพธ์:
$ 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"
นี่คือdata.tableวิธีแก้ปัญหาเพราะฉันสบายใจกับmeltและdcastแต่ควรโอนไปยังdplyr:
library(data.table)
df <- setDT(df_1)
plouf <- melt(df,measure.vars = patterns("value")) %>%
.[!is.na(value),.(key,level = gsub("values.","",variable),value)]
สิ่งนี้ให้:
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
ตอนนี้คุณสามารถวนซ้ำkeyค่าที่ไม่ซ้ำกันเพื่อส่งออกสิ่งที่คุณต้องการ:
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]
}
})
)
ที่นี่คุณจะได้รับ tibble ที่ซ้อนกันของคุณ (พร้อม data.tables และตัวอักษรภายใน)