data-visualization - 深度剖析可视化

Question

我正在尝试使用变量深度、距离和温度创建深度剖面图。收集的数据来自 9 个不同的点，它们之间的距离已知(距离 5m，9 个站点，9 组不同的数据)。温度读数是根据这 9 个站台直接下降的，每 2 秒读取一次温度读数。 9 个站点中每个站点的最大深度也取自船。

所以我的数据是:

1. 9 个站点中每个站点的深度(y 轴)
2. 9 个站点中每个站点的温度读数，垂直间隔约为 0.2 米，直到到达底部(填充区域)
3. 站点之间的距离，(x 轴)

是否可以创建与此类似的深度剖面？ (显然这张图中没有更高的分辨率)

我已经尝试过使用 ggplot2 和光栅，但我似乎无法弄清楚如何做到这一点。我遇到的问题之一是如何让 ggplot2 区分 1 号站的 5 米深度温度读数和 5 号站的 5 米深度温度读数，因为它们具有相同的深度值。

即使你能指导我使用另一个程序来创建这样的图表，那也很好

Answer 1

[修订]
(如果你知道更合适的插值方法，尤其是不需要在底部数据下切割的方法，请评论我。)

ggplot() 需要长数据形式。

library(ggplot2)

# example data
max.depths <- c(1.1, 4, 4.7, 7.7, 8.2, 7.8, 10.7, 12.1, 14.3)
depth.list <- sapply(max.depths, function(x) seq(0, x, 0.2))
temp.list <- list()
set.seed(1); for(i in 1:9) temp.list[[i]] <- sapply(depth.list[[i]], function(x) rnorm(1, 20 - x*0.5, 0.2))
set.seed(1); dist <- c(0, sapply(seq(5, 40, 5), function(x) rnorm(1, x, 1)))
dist.list <- sapply(1:9, function(x) rep(dist[x], length(depth.list[[x]])))

main.df <- data.frame(dist = unlist(dist.list), depth = unlist(depth.list) * -1, temp = unlist(temp.list))

# a raw graph
ggplot(main.df, aes(x = dist, y = depth, z = temp)) + 
  geom_point(aes(colour = temp), size = 1) +
  scale_colour_gradientn(colours = topo.colors(10))

# a relatively raw graph   (don't run with this example data)
ggplot(main.df, aes(x = dist, y = depth, z = temp)) + 
  geom_raster(aes(fill = temp)) + # geom_contour() +
  scale_fill_gradientn(colours = topo.colors(10))

如果你想要一个像你展示的那样的图表，你必须进行插值。一些软件包为您提供空间插值方法。在此示例中，我使用了 akima 包，但您应该认真考虑使用哪种插值方法。

我在下面的代码中使用了 nx = 300 和 ny = 300，但我认为最好仔细决定这些值。大的 nx 和 ny 给出了高分辨率的图形，但不要忘记真正的 nx 和 ny(在这个例如，真正的 nx 只有 9 而 ny 是 101)。

library(akima); library(dplyr)

interp.data <- interp(main.df$dist, main.df$depth, main.df$temp, nx = 300, ny = 300)
interp.df <- interp.data %>% interp2xyz() %>% as.data.frame()
names(interp.df) <- c("dist", "depth", "temp")

# draw interp.df
ggplot(interp.df, aes(x = dist, y = depth, z = temp)) + 
  geom_raster(aes(fill = temp)) + # geom_contour() +
  scale_fill_gradientn(colours = topo.colors(10))

# to think appropriateness of interpolation (raw and interpolation data)
ggplot(interp.df, aes(x = dist, y = depth, z = temp)) + 
  geom_raster(aes(fill = temp), alpha = 0.3) +                 # interpolation
  scale_fill_gradientn(colours = topo.colors(10)) + 
  geom_point(data = main.df, aes(colour = temp), size = 1) +  # raw
  scale_colour_gradientn(colours = topo.colors(10))

底部不匹配!!
我发现 ?interp 说“仅在凸包内插值!”，哎呀...我很担心关于问题区域周围的插值，可以吗？如果没有问题，你只需要切割底部的数据。如果不是，...我不能立即回答(下面是要剪切的示例代码)。

bottoms <- max.depths * -1

# calculate bottom values using linear interpolation
approx.bottoms <- approx(dist, bottoms, n = 300) # n must be the same value as interp()'s nx

# change temp values under bottom into NA
library(dplyr)
interp.cut.df <- interp.df %>% cbind(bottoms = approx.bottoms$y) %>% 
  mutate(temp = ifelse(depth >= bottoms, temp, NA)) %>% select(-bottoms)

ggplot(interp.cut.df, aes(x = dist, y = depth, z = temp)) + 
  geom_raster(aes(fill = temp)) + 
  scale_fill_gradientn(colours = topo.colors(10)) + 
  geom_point(data = main.df, size = 1)

如果你想使用stat_contour
使用 stat_contour 比使用 geom_raster 更难，因为它需要规则的网格形式。据我所见，您的数据(深度和距离)没有形成规则的网格，这意味着很难将 stat_contour 与您的原始数据一起使用。所以我使用 interp.cut.df 绘制等高线图。 stat_contour 有一个地方性问题(参见 How to fill in the contour fully using stat_contour )，因此您需要扩展数据。

library(dplyr)

# 1st: change NA into a temp's out range value (I used 0)
interp.contour.df <- interp.cut.df
interp.contour.df[is.na(interp.contour.df)] <- 0

# 2nd: expand the df (It's a little complex, so please use this function)
contour.support.func <- function(df) {
  colname <- names(df)
  names(df) <- c("x", "y", "z")
  Range <- as.data.frame(sapply(df, range))
  Dim <- as.data.frame(t(sapply(df, function(x) length(unique(x)))))
  arb_z = Range$z[1] - diff(Range$z)/20
  df2 <- rbind(df,
               expand.grid(x = c(Range$x[1] - diff(Range$x)/20, Range$x[2] + diff(Range$x)/20), 
                           y = seq(Range$y[1], Range$y[2], length = Dim$y), z = arb_z),
               expand.grid(x = seq(Range$x[1], Range$x[2], length = Dim$x),
                           y = c(Range$y[1] - diff(Range$y)/20, Range$y[2] + diff(Range$y)/20), z = arb_z))
 names(df2) <- colname
 return(df2)
}

interp.contour.df2 <- contour.support.func(interp.contour.df)

# 3rd: check the temp range (these values are used to define contour's border (breaks))
range(interp.cut.df$temp, na.rm=T)        # 12.51622 20.18904

# 4th: draw ... the bottom border is dirty !!
ggplot(interp.contour.df2, aes(x = dist, y = depth, z = temp)) + 
  stat_contour(geom="polygon", breaks = seq(12.51622, 20.18904, length = 11), aes(fill = ..level..)) + 
  coord_cartesian(xlim = range(dist), ylim = range(bottoms), expand = F) + # cut expanded area
  scale_fill_gradientn(colours = topo.colors(10)) # breaks's length is 11, so 10 colors are needed

# [Note]
# You can define the contour's border values (breaks) and colors.
contour.breaks <- c(12.5, 13.5, 14.5, 15.5, 16.5, 17.5, 18.5, 19.5, 20.5) 
    # = seq(12.5, 20.5, 1) or seq(12.5, 20.5, length = 9)
contour.colors <- c("darkblue", "cyan3", "cyan1", "green3", "green", "yellow2","pink", "darkred")
   # breaks's length is 9, so 8 colors are needed.

# 5th: vanish the bottom border by bottom line
approx.df <- data.frame(dist = approx.bottoms$x, depth = approx.bottoms$y, temp = 0)  # 0 is dummy value

ggplot(interp.contour.df2, aes(x = dist, y = depth, z = temp)) + 
  stat_contour(geom="polygon", breaks = contour.breaks, aes(fill = ..level..)) +
  coord_cartesian(xlim=range(dist), ylim=range(bottoms), expand = F) + 
  scale_fill_gradientn(colours = contour.colors) +
  geom_line(data = approx.df, lwd=1.5, color="gray50")

奖励:传奇技术

library(dplyr)
interp.contour.df3 <- interp.contour.df2 %>% mutate(temp2 = cut(temp, breaks = contour.breaks))
interp.contour.df3$temp2 <- factor(interp.contour.df3$temp2, levels = rev(levels(interp.contour.df3$temp2)))

ggplot(interp.contour.df3, aes(x = dist, y = depth, z = temp)) + 
  stat_contour(geom="polygon", breaks = contour.breaks, aes(fill = ..level..)) +
  coord_cartesian(xlim=range(dist), ylim=range(bottoms), expand = F) + 
  scale_fill_gradientn(colours = contour.colors, guide = F) +   # add guide = F
  geom_line(data = approx.df, lwd=1.5, color="gray50") +
  geom_point(aes(colour = temp2), pch = 15, alpha = 0) +        # add
  guides(colour = guide_legend(override.aes = list(colour = rev(contour.colors), alpha = 1, cex = 5))) +  # add
  labs(colour = "temp")   # add