Unable to zoom or hover map using nested subplot()
Ninguém assumiu esta issue ainda.
Avaliação
- Dificuldade
- 4/5
- Tempo estimado
- 3-5 dias
- Facilidade para iniciantes
- 35/100
- Tipo de issue
- Bug
- Clareza
- Razoavelmente clara
- Status de atividade
- Estagnada
- Stack de tecnologia
- r
- Domínio
- data-visualization
Direção de pesquisa
Comece executando o exemplo fornecido de subplots aninhados e inspecione final_combined, plotly_combined e os traces de mapa baseados em sf. Use plotly_json(final_combined, jsonedit = FALSE) para comparar o layout aninhado com os mapas renderizados individualmente. Considera-se concluído quando os mapas incorporados mantiverem zoom, panorâmica e texto ao passar o mouse sem quebrar a tabela ou o conteúdo de outros subplots.
Escrita pelo modelo de indexação a partir do texto da issue.
Descrição
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)
- Linguagem predominante
- R
- Estrelas
- 2.7k
- Forks
- 641
- Métricas de merge de PRs
- Nenhum PR com merge em 30d
Guia de contribuição
Primeiros passos
- Leia a issue inteira e depois o guia de contribuição do projeto.
- Comente na issue dizendo que vai assumir — evita que duas pessoas façam o mesmo trabalho.
- Faça um fork do repositório e trabalhe em uma branch.
- Abra um pull request que referencie o número da issue.
Mais de plotly/plotly.R
-
Dificuldade 2/5 1-3 horas Facilidade para iniciantes 62/100
-
Dificuldade 4/5 3-5 dias Facilidade para iniciantes 35/100
-
Dificuldade 3/5 1-2 dias Facilidade para iniciantes 68/100
-
Dificuldade 3/5 1-2 dias Facilidade para iniciantes 72/100
-
save_image Error Aberta
Dificuldade 3/5 1-2 dias Facilidade para iniciantes 52/100
Todas as issues de plotly/plotly.R
Issues semelhantes
-
Dificuldade 2/5 1-3 horas Facilidade para iniciantes 75/100
robjhyndman/forecast#1220 ·
-
Dificuldade 2/5 1-3 horas Facilidade para iniciantes 65/100
JamesHWade/deputy#192 ·
-
Dificuldade 2/5 1-3 horas Facilidade para iniciantes 75/100
-
bug triage_needed
Dificuldade 2/5 1-3 horas Facilidade para iniciantes 75/100
-
Dificuldade 2/5 1-3 horas Facilidade para iniciantes 72/100
pharmaverse/rtables#1123 · 1 comentário · 1 reação ·