Unable to zoom or hover map using nested subplot()

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, " ",
 "To: ", seg_data_color$TO_NAME, " ",
 "Age 15 - 34 Migrations: ", seg_data_color$AGE_15_34, " ",
 "Age 35 - 49 Migrations: ", seg_data_color$AGE_35_49, " ",
 "Age 50 - 65 Migrations: ", seg_data_color$AGE_50_65, " ",
 "Age 66+ Migrations: ", seg_data_color$AGE_65_PLUS, " ",
 "Net Migrations: ", seg_data_color$TOTAL, ""
 ),
 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, " ",
 "Age 15 - 34 Migrations: ", inter_lines_segments$AGE_15_34, " ",
 "Age 35 - 49 Migrations: ", inter_lines_segments$AGE_35_49, " ",
 "Age 50 - 65 Migrations: ", inter_lines_segments$AGE_50_65, " ",
 "Age 66+ Migrations: ", inter_lines_segments$AGE_65_PLUS, " ",
 "State: ", inter_lines_segments$State, " ",
 "Net Value: ", inter_lines_segments$FinalValue, ""
 )

 # 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 = "Inter State Migration Map",
 x = 0.185,
 y = 1.035,
 xref = "paper",
 yref = "paper",
 showarrow = FALSE
 ),
 list(
 text = "Intra State Migration Map",
 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("Sources: 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 = "Average Monthly Net Migration",
 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][1]. 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)
```


 [1]: https://drive.google.com/drive/folders/1FlY66OtUxS7WTTG08eR1y8EkovnGieKQ?usp=sharing

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

Uh oh!

Unable to zoom or hover map using nested subplot() #2450

Metadata

Assignees

Labels

Type

Projects

Milestone

Relationships

Development

Unable to zoom or hover map using nested subplot() #2450

Description

Metadata

Metadata

Assignees

Labels

Type

Projects

Milestone

Relationships

Development

Issue actions