ggplot2中的topoplot - 例如EEG数据的2D可视化

Question

可以ggplot2用来产生一个所谓的topoplot(经常用于神经科学)？

样本数据:

   label          x          y     signal
1     R3 0.64924459 0.91228430  2.0261520
2     R4 0.78789621 0.78234410  1.7880972
3     R5 0.93169511 0.72980685  0.9170998
4     R6 0.48406513 0.82383895  3.1933129

完整的样本数据.

行代表单个电极.列x和y表示投影到2D空间中,列signal基本上是z轴,表示在给定电极处测量的电压.

stat_contour 不起作用,显然是由于网格不平等.

geom_density_2d只提供的密度估计x和y.

geom_raster 是不适合这项任务的,或者我必须错误地使用它,因为它很快就会耗尽内存.

不需要平滑(如右图所示)和头部轮廓(鼻子,耳朵).

我想避免使用Matlab并转换数据,以便它适合这个或那个工具箱......非常感谢!

更新(2016年1月26日)

我能够达到目标的最接近的是通过

library(colorRamps)
ggplot(channels, aes(x, y, z = signal)) + stat_summary_2d() + scale_fill_gradientn(colours=matlab.like(20))

产生这样的图像:

更新2(2016年1月27日)

我已经尝试了@ alexforrence的完整数据方法,这就是结果:

这是一个很好的开始,但有几个问题:

1. 最后一次调用(ggplot())在Intel i7 4790K上大约需要40秒,而Matlab工具箱几乎可以立即生成这些内容.我上面的'紧急解决方案'需要大约一秒钟.
2. 正如你所看到的,中央部分的上边界和下边界似乎是"切片" - 我不确定是什么导致这种情况,但它可能是第三个问题.

3. 我收到这些警告:

   1: Removed 170235 rows containing non-finite values (stat_contour). 
   2: Removed 170235 rows containing non-finite values (stat_contour). 
   

更新3(2016年1月27日)

两个地块之间的比较产生了不同的interp(xo, yo)和stat_contour(binwidth)价值观:

如果选择低的边缘,则是粗糙的边缘interp(xo, yo),在这种情况下xo/ yo = seq(0, 1, length = 100):

Answer 1

这是一个潜在的开始:

首先,我们将附上一些包.我正在使用akima进行线性插值,虽然看起来EEGLAB 在这里使用某种球面插值？(尝试它的数据有点稀疏).

library(ggplot2)
library(akima)
library(reshape2)

接下来,阅读数据:

dat <- read.table(text = "   label          x          y     signal
1     R3 0.64924459 0.91228430  2.0261520
2     R4 0.78789621 0.78234410  1.7880972
3     R5 0.93169511 0.72980685  0.9170998
4     R6 0.48406513 0.82383895  3.1933129")

我们将插入数据,并将其粘贴在数据框中.

datmat <- interp(dat$x, dat$y, dat$signal, 
                 xo = seq(0, 1, length = 1000),
                 yo = seq(0, 1, length = 1000))
datmat2 <- melt(datmat$z)
names(datmat2) <- c('x', 'y', 'value')
datmat2[,1:2] <- datmat2[,1:2]/1000 # scale it back

我将借用一些以前的答案.在circleFun下面是绘制GGPLOT2一个圆圈.

circleFun <- function(center = c(0,0),diameter = 1, npoints = 100){
  r = diameter / 2
  tt <- seq(0,2*pi,length.out = npoints)
  xx <- center[1] + r * cos(tt)
  yy <- center[2] + r * sin(tt)
  return(data.frame(x = xx, y = yy))
}

circledat <- circleFun(c(.5, .5), 1, npoints = 100) # center on [.5, .5]

# ignore anything outside the circle
datmat2$incircle <- (datmat2$x - .5)^2 + (datmat2$y - .5)^2 < .5^2 # mark
datmat2 <- datmat2[datmat2$incircle,]

我真的很喜欢ggpplot2中R plot filled.contour()输出中轮廓图的外观,所以我们将借用那个.

ggplot(datmat2, aes(x, y, z = value)) +
  geom_tile(aes(fill = value)) +
  stat_contour(aes(fill = ..level..), geom = 'polygon', binwidth = 0.01) +
  geom_contour(colour = 'white', alpha = 0.5) +
  scale_fill_distiller(palette = "Spectral", na.value = NA) + 
  geom_path(data = circledat, aes(x, y, z = NULL)) +
  # draw the nose (haven't drawn ears yet)
  geom_line(data = data.frame(x = c(0.45, 0.5, .55), y = c(1, 1.05, 1)), 
            aes(x, y, z = NULL)) +
  # add points for the electrodes
  geom_point(data = dat, aes(x, y, z = NULL, fill = NULL), 
             shape = 21, colour = 'black', fill = 'white', size = 2) +
  theme_bw()

随着在评论中所提到的改善(设定extrap = TRUE并linear = FALSE在interp呼叫分别以填补空白,并做了样条平滑,并绘制之前删除NAS),我们得到:

mgcv可以做球形花键.这取代了akima(包含interp()的块不是必需的).

library(mgcv)
spl1 <- gam(signal ~ s(x, y, bs = 'sos'), data = dat)
# fine grid, coarser is faster
datmat2 <- data.frame(expand.grid(x = seq(0, 1, 0.001), y = seq(0, 1, 0.001)))
resp <- predict(spl1, datmat2, type = "response")
datmat2$value <- resp