Rでggplot2を使用してファンネルプロットを描画する方法


12

タイトルとして、私はこのようなものを描く必要があります:

代替テキスト

ggplot、またはggplotが機能しない場合は他のパッケージを使用して、このようなものを描画できますか?


2
これを行う方法と実装する方法についていくつかのアイデアがありますが、いくつかのデータを操作していただければ幸いです。その上で何かアイデアはありますか?
チェイス

1
はい、ggplotは点と線で構成されるプロットを簡単に描画できます;)geom_smoothは95%の方法を提供します-さらにアドバイスが必要な場合は、詳細を提供する必要があります。
ハドリーは

2
これはファンネルプロットではありません。代わりに、入場者数に基づく標準誤差の推定値から線が構築されていることは明らかです。それらは、許容範囲の制限となる特定の割合のデータを囲むことを意図しているようです それらはおそらくy =ベースライン+定数/ Sqrt(#入学* f(ベースライン))の形式です。既存の応答のコードを変更して線をグラフ化することもできますが、それらを計算するために独自の式を提供する必要がある可能性があります。私が見た例では、適合線自体の信頼区間をプロットしています。だから彼らはとても異なって見えます。
whuber

@whuber(+1)それは確かに非常に良い点です。とにかくこれが良い出発点になると思います(私のRコードが最適化されていなくても)。
2010

Ggplotはまだstat_quantile()散布図に条件付き分位数を配置するために提供しています。その後、式パラメーターを使用して、変位値回帰の関数形式を制御できます。y~ns(x,4)スムーズなスプラインフィットを得るには、formula =のようなものをお勧めします。
シアパークス2013年

回答:


12

改善の余地はありますが、シミュレーションされた(異分散)データを使用した小さな試みを次に示します。

library(ggplot2)
set.seed(101)
x <- runif(100, min=1, max=10)
y <- rnorm(length(x), mean=5, sd=0.1*x)
df <- data.frame(x=x*70, y=y)
m <- lm(y ~ x, data=df) 
fit95 <- predict(m, interval="conf", level=.95)
fit99 <- predict(m, interval="conf", level=.999)
df <- cbind.data.frame(df, 
                       lwr95=fit95[,"lwr"],  upr95=fit95[,"upr"],     
                       lwr99=fit99[,"lwr"],  upr99=fit99[,"upr"])

p <- ggplot(df, aes(x, y)) 
p + geom_point() + 
    geom_smooth(method="lm", colour="black", lwd=1.1, se=FALSE) + 
    geom_line(aes(y = upr95), color="black", linetype=2) + 
    geom_line(aes(y = lwr95), color="black", linetype=2) +
    geom_line(aes(y = upr99), color="red", linetype=3) + 
    geom_line(aes(y = lwr99), color="red", linetype=3)  + 
    annotate("text", 100, 6.5, label="95% limit", colour="black", 
             size=3, hjust=0) +
    annotate("text", 100, 6.4, label="99.9% limit", colour="red", 
             size=3, hjust=0) +
    labs(x="No. admissions...", y="Percentage of patients...") +    
    theme_bw() 

代替テキスト


20

この(メタ分析)タイプのファンネルプロットを探している場合は、以下が出発点となる場合があります。

library(ggplot2)

set.seed(1)
p <- runif(100)
number <- sample(1:1000, 100, replace = TRUE)
p.se <- sqrt((p*(1-p)) / (number))
df <- data.frame(p, number, p.se)

## common effect (fixed effect model)
p.fem <- weighted.mean(p, 1/p.se^2)

## lower and upper limits for 95% and 99.9% CI, based on FEM estimator
number.seq <- seq(0.001, max(number), 0.1)
number.ll95 <- p.fem - 1.96 * sqrt((p.fem*(1-p.fem)) / (number.seq)) 
number.ul95 <- p.fem + 1.96 * sqrt((p.fem*(1-p.fem)) / (number.seq)) 
number.ll999 <- p.fem - 3.29 * sqrt((p.fem*(1-p.fem)) / (number.seq)) 
number.ul999 <- p.fem + 3.29 * sqrt((p.fem*(1-p.fem)) / (number.seq)) 
dfCI <- data.frame(number.ll95, number.ul95, number.ll999, number.ul999, number.seq, p.fem)

## draw plot
fp <- ggplot(aes(x = number, y = p), data = df) +
    geom_point(shape = 1) +
    geom_line(aes(x = number.seq, y = number.ll95), data = dfCI) +
    geom_line(aes(x = number.seq, y = number.ul95), data = dfCI) +
    geom_line(aes(x = number.seq, y = number.ll999), linetype = "dashed", data = dfCI) +
    geom_line(aes(x = number.seq, y = number.ul999), linetype = "dashed", data = dfCI) +
    geom_hline(aes(yintercept = p.fem), data = dfCI) +
    scale_y_continuous(limits = c(0,1.1)) +
  xlab("number") + ylab("p") + theme_bw() 
fp

代替テキスト


1
存在linetype=2内部引数aes()ブラケット- 99%の線をプロット-現在ggplot2(0.9.3.1)と「連続変数は、線種にマッピングすることができません」エラーを生じさせます。私のためgeom_line(aes(x = number.seq, y = number.ll999, linetype = 2), data = dfCI)geom_line(aes(x = number.seq, y = number.ll999), linetype = 2, data = dfCI)働くように修正します。元の回答を自由に修正して、これを失ってください。


2

Bernd Weissのコードは非常に役立ちます。いくつかの機能を変更/追加するために、以下の修正を行いました。

  1. 精度の尺度として標準誤差を使用しました。これは、私が見るファンネルプロットのより一般的なものです(心理学)
  2. 軸を入れ替えたので、精度(標準誤差)はy軸にあり、効果サイズはx軸にあります
  3. メタ分析平均を区切る線のgeom_segment代わりに使用geom_lineされるため、95%および99%の信頼領域を区切る線と同じ高さになります。
  4. メタ分析平均をプロットする代わりに、95%の信頼区間をプロットしました

私のコードでは、例として0.0892(se = 0.0035)のメタ分析平均を使用していますが、独自の値で置き換えることもできます。

estimate = 0.0892
se = 0.0035

#Store a vector of values that spans the range from 0
#to the max value of impression (standard error) in your dataset.
#Make the increment (the final value) small enough (I choose 0.001)
#to ensure your whole range of data is captured
se.seq=seq(0, max(dat$corr_zi_se), 0.001)

#Compute vectors of the lower-limit and upper limit values for
#the 95% CI region
ll95 = estimate-(1.96*se.seq)
ul95 = estimate+(1.96*se.seq)

#Do this for a 99% CI region too
ll99 = estimate-(3.29*se.seq)
ul99 = estimate+(3.29*se.seq)

#And finally, calculate the confidence interval for your meta-analytic estimate 
meanll95 = estimate-(1.96*se)
meanul95 = estimate+(1.96*se)

#Put all calculated values into one data frame
#You might get a warning about '...row names were found from a short variable...' 
#You can ignore it.
dfCI = data.frame(ll95, ul95, ll99, ul99, se.seq, estimate, meanll95, meanul95)


#Draw Plot
fp = ggplot(aes(x = se, y = Zr), data = dat) +
  geom_point(shape = 1) +
  xlab('Standard Error') + ylab('Zr')+
  geom_line(aes(x = se.seq, y = ll95), linetype = 'dotted', data = dfCI) +
  geom_line(aes(x = se.seq, y = ul95), linetype = 'dotted', data = dfCI) +
  geom_line(aes(x = se.seq, y = ll99), linetype = 'dashed', data = dfCI) +
  geom_line(aes(x = se.seq, y = ul99), linetype = 'dashed', data = dfCI) +
  geom_segment(aes(x = min(se.seq), y = meanll95, xend = max(se.seq), yend = meanll95), linetype='dotted', data=dfCI) +
  geom_segment(aes(x = min(se.seq), y = meanul95, xend = max(se.seq), yend = meanul95), linetype='dotted', data=dfCI) +
  scale_x_reverse()+
  scale_y_continuous(breaks=seq(-1.25,2,0.25))+
  coord_flip()+
  theme_bw()
fp

ここに画像の説明を入力してください

弊社のサイトを使用することにより、あなたは弊社のクッキーポリシーおよびプライバシーポリシーを読み、理解したものとみなされます。
Licensed under cc by-sa 3.0 with attribution required.