空间模型预测绘图故障排查（疑似维度不匹配问题）

我已经完成空间模型搭建与预测，但预测结果的绘图代码无法正常运行，疑似存在维度不匹配问题。以下是相关代码与数据处理步骤，请求协助修改代码解决该问题：

预处理代码 #

# 转换数据为长格式并合并两个数据框
MaxTemp %>%
  pivot_longer(.,Machrihanish:Lyneham, names_to = "Location") %>%
  full_join(.,metadata) -> MaxTemp_df

# 将value列重命名为温度
MaxTemp_df = MaxTemp_df %>%
  rename(Temp = 'value')

# 筛选夏季月份数据
summer_df = MaxTemp_df %>% 
  filter(Date >= 20200701 & Date <=20200731)

# 转换为地理数据格式
geo_summer_df = as.geodata(summer_df, coords.col = 4:5, data.col = 3) 
geo_summer_df2 = jitterDupCoords(geo_summer_df, max = 0.1, min = 0.05)

建模与预测代码 #

# 变异函数计算
summer_vario = variog(geo_summer_df2, option = 'bin', estimator.type='modulus', bin.cloud = TRUE)
# 拟合参数化模型
defult_summer_mod = variofit(summer_vario)

# 创建预测点网格
preds_grid = matrix(c(-5.697, 55.441, -0.807, 51.682, -5.328, 50.218, -2.451, 54.684, -4.121, 50.355, -1.586, 54.768, -0.131, 51.505, -4.158, 52.915, 
                  -0.442, 53.875, -3.413, 56.214, -2.860,   54.076, -3.323, 57.711, 0.566,  52.651, -0.626, 54.481, -1.185, 60.139, -2.643, 51.006,
                  -1.491,   53.381, -1.536, 52.424, -6.319, 58.213, -1.992, 51.503), nrow = 20, byrow = TRUE)
summer_preds = krige.conv(geo_summer_df2, locations = preds_grid, krige = krige.control(obj.model = defult_summer_mod))

# 预测结果绘图
# 均值图
image(summer_preds, col = viridis::viridis(100), zlim = c(100, max(c(summer_preds$predict))), 
  coords.data = geo_summer_df2[1]$coords, main = 'Mean', xlab = 'x', ylab = 'y',
  x.leg = c(700, 900), y.leg = c(20, 70))
# 方差图
image(summer_preds, values = summer_preds$krige.var, col = heat.colors(100)[100:1],
  zlim = c(0,max(c(summer_preds$krige.var))), coords.data = geo_summer_df2[1]$coords,
  main = 'Variance', xlab = 'x', ylab = 'y', x.leg = c(700, 900), y.leg = c(20, 70))

问题分析与解决方案 #

问题核心在于image()函数的使用场景：该函数要求输入的预测结果是规则网格格式，但你当前的preds_grid是20个离散点，并非规则网格，导致维度不匹配报错。以下是两种可行修改方案：

方案1：生成规则网格并重新预测 #

先基于原始数据的坐标范围生成规则网格，再执行预测与绘图：

# 基于原始数据坐标范围生成规则网格
x_range = range(geo_summer_df2$coords[,1])
y_range = range(geo_summer_df2$coords[,2])
preds_grid = expand.grid(x = seq(x_range[1], x_range[2], length.out = 50),
                         y = seq(y_range[1], y_range[2], length.out = 50))
# 转换为矩阵格式
preds_grid_mat = as.matrix(preds_grid)

# 重新执行克里金预测
summer_preds = krige.conv(geo_summer_df2, locations = preds_grid_mat, krige = krige.control(obj.model = defult_summer_mod))

# 绘制均值图
image(summer_preds, col = viridis::viridis(100), zlim = range(summer_preds$predict), 
      coords.data = geo_summer_df2$coords, main = '夏季温度预测均值', 
      xlab = '经度', ylab = '纬度')
# 添加原始观测点
points(geo_summer_df2$coords, pch = 16, cex = 0.5)

# 绘制方差图
image(summer_preds, values = summer_preds$krige.var, col = heat.colors(100)[100:1],
      zlim = range(summer_preds$krige.var), coords.data = geo_summer_df2$coords,
      main = '夏季温度预测方差', xlab = '经度', ylab = '纬度')
points(geo_summer_df2$coords, pch = 16, cex = 0.5)

方案2：针对离散点绘制散点图（保留原预测点） #

如果想保留原有的20个离散预测点，可使用散点图结合颜色映射展示结果：

# 将预测结果与坐标合并
pred_results = data.frame(
  lon = preds_grid[,1],
  lat = preds_grid[,2],
  pred_temp = summer_preds$predict,
  pred_var = summer_preds$krige.var
)

# 绘制均值散点图
library(ggplot2)
ggplot(pred_results, aes(x = lon, y = lat, color = pred_temp)) +
  geom_point(size = 4) +
  scale_color_viridis_c(limits = range(pred_results$pred_temp)) +
  geom_point(data = as.data.frame(geo_summer_df2$coords), aes(x = V1, y = V2), color = "black", size = 1) +
  labs(title = '夏季温度预测均值', x = '经度', y = '纬度', color = '温度') +
  theme_bw()

# 绘制方差散点图
ggplot(pred_results, aes(x = lon, y = lat, color = pred_var)) +
  geom_point(size = 4) +
  scale_color_gradientn(colors = rev(heat.colors(100)), limits = range(pred_results$pred_var)) +
  geom_point(data = as.data.frame(geo_summer_df2$coords), aes(x = V1, y = V2), color = "black", size = 1) +
  labs(title = '夏季温度预测方差', x = '经度', y = '纬度', color = '方差') +
  theme_bw()

内容的提问来源于stack exchange，提问作者Joe