Unable to zoom or hover map using nested subplot()
還沒有人認領這個 Issue。
評估
- 難度
- 4/5
- 預估耗時
- 3-5 天
- 新手友好度
- 35/100
- Issue 類型
- 缺陷
- 描述清晰度
- 基本清楚
- 活躍度
- 停滯
- 技術堆疊
- r
研究方向
先執行提供的巢狀子圖範例,並檢查 final_combined、plotly_combined 以及以 sf 為基礎的地圖軌跡。使用 plotly_json(final_combined, jsonedit = FALSE) 比較巢狀版面配置與個別繪製的地圖。當嵌入的地圖在不破壞表格或其他子圖內容的情況下保留縮放、平移和懸停文字時,即表示完成。
由索引模型根據 Issue 內容生成。
描述
My interactive dashboard where multiple Plotly objects including maps are displayed using nested subplot() in R:
library(digest)
library(sf)
library(jsonlite)
library(plotly)
library(ggplot2)
library(tidyr)
library(dplyr)
library(tibble)
sa_final_dataset <- read.csv("state_data.csv")
final_dataset <- read.csv("nation_data.csv")
australia_data <- read_sf("australia_map.shp")
pivot_data <- read.csv("pivot_data.csv")
sa_map_data <- subset(australia_data, STE_NAME21 == "South Australia")
# Interpolate and split into line segments
interpolate_segments_as_lines <- function(df, steps = 50) {
df %>%
rowwise() %>%
do({
x_vals <- seq(.$fromX, .$X, length.out = steps)
y_vals <- seq(.$fromY, .$Y, length.out = steps)
position <- seq(0, 1, length.out = steps)
# Construct segments
data.frame(
x = head(x_vals, -1),
y = head(y_vals, -1),
xend = tail(x_vals, -1),
yend = tail(y_vals, -1),
position = head(position, -1),
FROM_NAME = .$FROM_NAME,
TO_NAME = .$TO_NAME,
TOTAL = .$TOTAL,
AGE_15_34 = .$AGE_15_34,
AGE_35_49 = .$AGE_35_49,
AGE_50_65 = .$AGE_50_65,
AGE_65_PLUS = .$AGE_65_PLUS
)
}) %>%
ungroup()
}
# Apply interpolation
sa_lines_segments <- interpolate_segments_as_lines(sa_final_dataset)
sa_lines_segments <- sa_lines_segments %>%
mutate(
thickness = round(rescale(abs(TOTAL), to = c(3, 10))),
color = rgb(
colorRamp(c("#cc0b15ff", "#1cc00dff"))(position),
maxColorValue = 255
)
)
# Use add_segments with thickness mapped to line width
sa_plotly <- plot_ly(height = 900, source = "South_Australia_Map") %>%
add_sf(
data = sa_map_data,
fill = "#007499",
line = list(color = "black"),
showlegend = FALSE,
hoverinfo = "skip"
)
# Optionally, you can color by direction or other variable if needed
for (t in sort(unique(sa_lines_segments$thickness))) {
seg_data <- sa_lines_segments %>% filter(thickness == t )
for (g in unique(seg_data$color)) {
seg_data_color <- seg_data %>% filter(color == g)
if (nrow(seg_data_color) > 0) {
sa_plotly <- sa_plotly %>%
add_segments(
data = seg_data_color,
x = ~x, y = ~y, xend = ~xend, yend = ~yend,
line = list(
color = ~color,
width = t
),
opacity = 0.8,
hovertext = paste0(
"From: ", seg_data_color$FROM_NAME, "<br>",
"To: ", seg_data_color$TO_NAME, "<br>",
"Age 15 - 34 Migrations: <b>", seg_data_color$AGE_15_34, "</b><br>",
"Age 35 - 49 Migrations: <b>", seg_data_color$AGE_35_49, "</b><br>",
"Age 50 - 65 Migrations: <b>", seg_data_color$AGE_50_65, "</b><br>",
"Age 66+ Migrations: <b>", seg_data_color$AGE_65_PLUS, "</b><br>",
"Net Migrations: <b>", seg_data_color$TOTAL, "</b>"
),
hoverinfo = "text",
showlegend = FALSE,
inherit = FALSE,
yaxis="y"
)
}
}
}
sa_plotly <- sa_plotly %>%
layout(
xaxis = list(title = ""),
yaxis = list(title = "")
)
interpolate_segments_as_lines_inter <- function(df, steps = 50) {
df %>%
rowwise() %>%
do({
x_vals <- seq(.$fromX, .$X, length.out = steps)
y_vals <- seq(.$fromY, .$Y, length.out = steps)
position <- seq(0, 1, length.out = steps)
data.frame(
x = head(x_vals, -1),
y = head(y_vals, -1),
xend = tail(x_vals, -1),
yend = tail(y_vals, -1),
position = head(position, -1),
group = .$group,
thickness = .$thickness,
SA3_NAME21 = .$SA3_NAME21,
State = .$State,
FinalValue = .$FinalValue,
AGE_15_34 = .$AGE_15_34,
AGE_35_49 = .$AGE_35_49,
AGE_50_65 = .$AGE_50_65,
AGE_65_PLUS = .$AGE_65_PLUS
)
}) %>%
ungroup()
}
inter_lines_segments <- interpolate_segments_as_lines_inter(final_dataset)
inter_hovertexts <- paste0(
"SA3 Name: ", inter_lines_segments$SA3_NAME21, "<br>",
"Age 15 - 34 Migrations: <b>", inter_lines_segments$AGE_15_34, "</b><br>",
"Age 35 - 49 Migrations: <b>", inter_lines_segments$AGE_35_49, "</b><br>",
"Age 50 - 65 Migrations: <b>", inter_lines_segments$AGE_50_65, "</b><br>",
"Age 66+ Migrations: <b>", inter_lines_segments$AGE_65_PLUS, "</b><br>",
"State: <b>", inter_lines_segments$State, "</b><br>",
"Net Value: <b>", inter_lines_segments$FinalValue, "</b>"
)
# Build plotly map for inter-state migration
plotly_gg_map <- plot_ly(height = 900, source = "Australia_Map") %>%
add_sf(
data = subset(australia_data, STE_NAME21 != "South Australia"),
fill = "#007499",
line = list(color = "black"),
showlegend = FALSE,
hoverinfo = "skip"
) %>%
add_sf(
data = subset(australia_data, STE_NAME21 == "South Australia"),
fill = "#007499",
line = list(color = "black"),
showlegend = FALSE,
hoverinfo = "skip"
)
groups <- c("Outgoing Migration", "Incoming Migration")
colors <- c("Outgoing Migration" = "#cc0b15ff", "Incoming Migration" = "#1cc00dff")
# Track if legend has been added for each group
legend_added <- setNames(rep(FALSE, length(groups)), groups)
for (g in groups) {
for (t in sort(unique(inter_lines_segments$thickness))) {
seg_data <- inter_lines_segments %>%
filter(group == g, thickness == t)
if (nrow(seg_data) > 0) {
seg_hovertexts <- inter_hovertexts[which(inter_lines_segments$group == g & inter_lines_segments$thickness == t)]
plotly_gg_map <- plotly_gg_map %>%
add_segments(
data = seg_data,
x = ~x, y = ~y, xend = ~xend, yend = ~yend,
line = list(color = colors[[g]], width = t),
opacity = 0.7,
hovertext = seg_hovertexts,
hoverinfo = "text",
name = g,
legendgroup = g,
showlegend = !legend_added[[g]]
)
legend_added[[g]] <- TRUE
}
}
}
plotly_gg_map <- plotly_gg_map %>%
layout(
showlegend = TRUE,
xaxis = list(title = ""),
yaxis = list(overlaying="y2"),
legend = list(title = list(text = ""))
)
plotly_combined <- subplot(
plotly_gg_map,
sa_plotly,
nrows = 1
) %>%
layout(
showlegend = TRUE,
legend = list(
orientation = "h",
x = 0.5,
y = 0.1,
xanchor = "center",
yanchor = "top",
font = list(size = 12)
),
annotations = list(
list(
text = "<b>Inter State Migration Map</b>",
x = 0.185,
y = 1.035,
xref = "paper",
yref = "paper",
showarrow = FALSE
),
list(
text = "<b>Intra State Migration Map</b>",
x = 0.825,
y = 1.035,
xref = "paper",
yref = "paper",
showarrow = FALSE
)
)
)
# Plotly table
table_plot <- plot_ly(
source = "Table 1",
type = "table",
columnwidth = c(15, 10, 10, 10, 10, 10, 10, 10, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20),
header = list(
values = colnames(pivot_data),
align = "center",
line = list(color = "#000000ff"),
font = list(color = list(
"black",
"white",
"white",
"white",
"white",
"white",
"white",
"white",
"white",
"white",
"white",
"white",
"white",
"white",
"white",
"white",
"white",
"white"
), size = 12),
fill = list(
color = list(
c("#ffffffff"),
c("#6A625E"),
c("#6A625E"),
c("#6A625E"),
c("#6A625E"),
c("#6A625E"),
c("#6A625E"),
c("#6A625E"),
c("#333333"),
c("#333333"),
c("#333333"),
c("#333333"),
c("#333333"),
c("#333333"),
c("#333333"),
c("#333333"),
c("#333333"),
c("#333333")
)
),
height = 40
),
cells = list(
values = rbind(t(as.matrix(unname(pivot_data)))
),
align = "center",
line = list(color = "#000000ff"),
fill = list(color = "#ffffffff"),
font = list(color = "#000000ff", size = 12)
)
)
table_plot2 <- plot_ly(
type = "table",
source = "Table 2",
header = list(
values = list(
c("<b>Sources:</b> Demo")
),
align = "left",
font = list(family = "Arial", size = 12),
height = 40,
line = list(color = "rgba(0,0,0,0)") # Remove borders
),
cells = list(
line = list(color = "rgba(0,0,0,0)") # Remove borders
),
domain = list(
x = c(0, 1),
y = c(0, 0.03)
)
)
# Ensure hoverinfo is retained for all subplots by explicitly setting hoverinfo for each axis
final_combined <- subplot(
table_plot, plotly_combined, table_plot2,
nrows = 3,
heights = c(0.25, 0.7, 0.05),
shareX = FALSE,
shareY = FALSE,
titleX = FALSE,
titleY = FALSE
) %>%
layout(
annotations = list(
list(
text = "<b>Average Monthly Net Migration</b>",
x = 0.5,
y = 1.035,
xref = "paper",
yref = "paper",
showarrow = FALSE,
font = list(size = 16, color = "#000000")
)
)
)
print(final_combined)
When using subplot() with multiple maps from sf objects I cannot zoom or pan into the maps and hover text does not appear. It works when the map is plotted individually. Files to reproduce the issue. The data has been modified to remove confidential information so please ignore inconsistency or logical mismatches. It's part of a larger architecture where R acts only as the backend, hence I am limited to Plotly, Leaflet and MapView.
Is this a bug in nested subplot() when used with sf objects or map traces? How can I retain map interactivity (zoom, pan, hover) when embedded as part of a nested subplot() layout? I've tried using subplot() with add_sf() and add_trace() and modifying layout options (dragmode, uirevision, and geo anchoring). final_combined should be able to convert it into Plotly JSON using:
plotly_json <- plotly_json(final_combined, jsonedit = FALSE)
- 主要語言
- R
- 星號
- 2.7k
- 分支
- 641
- PR 合併指標
- 30 天內沒有已合併 PR
貢獻指南
從這裡開始
- 先讀完整個 Issue,再讀專案的貢獻指南。
- 在 Issue 下留言說明你要接手 —— 這能避免兩個人做同樣的事。
- Fork 儲存庫,在一個分支上完成修改。
- 送出 Pull Request,並在描述裡引用這個 Issue 編號。
plotly/plotly.R 的其他 Issue
-
難度 2/5 1-3 小時 新手友好度 62/100
-
難度 4/5 3-5 天 新手友好度 35/100
-
難度 3/5 1-2 天 新手友好度 68/100
-
難度 3/5 1-2 天 新手友好度 72/100
-
save_image Error 未關閉
難度 3/5 1-2 天 新手友好度 52/100
相似的 Issue
-
難度 2/5 1-3 小時 新手友好度 75/100
easystats/performance#950 ·
-
難度 2/5 1-3 小時 新手友好度 70/100
-
難度 2/5 1-3 小時 新手友好度 75/100
briandconnelly/airnow#9 ·
-
難度 2/5 1-3 小時 新手友好度 75/100
OHDSI/CohortConstructor#774 ·
-
難度 2/5 1-3 小時 新手友好度 65/100