如何修改R语言leaflet代码实现平滑等高线？

问题描述 #

我使用以下代码绘制交互式Leaflet地图，但等高线存在尖锐转折，不够平滑圆润。请问如何修改代码实现平滑等高线？

原始代码：

Sta_den <- eks::st_kde(df) # calculate density
contours <- eks::st_get_contour(Sta_den, cont=c(20,40,60,80)) %>% 
  mutate(value=as.numeric(levels(contlabel)))
pal <- colorBin("YlOrRd", contours$contlabel, bins = c(20,40,60,80), reverse = TRUE)

pal_fun <- leaflet::colorQuantile("YlOrRd", NULL, n = 4)

p_popup <- paste("Density", as.numeric(levels(contours$contlabel)), "%")

leaflet::leaflet(contours) %>% 
  leaflet::addTiles() %>% # OpenStreetMap by default
  leaflet::addPolygons(fillColor = ~pal_fun(as.numeric(contlabel)),
                       popup = p_popup, weight=2)%>% 
  leaflet::addLegend(pal = pal, values = ~contlabel, group = "circles", position = "bottomleft",title="Density quantile")

解决方案 #

方法1：用smoothr包直接平滑等高线多边形 #

这是最便捷的处理方式，通过专用的空间多边形平滑函数优化轮廓：

1. 安装并加载依赖包：

install.packages("smoothr")
library(smoothr)

2. 修改等高线生成代码，加入平滑步骤：

Sta_den <- eks::st_kde(df) # 计算核密度
contours <- eks::st_get_contour(Sta_den, cont=c(20,40,60,80)) %>% 
  mutate(value=as.numeric(levels(contlabel))) %>%
  # 平滑处理：method可选"chaikin"（保留形状）或"ksmooth"（柔和曲线）
  smooth(method = "ksmooth", smoothness = 5) # smoothness值越大，平滑程度越高

pal <- colorBin("YlOrRd", contours$contlabel, bins = c(20,40,60,80), reverse = TRUE)

pal_fun <- leaflet::colorQuantile("YlOrRd", NULL, n = 4)

p_popup <- paste("Density", as.numeric(levels(contours$contlabel)), "%")

leaflet::leaflet(contours) %>% 
  leaflet::addTiles() %>% 
  leaflet::addPolygons(fillColor = ~pal_fun(as.numeric(contlabel)),
                       popup = p_popup, weight=2)%>% 
  leaflet::addLegend(pal = pal, values = ~contlabel, group = "circles", position = "bottomleft",title="Density quantile")

• 若需要保留更多原始轮廓细节，推荐用method="chaikin"；若追求极致平滑，选method="ksmooth"
• smoothness参数可在3-10之间调整，根据实际效果微调

方法2：提高KDE计算的分辨率 #

尖锐等高线可能源于核密度计算的网格分辨率过低，增大st_kde的n参数提升精度：

# 将n值从默认100调整为200（或更高），提升网格密度
Sta_den <- eks::st_kde(df, n = 200) 
contours <- eks::st_get_contour(Sta_den, cont=c(20,40,60,80)) %>% 
  mutate(value=as.numeric(levels(contlabel)))

# 后续绘图代码保持不变

这种方法从源头上减少轮廓的锯齿感，若结合smoothr的平滑处理，效果会更理想。

方法3：调整等高线插值方法 #

st_get_contour支持不同的插值算法，切换为双线性插值可优化轮廓平滑度：

contours <- eks::st_get_contour(Sta_den, cont=c(20,40,60,80), interp = "bilinear") %>% 
  mutate(value=as.numeric(levels(contlabel)))

interp="bilinear"比默认的线性插值生成的轮廓更流畅，适合改善轻微的尖锐转折。

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