安排大量的情节并与r中的线连接
我有大量的小块地块需要放在一个更大的地块画布上,并将小块地块安排进去并用线条连接起来.一个小例子如下所示:
A到L是独立的图.给出了他们的位置的坐标.
绘图网格坐标:PlotgridX和plotgridY可以决定小图需要居中的时间
plotcord <- data.frame (
plotname = c("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L"),
plotgridX = c( 1.5, 2, 5, 5.5, 1.75, 5.25, 8 , 1 , 2, 3.5, 6, 7.5),
plotgridY = c( 3, 3, 3, 3, 2 , 2, 2, 2 , 1, 1, 1, 1))
plotname plotgridX plotgridY
1 A 1.50 3
2 B 2.00 3
3 C 5.00 3
4 D 5.50 3
5 E 1.75 2
6 F 5.25 2
7 G 8.00 2
8 H 1.00 2
9 I 2.00 1
10 J 3.50 1
11 K 6.00 1
12 L 7.50 1
连接线由以下数据框决定:
connectd <- data.frame (id = c( "E", "F", "I", "J", "K", "L"),
parent1 = c("A", "C", "H", "E" ,"E", "F"),
parent2 = c("B", "D", "E", "F", "F", "G"))
connectd
id parent1 parent2
1 E A B
2 F C D
3 I H E
4 J E F
5 K E F
6 L F G
例如,这里图E应连接到其父1"A",父2"B"图同时连接"A","B"应连接以使其成为"T形"连接.对于其他ID也是如此.
虽然我有其他细节可以在每个子图中绘制,但作为概念证明,我想绘制一个带有名称为n1和n2的每个图的矩形,以形成如下图:
ags*_*udy 12
赏金开始后编辑:
- Chage如何计算线的坐标:无需使用合并
- 更改如何绘制连接线:相当连接的线条.
首先,我需要将连接数据从点标签转换为协调点(x,y)
## here the edit
dat.lines <- do.call(cbind,apply(connectd,2,
function(x){
id <- match(x,plotcord$plotname)
plotcord[id,c(2,3)]}))
colnames(dat.lines) <- paste(rep(c('x','y'),3),rep(1:3,each=2),sep='')
这就是它看起来我的dat.lines:
x1 y1 x2 y2 x3 y3
1 1.750 2 1.50 3 2.00 3
2 5.250 2 5.00 3 5.50 3
3 1.375 1 1.00 2 1.75 2
4 3.500 1 1.75 2 5.25 2
5 6.000 1 1.75 2 5.25 2
6 7.500 1 5.25 2 8.00 2
然后,我使用晶格绘制点xyplot.晶格的使用非常适合这种情节.无需对数据进行处理(例如网格包).然后我自定义面板添加矩形,段,...
library(latticeExtra))
xyplot(plotgridY~plotgridX,data= plotcord,
panel=function(x,y,...){
apply(dat.lines,1,function(x){
panel.segments(x0=x['x2'],y0=x['y2'],x1=x['x3'],y1=x['y3'])
boxh <- 0.5
x1=x['x1']
y1=x['y1']
y2 <- x['y2']
x2 <- (x['x2']+x['x3'])/2
ydelta <- (y2 - y1)/2
browser()
panel.segments(c(x1, x1, x2), c(y1, y1 + ydelta, y2 -
ydelta), c(x1, x2, x2), c(y1 + ydelta, y2 -
ydelta, y2))
})
panel.rect(x=x,y=y,width=unit(2,'cm'),
height=unit(2,'cm'),col='lightyellow')
panel.xyplot(x,y,...)
panel.text(x,y,adj=c(0,-3),
label=plotcord$plotname,cex=1.5)
## add some prove of concept detail
panel.rect(x=x,y=y,width=unit(0.5,'cm'),
height=unit(0.5,'cm'),col='lightblue',lty=2)
panel.text(x,y,adj=c(1,2),
label=paste(plotcord$plotname,1,sep=''),cex=1,col='blue')
panel.text(x,y,adj=c(-0.5,2),
label=paste(plotcord$plotname,2,sep=''),
cex=1,col='blue')
},ylim=extendrange(plotcord$plotgridY,f=0.5),xlab='',ylab='', axis = axis.grid,
main='Arrangement of large number of plots \n and connect with lines ')
Din*_*nre 12
我正在写这个答案,部分是为了子孙后代,部分是因为我一直想为其他一些试图在R中进行自定义可视化的人写一些这样的函数.
背景
在R中,许多人正确地留下了基本绘图功能,并开始转向更灵活的包装包,'lattice'和'ggplot2'.这些是通过在单个图上应用逻辑层来快速浏览数据的强大工具.然后包处理所有层并产生一个适当排列的绘图窗口.这些包很棒,我建议每个R用户至少学习其中一个.
但需要注意的是,'lattice'和'ggplot2'软件包实际上更适用于数据探索,而不是智能数据可视化.在创建自定义数据可视化时,这些包会为您做出太多决定,因为这就是包装器的用途:从您手中做出一些决策.
定制可视化？输入'grid'
基础'网格'包是最大的绘图灵活性,部分原因是它扩展了基础绘图功能的功能,而不是包装它们.通过"网格"功能,我们可以使用各种不同的单位创建可视对象以进行放置和大小调整,并且(这非常重要)我们可以使用对齐锚点的理由.如果你想学习,Paul Murrell的书"R Graphics"是一本很好的资源.它的副本坐在我的桌子上.
如果您曾经使用过矢量图形绘制程序(如Illustrator或Inkscape),那么当我提到理由时,您可能已经知道我在谈论什么.这是通过引用其他项目的位置来对项目进行排序的功能.我会更多地谈论这个,但我可以整天谈论它.让我们继续讨论这个过程.
这个过程
现在,我应该这样说,我花了大约两个小时来编写函数库,大约花了5分钟来编写演示代码.我将来将使用函数库作为培训工具,任何人都可以随意使用/修改它.
"网格"过程分为三个基本步骤:
- 制作一个视口
- 画一些物体
- 弹出您的视口
在制作视口时,我们使用'pushViewport'来推送'viewport'对象,如下所示:
pushViewport(viewport(x=0, y=1, xscale=c(1, 10), yscale=c(0, 100), width=0.25, height=0.25, default.units="npc", just=c("left","bottom"), clip="off"))
基本视口有一组"npc"单位,其中x从0到1,从左到右,y从0到1,从下到上.这意味着原点位于左下角.上面的视口创建为左下角绘图的四分之一.但是,当我们指定"xscale"和"yscale"时,我们可以在绘制对象时引用"本机"单位.这意味着我们可以使用"原生"单位绘制数据,并在绘制轴和标签等内容时使用"npc"单位.
绘制对象时,我们使用'grid.lines','grid.polygon','grid.points','grid.circle'等函数.我做过的每个可视化都使用了这些对象.通过手动指定这些对象来绘制数据时,您将获得大量的控制权.填充折线图是添加功能的最明显示例之一.填充区域只是一个多边形,其中多边形的点由数据指定,并添加了两个锚点.我用它来突出折线图的区域,或者更容易在同一个图表上读取多行.
您还可以创造性,例如,创建非矩形的条形图,或以更复杂的方式组合多个图形.我和其他一些人最近开了一个以科幻为主题的步行游戏,我们使用自定义图表(用'网格'制作)来显示我们的最终表现.该图表将"幸存者"团队的天数与时间轴相结合,将球员与每天的敌人步数显示为条形图,并将每天累积的球员和敌人步数显示为实线图.我会很难用'lattice'或'ggplot2'软件包创建一个类似的视觉效果.
以下是其中一个图表(没有现实生活中的玩家名称)的示例,以便了解"网格"视觉效果的灵活性:
问题的概念证明
现在专门解决OP提出的问题.在这个问题中,OP意味着他/她将在每个区域内绘制图表.使用预先构建的绘图包时,这可能会变得棘手,因为大多数绘图功能将覆盖您已设置的任何绘图规范.相反,使用诸如基本"网格"功能之类的东西来指定绘图区域然后在视口中绘制必要的数据对象更为可靠.
为了避免工作太辛苦,我首先编写了一个自定义函数库,它设置了我的各种图表参数,并为我绘制了每种类型的图表.我不喜欢调试代码,因此函数是我处理事物的方式.每次我得到一段正确的代码,我都会把它扔进一个函数供以后使用.
代码可能看起来有点复杂,但请记住三个"网格"步骤:推视口,绘图,弹出视口.这是每个功能正在做的事情.为了演示这项工作,我制作了四种不同的绘图功能:填充折线图,散点图,直方图和OP建议的方框图.每个函数都足够灵活,可以在每个图表中容纳多组数据值,设置alpha值以进行补偿,并允许我们查看相互叠加的值.
在这种情况下,你只需要使你的功能变得灵活,所以我确实在线上使用了一个快捷方式,并从演示中的一些代码中提取了很多假设.不过,我仍然用逻辑驱动的代码绘制它,以演示如何使用简单的逻辑绘制更复杂的对象.
以下是演示代码的结果,使用一些内置的R数据集来实现简单的数据(EuStockMarkets,nottem,sunspots.month):
自定义函数库:
library(grid)
# Specify general chart options.
chart_Fill = "lemonchiffon"
chart_Col = "snow3"
space_Background = "white"
title_CEX = 0.8
axis_CEX = 0.6
chart_Width <- 3/3
chart_Height <- 2/5
# Function to initialize a plotting area.
init_Plot <- function(
.df,
.x_Loc,
.y_Loc,
.justify,
.width,
.height
){
# Initialize plotting area to fit data.
# We have to turn off clipping to make it
# easy to plot the labels around the plot.
pushViewport(viewport(xscale=c(min(.df[,1]), max(.df[,1])), yscale=c(min(0,min(.df[,-1])), max(.df[,-1])), x=.x_Loc, y=.y_Loc, width=.width, height=.height, just=.justify, clip="off", default.units="native"))
# Color behind text.
grid.rect(x=0, y=0, width=unit(axis_CEX, "lines"), height=1, default.units="npc", just=c("right", "bottom"), gp=gpar(fill=space_Background, col=space_Background))
grid.rect(x=0, y=1, width=1, height=unit(title_CEX, "lines"), default.units="npc", just=c("left", "bottom"), gp=gpar(fill=space_Background, col=space_Background))
# Color in the space.
grid.rect(gp=gpar(fill=chart_Fill, col=chart_Col))
}
# Function to finalize and label a plotting area.
finalize_Plot <- function(
.df,
.plot_Title
){
# Label plot using the internal reference
# system, instead of the parent window, so
# we always have perfect placement.
grid.text(.plot_Title, x=0.5, y=1.05, just=c("center","bottom"), rot=0, default.units="npc", gp=gpar(cex=title_CEX))
grid.text(paste(names(.df)[-1], collapse=" & "), x=-0.05, y=0.5, just=c("center","bottom"), rot=90, default.units="npc", gp=gpar(cex=axis_CEX))
grid.text(names(.df)[1], x=0.5, y=-0.05, just=c("center","top"), rot=0, default.units="npc", gp=gpar(cex=axis_CEX))
# Finalize plotting area.
popViewport()
}
# Function to plot a filled line chart of
# the data in a data frame. The first column
# of the data frame is assumed to be the
# plotting index, with each column being a
# set of y-data to plot. All data is assumed
# to be numeric.
plot_Line_Chart <- function(
.df,
.x_Loc,
.y_Loc,
.justify,
.width,
.height,
.colors,
.plot_Title
){
# Initialize plot.
init_Plot(.df, .x_Loc, .y_Loc, .justify, .width, .height)
# Calculate what value to use as the
# return for the polygons.
y_Axis_Min <- min(0, min(.df[,-1]))
# Plot each set of data as a polygon,
# so we can fill it in with color to
# make it easier to read.
for (i in 2:ncol(.df)){
grid.polygon(x=c(min(.df[,1]),.df[,1], max(.df[,1])), y=c(y_Axis_Min,.df[,i], y_Axis_Min), default.units="native", gp=gpar(fill=.colors[i-1], col=.colors[i-1], alpha=1/ncol(.df)))
}
# Draw plot axes.
grid.lines(x=0, y=c(0,1), default.units="npc")
grid.lines(x=c(0,1), y=0, default.units="npc")
# Finalize plot.
finalize_Plot(.df, .plot_Title)
}
# Function to plot a scatterplot of
# the data in a data frame. The
# assumptions are the same as 'plot_Line_Chart'.
plot_Scatterplot <- function(
.df,
.x_Loc,
.y_Loc,
.justify,
.width,
.height,
.colors,
.plot_Title
){
# Initialize plot.
init_Plot(.df, .x_Loc, .y_Loc, .justify, .width, .height)
# Plot each set of data as colored points.
for (i in 2:ncol(.df)){
grid.points(x=.df[,1], y=.df[,i], pch=19, size=unit(1, "native"), default.units="native", gp=gpar(col=.colors[i-1], alpha=1/ncol(.df)))
}
# Draw plot axes.
grid.lines(x=0, y=c(0,1), default.units="npc")
grid.lines(x=c(0,1), y=0, default.units="npc")
# Finalize plot.
finalize_Plot(.df, .plot_Title)
}
# Function to plot a histogram of
# all the columns in a data frame,
# except the first, which is assumed to
# be an index.
plot_Histogram <- function(
.df,
.x_Loc,
.y_Loc,
.justify,
.width,
.height,
.colors,
.plot_Title,
...
){
# Create a list containing the histogram
# data for each data column and calculate
# data ranges. Any extra parameters
# specified will pass to the 'hist' function.
hist_Data <- list()
hist_Count_Range <- c(0,NA)
hist_Breaks_Range <- c(NA,NA)
for (i in 2:ncol(.df)){
hist_Data[[i]] <- hist(.df[,i], plot=FALSE, ...)
hist_Count_Range[2] <- max(max(hist_Data[[i]]$counts), hist_Count_Range[2], na.rm=TRUE)
hist_Breaks_Range <- c(min(min(hist_Data[[i]]$breaks), hist_Breaks_Range[1], na.rm=TRUE), max(max(hist_Data[[i]]$breaks), hist_Breaks_Range[2], na.rm=TRUE))
}
# Initialize plotting area to fit data.
# We are doing this in a custom way to
# allow more flexibility than built into
# the 'init_Plot' function.
# We have to turn off clipping to make it
# easy to plot the labels around the plot.
pushViewport(viewport(xscale=hist_Breaks_Range, yscale=hist_Count_Range, x=.x_Loc, y=.y_Loc, width=.width, height=.height, just=.justify, clip="off", default.units="native"))
# Color behind text.
grid.rect(x=0, y=0, width=unit(axis_CEX, "lines"), height=1, default.units="npc", just=c("right", "bottom"), gp=gpar(fill=space_Background, col=space_Background))
grid.rect(x=0, y=1, width=1, height=unit(title_CEX, "lines"), default.units="npc", just=c("left", "bottom"), gp=gpar(fill=space_Background, col=space_Background))
# Color in the space.
grid.rect(gp=gpar(fill=chart_Fill, col=chart_Col))
# Draw x axis.
grid.lines(x=c(0,1), y=0, default.units="npc")
# Plot each set of data as a histogram.
for (i in 2:ncol(.df)){
grid.rect(x=hist_Data[[i]]$mids, y=0, width=diff(hist_Data[[i]]$mids[1:2]), height=hist_Data[[i]]$counts, default.units="native", just=c("center","bottom"), gp=gpar(fill=.colors[i-1], col=.colors[i-1], alpha=1/ncol(.df)))
}
# Label plot using the internal reference
# system, instead of the parent window, so
# we always have perfect placement.
grid.text(.plot_Title, x=0.5, y=1.05, just=c("center","bottom"), rot=0, default.units="npc", gp=gpar(cex=title_CEX))
grid.text(paste(names(.df)[-1], collapse=" & "), x=-0.05, y=0.5, just=c("center","bottom"), rot=90, default.units="npc", gp=gpar(cex=axis_CEX))
# Finalize plotting area.
popViewport()
}
draw_Sample_Box <- function(
.x_Loc,
.y_Loc,
.x_Scale,
.y_Scale,
.justify,
.width,
.height,
.colors,
.box_X,
.box_Y,
.plot_Title
){
pushViewport(viewport(xscale=.x_Scale, yscale=.y_Scale, x=.x_Loc, y=.y_Loc, width=chart_Width, height=chart_Height, just=.justify, clip="off", default.units="native"))
# Color behind text.
grid.rect(x=0, y=1, width=1, height=unit(title_CEX, "lines"), default.units="npc", just=c("left", "bottom"), gp=gpar(fill=space_Background, col=space_Background))
# Color in the space.
grid.rect(gp=gpar(fill=chart_Fill, col=chart_Col))
# Label plot.
grid.text(.plot_Title, x=0.5, y=1.05, just=c("center","bottom"), rot=0, default.units="npc", gp=gpar(cex=title_CEX))
# Draw box and label points.
grid.polygon(x=.box_X, y=.box_Y, default.units="native", gp=gpar(fill=.colors[1], col=.colors[2]))
grid.text(paste(.plot_Title, 1, sep=""), x=min(.box_X), y=min(.box_Y), default.units="native", just=c("right","top"), gp=gpar(cex=0.5))
grid.text(paste(.plot_Title, 2, sep=""), x=max(.box_X), y=min(.box_Y), default.units="native", just=c("left","top"), gp=gpar(cex=0.5))
# Finalize plot.
popViewport()
}
演示代码:
# Draw twelve independent charts as
# a demo and connect with lines similar
# to a heiritage chart.
grid.newpage()
# Initialize a viewport to make our locations
# easier to map.
pushViewport(viewport(x=0, y=0, width=1, height=1, just=c("left","bottom"), xscale=c(0,10), yscale=c(0,4)))
# Color background of overall plot.
grid.rect(gp=gpar(fill=space_Background, col=space_Background))
# Store plot locations for convenience.
plot_Loc <- data.frame(x=c(2,4,6,8,1,3,7,9,2,4,6,8), y=c(3,3,3,3,2,2,2,2,1,1,1,1))
# Draw connecting lines.
connections <- data.frame(a=c(1, 3, 5, 6, 7, 1, 3, 5, 7, 6), b=c(2, 4, 6, 7, 8, 2, 4, 6, 8, 7), c=c(NA, NA, NA, NA, NA, 6, 7, 9, 12, 10), d=c(NA, NA, NA, NA, NA, NA, NA, NA, NA, 11))
for (i in 1:nrow(connections)){
if (is.na(connections$c[i])){
grid.lines(x=plot_Loc$x[unlist(connections[i,1:2])], y=plot_Loc$y[unlist(connections[i,1:2])], default.units="native")
} else if (is.na(connections$d[i])) {
grid.lines(x=median(plot_Loc$x[unlist(connections[i,1:2])]), y=plot_Loc$y[unlist(connections[i,2:3])], default.units="native")
} else {
grid.lines(x=median(plot_Loc$x[unlist(connections[i,1:2])]), y=c(plot_Loc$y[connections[i,2]], median(plot_Loc$y[unlist(connections[i,2:3])])), default.units="native")
grid.lines(x=plot_Loc$x[unlist(connections[i,3:4])], y=median(plot_Loc$y[unlist(connections[i,2:3])]), default.units="native")
grid.lines(x=plot_Loc$x[connections[i,3]], y=c(median(plot_Loc$y[unlist(connections[i,2:3])]), plot_Loc$y[connections[i,3]]), default.units="native")
grid.lines(x=plot_Loc$x[connections[i,4]], y=c(median(plot_Loc$y[unlist(connections[i,2:3])]), plot_Loc$y[connections[i,4]]), default.units="native")
}
}
# Draw four independent line charts.
p <- 1
plot_Line_Chart(data.frame(time=1:1860, EuStockMarkets)[1:3], .x_Loc=plot_Loc$x[p], .y_Loc=plot_Loc$y[p], .just=c("center","center"), .width=chart_Width, .height=chart_Height, c("dodgerblue", "deeppink"), "EU Stocks")
p <- 2
plot_Line_Chart(data.frame(time=1:1860, EuStockMarkets)[c(1,4,5)], .x_Loc=plot_Loc$x[p], .y_Loc=plot_Loc$y[p], .just=c("center","center"), .width=chart_Width, .height=chart_Height, c("green", "purple"), "EU Stocks")
p <- 3
plot_Line_Chart(data.frame(time=1:(12*20), sunspots=sunspot.month[(171*12+1):(171*12+12*20)]), .x_Loc=plot_Loc$x[p], .y_Loc=plot_Loc$y[p], .just=c("center","center"), .width=chart_Width, .height=chart_Height, c("darkgoldenrod"), "Sunspots")
p <- 4
plot_Line_Chart(data.frame(time=1:(12*20), temp=nottem), .x_Loc=plot_Loc$x[p], .y_Loc=plot_Loc$y[p], .just=c("center","center"), .width=chart_Width, .height=chart_Height, c("red"), "Nottem")
# Draw four independent scatterplots.
p <- 5
plot_Scatterplot(data.frame(time=1:(1860 + 1 - 1000), DAX=rowMeans(embed(EuStockMarkets[,1], 1000)), FTSE=rowMeans(embed(EuStockMarkets[,4], 1000))), .x_Loc=plot_Loc$x[p], .y_Loc=plot_Loc$y[p], .just=c("center","center"), .width=chart_Width, .height=chart_Height, c("deeppink", "purple"), "Smooth")
p <- 6
plot_Scatterplot(data.frame(time=1:1860, EuStockMarkets)[c(1,2,5)], .x_Loc=plot_Loc$x[p], .y_Loc=plot_Loc$y[p], .just=c("center","center"), .width=chart_Width, .height=chart_Height, c("deeppink", "purple"), "EU Stocks")
p <- 9
plot_Scatterplot(data.frame(time=1:(1860 + 1 - 20), DAX=rowMeans(embed(EuStockMarkets[,1], 20)), FTSE=rowMeans(embed(EuStockMarkets[,4], 20))), .x_Loc=plot_Loc$x[p], .y_Loc=plot_Loc$y[p], .just=c("center","center"), .width=chart_Width, .height=chart_Height, c("deeppink", "purple"), "Smooth*20")
p <- 10
plot_Scatterplot(data.frame(time=1:(1860 + 1 - 100), DAX=rowMeans(embed(EuStockMarkets[,1], 100)), FTSE=rowMeans(embed(EuStockMarkets[,4], 100))), .x_Loc=plot_Loc$x[p], .y_Loc=plot_Loc$y[p], .just=c("center","center"), .width=chart_Width, .height=chart_Height, c("deeppink", "purple"), "Smooth*100")
# Draw two independent histograms.
p <- 7
plot_Histogram(data.frame(time=1:(12*20), sunspots=sunspot.month[(171*12+1):(171*12+12*20)]), .x_Loc=plot_Loc$x[p], .y_Loc=plot_Loc$y[p], .just=c("center","center"), .width=chart_Width, .height=chart_Height, c("darkgoldenrod"), "Sunspots", breaks=6)
p <- 8
plot_Histogram(data.frame(time=1:(12*20), temp=nottem), .x_Loc=plot_Loc$x[p], .y_Loc=plot_Loc$y[p], .just=c("center","center"), .width=chart_Width, .height=chart_Height, c("red"), "Nottem", breaks=6)
# Draw sample objects in two charts spaces.
p <- 11
draw_Sample_Box(.x_Loc=plot_Loc$x[p], .y_Loc=plot_Loc$y[p], .x_Scale=c(0,10), .y_Scale=c(-10,0), .justify=c("center","center"), .width=chart_Width, .height=chart_Height, .colors=c("dodgerblue","blue"), .box_X=c(4,6,6,4), .box_Y=c(-4,-4,-5,-5), .plot_Title="K")
p <- 12
draw_Sample_Box(.x_Loc=plot_Loc$x[p], .y_Loc=plot_Loc$y[p], .x_Scale=c(-1,1), .y_Scale=c(0,1), .justify=c("center","center"), .width=chart_Width, .height=chart_Height, .colors=c("dodgerblue","blue"), .box_X=c(-0.5,0,0,-0.5), .box_Y=c(0.8,0.8,0.7,0.7), .plot_Title="L")
| 归档时间： |
|
| 查看次数： |
1186 次 |
| 最近记录： |