使用智能间距垂直分布多条线

Question

下面使用光谱数据的常见显示(强度与波长)来比较多个光谱中数据中峰的位置.假设它们在0处共享基线,则可以方便地将多条线垂直偏移恒定间距,以避免重叠线的分心.

这样变成了

我正在寻找一种更好的策略来自动执行此垂直移位,从长格式数据开始.这是一个最小的例子.

# fake data (5 similar-looking spectra)
spec <- function(){
  x <- runif(100, 0, 100)
  data.frame(x=x, y=jitter(dnorm(x, mean=jitter(50), sd=jitter(5)), amount=0.01))
}
require(plyr)
all <- ldply(1:5, function(ii) data.frame(spec(), id=ii))

我目前的策略如下:

• 将光谱从长格式转换为宽格式.这涉及插值,因为光谱不一定具有相同的x轴值.

• 找到光谱之间的最小偏移,以避免邻居之间的重叠

• 将光谱移动此距离的倍数

• 融化回长格式

我用plyr实现了这个,

# function that evenly spaces the spectra to avoid overlap
# d is in long format, s is a scaling factor for the vertical shift
require(plyr); require(ggplot2)

spread_plot <- function(d, s=1){
  ranges <- ddply(d, "id", with, each(min,max,length)(x))
  common_x <- seq(max(ranges$min), min(ranges$max), length=max(ranges$length))
  new_y <- dlply(d, "id", function(x) approx(x$x, x$y, common_x)$y)
  mat <- do.call(cbind, new_y)
  test <- apply(mat, 1, diff)
  shift <- max(-test[test < 0])
  origins <- s*seq(0, by=shift, length=ncol(mat))

  for(ii in seq_along(origins)){
    current <- unique(d[["id"]])[ii]
    d[d[["id"]] == current, "y"] <- 
      d[d[["id"]] == current, "y"] + origins[ii]
  }
  d
}

test <- spread_plot(all)

ggplot(test, aes(x, y, colour=id, group=id))+
  geom_line() + guides(colour=guide_legend())

这种策略有一些缺点:

• 它很慢

• 偏移量不是一个漂亮的数字; 我不知道如何自动地使其圆形化以使光谱偏移例如0.02或50等,这取决于强度的范围.pretty(origins)是有问题的,因为它可以返回不同数量的值.

我觉得我错过了一个更简单的解决方案,可能直接使用长格式的原始数据.

Answer 1

有趣的问题。

这是一种可能性，没有详细评论，只是指出它：

• 应该非常快，因为它避免了plyr、使用data.table以及对原始长格式数据的操作。
• 用于pretty()选择一个漂亮的偏移量。
• 与您的代码一样，不能保证不会产生线的交点，因为由 形成的点阵之间可能发生重叠common_x。

这是代码

## Setup
library(data.table)
library(plyr)
library(ggplot2)

spec <- function(){
  x <- runif(100, 0, 100)
  data.frame(x=x, y=jitter(dnorm(x, mean=jitter(50), sd=jitter(5)), amount=0.01))
}
all <- ldply(1:5, function(ii) data.frame(spec(), id=ii))

## Function that uses data.table rather than plyr to compute and add offsets
spread_plot <- function(d, s=1){
    d <- data.table(d, key="id")
    ranges <- d[, list(min=min(x), max=max(x), length=length(x)),by="id"]
    common_x <- seq(max(ranges$min), min(ranges$max), length=max(ranges$length))
    new_y <- d[,list(y=approx(x, y, common_x)$y, N=seq_along(common_x)),
               by="id"]
    shift <- max(new_y[, max(abs(diff(y))), by = "N"][[2]])
    shift <- pretty(c(0, shift), n=0)[2]
    origins <- s*seq(0, by=shift, length=length(unique(d$id)))
    d[,y:=(y + origins[.GRP]),by="id"]
    d
}

## Try it out
test <- spread_plot(all)
ggplot(test, aes(x, y, colour=id, group=id))+
  geom_line() + guides(colour=guide_legend())