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） - ”将它锁定给我“”

提前非常感谢你！

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!")

突出显示R

2 个答案: