plotly / plotly/plotly.R

Unable to zoom or hover map using nested subplot()

未关闭
#2,450 0 条评论 0 个 reaction 已指派 0 人 在 GitHub 查看

还没有人认领这个 Issue。

主要语言
R
星标
2.7k
派生
641
PR 合并指标
30 天内没有已合并 PR

描述

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)

贡献指南

打开贡献指南

从这里开始

  1. 先读完整个 Issue,再读项目的贡献指南。
  2. 在 Issue 下留言说明你要接手 —— 这能避免两个人做同样的事。
  3. Fork 仓库,在一个分支上完成修改。
  4. 提交 Pull Request,并在描述里引用这个 Issue 编号。

调研方向

首先运行提供的嵌套子图示例,并检查 final_combined、plotly_combined 以及基于 sf 的地图轨迹。使用 plotly_json(final_combined, jsonedit = FALSE) 将嵌套布局与单独渲染的地图进行比较。当嵌入式地图在不破坏表格或其他子图内容的情况下保留缩放、平移和悬停文本时,即表示完成。

由索引模型根据 Issue 内容生成。

评估

技术栈
r
领域
data-visualization
Issue 类型
缺陷
难度
4/5
预计耗时
3-5 天
活跃度
停滞
描述清晰度
基本清楚
新手友好度
35/100

把新 issue 发到你的邮箱

精选适合新手参与的 GitHub issue 摘要。