stat_function和legends:使用映射到不同变量的两个独立的颜色图例创建绘图 [英] stat_function and legends: create plot with two separate colour legends mapped to different variables

查看:143
本文介绍了stat_function和legends:使用映射到不同变量的两个独立的颜色图例创建绘图的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

我想用ggplot2在一幅图像中组合两种不同类型的图。这里是我使用的代码:

  fun.bar<  -  function(x,param = 4){
return (((x + 1)^(1-param))/(1-param))
}

plot.foo < - 函数(df,par = c 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,color = variable))+
geom_point(position =jitter,alpha = 0.2,size = 2)+
xlim(-1,1)+ ylim(-5,5)+
guides(color =
guide_legend(Type,override.aes = list(alpha = 1,size = 4)))
pal < - brewer.pal(length(par),Set1)
for在seq_along(par)){
p < - p + stat_function(fun = fun.bar,
arg = list(param = par [i]),color = 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.2 5))
plot.foo(df.foo)

结果,我得到下面的图片。

但是,我想要另一个图例,颜色从红色到粉红色,在曲线下部显示有关曲线参数的信息。问题是这两个部分的关键美学是颜色,所以通过 scale_colour_manual()手动覆盖会破坏现有的图例。



我知道这是一个唯美 - 一个传奇的概念,但在这种特殊情况下我怎么能绕过这个限制?


<当看前面 stat_function 图例的例子时, >在SO上,我觉得让这两个人快乐地生活在一起并不是很容易,没有一些硬编码由 stat_summary 生成的每条曲线(我会很高兴发现我错了)。见例如此处 here ,和此处。在最后回答@baptiste写道:在绘图之前建立一个data.frame会更好。这就是我在我的答案中尝试的:我使用该函数预先计算了数据,然后使用 geom_line 而不是 stat_summary 在情节。

 #加载相关的程序包
library(ggplot2)
library(reshape2)
library RColorBrewer)
library(gridExtra)
library(gtable)
library(plyr)

#创建基础数据
df< - data.frame( A = rnorm(1000,sd = 0.25),
B = rnorm(1000,sd = 0.25),
C = rnorm(1000,sd = 0.25))
melt.df< - 熔化(df)
melt.df $ ypos < - as.numeric(melt.df $变量)

#仅绘制点数,获得点数$ b $的颜色图例b p1 < - ggplot(data = melt.df,aes(x = value,y = ypos,color = variable))+
geom_point(position =jitter,alpha = 0.2,size = 2)+
xlim(-1,1)+ ylim(-5,5)+
guides(color =
guide_legend(Type,override.aes = list(alpha = 1,size = 4)))

p1

#获取点的颜色图例
legend_points< - gtable_filter(ggplot_gtable(ggplot_build(p1)),guide-box )

#为点取色。用于最终绘图
point_cols< - unique(ggplot_build(p1)[[data]] [[1]] $ color)


#创建数据对于
#行定义函数
fun.bar< - function(x,param = 4){
return(((x + 1)^(1 - param))/ (1 - param))
}

#行参数
pars = c(1.7,2:8)

#参数和x(即x = melt.df $ value),
#为行计算ypos
df2 < - ldply(.data = pars,.fun = function(pars){
ypos = fun.bar(melt.df $ value,pars)
data.frame(pars = pars,value = melt.df $ value,ypos)
})

#行的颜色调色板
line_cols< - brewer.pal(length(pars),Set1)

#仅限绘制线条,以获得行的颜色图例
#请注意,当使用ylim时:
#不在此范围内的观察值将完全丢弃并且不会传递到任何其他层
#因此警告
p2 < - ggplot(data = df2,
aes(x = value,y = ypos,group = pars,color = as.factor(pars))+
geom_line()+
xlim(-1,1)+ ylim(-5,5)+
scale_colour_manual(name =Param,values = line_cols,labels = as.character(pars))

p2

#获取线条的颜色图例
legend_lines< ; - gtable_filter(ggplot_gtable(ggplot_build(p2)),guide-box)


#绘制带有图例的点和线条被压制
p3 < - ggplot(data = a.color = variable,
position =jitter,alpha = 0.2,size = 2)+
geom_point(x = value,y = ypos) b $ b geom_line(data = df2,aes(group = pars,color = as.factor(pars)))+
xlim(-1,1)+ ylim(-5,5)+
theme(legend.position =none)+
scale_colour_manual(values = c(line_cols,point_cols))
#'scale_colour_manual'中的颜色按照它们出现在图例$ b $中的顺序添加b#线颜色(2,3)出现在点cols(A,B,C)之前
#稍微硬编码
#请参阅a备选在

p3

以下$ b $为带有视口的点和线设置图形和图例
#定义绘图区域(视口)
#一些硬编码
grid.newpage()
vp_plot< - viewport(x = 0.45,y = 0.5,
width = 0.9,height = 1)

vp_legend_points < - 视口(x = 0.91,y = 0.7,
宽度= 0.1,高度= 0.25)

vp_legend_lines< - 视口(x = 0.93,y = 0.35,
宽度= 0.1,高度= 0.75)

#添加阴谋
打印(p3,vp = vp_plot)

#为点添加图例
upViewport (0)
pushViewport(vp_legend_points)
grid.draw(legend_points)

#添加图例
upViewport(0)
pushViewport(vp_legend_lines)
grid.draw(legend_lines)


 #第二个替代方案是对颜色的更好的控制
#首先,绘制颜色图例中的点和线都被抑制
#let ggplot选择颜色
p3 < - ggplot(data = melt.df,aes(x = value,y = ypos))+
geom_point(aes(color = variable),
position =jitter,alpha = 0.2,size = 2)+
geom_line(data = df2 ,aes(group = pars,color = as.factor(pars)))+
xlim(-1,1)+ ylim(-5,5)+
theme(legend.position =none )

p3

#渲染p3渲染
#获取可以操纵的数据框列表(每层一个)
第3页< - ggplot_build(p3)

#从图p1中获取点颜色的整个向量
point_cols_vec < - ggplot_build(p1)[[data]] [[1]] $ color

#从图中获取线条颜色的整个矢量p2
line_cols_vec< - ggplot_build(p2)[[data]] [[1]] $ color

#将颜色值替换为点,颜色来自图p1
#点位于第一层 - > 'data'列表中的第一个元素
pp3 [[data]] [[1]] $ color < - point_cols_vec

#用行替换'color'值来自图p2
#行的颜色位于第二层 - > 'data'列表中的第二个元素
pp3 [[data]] [[2]] $ color <-line_cols_vec

#从ggplot_build生成的数据
#在grid.draw中使用
grob3< - ggplot_gtable(pp3)

#排列绘图和带有视口的两个图例
#定义绘图区域(视口)
vp_plot< - 视口(x = 0.45,y = 0.5,
宽度= 0.9,高度= 1)

vp_legend_points< - 视口(x = 0.91 ,y = 0.7,
width = 0.1,height = 0.25)

vp_legend_lines< - 视口(x = 0.92,y = 0.35,
宽度= 0.1,高度= 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)


I would like to combine two different types of plots in one image with ggplot2. Here's the code I 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")
 for (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 a result, I get the following picture. However, I'd like to have another legend with colours from red to pink, displaying information about parameters of curves in the lower part of the plot. The problem is the key aesthetics for both parts is the colour, so manual overriding via scale_colour_manual() destroys the existing legend.

I understand there's a "one aesthetic -- one legend" concept, but how can I bypass this restriction in this specific case?

解决方案

When looking at previous examples of stat_function and legend on SO, I got the impression that it is not very easy to make the two live happily together without some hard-coding of each curve generated by stat_summary (I would be happy to find that I am wrong). See e.g. here, here, and here. In the last answer @baptiste wrote: "you'll be better off building a data.frame before plotting". That's what I try in my answer: I pre-calculated data using the function, and then use geom_line instead of stat_summary in the 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, to get a colour legend for 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 for points
legend_points <- gtable_filter(ggplot_gtable(ggplot_build(p1)), "guide-box")

# grab colours for points. To be used in final plot
point_cols <- unique(ggplot_build(p1)[["data"]][[1]]$colour)


# create data for lines
# define function for lines
fun.bar <- function(x, param = 4) {
  return(((x + 1) ^ (1 - param)) / (1 - param))
}

# parameters for lines
pars = c(1.7, 2:8)

# for each value of parameters and x (i.e. x = melt.df$value),
# calculate ypos for 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 for lines
line_cols <- brewer.pal(length(pars), "Set1")    

# plot lines only, to get a colour legends for lines
# please note that when using ylim:
# "Observations not in this range will be dropped completely and not passed to any other layers"
# thus the 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 for lines
legend_lines <- gtable_filter(ggplot_gtable(ggplot_build(p2)), "guide-box") 


# plot both points and lines with 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))
  # the colours in 'scale_colour_manual' are added in the order they appear in the legend
  # line colour (2, 3) appear before point cols (A, B, C)
  # slightly hard-coded
  # see alternative below

p3

# arrange plot and legends for points and lines with viewports
# define plotting regions (viewports)
# some 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 for points
upViewport(0)
pushViewport(vp_legend_points)
grid.draw(legend_points)

# add legend for lines
upViewport(0)
pushViewport(vp_legend_lines)
grid.draw(legend_lines)

# A second alternative, with greater control over the colours
# First, plot both points and lines with colour legend suppressed
# let ggplot choose the 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 for rendering
# get a list of data frames (one for each layer) that can be manipulated
pp3 <- ggplot_build(p3)

# grab the whole vector of point colours from plot p1
point_cols_vec <- ggplot_build(p1)[["data"]][[1]]$colour

# grab the whole vector of line colours from plot p2
line_cols_vec <- ggplot_build(p2)[["data"]][[1]]$colour

# replace 'colour' values for points, with the colours from plot p1
# points are in the first layer -> first element in the 'data' list
pp3[["data"]][[1]]$colour <- point_cols_vec

# replace 'colour' values for lines, with the colours from plot p2
# lines are in the second layer -> second element in the 'data' list
pp3[["data"]][[2]]$colour <- line_cols_vec

# build a plot grob from the data generated by ggplot_build
# to be used in grid.draw below
grob3 <- ggplot_gtable(pp3)

# arrange plot and the two legends with 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)

这篇关于stat_function和legends:使用映射到不同变量的两个独立的颜色图例创建绘图的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆