0

:-)

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

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

生成的情节是这样的（你应该可以重现）： 我还不能链接图像，所以这里是链接

所以，这暂时没关系。

但是，我想直观地突出直方图中的差异。当然我可以计算差异，这很好，因为我也需要，但我也想突出差异以显示有趣的区域。最终的图片应该是这样的

我不一定需要在正负差异之间进行颜色区分，但这会很好。我不知道如何遮蔽步骤数据之间的区域。

有人可以帮我弄这个吗？还有一件事，由于一些限制，我不允许使用太多的附加包。我正在使用“R 版本 3.1.1 (2014-07-10) -- “Sock it to Me””

非常感谢您！

4

2 回答 2

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

这是你得到的情节：

在此处输入图像描述

希望能帮助到你！

于 2017-12-06T12:27:45.530 回答
0

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

# 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!")
于 2017-12-06T14:06:46.917 回答