Leaflet graph does not plot filtered data after merging spatial data frame based on user input

[Q007]

I have a sample data set with 4 columns

Year_of_connection
country
Method_of_connection
User_Counts
I am trying to create a dashboard using Shiny where the user is requested to input the year using a slider input and click the submit button. Upon clicking submit the output should be a leaflet map only for the year selected and reflecting User_counts from various countries
I followed the steps of getting the shapefile , ShapepolygonDataFrame using the maps package and then am trying to merge the shapefile with the dataframe - the dataframe is generated when user selects a set of specific dates only.

However, I am unable to see the selected countries on the map. Infact I see all countries from the shapefile

What am I doing wrong or have missed ?

you can observe that its plotting all countries rather than those only that are to be selected for the year via the slider input

###Code
library(shiny)
library(shinydashboard)
library(lubridate)
library(sp)
library(sf)
library(maps)
library(maptools)
library(leaflet)
library(stringr)
library(dplyr)

#Read the file
my_data <- read.csv(file.choose(),header = T)

#my_data$YEAR<-year(my_data$DATE_OF_CONNECTION)

#get shape files from world map
world <- map("world", fill=TRUE, plot=F)
world_map <- map2SpatialPolygons(world, sub(":.*$", "", world$names))
world_map <- SpatialPolygonsDataFrame(world_map,
data.frame(country=names(world_map),
stringsAsFactors=FALSE), FALSE)

world_map$country <- str_to_upper(world_map$country)

Take a subset of spatialPolygonDataFrame only for countries that match your dataset

t2 <- subset(world_map, country %in% my_data$country)

Define UI

ui <- navbarPage("Cell Connectivity",

             tabPanel("Country based Cellular Connections",
                      sidebarLayout(
                          sidebarPanel(
                              
                              sliderInput("val",
                                          "YOC:",
                                          min = 2015,
                                          max = 2021,
                                          value = 2018, #value is the starting value so should be value within date range
                                          sep="",
                                          ticks = FALSE),
                              
                              br(),
                              br(),
                              
                              
                              submitButton("Submit")
                              
                          ),
                          
                          
                          
                          # 
                          mainPanel(
                              
                              leafletOutput("map")
                              
                              
                          )
                      ) 
                      
                      
             )

)

Define server logic required to draw a histogram

server <- function(input, output) {

selected <- reactive({
     my_data[my_data$YEAR_OF_CONNECTION == input$val ,]
    
    
})




output$map <- renderLeaflet({
    # Use leaflet() here, and only include aspects of the map that
    # won't need to change dynamically (at least, not unless the
    # entire map is being torn down and recreated).
    leaflet(t2) %>% 
        addProviderTiles("CartoDB.Positron") 
        
      
})




observe({
    if(!is.null(input$val)){
      #t2@data <- left_join(t2@data, selected, by="country")
        
        
        t2@data <- inner_join(t2@data, selected(),by="country")
        
         #t3 <- merge(world_map, selected(),by.x="country",by.y="country",all.y= TRUE)
    
        
        leafletProxy("map", data =  t2) %>%
            
            #addTiles() %>% 
            clearShapes() %>% 
            addPolygons(data = t2, 
                        
                        fillOpacity = 0.7, 
                        color = "Blue", weight = 2)
        
    }
    
})

}

Run the application

shinyApp(ui = ui, server = server)

.###End

[Q007]

Found the issue, and made changes to the code.

I made the changes to my code, rather than merging the entire subset of the SpatialpolygonDataFrame containing countries of interest, I merged them with shapefile@data attribute (where shapefile is your shapefile and @data is part of the large shapefile). Then I assigned the merged component (Shapefile@data and user's selected data frame) back to the shapefile@data attribute of the original subseted SpatialpolygonDataFrame. Thus the originally subseted data frame now contains the correct label values .

Here is the updated code
Also posted the solution on Stackoverflow StackOverflow solution
...

library(shiny)
library(shinydashboard)
library(lubridate)
library(sp)
library(sf)
library(leaflet)
library(stringr)
library(dplyr)
library(maps)
library(maptools)

#Read the file
my_data <- read.csv(file.choose(),header = T)

my_data$YEAR_OF_CONNECTION <- strptime(my_data$YEAR_OF_CONNECTION,"%Y")

my_data$YEAR_OF_CONNECTION <- as.numeric(format(my_data$YEAR_OF_CONNECTION,"%Y"))

print(my_data)

print(class(my_data$YEAR_OF_CONNECTION))

Define UI

ui <- navbarPage("Cell Connectivity",

             tabPanel("Country based Cellular Connections",
                      sidebarLayout(
                        sidebarPanel(
                          
                          selectInput(
                            inputId =  "val", 
                            label = "Select time period:", 
                            choices = 2014:2021
                          ),
                          
                          br(),
                          br(),
                          
                          
                          submitButton("Submit")
                          
                        ),
                        
                        
                        
                        # 
                        mainPanel(
                          
                          leafletOutput("map")
                          
                          
                        )
                      ) 
                      
                      
             )

)

Define server logic required

server <- function(input, output) {

selected <- reactive({

fildata <- filter(my_data,my_data$YEAR_OF_CONNECTION == input$val)
fildata
# my_data[my_data$YEAR_OF_CONNECTION == input$val,]
# 
# print(class((input$val)))
# print(input$val)

})

output$map <- renderLeaflet({
# Use leaflet() here, and only include aspects of the map that
# won't need to change dynamically (at least, not unless the
# entire map is being torn down and recreated).
leaflet() %>%
addProviderTiles("CartoDB.Positron")

})

observe({
if(!is.null(input$val)){

  #t2@data <- left_join(t2@data, selected (), by="country")
  
  worldmap <- map("world", fill=TRUE, plot=FALSE)
  
  
  IDs <- sapply(strsplit(worldmap$names, ":"), function(x) x[1])

  
  worldmap_poly <- map2SpatialPolygons(worldmap, IDs=IDs, proj4string=CRS("+proj=longlat +datum=WGS84"))
  
  
  
  worldmap_poly_sp <- SpatialPolygonsDataFrame(worldmap_poly,
                                               data.frame(IDs=names(worldmap_poly), 
                                                          stringsAsFactors=FALSE), FALSE)
  
  
  ##subset the SpatialpolygonDataFrame only for country of interest
  t2 <- subset(worldmap_poly_sp, IDs %in% selected()$country)
  
  
  
 
  
  #t2@data <- inner_join(t2@data, selected(), by=character(),copy = TRUE)
  
  t3 <- merge(t2@data, selected(),by.x="IDs",by.y="country",all.y= TRUE)
  
  t2@data <- t3
  
  leafletProxy("map", data = t2 ) %>%
    
    
    
    addTiles() %>% 
    clearShapes() %>% 
    addPolygons(data = t2, 
                #fillColor = "Green",
                fillOpacity = 0.7, 
                #color = "Blue", weight = 2,
                popup = ~ paste0("USER_COUNTS: ", as.character(t2@data$USER_COUNTS),
                                 "<br>","<b>",
                                 "COUNTRY:",as.character(t2@data$IDs)))
  
}

})

}

Run the application

shinyApp(ui = ui, server = server)

....

[Q007]