Update opts
is deprecated; use theme
instead.
Extending bdemarest's response a little, I think this calculates the bar heights programatically. The last two columns of arrow_pos
contain the relevant information: Freq
is the height of the bar; xval
in the x position of the midpoint of the bar. But still, some of the labels overlap the bars.
EDIT By default cut
bounds its intervals as (b1, b2], whereas it appeas that ggplot2
bounds its intervals in geom_histogram as [b1, b2). I've modified the code so that both bound their intervals as [b1, b2), ie the ggplot way.
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")))
