首页 > 解决方案 > R:你可以从源文件中包含的函数引用服务器或全局环境中的反应变量而不作为参数传递吗?

问题描述

我正在构建一个闪亮的仪表板,我发现我需要很多不同的函数来创建各种表。我还使用了用于过滤反应数据集的反应变量。

我发现的问题是,当函数直接编码到服务器部分时,它可以引用反应变量而不必将它们作为参数传递,这就是我想要的。但是,当我将它们放在源文件中并通过“源”函数导入函数时,除非您直接将它们作为参数传递,否则它们不能使用反应值。

有没有办法让源文件中的函数能够引用服务器中定义的反应值而不直接将它们作为参数传递?我有很多反应变量,如果可能的话,我不想继续将它们从一个函数传递到另一个函数。

这是我正在尝试做的一个模型示例。下面的代码确实有效,但 max_length 和 min_length 反应值必须作为参数直接传递给函数。

应用程序文件

# Import packages.
library(shiny)
library(shinydashboard)
library(DT)
library(data.table)
library(tidyverse)
library(dtplyr)

# Directory
directory <- ''

# Source function stored in separate file.
#source(paste(directory,"Test Functions.R",sep=""))

# UI
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sidebarMenu(
      id = "tabs",
      menuItem("Sepal Length Filter", icon=icon("flower"),
               startExpanded= TRUE,
               uiOutput("ui_sepalLengthSlider"),
               uiOutput("ui_speciesSelection")
      ),
      menuItem("Iris Data", tabName="tab_data",icon=icon("table"))
    )
  ),
  dashboardBody(
    tabItem("tab_data",
                  fluidPage(
                    fluidRow(column(width=12,
                                    h4('Iris Data - Filtered by Species'),
                                    DTOutput('display_data')
                    )),
                    fluidRow(column(width=12,
                                    h4('Iris Data - Filtered by Species and Sepal Length'),
                                    DTOutput('display_data_sepal_filtered')
                    ))
                  )
            )
    )
)

# Server
server <- function(input, output, session) {
  
  # Reactive values for length and species that will be updated by the filters.
  min_length <- reactiveVal(0)
  max_length <- reactiveVal(8)
  selected_species <- reactiveVal("setosa")
  
  # Species Selection Radio Buttons
  output$ui_speciesSelection <- renderUI({
    radioButtons("input_speciesSelection",
                 label = "Species:",
                 choiceNames = c("setosa","versicolor", "virginica"),
                 choiceValues = c("setosa","versicolor", "virginica"),
                 selected=selected_species())
  })
  
  # Sepal Length Filter Slider.
  output$ui_sepalLengthSlider <- renderUI({
    sliderInput("input_sepalLengthSlider",
                label = "Sepal Length:",
                min = 0,
                max = 8,
                value=c(0,8)
    )
  })
  
  # If Species filter is updated, update the selected species reactive variable.
  observeEvent(input$input_speciesSelection, {
    selected_species(input$input_speciesSelection)
  })
  
  # If Sepal Length filter is updated, update the min/max length reactive variables.
  observeEvent(input$input_sepalLengthSlider, {
    #print(paste("Date Slider: ", start_date, end_date))
    min_length(input$input_sepalLengthSlider[[1]])
    max_length(input$input_sepalLengthSlider[[2]])
  })
  
  
  # Reactive dataset that updates automatically whenever the species selection is changed. 
  filtered_data <- reactive({
    data <- iris %>%
      filter(Species == selected_species())
    data
  })
  
  source(paste(directory,"Test Functions.R",sep=""))
  
  # # Function that filters the given dataset by the selected max and min sepal length.
  # sepalFilterFunction <- function(data){
  #   data <- filter(data,Sepal.Length >= min_length() & Sepal.Length <= max_length())
  #   return(data)
  # }

  # Output the Iris dataset, filtered by species only.
  output$display_data <- DT:: renderDT({
    (datatable(escape=FALSE,
               filtered_data(),
               options= list(
                 scrollX=TRUE
               )
    )
    )
  })
  
  # Output the Iris dataset, filtered by species AND sepal length.
  output$display_data_sepal_filtered <- DT:: renderDT({
    (datatable(escape=FALSE,
               # Start from the reactive dataset which has already been filtered by species.
               sepalFilterFunction(filtered_data(),min_length(),max_length()),
               options= list(
                 scrollX=TRUE
               )
    )
    )
  })
  
  
}

shinyApp(ui, server)

源文件,“测试函数.R”

sepalFilterFunction <- function(data, min_length, max_length){
  data <- filter(data,Sepal.Length >= min_length & Sepal.Length <= max_length)
  return(data)
}

查看上面的函数,当我将它包含在服务器文件中时,我能够排除 min_length 和 max_length 参数,而是使用 min_length() 和 max_length() 在过滤步骤中直接调用反应值。当我在函数文件中执行此操作时,会产生以下错误:

Warning: Error in : Problem with `filter()` input `..1`.
x could not find function "min_length"
Input `..1` is `Sepal.Length >= min_length() & Sepal.Length <= max_length()`.

我想我明白发生了什么 - 它不能引用反应值,除非它作为参数直接传递给它,或者函数是在服务器步骤而不是源文件中定义的。我的问题是,有没有办法在源文件中拥有该函数,但不必将反应值作为参数传递。显然这是一个简单的例子——我的实际项目更复杂,需要模块化并分解成单独的文件,并且有多个反应值,我希望避免通过多个函数作为单独的参数传递。

标签: rfunctionshiny

解决方案


推荐阅读