根据 Shiny 中的功能参数动态更改小部件/页面

Question

我正在尝试生成一个闪亮的应用程序，它依赖于函数的某些参数。如果我使用quantmod 包下载数据，然后使用TTR 包进行一些数据修改，我想根据选择的下拉值更改numericInput()（添加/删除输入）。

我想复制类似于以下内容的内容。

library(quantmod)
library(TTR)

sym <- "GOOG"

data <- getSymbols(Symbols = sym, src = "yahoo", index.class = "POSIXct", from = "2018-01-01", to = "2019-01-01", auto.assign = FALSE)

SMA(Cl(data), n = 5)
EMA(Cl(data), n = 5)
WMA(Cl(data), n = 5, wts = 1:5)

我有一些数据，我将 3 个函数应用于数据 SMA、EMA 和 WMA。 SMA 和 EMA 很简单，因为它只需要一个参数 n，但是 WMA 需要 n 和一个附加参数 wts。

我创建了一个基本的 Shiny 应用程序，我正在修改 Widgets 选项卡。我创建了 4 个字段。一个简单的文本字段、一个下拉菜单、一个指定 n 的参数和一个权重字段。

我想根据下拉菜单中的选择显示“正确”的指定输入字段。也就是说，为所有选项显示selectedN，因为函数SMA、EMA 和WMA 都依赖于它，但是一旦选择了WMA，我希望用户能够输入一些权重/值。

我在这里遇到了困难。

1. 在代码的reactive({}) 部分添加多个权重/数值并将其传递给wts 值。
2. 找到将此动态输入应用到server 中的数据的最合适方法。我在想的是根据函数名称应用if 语句，但我想我已经在一些闪亮的教程中看到了更简单的方法。 - 因此，根据指定的下拉菜单中的函数，我想向用户展示所选函数的参数。

任何朝着正确方向的推动都会很棒。

闪亮代码：

## app.R ##
library(shiny)
library(shinydashboard)
library(quantmod)
library(TTR)

ui <- dashboardPage(
    dashboardHeader(title = "Basic dashboard"),
    dashboardSidebar(
        sidebarMenu(
            menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
            menuItem("Widgets", tabName = "widgets", icon = icon("th"))
        )
    ),
    dashboardBody(
        tabItems(
            # First tab content
            tabItem(tabName = "dashboard",
                    fluidRow(
                        box(plotOutput("plot1", height = 250)),
                        
                        box(
                            title = "Controls",
                            sliderInput("slider", "Number of observations:", 1, 100, 50)
                        )
                    )
            ),
            
            # Second tab content
            tabItem(tabName = "widgets",
                    fluidPage(
                        titlePanel(title = h2("Algo Backtester", align = "center")),
                        sidebarPanel(
                            textInput("sym", "Symbol", "MSFT"),
                            selectInput(inputId = "selectDropdown", label = "dropdownChoice", choices = c("SMA", "EMA", "WMA")),
                            numericInput(inputId = "selectN", label = "selectedN", value = 3),
                            numericInput(inputId = "weights", label = "Weights", value = 1)              # stuck here with adding multiple weights
                        ),
                        mainPanel(
                            tableOutput("modData"),
                            
                        )
                    )
            )
            )
        )
    )

server <- function(input, output) {
    set.seed(122)
    histdata <- rnorm(500)
    
    output$plot1 <- renderPlot({
        data <- histdata[seq_len(input$slider)]
        hist(data)
    })
    
    output$out <- reactive({
        selectedDropdown <- input$selectDropdown
        data <- getSymbols(Symbols = input$sym, src = "yahoo", index.class = "POSIXct", from = "2018-01-01", to = "2019-01-01", auto.assign = FALSE)
        n = input$selectN
        wts = 1:5                                   # would like to modify here                             
        # Apply selection to "data"
        if(selectDropdown == "SMA"){
            SMA(Cl(data), n = n)
        } 
        if(selectDropdown == "EMA"){
            EMA(Cl(data), n = n)
        }
        if(selectDropdown == "WMA"){
            WMA(Cl(data), n = n, wts = wts)
        }
        
        
    })
    
    output$modData <- renderTable({
        head(output$out())
    })
    
    
}

shinyApp(ui, server)

Answer 1

要动态生成 UI 元素，需要在服务器中使用 renderUI，并在 UI 函数中将其分配给 uiOutput。由于您只想在选择 WMA 函数时渲染元素，因此您可以在 renderUI 调用中使用 req(input$selectDropdown == "WMA")。 req 评估表达式是否“真实”，并且仅在满足条件时执行以下代码。

由于您只有 3 种不同的函数选择，我认为您在这里使用 if 子句非常好。

您的代码还有其他一些问题：

• 如果生成reactive 函数，只需将其分配给函数名称，而不是output$functionname
• 错字用selectDropdown 而不是selectedDropdown
• 我不知道wtsargument 的合理输入是什么。 numericInput 只返回一个值，但你需要一个长度为x 的向量。我刚刚使用rep(input$weights, times = nrow(data)) 让它工作

library(shiny)
library(shinydashboard)
library(quantmod)
library(TTR)

ui <- dashboardPage(
  dashboardHeader(title = "Basic dashboard"),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
      menuItem("Widgets", tabName = "widgets", icon = icon("th"))
    )
  ),
  dashboardBody(
    tabItems(
      # First tab content
      tabItem(tabName = "dashboard",
              fluidRow(
                box(plotOutput("plot1", height = 250)),
                
                box(
                  title = "Controls",
                  sliderInput("slider", "Number of observations:", 1, 100, 50)
                )
              )
      ),
      
      # Second tab content
      tabItem(tabName = "widgets",
              fluidPage(
                titlePanel(title = h2("Algo Backtester", align = "center")),
                sidebarPanel(
                  textInput("sym", "Symbol", "MSFT"),
                  selectInput(inputId = "selectDropdown", label = "dropdownChoice", choices = c("SMA", "EMA", "WMA")),
                  numericInput(inputId = "selectN", label = "selectedN", value = 3),
                  uiOutput(outputId = "weights_UI")
                ),
                mainPanel(
                  tableOutput("modData"),
                  
                )
              )
      )
    )
  )
)

server <- function(input, output) {
  set.seed(122)
  histdata <- rnorm(500)
  
  output$plot1 <- renderPlot({
    data <- histdata[seq_len(input$slider)]
    hist(data)
  })
  
  output$weights_UI <- renderUI({
    req(input$selectDropdown == "WMA")
    
    numericInput(inputId = "weights", label = "Weights", value = 1)
  })
  
  out <- reactive({
    selectedDropdown <- input$selectDropdown
    data <- getSymbols(Symbols = input$sym, src = "yahoo", index.class = "POSIXct", from = "2018-01-01", to = "2019-01-01", auto.assign = FALSE)
    
    n = input$selectN
    # wts = 1:5                                   # would like to modify here                             
    # Apply selection to "data"
    if(selectedDropdown == "SMA"){
      SMA(Cl(data), n = n)
    } 
    if(selectedDropdown == "EMA"){
      EMA(Cl(data), n = n)
    }
    if(selectedDropdown == "WMA"){
      WMA(Cl(data), n = n, wts = rep(input$weights, times = nrow(data)))
    }
    
    
  })
  
  output$modData <- renderTable({
    head(out())
  })
  
  
}

shinyApp(ui, server)