2012-06-20 27 views
22

は、データセットである:ggplot2を使って描画したヒストグラムに矢印を描くにはどうすればよいですか?ここ

set.seed(123) 
    myd <- data.frame (class = rep(1:4, each = 100), yvar = rnorm(400, 50,30)) 
    require(ggplot2) 
    m <- ggplot(myd, aes(x = yvar)) 
    p <- m + geom_histogram(colour = "grey40", fill = "grey40", binwidth = 10) + 
     facet_wrap(~class) + theme_bw() 
    p + opts(panel.margin=unit(0 ,"lines")) 

私はにどの各被験者クラス秋棒にラベルを追加し、事後処理さパワーポイントグラフのようなものを生成します。 Rの中でこれを行う方法はありますか? ......

編集:私たちは、このようなドットやエラーバーなど、さまざまなポインターと考えることができ、矢印は不可能ではない場合

enter image description here

のは、以下のラベル付けする科目であるとしましょう:

ここで
class name  yvar 
2  subject4 104.0 
3  subject3 8.5 
3  subject1 80.0 
4  subject2 40.0 
4  subject1 115.0 

classd <- data.frame (class = c(2,3,3,4,4), 
name = c ("subject4", "subject3", "subject1", "subject2", "subject1"), 
yvar = c(104.0, 8.5,80.0,40.0, 115.0)) 
+0

あなたは確かにggplot内からのもののような矢印を追加することができますが、より具体的にする必要があります。あなたは、どのバーが入ってくるのかを判断できるように、いくつかのサンプルデータを提供できますか? – joran

+0

@joranオクラホマサンプルデータを追加しました。 – jon

答えて

15

更新optsは廃止されます。代わりにthemeを使用してください。

bdemarestの応答を少し伸ばして、これはプログラム的にバーの高さを計算すると思います。 arrow_posの最後の2つの列には、関連情報が含まれています。Freqはバーの高さです。 xvalは、バーの中間点のx位置にあります。しかし、まだいくつかのラベルがバーに重なっています。デフォルトcutにより

EDITのようにその区間の境界(B1、B2]、それはggplot2としてgeom_histogramにおけるその間隔の境界ことappeasに対し[B1、B2)。私はコードを変更して両方の間隔を[b1、b2]、つまりggplotのようにしました。

library(ggplot2) 
library(grid) # unit() is in the grid package. 
library(plyr) # Data restructuring 

set.seed(123) 
myd <- data.frame (class = rep(1:4, each = 100), yvar = rnorm(400, 50, 30)) 

arrow_pos = read.table(header=TRUE, stringsAsFactors=FALSE, 
         text="class name  yvar 
          2  subject4 104.0 
          3  subject3 8.5 
          3  subject1 80.0 
          4  subject2 40.0 
          4  subject1 115.0") 

# Calculate the y positions for the labels and arrows 
# For the myd data frame, obtain counts within each bin, but separately for each class 
bwidth <- 10 # Set binwidth 
Min <- floor(min(myd$yvar)/bwidth) * bwidth 
Max <- ceiling(max(myd$yvar)/bwidth) * bwidth 

# Function to do the counting 
func <- function(df) { 
    tab = as.data.frame(table(cut(df$yvar, breaks = seq(Min, Max, bwidth), right = FALSE))) 
    tab$upper = Min + bwidth * (as.numeric(rownames(tab))) 
    return(tab) 
    } 

# Apply the function to each class in myd data frame 
TableOfCounts <- ddply(myd, .(class), function(df) func(df)) 

# Transfer counts of arrow_pos 
arrow_pos$upper <- (floor(arrow_pos$yvar/bwidth) * bwidth) + bwidth 
arrow_pos <- merge(arrow_pos, TableOfCounts, by = c("class", "upper")) 
arrow_pos$xvar <- (arrow_pos$upper - .5 * bwidth)  # x position of the arrow is at the midpoint of the bin 
arrow_pos$class=factor(as.character(arrow_pos$class), 
    levels=c("1", "2", "3", "4")) # Gets rid of warnings. 

ggplot(myd, aes(x=yvar)) + 
    theme_bw() + 
    geom_histogram(colour="grey70", fill="grey70", binwidth=bwidth) + 
    facet_wrap(~ class) + 
    theme(panel.margin=unit(0, "lines")) + 
    geom_text(data=arrow_pos, aes(label=name, x=xvar, y=Freq + 2), size=4) + 
    geom_segment(data=arrow_pos, 
        aes(x=xvar, xend=xvar, y=Freq + 1.5, yend=Freq + 0.25), 
        arrow=arrow(length=unit(2, "mm"))) 

enter image description here

17

矢印を追加するarrowオプションでラベルとgeom_segment()を追加するgeom_text()を使用して部分的な解決策です。

欠点は、矢印とラベルごとにyの位置を手動で選択する必要があったことです。たぶん誰かが、ヒストグラムバーの高さをプログラムでどのように見つけるかを理解するのに役立つかもしれません。

set.seed(123) 
myd <- data.frame (class = rep(1:4, each = 100), yvar = rnorm(400, 50,30)) 

library(ggplot2) 
library(grid) # unit() is in the grid package. 

arrow_pos = read.table(header=TRUE, stringsAsFactors=FALSE, 
         text="class name  yvar 
          2  subject4 104.0 
          3  subject3 8.5 
          3  subject1 80.0 
          4  subject2 40.0 
          4  subject1 115.0") 

arrow_pos$y = c(3, 5, 9, 13, 1) # Manually enter y position. 
arrow_pos$class = factor(as.character(arrow_pos$class), 
    levels=c("1", "2", "3", "4")) # Gets rid of warnings. 

p1 = ggplot(myd, aes(x=yvar)) + 
    theme_bw() + 
    geom_histogram(colour="grey40", fill="grey40", binwidth=10) + 
    facet_wrap(~ class) + 
    opts(panel.margin=unit(0 ,"lines")) + 
    geom_text(data=arrow_pos, aes(label=name, x=yvar, y=y + 2), size=3) + 
    geom_segment(data=arrow_pos, 
        aes(x=yvar, xend=yvar, y=y + 1.5, yend=y + 0.25), 
        arrow=arrow(length=unit(2, "mm"))) 

png("p1.png", height=600, width=600) 
print(p1) 
dev.off() 

enter image description here

+0

ありがとうございます。私はあなたが最初に答えて、アイデアを開始するので、あなたの答えを受け入れることができればいいと思います。 2番目の答え...しかし、感謝のトークンに値する – jon

+2

私は助けることができてうれしい!私は@Sandy Musprattが完全なソリューションの功績に値することに同意します。 – bdemarest

関連する問題