Search code examples
rshinytmap

R tmap not reacting to color palette in a shiny app


I have a shiny app that is not showing the points as the color palette. It just shows them black. I would like the points to change color based on whether the value high or low.

How can I do this?

Sample data:

structure(list(Info = c(NA_character_, NA_character_, NA_character_, 
NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, 
NA_character_), tmean = c(22.2395992279053, 22.7657985687256, 
24.4260005950928, 19.601001739502, 21, 24, 26, 21.45, 27.6), Variable = c("tmean", "tmean", 
    "tmean", "tmean", "tmax", "tmax", "tmax", "tmax", "tmax"), 
     year = c(2021L, 2021L, 1980L, 1980L, 2021L, 2021L, 
    2021L, 2021L, 2021L), month = c(11L, 12L, 0L, 1L, 6L, 7L, 
    8L, 9L, 10L), TMin = c(15, 15.23, 16.12, 13.45, 16.46, 12.11, 11.55, 9.78, 10.56), TMax = c(0, 
    39.69, 40.001, 43.2, 40.6976985931396, 41.7550983428955, 42.1988983154297, 
    41.6512985229492, 40.2621994018555), geometry = structure(list(
        structure(c(-80.2083333327448, 26.2083333333333), class = c("XY", 
        "POINT", "sfg")), structure(c(-80.2083333327448, 26.2083333333333
        ), class = c("XY", "POINT", "sfg")), structure(c(-80.2083333327448, 
        26.2083333333333), class = c("XY", "POINT", "sfg")), 
        structure(c(-80.2083333327448, 26.2083333333333), class = c("XY", 
        "POINT", "sfg")), structure(c(-80.2083333327448, 26.0416666666667
        ), class = c("XY", "POINT", "sfg")), structure(c(-80.2083333327448, 
        26.0416666666667), class = c("XY", "POINT", "sfg")), 
        structure(c(-80.2083333327448, 26.0416666666667), class = c("XY", 
        "POINT", "sfg")), structure(c(-80.2083333327448, 26.0416666666667
        ), class = c("XY", "POINT", "sfg")), structure(c(-80.2083333327448, 
        26.0416666666667), class = c("XY", "POINT", "sfg"))), precision = 0, bbox = structure(c(xmin = -80.2083333327448, 
    ymin = 26.0416666666667, xmax = -80.2083333327448, ymax = 26.2083333333333
    ), class = "bbox"), crs = structure(list(input = "WGS 84", 
        wkt = "GEOGCRS[\"WGS 84\",\n    DATUM[\"World Geodetic System 1984\",\n        ELLIPSOID[\"WGS 84\",6378137,298.257223563,\n            LENGTHUNIT[\"metre\",1]]],\n    PRIMEM[\"Greenwich\",0,\n        ANGLEUNIT[\"degree\",0.0174532925199433]],\n    CS[ellipsoidal,2],\n        AXIS[\"latitude\",north,\n            ORDER[1],\n            ANGLEUNIT[\"degree\",0.0174532925199433]],\n        AXIS[\"longitude\",east,\n            ORDER[2],\n            ANGLEUNIT[\"degree\",0.0174532925199433]],\n    ID[\"EPSG\",4326]]"), class = "crs"), n_empty = 0L, class = c("sfc_POINT", 
    "sfc"))), row.names = c(NA, 9L), sf_column = "geometry", agr = structure(c(Info = NA_integer_, 
tmean = NA_integer_, CITYNAME = NA_integer_, Model = NA_integer_, 
Variable = NA_integer_, Datatype = NA_integer_, Resolution = NA_integer_, 
year = NA_integer_, month = NA_integer_, TMin = NA_integer_, 
TMax = NA_integer_), class = "factor", .Label = c("constant", 
"aggregate", "identity")), class = c("sf", "data.frame"))

Part of the Shiny App Tmap server code:

library(tmap)
library(tmaptools)

output$mapview =  renderLeaflet({
            Map_data =  Temp_map() 
            Tmap_map = tm_basemap()+
              tm_shape(Map_data)+
              tm_dots(size=input$Temp,
                      palette=get_brewer_pal(palette="OrRd", n=3, plot=FALSE),
                      style = "jenks",
                      labels = c("High", "Medium", "Yellow"),
                      popup.vars = ~(paste0("Temperature: ", input$Temp)),
                      legend.show = TRUE)+
              tm_layout(title = "40 Year Average Air Temperature")
            tmap_leaflet(Tmap_map)
          })

Current Output based on original data:

enter image description here

Update

I changed the code to use tmapOutput instead of leafletOutput and the result is still the same.

Part of UI:

library(shiny)
library(shinythemes)
library(sf)
library(tmap

  ui =   navbarPage(tabPanel("Temperature Map",  sidebarLayout(sidebarPanel(fileInput("filemap", label = "Input Shapfile (.shp,.dbf,.sbn,.sbx,.shx,.prj)",
                                                         multiple=TRUE,
                                                         accept = c(".shp",
                                                                    ".dbf",
                                                                    ".sbn",
                                                                    ".sbx",
                                                                    ".shx",
                                                                    ".prj")),
                                               selectInput(inputId = "Temp",
                                                           label = "Select Temperature Variable", 
                                                           choices = c("Mean Temperature" = "TMean",
                                                                       "Minimum Temperature" = "TMin",
                                                                       "Maximum Temperature" = "TMax"))),
                    mainPanel(tmapOutput("mapview"))))
)

Part of Server:

# Tell the server how to assemble inputs into outputs
    server = function(input, output, session) {
     # Read-in shapefile function
            Read_Shapefile = function(shp_path) {
              infiles = shp_path$datapath # get the location of files
              dir = unique(dirname(infiles)) # get the directory
              outfiles = file.path(dir, shp_path$name) # create new path name
              name = strsplit(shp_path$name[1], "\\.")[[1]][1] # strip name 
              purrr::walk2(infiles, outfiles, ~file.rename(.x, .y)) # rename files
              x = read_sf(file.path(dir, paste0(name, ".shp"))) # read-in shapefile
              return(x)
            }
            
            # Read-shapefile once user submits files
            
            Temp_map =   reactive({
                req(input$filemap)
              df = Read_Shapefile(input$filemap) %>% 
              group_by("year")
              df
            })
              
              pal = colorRampPalette(brewer.pal(3, "YlOrRd")) # Define color palette and classes
              
              observe({
                dff = Temp_map()
                updateSelectInput(session, "Temp", choices = names(dff))
              })
              
              #t_popup = paste0("Air Temperature", input$Temp) # Popup depends on the "Temp" variable selected 
              
              
              output$mapview =  renderTmap({
                Map_data =  Temp_map() 
                Tmap_map = tm_basemap()+
                  tm_shape(Map_data)+
                  tm_dots(size=input$Temp,
                          palette=get_brewer_pal(palette="OrRd", n=3, plot=FALSE),
                          style = "jenks",
                          labels = c("High", "Medium", "Yellow"),
                          #popup= ~(paste0("Temperature: ", input$Temp))
                          )+
                  tm_layout(title = "40 Year Average Air Temperature",
                            legend.show = TRUE,
                            legend.position = "right")
              })

}

Solution

  • I did not want this to get buried under the comments so the solution is quite simple, set col = input$Temp solves the problem.