r - 垂直分布具有智能间距的多行

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

有趣的问题。

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

应该非常快，因为它避免了 的组合。胶合板 ，使用数据表 , 以及对原始长格式数据的操作。

用途 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())