Is it possible to create a reactive value from a function

[williaml]

Is it possible to create a reactive value from a function?

I want a function that will create the object thing below. The selected_type() is in a module, but could is just something from a selectInput (e.g. input$item).

I had a bit of a look at reactiveValues(), but couldn't quite work out to match it with what I want.

thing <- reactive({
  
  if (selected_type() == "A"){
    
    "something"
    
  } else if (selected_type() == "B"){
    
    "something else"
    
  } else {
    
    "some_other_thing"
    
  }
})

# this doesn't work but just an example ----------------
# test function
build_thing <- function(selected){
  
  if (selected == "A"){
    
    "something"
    
  } else if (selected == "B"){
    
    "something else"
    
  } else {
    
    "some_other_thing"
    
  }
}

thing <- reactiveValues()
# it might be something like this but not this
thing <- build_thing(selected_type())

[gitdemont]

Hi,
Like this ?

ui <- fluidPage(numericInput(inputId = "foo", label = "you should get x^2", value = 0),
                verbatimTextOutput("out"))
server <- function(input, output) {
  react <- reactive(x = function(x) return(x*x))
  output$out <- renderPrint(do.call(react(), list(x = input$foo)))
}
shinyApp(ui = ui, server = server)

[williaml]

Thanks. I will play around with it, but I am not quite sure.

What I want to do is return a different polygon (different geographical boundaries), depending on the input (the name of the geographical category).

[gitdemont]

Maybe more like this

ui <- fluidPage(selectInput(inputId = "foo", choices = LETTERS, label = "category", multiple = FALSE, selected = "A"),
                verbatimTextOutput("out"))
server <- function(input, output) {
  poly_family <- reactiveVal()
  react <- reactive(x = function(x) {
    res = switch(x, 
      "A" = "Almond starts with A",
      "B" = "Banana starts with B",
      paste0("another fruit name with", x)
    )
    poly_family(res)
  })
  observe(do.call(react(), list(x = input$foo)))
  output$out <- renderPrint(poly_family())
}
shinyApp(ui = ui, server = server)

But it can be simply done with this

library(shiny)
ui <- fluidPage(selectInput(inputId = "foo", choices = LETTERS, label = "category", multiple = FALSE, selected = "A"),
                verbatimTextOutput("out"))
server <- function(input, output) {
  output$out <- renderPrint(
    switch(input$foo, 
           "A" = "Almond starts with A",
           "B" = "Banana starts with B",
           paste0("another fruit name with ", input$foo)
    )
  )
}

[williaml]

@gitdemont

Maybe more like this

Thanks for the response. I am not sure what is happening here, but I have taken your switch() function in the second part and put it in to a better reprex. The reactive is in the bit where the reactive variable new_poly is created. It is fine for one, but if I have a lot of them it could be an issue. The real data has four or more polygons to choose from and currently three maps, which isn't a huge amount. I was just wondering if there was a better way of doing it.

# libraries ---------------------------------------------------------------

library(shiny)
library(sf)
library(tidyverse)
library(leaflet)
library(spData)

# data --------------------------------------------------------------------

# data from the package
world <- st_read(system.file("shapes/world.gpkg", package="spData"))

continents <- world %>% 
  group_by(continent) %>% 
  summarise() 

countries <- world %>% 
  select(country = name_long)


# modules -----------------------------------------------------------------

map_ui <- function(id) {
  ns <- NS(id)
  tagList(
    leafletOutput(ns("map"))
  )
}

map_server <- function(id, dropdown){
  moduleServer(id, function(input, output, session){
    
    output$map <- renderLeaflet({
      
      # initial map
      leaflet() %>% 
        addProviderTiles("Stamen.TonerHybrid") %>% 
        
        # base layer
        addPolygons(data = countries, 
                    fillOpacity = 0.1,
                    weight = 1,
                    stroke = TRUE,
                    color = "black", 
                    opacity = 1) 
        
      
    })
    
    # new polygon #### this is the bit I am interested in
    # this is fine for one map, but if I have a lot of maps, is there a way to do this?
    new_poly <- reactive({
      
      switch(dropdown(),
             "countries" = countries,
             "continents" = continents)
    })
    
    # update polygon for new map
    observe({

      leafletProxy("map") %>%
        clearShapes() %>%
        # base layer
        addPolygons(data = new_poly(),
                    fillColor =  "grey",
                    fillOpacity = 0.1,
                    weight = 1,
                    stroke = TRUE,
                    color = "black",
                    opacity = 1)
  
    })
    
  })
  
}

# app ---------------------------------------------------------------------

# Define UI for application that draws a histogram
ui <- fluidPage(    
  
  sidebarLayout(      
    sidebarPanel(
      selectInput("type",
                  label = "Geography type",
                  selected = "countries",
                  choices = c("countries", "continents"))
    ),
    
    mainPanel(
      map_ui("map")
    )
  )
)

server <- function(input, output, session) {
  
  # map from server
  map_server("map", dropdown = drop_val)
  
  # reactive values
  drop_val <- reactive(input$type)
  
}

shinyApp(ui, server)

[nirgrahamuk]

I may be assuming too much but it seems like you want a generic way to pass a character string and retrieve a pre-prepared object of the same name. That seems like a use case for get() or mget() base functions to me.

[williaml]

Not necessarily the same name, it is just that way in this example. But I suppose they could be renamed, or I could use something else to be able to use get() or mget().

[gitdemont]

I don't know if this could help or not...

# libraries ---------------------------------------------------------------

library(shiny)
library(sf)
library(tidyverse)
library(leaflet)
library(spData)

# data --------------------------------------------------------------------

# data from the package
world <- st_read(system.file("shapes/world.gpkg", package="spData"))

continents <- world %>% 
  group_by(continent) %>% 
  summarise() 

countries <- world %>% 
  select(country = name_long)


# modules -----------------------------------------------------------------

map_ui <- function(id) {
  ns <- NS(id)
  tagList(
    leafletOutput(ns("map")),
    verbatimTextOutput(ns("click_info"))
  )
}

map_server <- function(id, dropdown){
  moduleServer(id, function(input, output, session){
    output$map <- renderLeaflet({
      # initial map
      world_map <- leaflet() %>% 
        addPolygons(data = continents,
                    group = "base",
                    fillOpacity = 0.1,
                    weight = 1,
                    stroke = TRUE,
                    color = "black", 
                    opacity = 1) %>% 
        addPolygons(data = countries,
                    group = "base",
                    fillOpacity = 0.1,
                    weight = 1,
                    stroke = TRUE,
                    color = "grey", 
                    opacity = 1)
      
      # add clickabe continents
      apply(continents, 1, FUN = function(x) {
        world_map <<- addPolygons(world_map,
                                  group = "continents",
                                  layerId = x[[1]],
                                  data = x[[2]], 
                                  fillOpacity = 0.1,
                                  weight = 1,
                                  stroke = TRUE,
                                  color = "black", 
                                  opacity = 1)
      })
      # add clickabe countries
      apply(countries, 1, FUN = function(x) {
        world_map <<- addPolygons(world_map,
                                  group = "countries",
                                  layerId = x[[1]],
                                  data = x[[2]], 
                                  fillOpacity = 0.1,
                                  weight = 1,
                                  stroke = TRUE,
                                  color = "grey", 
                                  opacity = 1)
      })
      world_map
    })
    
    output$click_info <- renderPrint({
      str(input$map_shape_click)
    })
    
    # update polygon for new map
    observe({
      if(length(input$map_shape_click) == 0) return(NULL)
      d = switch(dropdown(), "continents" = continents, "countries" = countries)
      leafletProxy("map") %>%
        showGroup(dropdown()) %>%
        hideGroup(setdiff(c("continents", "countries"), dropdown())) %>%
        removeShape(layerId = "selection") %>%
        addPolygons(data = d[[2]][d[[1]] == input$map_shape_click$id],
                    layerId = "selection",
                    fillColor =  "darkorange",
                    fillOpacity = 0.5,
                    weight = 1,
                    stroke = TRUE,
                    color = "blue",
                    opacity = 1)
      
    })
  })
  
}

# app ---------------------------------------------------------------------

# Define UI for application that draws a histogram
ui <- fluidPage(    
  
  sidebarLayout(      
    sidebarPanel(
      selectInput("type",
                  label = "Geography type",
                  selected = "countries",
                  choices = c("countries", "continents"))
    ),
    
    mainPanel(
      map_ui("map")
    )
  )
)

server <- function(input, output, session) {
  drop_val <- reactive(input$type)
  # map from server
  map_server("map", dropdown = drop_val)
}

shinyApp(ui, server)

[williaml]

Thanks for your help on this.

That is really useful. Not necessarily for this as I would want to completely swap the polygons, but I am sure that it could be useful for other things.