R ggplot：ファセットのトラブルごとに異なるgeom_rectsを持つfacet_grid

Question

私は歩行のさまざまなフェーズを識別するためにいくつかのピーク検出を実行した加速度計データの時系列データセットを持っています。私はggplotを使用して左右の脚のデータをfacet_gridの2つのファセットとしてプロットしています。今度は、それぞれの脚の歩き方の相違を表示するためにgeom_rectをオーバーレイします。私はrectレイヤーを追加することができますが、左の脚のファセットには左のgeom_rectを、右のファセットには右のgeom_rectを保持する方法を理解できません。例えば、体重が左脚にあるときの歩行サイクル（左の姿勢段階）では、右脚が前方にスイングしている（右はスイング段階）ので、位相のタイミングが異なります。これは、左のトラフと右のトラフの時刻を視覚的に比較することで確認できます。

私はGoogleで検索して自分の道をSO'ed問題を通って、私は答えを見つけることができませんでしたしました。私が見つけた最も近いものはthisですが、作者はファセットの中で同じgeom_rectを使用していますので、私が欲しいものではありません。私は単純化されたRscriptとデータをcsvのものとして添付しました。誰も私にこのプロットを作るためのヒントを教えてもらえますか？

facet_rects_test.zip (.csv and R Script)

感謝！

Answer 1

tidyr関数を使用answerは最適なソリューションです。もちろん、すでによく知っているreshape2パッケージを使って、必要な結果を得ることができます。

欠けていた重要な要素は、名前とレベルが同じであれば、複数のデータ引数からファセット変数を取得できることです。以下の関数は、データを読み込んだときに動作します（関数定義をスクリプトで最初に使用する前に置いておきたいのですが！）。

plotAccelerometerDataWithPhasesSuperimposed <- function(acceldf, phasesdf) { 

    # melt the rows for column left/right in order to facet_wrap on it 
    acceldf_melted <- melt(acceldf[, c('time_ms', 'Ly', 'Ry')], 
         id.vars = 'time_ms') 

    # make the facet variables identical 
    phasesdf$variable <- factor(phasesdf$side, levels = c('Left', 'Right'), 
           labels = c('Ly', 'Ry')) 

    ggplot(acceldf_melted, aes(x=time_ms, y=value)) + 

    # Phases 
    geom_rect(data = phasesdf, inherit.aes = FALSE, aes(
     xmin = acceldf$time_ms[swingStart], 
     xmax = acceldf$time_ms[heelStrike] - 1, 
     ymin = -Inf, ymax = Inf, fill = "Swing"), colour = NA, alpha = 0.3) + 
    geom_rect(data = phasesdf, inherit.aes = FALSE, aes(
     xmin = acceldf$time_ms[toeOff], 
     xmax = acceldf$time_ms[swingEnd] - 1, 
     ymin = -Inf, ymax = Inf, fill = "Pre-swing"), colour = NA, alpha = 0.3) + 
    geom_rect(data = phasesdf, inherit.aes = FALSE, aes(
     xmin = acceldf$time_ms[heelStrike], 
     xmax = acceldf$time_ms[toeOff] - 1, 
     ymin = -Inf, ymax = Inf, fill = "Stance"), colour = NA, alpha = 0.3) + 

    # Lines 
    facet_grid(variable~., labeller = labeller(
     variable = c(Ly = "Left", Ry = "Right"))) + 
    labs(title = "Gait Phases by Accelerometer", x = "time (ms)", 
     y = "Sensors Values") + 
    geom_line() + 
    scale_fill_manual('Phases', 
     values = c('firebrick2', 'orange', 'steelblue2'), 
     guide = guide_legend()) + 
    guides(colour = FALSE) + 
    theme(legend.direction = "horizontal", legend.position = "bottom", 
      strip.text.y = element_text(size=16, colour = "blue")) 
} 

Answer 2

これはデータを正しい形式にするための問題だと思います。

library(tidyverse) 

最初に、gait_cycleを長形式に変換して正しく名前を付けましょう。 LyとRyをLeftとRightに変換し、グループ化変数sideをgaitPointsデータフレームのside列と一致するように呼び出します。両方のデータフレームには、ファセットに使用する同じside列があり、各データフレームの対応するデータが確実に目的のファセットにプロットされます。 gather関数は、データフレームを長形式に変換します（tidyrパッケージにあり、meltをreshape2に置き換えます）。

gait_cycle_m = gait_cycle %>% 
    select(-X) %>% 
    rename(Left=Ly, Right=Ry) %>% 
    gather(side, value, -time_ms) 

今、私たちは3人の歩行Phasesプロットするために正しく設定を取得する必要があります。 geom_rectを一度呼び出してデータ列を美学に直接マップできるように、「長い」データフレームが必要です。したがって、歩行サイクルの各フェーズの開始と終了を示すb（開始）列とe（終了）列を作成します。その後、審美的になるPhases列を作成します（つまり、各データ行が表す歩容のどの段階にマークするか）。

gaitPoints_new = data.frame(swingStart=gait_cycle$time_ms[gaitPoints$swingStart], 
          heelStrike=gait_cycle$time_ms[gaitPoints$heelStrike], 
          toeOff=gait_cycle$time_ms[gaitPoints$toeOff], 
          swingEnd=gait_cycle$time_ms[gaitPoints$swingEnd], 
          side=gaitPoints$side) 

gaitPoints_new = bind_rows(gaitPoints_new %>% select(b=1,e=2,5) %>% mutate(Phases="Pre-swing"), 
          gaitPoints_new %>% select(b=2,e=3,5) %>% mutate(Phases="Stance"), 
          gaitPoints_new %>% select(b=3,e=4,5) %>% mutate(Phases="Swing")) 

データが正しく設定されたら、プロットは比較的簡単です。以下のコードでは引数とaesマッピングをgeomステートメントの内部にのみ入力するため、aesの継承に問題はありません。

ggplot() + 
    geom_rect(data=gaitPoints_new, aes(xmin=b, xmax=e, ymin=-Inf, max=Inf, fill=Phases), alpha=0.5) + 
    geom_line(data=gait_cycle_m, aes(x=time_ms, y=value)) + 
    facet_grid(side ~ .) + 
    scale_fill_manual(values=c('firebrick2','orange','steelblue2')) + 
    theme_bw() + 
    theme(legend.position = "bottom") + 
    labs(x="Time (ms)", y="Sensor Values")