r语言 - 在闪亮中更改谷歌地图热图选项

Question

我在Shiny R中使用googleway库。

热图

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

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

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