चौड़े से लेकर लंबे प्रारूप और फिर नेस्टिंग कॉलम

Jan 04 2021

मुझे एक विस्तृत प्रारूप में दिया गया डेटा दिया गया है। प्रत्येक पंक्ति वर्तमान तालिका के लिए एक बाहरी चर से संबंधित है, और उस चर के लिए प्रासंगिक संभव मान। मैं कोशिश कर रहा हूँ: (1) लम्बे प्रारूप में धुरी, और (2) घोंसले के पिवोट मान।

उदाहरण

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भी हो सकता है । दूसरी ओर, का केवल एक ही मूल्य हो सकता है । पंक्ति # 3 से हम सीखते हैं कि और , और के मूल्य हो सकते हैं ।female = 0.5male = 0.5age50colorred = TRUEgreen = 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()के ".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

मुझे इसे हल करने के लिए कुछ कमज़ोर चाल की कमी है।

जवाब

4 stefan Jan 04 2021 at 06:10

अपने वांछित परिणाम को प्राप्त करने के लिए एक व्यापक दृष्टिकोण ऐसा लग सकता है:

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]>

संपादित करें वांछित परिणाम पर आपकी टिप्पणियों में स्पष्टीकरण के बाद हम अंत में नक्शे के बयान से छुटकारा पा सकते हैं (जो मूल रूप से वेक्टर के स्तर के बिना श्रेणियों के लिए टिबेल्स को परिवर्तित करने के लिए था) और नेस्टिंग से पहले एक उत्परिवर्ती बयान जोड़ें। बिना श्रेणियों के एनए के साथ स्तर 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

3 tmfmnk Jan 04 2021 at 06:38

एक विकल्प जो आपूर्ति किए गए इनपुट के समान आउटपुट लौटाएगा:

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"

1 denis Jan 04 2021 at 06:01

यहां एक 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]
                 }
               })
               
)

यहां आप अपना नेस्टेड टिबबल (डेटा के साथ। टेबल्स और अक्षर अंदर) प्राप्त करते हैं