r - stat_function and legends: create plot with two separate colour legends mapped to different variables -
i combine 2 different types of plots in 1 image ggplot2. here's code use:
fun.bar <- function(x, param = 4) { return(((x + 1) ^ (1 - param)) / (1 - param)) } plot.foo <- function(df, par = c(1.7, 2:8)) { require(ggplot2) require(reshape2) require(rcolorbrewer) melt.df <- melt(df) melt.df$ypos <- as.numeric(melt.df$variable) p <- ggplot(data = melt.df, aes(x = value, y = ypos, colour = variable)) + geom_point(position = "jitter", alpha = 0.2, size = 2) + xlim(-1, 1) + ylim(-5, 5) + guides(colour = guide_legend("type", override.aes = list(alpha = 1, size = 4))) pal <- brewer.pal(length(par), "set1") (i in seq_along(par)) { p <- p + stat_function(fun = fun.bar, arg = list(param = par[i]), colour = pal[i], size = 1.3) } p } df.foo <- data.frame(a=rnorm(1000, sd=0.25), b=rnorm(1000, sd=0.25), c=rnorm(1000, sd=0.25)) plot.foo(df.foo) as result, following picture. 
however, i'd have legend colours red pink, displaying information parameters of curves in lower part of plot. problem key aesthetics both parts colour, manual overriding via scale_colour_manual() destroys existing legend.
i understand there's "one aesthetic -- 1 legend" concept, how can bypass restriction in specific case?
when looking @ previous examples of stat_function , legend on so, got impression not easy make 2 live happily without hard-coding of each curve generated stat_summary (i happy find wrong). see e.g. here, here, , here. in last answer @baptiste wrote: "you'll better off building data.frame before plotting". that's try in answer: pre-calculated data using function, , use geom_line instead of stat_summary in plot.
# load relevant packages library(ggplot2) library(reshape2) library(rcolorbrewer) library(gridextra) library(gtable) library(plyr) # create base data df <- data.frame(a = rnorm(1000, sd = 0.25), b = rnorm(1000, sd = 0.25), c = rnorm(1000, sd = 0.25)) melt.df <- melt(df) melt.df$ypos <- as.numeric(melt.df$variable) # plot points only, colour legend points p1 <- ggplot(data = melt.df, aes(x = value, y = ypos, colour = variable)) + geom_point(position = "jitter", alpha = 0.2, size = 2) + xlim(-1, 1) + ylim(-5, 5) + guides(colour = guide_legend("type", override.aes = list(alpha = 1, size = 4))) p1 # grab colour legend points legend_points <- gtable_filter(ggplot_gtable(ggplot_build(p1)), "guide-box") # grab colours points. used in final plot point_cols <- unique(ggplot_build(p1)[["data"]][[1]]$colour) # create data lines # define function lines fun.bar <- function(x, param = 4) { return(((x + 1) ^ (1 - param)) / (1 - param)) } # parameters lines pars = c(1.7, 2:8) # each value of parameters , x (i.e. x = melt.df$value), # calculate ypos lines df2 <- ldply(.data = pars, .fun = function(pars){ ypos = fun.bar(melt.df$value, pars) data.frame(pars = pars, value = melt.df$value, ypos) }) # colour palette lines line_cols <- brewer.pal(length(pars), "set1") # plot lines only, colour legends lines # please note when using ylim: # "observations not in range dropped , not passed other layers" # warnings p2 <- ggplot(data = df2, aes(x = value, y = ypos, group = pars, colour = as.factor(pars))) + geom_line() + xlim(-1, 1) + ylim(-5, 5) + scale_colour_manual(name = "param", values = line_cols, labels = as.character(pars)) p2 # grab colour legend lines legend_lines <- gtable_filter(ggplot_gtable(ggplot_build(p2)), "guide-box") # plot both points , lines legend suppressed p3 <- ggplot(data = melt.df, aes(x = value, y = ypos)) + geom_point(aes(colour = variable), position = "jitter", alpha = 0.2, size = 2) + geom_line(data = df2, aes(group = pars, colour = as.factor(pars))) + xlim(-1, 1) + ylim(-5, 5) + theme(legend.position = "none") + scale_colour_manual(values = c(line_cols, point_cols)) # colours in 'scale_colour_manual' added in order appear in legend # line colour (2, 3) appear before point cols (a, b, c) # hard-coded # see alternative below p3 # arrange plot , legends points , lines viewports # define plotting regions (viewports) # hard-coding of positions grid.newpage() vp_plot <- viewport(x = 0.45, y = 0.5, width = 0.9, height = 1) vp_legend_points <- viewport(x = 0.91, y = 0.7, width = 0.1, height = 0.25) vp_legend_lines <- viewport(x = 0.93, y = 0.35, width = 0.1, height = 0.75) # add plot print(p3, vp = vp_plot) # add legend points upviewport(0) pushviewport(vp_legend_points) grid.draw(legend_points) # add legend lines upviewport(0) pushviewport(vp_legend_lines) grid.draw(legend_lines) 
# second alternative, greater control on colours # first, plot both points , lines colour legend suppressed # let ggplot choose colours p3 <- ggplot(data = melt.df, aes(x = value, y = ypos)) + geom_point(aes(colour = variable), position = "jitter", alpha = 0.2, size = 2) + geom_line(data = df2, aes(group = pars, colour = as.factor(pars))) + xlim(-1, 1) + ylim(-5, 5) + theme(legend.position = "none") p3 # build p3 rendering # list of data frames (one each layer) can manipulated pp3 <- ggplot_build(p3) # grab whole vector of point colours plot p1 point_cols_vec <- ggplot_build(p1)[["data"]][[1]]$colour # grab whole vector of line colours plot p2 line_cols_vec <- ggplot_build(p2)[["data"]][[1]]$colour # replace 'colour' values points, colours plot p1 # points in first layer -> first element in 'data' list pp3[["data"]][[1]]$colour <- point_cols_vec # replace 'colour' values lines, colours plot p2 # lines in second layer -> second element in 'data' list pp3[["data"]][[2]]$colour <- line_cols_vec # build plot grob data generated ggplot_build # used in grid.draw below grob3 <- ggplot_gtable(pp3) # arrange plot , 2 legends viewports # define plotting regions (viewports) vp_plot <- viewport(x = 0.45, y = 0.5, width = 0.9, height = 1) vp_legend_points <- viewport(x = 0.91, y = 0.7, width = 0.1, height = 0.25) vp_legend_lines <- viewport(x = 0.92, y = 0.35, width = 0.1, height = 0.75) grid.newpage() pushviewport(vp_plot) grid.draw(grob3) upviewport(0) pushviewport(vp_legend_points) grid.draw(legend_points) upviewport(0) pushviewport(vp_legend_lines) grid.draw(legend_lines)
Comments
Post a Comment