如何為 R 中的 voronoi treemap 添加多邊形數據？

Question

賞金將在 3 分鍾后到期。 此問題的答案有資格獲得+100聲望賞金。 LDT想提請更多人關注這個問題：

到目前為止，所有答案都很棒並且得到了好評。 但是，我正在尋找一種更優雅的算法。 我期待看到任何答案。

我有一個看起來像這樣的數據框。 它包含每個國家的葵花籽生產力。 我想在這個數據旁邊添加多邊形數據，這樣我就可以用 plot 和 ggplot2。

有人告訴我使用這個網站： https://observablehq.com/@ladataviz/wip-voronoi-data-generator ，我想了解如何創建多邊形和 plot 圓形 voronoi 圖。

我過去曾創建過類似的帖子，但我在這里的問題卻大不相同。 我想找到一種方法來創建多邊形數據

df <- data.frame(country = c("Ukraine", "Russia", "Argentina", "China", "Romania", "Other"),
                 prod = c(11.0, 10.6, 3.1, 2.4, 2.1, 15.3))
df
#>     country prod
#> 1   Ukraine 11.0
#> 2    Russia 10.6
#> 3 Argentina  3.1
#> 4     China  2.4
#> 5   Romania  2.1
#> 6     Other 15.3

^{創建於 2023-01-20，使用reprex v2.0.2}

如果將多邊形添加到我的數據中應該如下所示：

       x            y path   split   group value
1   472.0117 220.08122253    0 Ukraine Ukraine    11
2   471.8336 217.18476868    1 Ukraine Ukraine    11
3   471.6556 214.28833008    2 Ukraine Ukraine    11
4   471.4776 211.39187622    3 Ukraine Ukraine    11
5   471.2996 208.49542236    4 Ukraine Ukraine    11
6   471.1216 205.59896851    5 Ukraine Ukraine    11

我希望我的數據看起來像這樣。

Answer 1

可能有一個聰明的算法，但這里是你如何通過蠻力制作這樣的圖表。

您的數據

df <- data.frame(country = c("Ukraine", "Russia", "Argentina", "China", "Romania", "Other"),
                  prod = c(11.0, 10.6, 3.1, 2.4, 2.1, 15.3))

通過優化找到解決方案的function

library(terra)

vtreeMap <- function(d) {

    p <- vect(cbind(0,0), crs="+proj=utm +zone=1") |> buffer(1)
    A <- expanse(p) * d / sum(d)

    f <- function(xy) {
        if (any(xy > 1) || any(xy < -1)) return(Inf)
        xy <- vect(matrix(xy, ncol=2), crs=crs(p))
        e <- extract(p, xy)
        if (any(is.na(e[,2]))) return(Inf)
        v <- crop(voronoi(xy, bnd=p), p)
        mean( (A - expanse(v))^2 )
    }

    xy <- spatSample(p, length(A)) |> crds() |> as.vector()
    opt <- optim(xy, f)
    print(paste("MSE:", round(opt$value, 5)))
    vp <- vect(matrix(opt$par, ncol=2))
    crop(voronoi(vp, bnd=p), p)
}

撥打function

set.seed(3)
vp <- vtreeMap(df$prod)
[1] "MSE: 0.01187"

和 plot 它

library(RColorBrewer)
vp$country <- df$country
plot(vp, col=brewer.pal(6, "Set2"), axes=FALSE, lwd=4, border="white", mar=rep(0.1, 4))
text(vp, "country", halo=TRUE)

您可能需要稍微調整優化過程（不同的算法、附加選項）以獲得最佳結果（低 MSE）。

例如，您可以使用

 opt <- optim(xy, f, method="BFGS", control=list(abstol=0.001, maxit=500))

如果您不喜歡這個特定的解決方案，請更改種子並重試，直到找到令您滿意的解決方案。

如果你想使用 ggplot2 你可以這樣做

library(tidyterra)
library(ggplot2)
ggplot(vp) + geom_spatvector(aes(fill = country)) + theme_void()

Answer 2

在 R 中制作 Voronoi 流蘇相對容易，但制作 Voronoi treemap比較難。 鏈接的問答通過使用voronoiTreemap package 來實現，它本質上只是 JavaScript 庫的包裝器。 據我所知，這是唯一發布的生成 Voronoi 樹圖的 R package。

我們的兩個選擇是自己從頭開始計算多邊形，或者以某種方式從 voronoiTreemap 的voronoiTreemap output 中提取多邊形。

關於第一個選項，這不是一個小問題。 要了解它到底有多復雜，並在 R 中獲得完整的解決方案，您可以查看Paul Murrell 撰寫的這篇精彩文章。 該代碼運行了好幾頁並且已有十多年的歷史了，因此我不確定所有依賴項是否仍然有效。 令人失望的是，沒有人將它們全部放在 CRAN 上的一個 package 中，但也許它有點小眾。

如果您對 Paul Murrell 的方法感到困惑，您將不得不嘗試從 voronoiTreemap 的voronoiTreemap中獲取多邊形。 盡管這個 package 運行良好，但 output 不適合用於多邊形采集，而且我們無法訪問允許我們自己在 R 中生成多邊形的中間計算。這並非不可能，有幾種方法來解決它，但它們都相當復雜。

以下方法首先使用voronoiTreemap正常繪制樹狀圖，但沒有標簽：

library(voronoiTreemap)
library(terra)
library(tidyverse)

df <- data.frame(country = c("Ukraine", "Russia", "Argentina", 
                             "China", "Romania", "Other"),
                 prod = c(11.0, 10.6, 3.1, 2.4, 2.1, 15.3))

vor <- data.frame(h1 = 'World', 
                  h2 = c('Europe', 'Europe', 'Americas', 'Asia',
                         'Europe', 'Other'),
                  h3 = df$country,
                  color = hcl.colors(nrow(df), palette = 'TealRose'),
                  weight = df$prod,
                  codes = "")

vt <- vt_input_from_df(vor)

v <- vt_d3(vt_export_json(vt))

v

現在點擊Export -> Save as image並將你的 plot 保存為Rplot.png

現在我們可以做

polygons <- rast('Rplot02.png')[[2]] %>% 
  app(fun = function(x) ifelse(x > 220, 255, 0)) %>%
  as.polygons() %>%
  sf::st_as_sf() %>% 
  filter(lyr.1 == 0) %>%
  sf::st_buffer(dist = -0.002) %>%
  sf::st_coordinates() %>%
  as.data.frame() %>%
  mutate(country = df$country[L2], prod = df$prod[L2]) %>%
  select(-(L1:L3))

使用我們的多邊形生成以下數據框：

head(polygons)
#>           X         Y country prod
#> 1 0.6460000 0.3970068 Ukraine   11
#> 2 0.6460000 0.4054322 Ukraine   11
#> 3 0.6460501 0.4054499 Ukraine   11
#> 4 0.6461468 0.4054900 Ukraine   11
#> 5 0.6462413 0.4055351 Ukraine   11

通過執行以下操作，我們可以看到這是 Voronoi 樹狀圖的多邊形數據框：

ggplot(polygons, aes(X, Y, fill = country)) + 
  geom_polygon() +
  coord_fixed(0.52) +
  theme_void()

Answer 3

被這個問題迷住了，我寫了一個小的 package 來解決它，你可以通過

devtools::install_github("AllanCameron/VoronoiPlus")

它可以通過調用voronoi_map來處理 Voronoi 映射（如本頁問題中所示），該映射采用權重和組標簽。 它也可以采用任意形狀作為圖塊的邊界，但如果缺少則默認為單位圓。

library(VoronoiPlus)

res <- voronoi_map(values = df$prod, groups = df$country)

plot(res)

您可以使用以下方法從此 object 中提取多邊形作為數據框：

polys <- get_polygons(res)

head(polys)
#>   geom          x          y   group value
#> 1    1 -0.6436006 -0.7649495 Ukraine    11
#> 2    1 -0.6691306 -0.7431448 Ukraine    11
#> 3    1 -0.7071068 -0.7071068 Ukraine    11
#> 4    1 -0.7431448 -0.6691306 Ukraine    11
#> 5    1 -0.7771460 -0.6293204 Ukraine    11
#> 6    1 -0.8090170 -0.5877853 Ukraine    11

package 還可以通過voronoi_treemap function 處理任意嵌套組以生成真正的樹圖，它采用公式界面（左側的權重和右側的分組變量）

df$region <- c("Europe", "Europe", "Other", "Other", "Europe", "Other")

dat <- voronoi_treemap(prod ~ region + country, data = df)

head(dat)
#>           x          y  group value parent level
#> 1 0.6657716 -0.7460137 Europe  23.7   root     1
#> 2 0.6293204 -0.7771460 Europe  23.7   root     1
#> 3 0.5877853 -0.8090170 Europe  23.7   root     1
#> 4 0.5446390 -0.8386706 Europe  23.7   root     1
#> 5 0.5000000 -0.8660254 Europe  23.7   root     1
#> 6 0.4539905 -0.8910065 Europe  23.7   root     1

這允許嵌套樹狀圖如下：

library(tidyverse)

ggplot(dat[dat$level == 2,], aes(x, y, label = group)) +
  geom_polygon(aes(fill = parent)) +
  geom_polygon(fill = "white", aes(group = group, alpha = group), 
               color = "black") +
  geom_text(data = . %>% group_by(group) %>% 
              summarize(x = mean(x), y = mean(y))) +
  scale_alpha_discrete(guide = "none") +
  coord_equal() +
  theme_void()

目前使用的算法也是一種蠻力法，雖然與Robert Hijmans演示的略有不同。 我正在研究一種更有針對性的方法來縮短收斂時間。

一個主要的警告是 package 處於初級階段，在撰寫本文時尚未經過適當的測試或記錄。