【问题标题】:R Shiny - Is it possible to nest reactive functions?R Shiny - 是否可以嵌套反应函数?
【发布时间】:2020-11-30 17:15:53
【问题描述】:

在 R-Shiny 中。试图分解一个非常长的反应函数(数千行!)。 假设,是否可以嵌套条件反应函数,类似于:

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")
  }
})

编辑

非假设性地,我正在尝试根据美国县的用户选择输入创建一个嵌套的反应式过滤函数。在他们选择县后,一个 circlepackeR 图应该在模态对话框中弹出。这是我正在使用的数据:

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")

这是我在下面使用的反应函数的示例。它是 10,000 多行的一小部分,我想先按州(阿拉巴马州的 AL,阿肯色州的 AR)拆分行来“嵌套”它,所以它是一段更简洁的代码。

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!")
  }
})

最后,这是我的服务器中使用此功能的图表:

     output$circle_graph_of_demographics <- renderCirclepackeR({
      circlepackeR(demographics_filter(), size = "r_count"
    })  

【问题讨论】:

  • 我不认为嵌套反应是可行的。您可以编写“常规函数”(接受“常规对象”)并将您需要的内容传递给它们。
  • 反应式值可以返回反应式值。这不是问题。不过,没有 run 声明之类的东西,只有 return() 反应值。所以return(AL_filter())。回答一个不太假设的问题会更容易,所以最好提供一个最小的reproducible example,我们可以用它来测试它是否有效。一般建议是将尽可能多的代码移到服务器函数之外,因此创建辅助函数是个好主意。
  • 谢谢,我编辑了我的问题,所以它(希望)可以重现。

标签: r if-statement filter shiny reactive


【解决方案1】:

就个人而言,如果单个函数/响应式是 1000 行长,那么通过重构肯定有改进的空间!

我对您给我们的 demographics_filter 反应式感到奇怪的一点是,它在有效数据的情况下返回 NULL,在无效数据的情况下返回 "ERROR!",所以我不确定如何您可以在output$circle_graph_of_demographics 中成功使用它。如果您不需要它来返回任何内容,那么eventReactive(input$selectcounty, {...}) 可能更合适?

您似乎需要根据input$selectcounty 值的更改创建一个(组)节点和一个(组)过滤数据帧。目前尚不清楚为什么当input$selectcountyBaldwin-AR 时,你需要一个节点和子集,比如Autauga-Al,这就是我将“set of”放在括号中的原因。

根据您告诉我们的内容(如果没有 MWE,无法确定到底什么适合您的需求),我会这样做:

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

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

它应该提供一个紧凑的解决方案,该解决方案对于县和州名称的变化是稳健的。如果我理解正确的话,这会用七行替换你的数千行。显然,您可能需要重构其余代码以考虑您的更改。

如果您确实需要过滤数据框和节点集,那么我会这样做:

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]])
})

同样,它是一个紧凑、强大的解决方案,您可能需要在其他地方重构代码以考虑更改。

我的所有代码都未经测试,因为我没有 MWE 可以使用。

【讨论】:

  • Limey,谢谢!我之前尝试过类似的方法,但无法完全让我的反应县过滤器功能适用于反应节点过滤器。我认为这是不可能的,并在过去的 2 周中创建了 10,000 多行将每个美国县输入到长条件语句中的行。你的方法奏效了。再次感谢。
【解决方案2】:

知道了!

是的,你(我)可以嵌套反应函数。

### 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")
  }
})

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 2017-04-05
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2018-09-15
    • 1970-01-01
    • 2012-08-15
    相关资源
    最近更新 更多