深度剖析可视化

Question

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

所以我的数据是：

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

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

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

即使您可以指导我使用另一个程序来创建这样的图表，那也很棒

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有一个地方性问题（请参阅如何使用 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