ggplot2：異なるスケールのファセットでファセットを作成するときのボックスプロットの幅が正しくありません

Question

ファセット付きボックスプロットが必要です。プロットのx軸は量的変数であり、この情報をプロットに反映させたい。横軸のスケールはファセット間で非常に異なる。

私の問題は、大規模なファセットの場合、ボックスの幅が非常に小さいことです。

ボックスの幅はすべてのファセットで同じですが、理想的には各ファセットのxlimによって決まるはずです。

私は2つの入力に対して感謝される：

• あなたは、これはバグであると報告されなければならないと思いますか？
• 解決策はありますか？

ありがとうございます！

備考：横座標をカテゴリ変数に変換することは1つの解決策になる可能性がありますが、いくつかの情報が失われるため完全ではありません。

最小実施例：

library(tidyverse) 

c(1:4,7) %>% 
    c(.,10*.) %>% # Create abscissa on two different scales 
    lapply(FUN = function(x) {tibble(x = x, y = rnorm(50), idx = ifelse(test = x<8, yes = 'A', no = 'B'))}) %>% # Create sample (y) and label (idx) 
    bind_rows() %>% 
    ggplot(aes(x = x, y = y, group = x)) + 
    geom_boxplot() + 
    facet_wrap(~idx, scales = 'free') 

結果：

面倒な溶液が最初から箱ひげ図を再描画することであろうが、これは非常に満足ではない：

draw_boxplot = function(locations, width, ymin, lower, middle, upper, ymax, idx){ 

    local_df = tibble(locations = locations, width = width, ymin = ymin, lower = lower, middle = middle, upper = upper, ymax = ymax, idx = idx) 

    ggplot(data = local_df) + 
    geom_rect(aes(xmin = locations - width/2, xmax = locations + width/2, ymin = lower, ymax = upper), fill = 'white', colour = 'black') + 
    geom_segment(aes(x = locations - width/2, xend = locations + width/2, y = middle, yend = middle), size = 0.8) + 
    geom_segment(aes(x = locations, xend = locations, y = upper, yend = ymax)) + 
    geom_segment(aes(x = locations, xend = locations, y = lower, yend = ymin)) + 
    facet_wrap(~idx, scales = 'free_x') 
} 

make_boxplot = function(to_plot){ 
    to_plot %>% 
    cmp_boxplot %>% 
    (function(x){ 
     draw_boxplot(locations = x$x, width = x$width, ymin = x$y0, lower = x$y25, middle = x$y50, upper = x$y75, ymax = x$y100, idx = x$idx) 
    }) 

} 


cmp_boxplot = function(to_plot){ 
    to_plot %>% 
    group_by(idx) %>% 
    mutate(width = 0.6*(max(x) - min(x))/length(unique(x))) %>% #hand specified width 
    group_by(x) %>% 
    mutate(y0 = min(y), 
      y25 = quantile(y, 0.25), 
      y50 = median(y), 
      y75 = quantile(y, 0.75), 
      y100 = max(y)) %>% 
    select(-y) %>% 
    unique() 
} 

c(1:4,7) %>% 
    c(.,10*.) %>% 
    lapply(FUN = function(x) {tibble(x = x, y = rnorm(50), idx = ifelse(test = x<8, yes = 'A', no = 'B'))}) %>% 
    bind_rows() %>% 
    make_boxplot 

結果：

Answer 1

geom_boxplotは美的としてwidthを変えることはできませんので、あなた自身を記述する必要があります。幸いにもそれほど複雑ではありません。

bp_custom <- function(vals, type) { 

    bp = boxplot.stats(vals) 

    if(type == "whiskers") { 
    y = bp$stats[1] 
    yend = bp$stats[5] 
    return(data.frame(y = y, yend = yend)) 
    } 

    if(type == "box") { 
    ymin = bp$stats[2] 
    ymax = bp$stats[4] 
    return(data.frame(ymin = ymin, ymax = ymax)) 
    } 

    if(type == "median") { 
    y = median(vals) 
    yend = median(vals) 
    return(data.frame(y = y, yend = yend)) 
    } 

    if(type == "outliers") { 
    y = bp$out 
    return(data.frame(y = y)) 
    } else { 
    return(warning("Type must be one of 'whiskers', 'box', 'median', or 'outliers'.")) 
    } 
} 

この機能は、すべての計算を行い、stat_summaryでの使用に適したデータフレームを返します。次に、それをいくつかの異なるレイヤーで呼び出して、ボックスプロットのさまざまなビットを構築します。ファセットのグループごとにボックスプロットの幅を計算する必要があることに注意してください（パイプ内でdplyrを使用）。 xの範囲が一意の番号xの値に基づいて等しいセグメントに分割されるような幅を計算した場合、各ボックスはそのセグメントの幅の約1/2になります。データに異なる調整が必要な場合があります。バグ（実際に必要な機能）としてこれを報告するよう

library(dplyr) 

c(1:4,7) %>% 
    c(.,10*.) %>% # Create abscissa on two different scales 
    lapply(FUN = function(x) { 
    tibble(x = x, y = rnorm(50), idx = ifelse(test = x<8, yes = 'A', no = 'B')) 
    }) %>% 
    bind_rows() %>%         
    group_by(idx) %>%            # NOTE THIS LINE 
    mutate(width = 0.25*diff(range(x))/length(unique(x))) %>%  # NOTE THIS LINE 
    ggplot(aes(x = x, y = y, group = x)) + 
    stat_summary(fun.data = bp_custom, fun.args = "whiskers", 
       geom = "segment", aes(xend = x)) + 
    stat_summary(fun.data = bp_custom, fun.args = "box", 
       geom = "rect", aes(xmin = x - width, xmax = x + width), 
       fill = "white", color = "black") + 
    stat_summary(fun.data = bp_custom, fun.args = "median", 
       geom = "segment", aes(x = x - width, xend = x + width), size = 1.5) + 
    stat_summary(fun.data = bp_custom, fun.args = "outliers", 
       geom = "point") + 
    facet_wrap(~idx, scales = 'free') 

、私はそれは彼らがそれに優先順位を付けないであろうことをまれに十分なユースケースだと思います。このコードをカスタムgeom（hereに基づく）にラップしてプルリクエストを送信すると、運が増える可能性があります。