突出显示 R 中两步数据（源自直方图）之间的差异

Question

:-)

我有两个数据集，从中我得到了直方图数据。这些都保存在两个单独的数组中。当前的源代码以及当前的绘图可以在下面找到。

# DEMO file for the awesome stackoverflow 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 版本 3.1.1 (2014-07-10) -- “Sock it to Me””

非常感谢您！

Answer 1

不是一个优雅的解决方案，但它可以满足您的需求。

 #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)
    }

这是你得到的情节：

希望对你有帮助！

Answer 2

为了区分正负差异，我在代码中添加了一些条件。它就像一个魅力！完整代码如下

# DEMO file for the awesome stackoverflow 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!")