ワイドフォーマットからロングフォーマットにピボットしてから、列をネストします
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は、female = 0.5とのいずれかを持つことができますmale = 0.5。一方、のage値は1つだけです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と競合するため、理想的ではありません。第二に、持っているとき（複数で）複数のオプションを持っている（例えば、「赤」とは「グリーン」）が、のためのちょうど1つのオプションがありますとき（単数）（などのように）。以下は、この回答に触発された、失敗したコードです。pivot_longer()".value"df_1valueskeycolorvaluekeyage
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：のないカテゴリのNAのレベル
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
提供された入力と同じタイプの出力を返す1つのオプション：
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]
}
})
)
ここで、ネストされたtibbleを取得します（data.tablesと文字が含まれています）