突出显示 R 中两个步骤数据（源自直方图）之间的差异
Highlight difference between two step data (derived from histogram) in R
:-)
我有两个数据集，我从中导出直方图数据。这些都保存在两个单独的数组中。可以在下面找到当前的源代码以及当前的情节。
# DEMO file for the awesome Whosebug community
require(plotrix)
# clear the global environment ----
rm(list=ls())
# Assign demo data ----
data_T <- c(rep(1,5),rep(2,10),rep(3,8),rep(4,2),rep(5,7),rep(6,2),rep(7,13),rep(9,7))
data_P <- c(rep(1,1),rep(2,4),rep(3,1),rep(4,7),rep(5,12),rep(6,10),rep(7,9),rep(10,2))
# Setting the limits of the result data ----
uxlimit <- 10
lxlimit <- 0
classes <- (uxlimit-lxlimit)
xtics <- seq(lxlimit,uxlimit)
uylimit <- 20
lylimit <- 0
yrange <- seq(lylimit,uylimit, by = 5)
# filter out of necessary ----
data_T [ data_T > uxlimit ] <- NaN
data_T [ data_T < lxlimit ] <- NaN
data_T <- na.omit(data_T)
# Setting the x-label and y-label according to the requested spectrum ----
xlabel <- "x-value / x-unit"
ylabel <- "y-value / y-unit"
# generate histogram data ----
data_T_hist <- hist(data_T,
breaks = seq(lxlimit,uxlimit,l = classes+1),
plot = F)
data_P_hist <- hist(data_P,
breaks = seq(lxlimit,uxlimit,l = classes+1),
plot = F)
# Plot data_T_hist ----
plot(data_T_hist$breaks,
c(data_T_hist$counts,0),
xlab=xlabel,
ylab=ylabel,
ylim = c(lylimit,uylimit),
xlim = c(lxlimit,uxlimit),
main="Histogram data",
axes=F,
type="s",
col="red",
lwd=4,
panel.first = grid(nx=NULL, ny=NULL))
# Plot data_P_hist ----
lines(data_P_hist$breaks,
c(data_P_hist$counts,0),
xlab=xlabel,
ylab=ylabel,
ylim = c(lylimit,uylimit),
xlim = c(lxlimit, uxlimit),
type="s",
col="blue",
lwd=4,
lty=2)
# Frame all plots with a solid border ----
box(which = "plot", lty = "solid")
# Add legend to the top right of all plots ----
legend("topright",
c("data_T_hist", "data_P_hist"),
col=c("red","blue"),
bg = "white",
lwd=4)
# Setting the axes right ----
axis(1, at=xtics, labels=NULL, tick = TRUE)
axis(2, at=yrange, labels=yrange, las=1)
# FINISHED! ----
message ("Finished!")
结果图是这样的（你应该可以重现）：
I cant link images yet, so here is the link
所以，暂时还可以。
但是，我想直观地突出直方图中的差异。当然我可以计算差异，这很好，因为我也需要它，但我也想突出显示差异以显示有趣的区域。最终图片应该是这样的 Again the link
我不一定需要在正负差异之间进行颜色区分，不过这会很好。我不知道如何遮蔽步骤数据之间的区域。
有人可以帮我解决这个问题吗？还有一件事，由于一些限制，我不允许使用太多额外的包。我正在使用 "R version 3.1.1 (2014-07-10) -- "Sock it to Me""
在此先感谢您！
这不是一个优雅的解决方案，但它仍然可以满足您的要求。
#Get pairwise min
y_low <-c(pmin(data_P_hist$counts, data_T_hist$counts),0)
#Get pairwise max
y_high <- c(pmax(data_P_hist$counts, data_T_hist$counts),0)
for(i in 2:length(xtics)-1){
rect(xtics[i], y_low[i], xtics[i+1],y_high[i], col="powderblue", border = NA)
}
这是你得到的情节：
希望对您有所帮助！
为了区分正负差异，我在代码中添加了一点条件。它就像一个魅力！完整代码如下
# DEMO file for the awesome Whosebug community
# TikzDevice is required to produce .tex files ----
require(plotrix)
# clear the global environment ----
rm(list=ls())
# Assign demo data ----
data_T <- c(rep(1,5),rep(2,10),rep(3,8),rep(4,2),rep(5,7),rep(6,2),rep(7,13),rep(9,7))
data_P <- c(rep(1,1),rep(2,4),rep(3,1),rep(4,7),rep(5,12),rep(6,10),rep(7,9),rep(10,2))
# Setting the limits of the result data ----
uxlimit <- 10
lxlimit <- 0
classes <- (uxlimit-lxlimit)
xtics <- seq(lxlimit,uxlimit)
uylimit <- 20
lylimit <- 0
yrange <- seq(lylimit,uylimit, by = 5)
# filter out of necessary ----
data_T [ data_T > uxlimit ] <- NaN
data_T [ data_T < lxlimit ] <- NaN
data_T <- na.omit(data_T)
# Setting the x-label and y-label according to the requested spectrum ----
xlabel <- "x-value / x-unit"
ylabel <- "y-value / y-unit"
# generate histogram data ----
data_T_hist <- hist(data_T,
breaks = seq(lxlimit,uxlimit,l = classes+1),
plot = F)
data_P_hist <- hist(data_P,
breaks = seq(lxlimit,uxlimit,l = classes+1),
plot = F)
# Plot data_T_hist ----
plot(data_T_hist$breaks,
c(data_T_hist$counts,0),
xlab=xlabel,
ylab=ylabel,
ylim = c(lylimit,uylimit),
xlim = c(lxlimit,uxlimit),
main="Histogram data",
axes=F,
type="s",
col="red",
lwd=4,
panel.first = grid(nx=NULL, ny=NULL))
#Get pairwise min
y_low <-c(pmin(data_T_hist$counts, data_P_hist$counts),0)
#Get pairwise max
y_high <- c(pmax(data_T_hist$counts, data_P_hist$counts),0)
for(i in 2:length(xtics)-1){
if (data_T_hist$counts[i] < data_P_hist$counts[i]) {
colselect <- "powderblue"
} else {
colselect <- "sienna1"
}
rect(xtics[i], y_low[i], xtics[i+1],y_high[i], col=colselect, border = NA)
}
# Plot data_P_hist ----
lines(data_P_hist$breaks,
c(data_P_hist$counts,0),
xlab=xlabel,
ylab=ylabel,
ylim = c(lylimit,uylimit),
xlim = c(lxlimit, uxlimit),
type="s",
col="blue",
lwd=4,
lty=2)
# Plot data_P_hist again to keep borders in the background
lines(data_T_hist$breaks,
c(data_T_hist$counts,0),
xlab=xlabel,
ylab=ylabel,
ylim = c(lylimit,uylimit),
xlim = c(lxlimit, uxlimit),
type="s",
col="red",
lwd=4,
lty=2)
# Frame all plots with a solid border ----
box(which = "plot", lty = "solid")
# Add legend to the top right of all plots ----
legend("topright",
c("data_T_hist", "data_P_hist"),
col=c("red","blue"),
bg = "white",
lwd=4)
# Setting the axes right ----
axis(1, at=xtics, labels=NULL, tick = TRUE)
axis(2, at=yrange, labels=yrange, las=1)
# FINISHED! ----
message ("Finished!")
:-)
我有两个数据集，我从中导出直方图数据。这些都保存在两个单独的数组中。可以在下面找到当前的源代码以及当前的情节。
# DEMO file for the awesome Whosebug community
require(plotrix)
# clear the global environment ----
rm(list=ls())
# Assign demo data ----
data_T <- c(rep(1,5),rep(2,10),rep(3,8),rep(4,2),rep(5,7),rep(6,2),rep(7,13),rep(9,7))
data_P <- c(rep(1,1),rep(2,4),rep(3,1),rep(4,7),rep(5,12),rep(6,10),rep(7,9),rep(10,2))
# Setting the limits of the result data ----
uxlimit <- 10
lxlimit <- 0
classes <- (uxlimit-lxlimit)
xtics <- seq(lxlimit,uxlimit)
uylimit <- 20
lylimit <- 0
yrange <- seq(lylimit,uylimit, by = 5)
# filter out of necessary ----
data_T [ data_T > uxlimit ] <- NaN
data_T [ data_T < lxlimit ] <- NaN
data_T <- na.omit(data_T)
# Setting the x-label and y-label according to the requested spectrum ----
xlabel <- "x-value / x-unit"
ylabel <- "y-value / y-unit"
# generate histogram data ----
data_T_hist <- hist(data_T,
breaks = seq(lxlimit,uxlimit,l = classes+1),
plot = F)
data_P_hist <- hist(data_P,
breaks = seq(lxlimit,uxlimit,l = classes+1),
plot = F)
# Plot data_T_hist ----
plot(data_T_hist$breaks,
c(data_T_hist$counts,0),
xlab=xlabel,
ylab=ylabel,
ylim = c(lylimit,uylimit),
xlim = c(lxlimit,uxlimit),
main="Histogram data",
axes=F,
type="s",
col="red",
lwd=4,
panel.first = grid(nx=NULL, ny=NULL))
# Plot data_P_hist ----
lines(data_P_hist$breaks,
c(data_P_hist$counts,0),
xlab=xlabel,
ylab=ylabel,
ylim = c(lylimit,uylimit),
xlim = c(lxlimit, uxlimit),
type="s",
col="blue",
lwd=4,
lty=2)
# Frame all plots with a solid border ----
box(which = "plot", lty = "solid")
# Add legend to the top right of all plots ----
legend("topright",
c("data_T_hist", "data_P_hist"),
col=c("red","blue"),
bg = "white",
lwd=4)
# Setting the axes right ----
axis(1, at=xtics, labels=NULL, tick = TRUE)
axis(2, at=yrange, labels=yrange, las=1)
# FINISHED! ----
message ("Finished!")
结果图是这样的（你应该可以重现）： I cant link images yet, so here is the link
所以，暂时还可以。
但是，我想直观地突出直方图中的差异。当然我可以计算差异，这很好，因为我也需要它，但我也想突出显示差异以显示有趣的区域。最终图片应该是这样的 Again the link
我不一定需要在正负差异之间进行颜色区分，不过这会很好。我不知道如何遮蔽步骤数据之间的区域。
有人可以帮我解决这个问题吗？还有一件事，由于一些限制，我不允许使用太多额外的包。我正在使用 "R version 3.1.1 (2014-07-10) -- "Sock it to Me""
在此先感谢您！
这不是一个优雅的解决方案，但它仍然可以满足您的要求。
#Get pairwise min
y_low <-c(pmin(data_P_hist$counts, data_T_hist$counts),0)
#Get pairwise max
y_high <- c(pmax(data_P_hist$counts, data_T_hist$counts),0)
for(i in 2:length(xtics)-1){
rect(xtics[i], y_low[i], xtics[i+1],y_high[i], col="powderblue", border = NA)
}
这是你得到的情节：
希望对您有所帮助！
为了区分正负差异，我在代码中添加了一点条件。它就像一个魅力！完整代码如下
# DEMO file for the awesome Whosebug community
# TikzDevice is required to produce .tex files ----
require(plotrix)
# clear the global environment ----
rm(list=ls())
# Assign demo data ----
data_T <- c(rep(1,5),rep(2,10),rep(3,8),rep(4,2),rep(5,7),rep(6,2),rep(7,13),rep(9,7))
data_P <- c(rep(1,1),rep(2,4),rep(3,1),rep(4,7),rep(5,12),rep(6,10),rep(7,9),rep(10,2))
# Setting the limits of the result data ----
uxlimit <- 10
lxlimit <- 0
classes <- (uxlimit-lxlimit)
xtics <- seq(lxlimit,uxlimit)
uylimit <- 20
lylimit <- 0
yrange <- seq(lylimit,uylimit, by = 5)
# filter out of necessary ----
data_T [ data_T > uxlimit ] <- NaN
data_T [ data_T < lxlimit ] <- NaN
data_T <- na.omit(data_T)
# Setting the x-label and y-label according to the requested spectrum ----
xlabel <- "x-value / x-unit"
ylabel <- "y-value / y-unit"
# generate histogram data ----
data_T_hist <- hist(data_T,
breaks = seq(lxlimit,uxlimit,l = classes+1),
plot = F)
data_P_hist <- hist(data_P,
breaks = seq(lxlimit,uxlimit,l = classes+1),
plot = F)
# Plot data_T_hist ----
plot(data_T_hist$breaks,
c(data_T_hist$counts,0),
xlab=xlabel,
ylab=ylabel,
ylim = c(lylimit,uylimit),
xlim = c(lxlimit,uxlimit),
main="Histogram data",
axes=F,
type="s",
col="red",
lwd=4,
panel.first = grid(nx=NULL, ny=NULL))
#Get pairwise min
y_low <-c(pmin(data_T_hist$counts, data_P_hist$counts),0)
#Get pairwise max
y_high <- c(pmax(data_T_hist$counts, data_P_hist$counts),0)
for(i in 2:length(xtics)-1){
if (data_T_hist$counts[i] < data_P_hist$counts[i]) {
colselect <- "powderblue"
} else {
colselect <- "sienna1"
}
rect(xtics[i], y_low[i], xtics[i+1],y_high[i], col=colselect, border = NA)
}
# Plot data_P_hist ----
lines(data_P_hist$breaks,
c(data_P_hist$counts,0),
xlab=xlabel,
ylab=ylabel,
ylim = c(lylimit,uylimit),
xlim = c(lxlimit, uxlimit),
type="s",
col="blue",
lwd=4,
lty=2)
# Plot data_P_hist again to keep borders in the background
lines(data_T_hist$breaks,
c(data_T_hist$counts,0),
xlab=xlabel,
ylab=ylabel,
ylim = c(lylimit,uylimit),
xlim = c(lxlimit, uxlimit),
type="s",
col="red",
lwd=4,
lty=2)
# Frame all plots with a solid border ----
box(which = "plot", lty = "solid")
# Add legend to the top right of all plots ----
legend("topright",
c("data_T_hist", "data_P_hist"),
col=c("red","blue"),
bg = "white",
lwd=4)
# Setting the axes right ----
axis(1, at=xtics, labels=NULL, tick = TRUE)
axis(2, at=yrange, labels=yrange, las=1)
# FINISHED! ----
message ("Finished!")