0

In R-Shiny. Trying to break up a really long reactive function (thousands of lines!). Hypothetically, is it possible to nest conditional reactive functions, something similar to:

STATE_filter <- reactive({
 
   if(input$selectcounty ends with "-AL") {
    run AL_filter()
  }
  else if (input$selectstate ends with "-AR"){
    run AR_filter()
  }
  else {
    return("ERROR")
  }
})

EDIT

Non-hypothetically, I'm trying to create a nested reactive filtering function based on user select inputs of U.S. counties. Upon their selection of county, a circlepackeR graph should pop up in a modal dialog box. This is the data I am using:

dput(head(demographics))
structure(list(NAME = c("Autauga-AL", "Baldwin-AL", "Barbour-AL", 
"Bibb-AL", "Blount-AL", "Bullock-AL"), STATE_NAME = c("AL", "AL", 
"AL", "AL", "AL", "AL"), gender = structure(c(2L, 2L, 2L, 2L, 
2L, 2L), .Label = c("female", "male"), class = "factor"), hispanic = structure(c(2L, 
2L, 2L, 2L, 2L, 2L), .Label = c("hispanic", "nonhispanic"), class = "factor"), 
    race = structure(c(6L, 6L, 6L, 6L, 6L, 6L), .Label = c("asian", 
    "black", "islander", "native", "two or more", "white"), class = "factor"), 
    makeup = structure(c(2L, 2L, 2L, 2L, 2L, 2L), .Label = c("in combination", 
    "one race", "two or more"), class = "factor"), r_count = c(456L, 
    1741L, 114L, 96L, 320L, 44L), pathString = c("world/male/nonhispanic/white/one race", 
    "world/male/nonhispanic/white/one race", "world/male/nonhispanic/white/one race", 
    "world/male/nonhispanic/white/one race", "world/male/nonhispanic/white/one race", 
    "world/male/nonhispanic/white/one race")), row.names = c(NA, 
6L), class = "data.frame")

Here's an example of the reactive function I'm using below. It's a small subset of 10,000 + lines, and I want to "nest" it by splitting the lines by state (AL for Alabama, AR for Arkansas) first so it's a cleaner piece of code.

demographics_filter <- reactive({
   if(input$selectcounty == "Autauga-AL") {
    race_autauga <- subset.data.frame(demographics, NAME=="Autauga-AL")
    nodes_autauga <- as.Node(race_autauga)
  } 
  else if(input$selectcounty== "Baldwin-AL") {
    race_baldwinAL <-subset.data.frame(demographics, NAME=="Baldwin-AL")
    nodes_baldwinAL<- as.Node(race_baldwinAL)
  } 
 else if(input$selectcounty== "Ashley-AR") {
    race_AshleyAR <-subset.data.frame(race, NAME=="Ashley-AR")
    nodes_AshleyAR<- as.Node(race_AshleyAR)
  }
  else {
    return("ERROR!")
  }
})

And finally, here's the graph in my server that's utilizing this function:

     output$circle_graph_of_demographics <- renderCirclepackeR({
      circlepackeR(demographics_filter(), size = "r_count"
    })  
  • I don't think nesting reactives is something that'll work. You can write "regular functions" (that accept "regular objects") and pass what you need to them. – r2evans Aug 11 '20 at 04:29
  • A reactive value can return a reactive value. That's not a problem. There's no such thing as a `run` statement though, just `return()` the reactive value. So `return(AL_filter())`. It would be easier to answer a less hypothetical question so it would be better to provide a minimal [reproducible example](https://stackoverflow.com/questions/5963269/how-to-make-a-great-r-reproducible-example) that we could use to test that this works. The general advice is to move as much code as you can outside of the server function so creating helper functions is a good idea. – MrFlick Aug 11 '20 at 04:36
  • Thank you, I edited my question so it's (hopefully) reproducible. – Melissa Allen Aug 11 '20 at 05:13

2 Answers2

3

Speaking personally, if a single function/reactive is 1000s of lines long, there's definitely room for improvement through refactorisation!

One thing I find strange about the demographics_filter reactive you've given us is that it returns NULL in the case of valid data and "ERROR!" in the case of invalid data, so I'm not sure how you can use it successfully in output$circle_graph_of_demographics. If you don't need it to return anything, then perhaps an eventReactive(input$selectcounty, {...}) would be more appropriate?

It looks as if you need to create both a (set of) nodes and a (set of) filtered data frames based on changes to the value of input$selectcounty. It's not clear why you need a node and subset for, say, Autauga-Al when input$selectcounty is, say, Baldwin-AR, which is why I've put "set of" in brackets.

Based on what you've told us (without a MWE, it's impossible to be sure exactly what will suit your needs), I would do something like:

demographics_filter <- reactive({
  req(input$selectcounty)
  subset.data.frame(demographics, NAME==input$selectcounty)
})

demographics_node <- reactive({
  as.Node(demographics_filter())
})

which should provide a compact solution that is robust with respect to changes in county and state names. If I understand you correctly, this replaces your many-thousands-of-lines with just seven. Obviously, you may need to refactor the rest of your code to take account of your changes.

If you do need sets of filtered data frames and nodes, then I'd do something like this:

v <- reactiveValues(
       demographics_filter=list(),
       demographics_nodes=list()
     )

eventReactive(input$selectcounty, {
  req(input$selectcounty)
  v$demographics_filter[[input$selectcounty]] <- subset.data.frame(demographics, NAME==input$selectcounty)
  v$demographics_node[[input$selectcounty]] <- as.Node(v$demographics_filter[[input$selectcounty]])
})

Again, it's a compact, robust solution, and you may need to refactor your code elsewhere to take account of the changes.

All my code is untested because I don't have a MWE to work with.

Limey
  • 10,234
  • 2
  • 12
  • 32
  • Limey, Thank you! I tried a similar approach earlier on and couldn't quite get my reactive county filter function to work for the reactive nodes filter. I assumed it just wasn't possible, and spent the past 2 weeks creating 10,000+ lines of inputting every US county into long conditional statements. Your approach worked. Thanks again. – Melissa Allen Aug 11 '20 at 07:03
1

Got it!

yes, you (I) can nest reactive functions.

### ALABAMA FILTER
al_filter <- reactive({
  if(input$selectcounty == "Autauga-AL") {
    demographics_autauga <- subset.data.frame(demographics, NAME=="Autauga-AL")
    nodes_autauga <- as.Node(demographics_autauga)
  } 
  else {
    return("ERROR2")
  }
})

##### ARKANSAS FILTER
ar_filter <- reactive ({
  if(input$selectcounty== "Arkansas-AR") {
    demographics_ArkansasAR <-subset.data.frame(demographics, NAME=="Arkansas-AR")
    nodes_ArkansasAR<- as.Node(demographics_ArkansasAR)
  }   
  else {
    return("ERROR2")
  }
})

##### STATES FILTER
demographics_filter <- reactive({
   if(grepl("-AL", input$selectcounty)){
    return(al_filter())
  }
  else if (grepl("-AR", input$selectcounty)){
    return (ar_filter())
  }
  else {
    return(" ERROR")
  }
})