r - 更改 Shiny 的谷歌地图热图选项

Question

我在 Shiny R 中使用 googleway 库。

热图显示正确，但我无法更改热图选项。如果我取消注释我尝试更改选项的 block 代码，应用程序会崩溃。

这是代码的一部分，其中有问题的行被注释掉了。

library(googleway)
library(magrittr)
library(shiny)
library(shinydashboard)

# Define UI for app

header1 <- dashboardHeader(
  title = "My Dashboard"
)

sidebar1 <- dashboardSidebar(
  sidebarMenu(
    fileInput("file0", "Choose CSV File",
              multiple = TRUE,
              accept = c("text/csv",
                         "text/comma-separated-values,text/plain",".csv")),
    sliderInput("opacity", "Opacity:",
                min = 0, max = 1,
                value = 0.5, step = 0.05),
    sliderInput("radius", "Radius:",
                min = 0, max = 50,
                value = 25),
    sliderInput("blur", "Blur:",
                min = 0, max = 1,
                value = 0.75, step = 0.05),
    sliderInput("maxvalue", "MaxValue:",
                min = 0, max = 1,
                value = 1, step = 0.05)
  ) #sidebarMenu
) #dashboardSidebar

body1 <- dashboardBody(
  fluidRow(
    tabBox(
      title = "TabBox Title 1",
      id = "tabset1", height = "400px", width = 11,
      selected = "Tab1",
      tabPanel("Tab1",
               google_mapOutput("Map1")
      ),
      tabPanel("Tab2", "Tab content 2")
    ) #box
  ) #fluidRow
) #dashboardBody

ui <- dashboardPage(header1, sidebar1, body1)

# Define data
df <- data.frame(lat = c(14.61),
                  lon = c(-90.54),
                  weight = c(100))


# Define SERVER logic
server <- function(input, output, session) {

  map_key <- "my_key"
  ## https://developers.google.com/maps/documentation/javascript/get-api-key

  ## plot the map
  output$Map1 <- renderGoogle_map({
    google_map(key = map_key, data = df, zoom = 2, search_box = F) %>%
      add_heatmap(weight = "weight") #%>%
      #add_traffic()

  }) #renderGoogle_map

  observeEvent(input$opacity, {

    # THIS PART IS COMMENTED OUT BECAUSE THE APP CRASHES
    # google_map_update(map_id = "Map1") %>%
    #   update_heatmap(data = df, option_opacity = input$opacity)

  }) #observeEvent

} #server


# Run app
shinyApp(ui, server)

非常感谢您对此的帮助! :)

Answer 1

可以用一个reactive({})携带input$opacity值直接传给add_heatmap()来实现不透明度响应能力。

这仍然可以在 google_map_update() 中完成，但您必须先清除热图图层，否则您只会在彼此之上添加图层。

server <- function(input, output, session) {

    map_key <- "your_key"
    ## https://developers.google.com/maps/documentation/javascript/get-api-key

    opacity <- reactive({
        return(input$opacity)
    })

    ## plot the map
    output$Map1 <- renderGoogle_map({
        google_map(key = map_key, data = df, zoom = 2, search_box = F) %>%
            add_heatmap(weight = "weight") #%>%
        #add_traffic()

    }) #renderGoogle_map

    observeEvent(input$opacity, { 

        google_map_update(map_id = "Map1") %>%
            clear_heatmap() %>%
            add_heatmap(data = df, option_opacity = opacity())
        })
    }

} #server