CODEWITHSUNDEEP
rdplyrshinyr-leaflet
rwjam
rwjam

Reputation: 173

How to create a shiny filter that can iterate through a list within a dataframe column?

I have an input dataframe whose column values may contain a comma separated list. Is there a way to create a filter for shiny that can iterate through list within a dataframe?

Ideally a user should be able to view all three points, and filter through those points who have a PointUse of either farm, house, or even both.

Going back and creating a 'both' option in the source data is not an option. Must stick with the just the two filter options, farm or house.

#############################################
# Needed Libraries & Input Files

library(shiny)
library(shinydashboard)
library(leaflet)
library(dplyr)

##The Data
Point_ID = c("A1", "B1", "C3")
Latitude = c(38.05, 39.08, 40.05)
Longitude = c(-107.00, -107.05, -108.00)
PointUse = I(list("farm", c("farm", "house"), "house"))  # <- the column with the list entries
Map_DF <- data.frame(Point_ID, Latitude, Longitude, PointUse)

choiseList <- c("farm", "house")

#############################################
# UI
ui <- dashboardPage(
    dashboardHeader(),
    dashboardSidebar(checkboxGroupInput(inputId = "PointUseInput", label = "Select Point Use", choices = choiseList, selected = choiseList)),
    dashboardBody(fluidRow(leafletOutput(outputId = 'mapA')))
)

#############################################
# SERVER
server <- function(input, output, session) {

    ## The Filter
    filter_df <- reactive({
      Map_DF %>% filter(for(p in PointUse){p} %in% input$PointUseInput)   # <- the filter
    })

    ## Base Map Creation
    output$mapA <- renderLeaflet({
        leaflet() %>%
            addProviderTiles(
                providers$Esri.DeLorme,
                options = providerTileOptions(
                    updateWhenZooming = FALSE,
                    updateWhenIdle = TRUE)
            ) %>%
            setView(lng = -107.50, lat = 39.00, zoom = 7)
    })

    ## Update Map with Filter Selection
    observe({
        leafletProxy("mapA", session) %>%
            clearMarkers() %>%
            addCircleMarkers(
                data = filter_df(),
                radius = 10,
                color = "red",
                lat = ~Latitude,
                lng = ~Longitude,
                popupOptions(autoPan = FALSE),
                popup = ~paste("PointUse: ", filter_df()$PointUse))
    })
}

############################################
shinyApp(ui = ui, server = server)

Upvotes: 2

Views: 624

Answers (2)

jpdugo17
jpdugo17

Reputation: 7106

filter function expects a logical vector as an input. We can use map_lgl to map through the list column and any to show if at least one value in each row is equal to the input value.

Map_DF %>% filter(map_lgl(PointUse, ~any(. %in% input$PointUseInput)))

Upvotes: 2

Geovany
Geovany

Reputation: 5677

What about using a logical vector as an index instead of filter? See the code below where sapply is used to create a logical vector of the rows that match the input$PointUseInput value.

library(shiny)
library(shinydashboard)
library(leaflet)

##The Data
Point_ID = c("A1", "B1", "C3")
Latitude = c(38.05, 39.08, 40.05)
Longitude = c(-107.00, -107.05, -108.00)
PointUse = I(list("farm", c("farm", "house"), "house"))  # <- the column with the list entries
Map_DF <- data.frame(Point_ID, Latitude, Longitude, PointUse)

choiseList <- c("farm", "house")

#############################################
# UI
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(checkboxGroupInput(inputId = "PointUseInput", label = "Select Point Use", choices = choiseList, selected = choiseList)),
  dashboardBody(fluidRow(leafletOutput(outputId = 'mapA')))
)

#############################################
# SERVER
server <- function(input, output, session) {
  
  ## The Filter
  filter_df <- reactive({
    Map_DF[sapply(Map_DF$PointUse, function(p) {any(input$PointUseInput %in% p)}), ]
  })
  
  ## Base Map Creation
  output$mapA <- renderLeaflet({
    leaflet() %>%
      addProviderTiles(
        providers$Esri.DeLorme,
        options = providerTileOptions(
          updateWhenZooming = FALSE,
          updateWhenIdle = TRUE)
      ) %>%
      setView(lng = -107.50, lat = 39.00, zoom = 7)
  })
  
  ## Update Map with Filter Selection
  observe({
    leafletProxy("mapA", session) %>%
      clearMarkers() %>%
      addCircleMarkers(
        data = filter_df(),
        radius = 10,
        color = "red",
        lat = ~Latitude,
        lng = ~Longitude,
        popupOptions(autoPan = FALSE),
        popup = ~paste("PointUse: ", filter_df()$PointUse))
  })
}

############################################
shinyApp(ui = ui, server = server)

Upvotes: 4

Related Questions