ネストされていないtibble列:dplyrv1.0.0を使用した「ワイド」データサマリー

1
Limey 2020-06-12 17:03.

この種の形式でデータの「広い」要約テーブルを作成したいと思います。

                                   ----   Centiles  ----
Param    Group   Mean       SD      25%     50%      75%
Height       1   x.xx    x.xxx     x.xx    x.xx     x.xx
             2   x.xx    x.xxx     x.xx    x.xx     x.xx
             3   x.xx    x.xxx     x.xx    x.xx     x.xx
Weight       1   x.xx    x.xxx     x.xx    x.xx     x.xx
             2   x.xx    x.xxx     x.xx    x.xx     x.xx
             3   x.xx    x.xxx     x.xx    x.xx     x.xx

私はdplyr0.8.xでそれを行うことができます。任意の数のレベルを持つ任意のグループ化変数と、任意の数の任意の名前の変数を要約する任意の統計を処理できる関数を使用して、一般的にそれを行うことができます。データを整理することで、そのレベルの柔軟性が得られます。それはこの質問が何であるかではありません。

まず、いくつかのおもちゃのデータ:

set.seed(123456)

toy <- tibble(
         Group=rep(1:3, each=5),
         Height=1.65 + rnorm(15, 0, 0.1),
         Weight= 75 + rnorm(15, 0, 10)
       ) %>% 
       pivot_longer(
         values_to="Value", 
         names_to="Parameter",
         cols=c(Height, Weight)
       )

さて、簡単な要約関数とヘルパー:

quibble2 <- function(x, q = c(0.25, 0.5, 0.75)) {
  tibble(Value := quantile(x, q), "Quantile" := q)
}

mySummary <- function(data, ...) {
  data %>% 
    group_by(Parameter, Group) %>% 
    summarise(..., .groups="drop")
}

だから私は次のようなことを言うことができます

summary <- mySummary(toy, Q=quibble2(Value), Mean=mean(Value, na.rm=TRUE), SD=sd(Value, na.rm=TRUE))
summary %>% head()

与える

# A tibble: 6 x 5
  Parameter Group Q$Value $Quantile  Mean     SD
  <chr>     <int>   <dbl>     <dbl> <dbl>  <dbl>
1 Height        1    1.45      0.25  1.54 0.141 
2 Height        1    1.49      0.5   1.54 0.141 
3 Height        1    1.59      0.75  1.54 0.141 
4 Height        2    1.64      0.25  1.66 0.0649
5 Height        2    1.68      0.5   1.66 0.0649
6 Height        2    1.68      0.75  1.66 0.0649

これが私が必要とする要約ですが、それは長い形式です。そしてQですdf-col。それはちょっとしたことです:

is_tibble(summary$Q)
[1] TRUE

したがって、pivot_wider機能していないようです。nest_by()グループごとに1行の形式にするために使用できます。

toySummary <- summary %>% nest_by(Group, Mean, SD)
toySummary
# Rowwise:  Group, Mean, SD
  Group  Mean      SD               data
  <int> <dbl>   <dbl> <list<tbl_df[,2]>>
1     1  1.54  0.141             [3 × 2]
2     1 78.8  10.2               [3 × 2]
3     2  1.66  0.0649            [3 × 2]
4     2 82.9   9.09              [3 × 2]
5     3  1.63  0.100             [3 × 2]
6     3 71.0  10.8               [3 × 2]

しかし、現在、百分位数の形式はさらに複雑です。

> toySummary$data[1]
<list_of<
  tbl_df<
    Parameter: character
    Q        : 
      tbl_df<
        Value   : double
        Quantile: double
      >
  >
>[1]>
[[1]]
# A tibble: 3 x 2
  Parameter Q$Value $Quantile
  <chr>       <dbl>     <dbl>
1 Height       1.45      0.25
2 Height       1.49      0.5 
3 Height       1.59      0.75

のように見えるlistのでlapply、おそらく何らかの形で機能すると思いますが、まだ見つけていない、きちんとした、きちんとした解決策はありますか?私はこの質問を研究しながら、アボ知らなかったことをいくつかの新しい動詞を発見した(choppackrowwise()nest_byおよびなど)が、どれも私が欲しいものを私に与えているように見える:理想的には、tibble6行で(ユニークで定義されたGroupParameterし、列の組み合わせ)以下のためMeanSDQ25Q50Q75

最初の2つの提案された回答に応じて明確にするために:私のおもちゃの例が生成する正確な数値を取得することは、v1.0.0で返される(s)から一般的な形式の幅広いデータ要約に移行するための一般的な手法を見つけることよりも重要ではありません私の例が示すように。df-colsummarisedplyr

2 answers

1
TimTeaFan 2020-06-13 06:34.

修正された回答

これが私の修正された答えです。今回は、quibble2関数をenframeとで書き直して、3行のpivot_wideratibbleを返すようにしました。

これは再びdf-colあなたのにつながりますsummary tibble、そして今、私たちは期待される結果を得るためにunpack使用せずに直接使用することができますpivot_wider

これは、百分位数などにも一般化する必要があります。

library(tidyverse)

set.seed(123456)

toy <- tibble(
  Group=rep(1:3, each=5),
  Height=1.65 + rnorm(15, 0, 0.1),
  Weight= 75 + rnorm(15, 0, 10)
) %>% 
  pivot_longer(
    values_to="Value", 
    names_to="Parameter",
    cols=c(Height, Weight)
  )

quibble2 <- function(x, q = c(0.25, 0.5, 0.75)) {
  pivot_wider(enframe(quantile(x, q)),
              names_from = name,
              values_from = value) 
}

mySummary <- function(data, ...) {
  data %>% 
    group_by(Parameter, Group) %>% 
    summarise(..., .groups="drop")
}

summary <- mySummary(toy, Q=quibble2(Value), Mean=mean(Value, na.rm=TRUE), SD=sd(Value, na.rm=TRUE))

summary %>% 
  unpack(Q)
#> # A tibble: 6 x 7
#>   Parameter Group `25%` `50%` `75%`  Mean    SD
#>   <chr>     <int> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1 Height        1  1.62  1.66  1.73  1.70 0.108
#> 2 Height        2  1.73  1.77  1.78  1.76 0.105
#> 3 Height        3  1.55  1.64  1.76  1.65 0.109
#> 4 Weight        1 75.6  80.6  84.3  80.0  9.05 
#> 5 Weight        2 75.4  76.9  79.6  77.4  7.27 
#> 6 Weight        3 70.7  75.2  82.0  76.3  6.94

2020年6月13日に作成されたreprexパッケージ(v0.3.0)

第二のアプローチ変えずにquibble2、我々は最初の呼び出しに必要になりunpack、その後とpivot_wider。これもスケーリングする必要があります。

library(tidyverse)

set.seed(123456)

toy <- tibble(
  Group=rep(1:3, each=5),
  Height=1.65 + rnorm(15, 0, 0.1),
  Weight= 75 + rnorm(15, 0, 10)
) %>% 
  pivot_longer(
    values_to="Value", 
    names_to="Parameter",
    cols=c(Height, Weight)
  )

quibble2 <- function(x, q = c(0.25, 0.5, 0.75)) {
  tibble(Value := quantile(x, q), "Quantile" := q)
}

mySummary <- function(data, ...) {
  data %>% 
    group_by(Parameter, Group) %>% 
    summarise(..., .groups="drop")
}

summary <- mySummary(toy, Q=quibble2(Value), Mean=mean(Value, na.rm=TRUE), SD=sd(Value, na.rm=TRUE))

summary %>% 
  unpack(Q) %>% 
  pivot_wider(names_from = Quantile, values_from = Value)
#> # A tibble: 6 x 7
#>   Parameter Group  Mean    SD `0.25` `0.5` `0.75`
#>   <chr>     <int> <dbl> <dbl>  <dbl> <dbl>  <dbl>
#> 1 Height        1  1.70 0.108   1.62  1.66   1.73
#> 2 Height        2  1.76 0.105   1.73  1.77   1.78
#> 3 Height        3  1.65 0.109   1.55  1.64   1.76
#> 4 Weight        1 80.0  9.05   75.6  80.6   84.3 
#> 5 Weight        2 77.4  7.27   75.4  76.9   79.6 
#> 6 Weight        3 76.3  6.94   70.7  75.2   82.0

reprexパッケージ(v0.3.0)の

一般化 されたアプローチによって2020-06-13に作成されました。関数を
書き直すことによって、より一般的なアプローチを理解しようとしましたmySummary。これでdf-cols、ベクトルまたは名前付きベクトルを返す出力が自動的に変換されます。またlist、必要に応じて式を自動的にラップします。

次に、supportedの呼び出しを含め、行を保持することにより、可能な限りwiden拡張する関数を定義しました。dfbroom::tidylist-columns

アプローチは完全ではなくunnest_widerwiden関数に含めることで拡張できます。

t.test別の出力例として使用できるように、例のグループ化を変更したことに注意してください。

library(tidyverse)
set.seed(123456)

toy <- tibble(
  Group=rep(1:3, each=5),
  Height=1.65 + rnorm(15, 0, 0.1),
  Weight= 75 + rnorm(15, 0, 10)
) %>% 
  pivot_longer(
    values_to="Value", 
    names_to="Parameter",
    cols=c(Height, Weight)
  )

# modified summary function
mySummary <- function(data, ...) {

  fns <- rlang::enquos(...)

  fns <- map(fns, function(x) {

    res <- rlang::eval_tidy(x, data = data)

    if ( ((is.vector(res)  || is.factor(res)) && length(res) == 1) ||
         ("list" %in% class(res) && is.list(res)) ||
           rlang::call_name(rlang::quo_get_expr(x)) == "list") {
      x
    }
    else if ((is.vector(res)  || is.factor(res)) && length(res) > 1) {
      x_expr <- as.character(list(rlang::quo_get_expr(x)))
      x_expr <- paste0(
        "pivot_wider(enframe(",
        x_expr,
        "), names_from = name, values_from = value)"
      )
      x <- rlang::quo_set_expr(x, str2lang(x_expr))

      x
    } else {
      x_expr <- as.character(list(rlang::quo_get_expr(x)))
      x_expr <- paste0("list(", x_expr,")")
      x <- rlang::quo_set_expr(x, str2lang(x_expr))

      x
    }
  })

  data %>% 
    group_by(Parameter) %>%
    summarise(!!! fns, .groups="drop")
}


# A function to automatically widen the df as much as possible while preserving rows
widen <- function(df) {

  df_cols <- names(df)[map_lgl(df, is.data.frame)]
  df <- unpack(df, all_of(df_cols), names_sep = "_")

  try_tidy <- function(x) {
    tryCatch({
      broom::tidy(x)
    }, error = function(e) {
      x
    })
  }

  df <- df %>% rowwise() %>% mutate(across(where(is.list), try_tidy))
  ungroup(df)
}

# if you want to specify function arguments for convenience use purrr::partial
quantile3 <- partial(quantile, x = , q = c(.25, .5, .75))

summary <- mySummary(toy,
                     Q = quantile3(Value),
                     R = range(Value),
                     T_test = t.test(Value),
                     Mean = mean(Value, na.rm=TRUE),
                     SD = sd(Value, na.rm=TRUE)
)

summary 
#> # A tibble: 2 x 6
#>   Parameter Q$`0%` $`25%` $`50%` $`75%` $`100%` R$`1`  $`2` T_test Mean SD #> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <list> <dbl> <dbl> #> 1 Height 1.54 1.62 1.73 1.77 1.90 1.54 1.90 <htest> 1.70 0.109 #> 2 Weight 67.5 72.9 76.9 83.2 91.7 67.5 91.7 <htest> 77.9 7.40 widen(summary) #> # A tibble: 2 x 11 #> Parameter `Q_0%` `Q_25%` `Q_50%` `Q_75%` `Q_100%` R_1 R_2 T_test$estimate
#>   <chr>      <dbl>   <dbl>   <dbl>   <dbl>    <dbl> <dbl> <dbl>           <dbl>
#> 1 Height      1.54    1.62    1.73    1.77     1.90  1.54  1.90            1.70
#> 2 Weight     67.5    72.9    76.9    83.2     91.7  67.5  91.7            77.9 
#> # … with 9 more variables: $statistic <dbl>, $p.value <dbl>, $parameter <dbl>, #> # $conf.low <dbl>, $conf.high <dbl>, $method <chr>, $alternative <chr>,
#> #   Mean <dbl>, SD <dbl>

reprexパッケージ(v0.3.0)によって2020-06-14に作成されました

0
Ian Campbell 2020-06-13 00:31.

quibble2リストを返すように変更してから使用するとunnest_widerどうなりますか?

quibble2 <- function(x, q = c(0.25, 0.5, 0.75)) {
  list(quantile(x, q))
}
mySummary(toy, Q=quibble2(Value), Mean=mean(Value, na.rm=TRUE), SD=sd(Value, na.rm=TRUE)) %>%
  unnest_wider(Q)
# A tibble: 6 x 7
  Parameter Group `25%` `50%` `75%`  Mean    SD
  <chr>     <int> <dbl> <dbl> <dbl> <dbl> <dbl>
1 Height        1  1.62  1.66  1.73  1.70 0.108
2 Height        2  1.73  1.77  1.78  1.76 0.105
3 Height        3  1.55  1.64  1.76  1.65 0.109
4 Weight        1 75.6  80.6  84.3  80.0  9.05 
5 Weight        2 75.4  76.9  79.6  77.4  7.27 
6 Weight        3 70.7  75.2  82.0  76.3  6.94 

Related questions

MORE COOL STUFF

Reba McEntire は、彼女が息子の Shelby Blackstock と共有する「楽しい」クリスマスの伝統を明らかにしました:「私たちはたくさん笑います」

Reba McEntire は、彼女が息子の Shelby Blackstock と共有する「楽しい」クリスマスの伝統を明らかにしました:「私たちはたくさん笑います」

Reba McEntire が息子の Shelby Blackstock と共有しているクリスマスの伝統について学びましょう。

メーガン・マークルは、自然な髪のスタイリングをめぐってマライア・キャリーと結ばれました

メーガン・マークルは、自然な髪のスタイリングをめぐってマライア・キャリーと結ばれました

メーガン・マークルとマライア・キャリーが自然な髪の上でどのように結合したかについて、メーガンの「アーキタイプ」ポッドキャストのエピソードで学びましょう.

ハリー王子は家族との関係を修復できるという「希望を持っている」:「彼は父親と兄弟を愛している」

ハリー王子は家族との関係を修復できるという「希望を持っている」:「彼は父親と兄弟を愛している」

ハリー王子が家族、特にチャールズ王とウィリアム王子との関係について望んでいると主張したある情報源を発見してください。

ワイノナ・ジャッドは、パニックに陥った休暇の瞬間に、彼女がジャッド家の家長であることを認識しました

ワイノナ・ジャッドは、パニックに陥った休暇の瞬間に、彼女がジャッド家の家長であることを認識しました

ワイノナ・ジャッドが、母親のナオミ・ジャッドが亡くなってから初めての感謝祭のお祝いを主催しているときに、彼女が今では家長であることをどのように認識したかを学びましょう.

セントヘレナのジェイコブのはしごを登るのは、気弱な人向けではありません

セントヘレナのジェイコブのはしごを登るのは、気弱な人向けではありません

セント ヘレナ島のジェイコブズ ラダーは 699 段の真っ直ぐ上る階段で、頂上に到達すると証明書が発行されるほどの難易度です。

The Secrets of Airline Travel Quiz

The Secrets of Airline Travel Quiz

Air travel is far more than getting from point A to point B safely. How much do you know about the million little details that go into flying on airplanes?

Where in the World Are You? Take our GeoGuesser Quiz

Where in the World Are You? Take our GeoGuesser Quiz

The world is a huge place, yet some GeoGuessr players know locations in mere seconds. Are you one of GeoGuessr's gifted elite? Take our quiz to find out!

バイオニック読書はあなたをより速く読むことができますか?

バイオニック読書はあなたをより速く読むことができますか?

BionicReadingアプリの人気が爆発的に高まっています。しかし、それは本当にあなたを速読術にすることができますか?

2017年の最も人気のある投稿

2017年の最も人気のある投稿

ここLifehackerでは大きな年でした。一緒に、私たちはミツバチを救おうとし、ハッキングされ、太陽をじっと見つめ、グロスチェーンレストランの食べ物を食べ、核爆弾から身を隠しました。

ラストコール:素晴らしき人生だ、コーシャワイン、そしてジュリアチャイルドはユールログを作るのが苦手

ラストコール:素晴らしき人生だ、コーシャワイン、そしてジュリアチャイルドはユールログを作るのが苦手

写真:ゲッティイメージズ経由のハーバート・ドーフマン/コービスさて、昨日、幼い子供たちにマジシャンズを見させて銃を飛び越えていたようです。知っておくと良い!昨夜、娘と私はシカゴの素晴らしいビンテージシアターであるミュージックボックスで映画を見に行きました。年齢に関係なく、誰も問題を抱えてはいけません。それは素晴らしい人生です。

それにふたを置きます。実際、すべてに蓋をしてください。14ドルで12個のシリコンストレッチキッチン蓋を手に入れよう. [エクスクルーシブ]

それにふたを置きます。実際、すべてに蓋をしてください。14ドルで12個のシリコンストレッチキッチン蓋を手に入れよう. [エクスクルーシブ]

Tomorrow's Kitchen シリコンストレッチ蓋 12個パック | $14 | アマゾン | プロモーション コード 20OFFKINJALids は基本的にキッチンの靴下です。常に迷子になり、二度と閉じられない孤立したコンテナーが残ります。しかし、蓋が伸びて、残った容器、鍋、フライパン、さらには大きなスライスされた果物のすべてに適合するとしたらどうでしょうか? その非常に特殊な蓋を失うことを二度と心配する必要はありません。

あなたの最高のワシントン DC ハックを教えてください

あなたの最高のワシントン DC ハックを教えてください

このコラムでは、ロサンゼルスやラスベガスなど、いくつかの産業都市をハッキングしました。今こそ、軍産複合都市の時代です。

米国のフィギュア スケートは、チーム イベントでの最終決定の欠如に「苛立ち」、公正な裁定を求める

米国のフィギュア スケートは、チーム イベントでの最終決定の欠如に「苛立ち」、公正な裁定を求める

ロシアのフィギュアスケーター、カミラ・バリエバが関与したドーピング事件が整理されているため、チームは2022年北京冬季オリンピックで獲得したメダルを待っています。

Amazonの買い物客は、わずか10ドルのシルクの枕カバーのおかげで、「甘やかされた赤ちゃんのように」眠れると言っています

Amazonの買い物客は、わずか10ドルのシルクの枕カバーのおかげで、「甘やかされた赤ちゃんのように」眠れると言っています

何千人ものAmazonの買い物客がMulberry Silk Pillowcaseを推奨しており、現在販売中. シルクの枕カバーにはいくつかの色があり、髪を柔らかく肌を透明に保ちます。Amazonで最大46%オフになっている間にシルクの枕カバーを購入してください

パデュー大学の教授が覚醒剤を扱った疑いで逮捕され、女性に性的好意を抱かせる

パデュー大学の教授が覚醒剤を扱った疑いで逮捕され、女性に性的好意を抱かせる

ラファイエット警察署は、「不審な男性が女性に近づいた」という複数の苦情を受けて、12 月にパデュー大学の教授の捜査を開始しました。

コンセプト ドリフト: AI にとって世界の変化は速すぎる

コンセプト ドリフト: AI にとって世界の変化は速すぎる

私たちの周りの世界と同じように、言語は常に変化しています。以前の時代では、言語の変化は数年または数十年にわたって発生していましたが、現在では数日または数時間で変化する可能性があります。

SF攻撃で91歳のアジア人女性が殴られ、コンクリートに叩きつけられた

犯罪擁護派のオークランドが暴力犯罪者のロミオ・ロレンゾ・パーハムを釈放

SF攻撃で91歳のアジア人女性が殴られ、コンクリートに叩きつけられた

認知症を患っている 91 歳のアジア人女性が最近、47 番街のアウター サンセット地区でロメオ ロレンゾ パーハムに襲われました。伝えられるところによると、被害者はサンフランシスコの通りを歩いていたところ、容疑者に近づき、攻撃を受け、暴行を受けました。

Precios accesibles, nuestro aprendizaje desde la perspectiva iOS

Precios accesibles, nuestro aprendizaje desde la perspectiva iOS

Cómo mejoramos la accesibilidad de nuestro componente de precio, y cómo nos marcó el camino hacia nuevos saberes para nuestro sistema de diseño. Por Ana Calderon y Laura Sarmiento Leer esta historia en inglés.

ℝ

“And a river went out of Eden to water the garden, and from thence it was parted and became into four heads” Genesis 2:10. ? The heart is located in the middle of the thoracic cavity, pointing eastward.

Language