CODEWITHSUNDEEP
rshinyheatmapgoogleway
fhaidacher
fhaidacher

Reputation: 123

Change google maps heatmap options in shiny

I am using googleway library in Shiny R.

The heatmap displays correctly, but I cannot change the heatmap options. If I uncomment the block code where I try to change options, the app crashes.

Here is the part of the code that works, with the offending lines commented out.

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)

Your help with this will be greatly appreciated! :)

Upvotes: 3

Views: 696

Answers (1)

Nate
Nate

Reputation: 10671

You can use a reactive({}) to carry the input$opacity value and pass it directly to add_heatmap() to achieve the opacity responsiveness.

This can still be done inside the google_map_update(), but you'd have to clear the heatmap layer first, otherwise you'd just be adding layers on top of each other. 

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

Upvotes: 3

Related Questions