开发者

Using custom colorscale when update the map

I would like to update the mailbox choropleth colorscale based on a dropdown menu selection.

I found this which was developed in Python, but I would like to do the same for R/Shiny.

This was what I tried:

global.R

library(dplyr)
library(geojsonsf)
library(shiny)
library(leaflet)
library(maps)
library(mapboxer)
library(plotly)
library(purrr)
library(rjson)
library(sf)

MAPBOX_TOKEN <- "MY_TOKEN_HERE"
Sys.setenv("MAPBOX_TOKEN" = MAPBOX_TOKEN)

MELBOURNE_MAP <- sf::st_read(geojsonsf::geo_melbourne)

places <- as.data.frame(MELBOURNE_MAP) %>% select(SA2_NAME) %>% pull() %>% append("All regions", 0)

places_length <- length(places)

Names <- as.vector(places[2 : places_length])
ColA <- as.vector(sample(1 : 100, size = places_length - 1, replace = TRUE))
ColB <- as.vector(sample(1 : 100, size = places_length - 1, replace = TRUE))

MELBOURNE_DATA <- data.frame(name = Names, ColA = ColA, ColB = ColB)

ui.R

ui <- fluidPage(
  selectInput("Column", label = "Column", choices = c("ColA", "ColB")),
  h1("Plotly Map"),
  plotlyOutput("plotlyMap", width = "50%")
)

server.R

server <- function(input, output, session) {
    bbox <- reactive ({
    st_bbox(MELBOURNE_MAP$geometry) %>% as.vector()
  })


  output$plotlyMap <- renderPlotly({

    # The line below is only to show how I transformed the map to geojson
    # st_write(MELBOURNE_MAP, "www/melbourne.geojson")

    url <- 'http://127.0.0.1:6764/melbourne.geojson'
    geojson <- rjson::fromJSON(file=url)
    
    cnumbers <- c(0, 0.05, 0.10, 0.15, 0.20, 0.25)
    ccolors <- c("#EDF8E9", "#C7E9C0", "#A1D99B", "#74C476", "#31A354", "#006D2C")
    
    fig <- plot_ly() 
    fig <- fig %>% add_trace(
      type="choroplethmapbox",
      geojson=geojson,
      locations=MELBOURNE_DATA$name,
      z=MELBOURNE_DATA$ColA,
      #colorscale="Viridis",
      colorscale=mapply(c, cnumbers, ccolors, SIMPLIFY = FALSE),    <- This is a CUSTOM colorscale, and it works
      featureidkey="properties.SA2_NAME"
    )
    fig <- fig %>% colorbar(title = "Numbers")
    fig <- fig %>% layout(
      mapbox=list(
        style="carto-positron",
        zoom =9,
        center=list(lon=bbox()[1], lat=bbox()[2]))
    )
    fig
  })

  myPlotProxy <- plotlyProxy("plotlyMap", session)
  
  update_plotlyMap <- function(column, region) {
    cnumbers <- c(0, 0.05, 0.10, 0.15, 0.20, 0.25)
    if (column == "ColA") {
      ccolors <- c("#开发者_高级运维EDF8E9", "#C7E9C0", "#A1D99B", "#74C476", "#31A354", "#006D2C")
      # cscale <- "Viridis"
    } else {
      ccolors <- c("#EFF3FF", "#C6DBEF", "#9ECAE1", "#6BAED6", "#3182BD", "#08519C")
      # cscale <- "Cividis"
    }
    cscale <- mapply(c, cnumbers, ccolors, SIMPLIFY = FALSE)

    myPlotProxy %>%
      plotlyProxyInvoke("update", list(
        z = list(MELBOURNE_DATA[[column]]),
        colorscale = list(cscale)    # HERE is the issue when I use CUSTOM colorscale
      ))
  }

NOTE: When I pass a named colorscale (eg: Viridis, Cividis) it works. Obviously commenting out the mapply line

I also find this dated 2020. The answer tells exactly what the note above.

Based on the first link, it looks like it works for Python. Is there a way to make it works using CUSTOM colorscale in Shiny?

0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜