如何统一R语言openair包后向轨迹聚类各簇的编号与颜色

以下方案可实现多年后向轨迹聚类结果的簇编号、区域映射、配色完全统一： #

1 预定义固定映射规则 #

首先提前声明区域、簇编号、配色的绑定关系，以及每个区域的中心参考经纬度用于匹配：

library(openair)
library(dplyr)

# 固定映射表：簇编号-对应区域-固定配色
cluster_fixed_map <- data.frame(
  new_cluster = factor(c("C1","C2","C3","C4","C5","C6"),
                       levels = c("C1","C2","C3","C4","C5","C6")),
  region = c("英国西部大西洋区域","英吉利海峡、比斯开湾","法国本土",
             "北海","北大西洋及英国本土","德国、比利时、荷兰北部海岸"),
  fixed_color = c("#1f77b4","#ff7f0e","#2ca02c","#d62728","#9467bd","#8c564b")
)

# 各区域中心参考经纬度，可根据你的研究范围微调提升匹配准确率
region_centroids <- data.frame(
  region = cluster_fixed_map$region,
  center_lon = c(-10, -3, 2, 5, -5, 6),
  center_lat = c(55, 48, 46, 55, 58, 53)
)

2 编写单年份聚类与重编号函数 #

对每年的聚类结果，通过平均轨迹的中心经纬度匹配对应区域，自动替换为统一的簇编号：

process_single_year <- function(traj_all, target_year, n_cluster=6) {
  # 运行原始聚类，先关闭默认绘图
  raw_clust <- trajCluster(
    selectByDate(traj_all, year = target_year),
    method = "Angle",
    n.cluster = n_cluster,
    plot = FALSE
  )
  
  # 计算每个原始聚类平均轨迹的中心经纬度
  cluster_cent <- raw_clust$clusters %>%
    group_by(cluster) %>%
    summarise(mean_lon = mean(lon), mean_lat = mean(lat), .groups = "drop")
  
  # 欧氏距离匹配对应区域
  cluster_match <- cluster_cent %>%
    rowwise() %>%
    mutate(
      region = region_centroids$region[
        which.min(
          sqrt((center_lon - mean_lon)^2 + (center_lat - mean_lat)^2)
        )
      ]
    ) %>%
    left_join(cluster_fixed_map, by = "region")
  
  # 替换轨迹数据的簇编号
  raw_clust$data <- raw_clust$data %>%
    left_join(cluster_match[,c("cluster","new_cluster","fixed_color")], by = "cluster") %>%
    rename(old_cluster = cluster, cluster = new_cluster)
  
  # 替换平均轨迹数据的簇编号
  raw_clust$clusters <- raw_clust$clusters %>%
    left_join(cluster_match[,c("cluster","new_cluster","fixed_color")], by = "cluster") %>%
    rename(old_cluster = cluster, cluster = new_cluster)
  
  return(raw_clust)
}

3 批量处理多年数据与绘图 #

批量处理2014-2018年数据，绘图时直接使用预定义的固定配色即可实现多年结果统一：

# 批量处理所有年份
year_list <- 2014:2018
clust_result <- lapply(year_list, function(y) process_single_year(traj, y))
names(clust_result) <- as.character(year_list)

# 绘制单年份结果示例
plot(clust_result[["2014"]],
     col = cluster_fixed_map$fixed_color,
     map.cols = openColours("Paired", 10),
     key.position = "top",
     key.title = "气团来源区域")

# 提取重编号后的轨迹数据示例
traj_2014_new <- clust_result[["2014"]]$data

注意事项 #

• 若出现区域匹配错误，可微调region_centroids中的参考经纬度，或额外加入轨迹平均方向、移动距离等特征提升匹配精度
• 固定配色可根据需求自行修改cluster_fixed_map中的fixed_color值即可

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