如何使用反應式物件創建函式？

下面的 MWE 代碼作業正常。它允許用戶單擊一個單選按鈕來選擇聚合資料的方法：在這種情況下，通過周期 1 或周期 2。

在要部署的更大的應用程式中，有許多列要聚合。在這個 MWE 中不僅僅是 2 個。所以我想創建一個服務的目的，一般功能sumColA()和sumColB()顯示如下。在下面注釋掉的代碼中，您可以看到我的嘗試之一。這些行被注釋掉，因為它們不起作用。

如何創建在概念上類似的反應性官能團sumCol()，其中，將與像被呼叫sumCol("ColA")，sumCol("ColB")或類似的東西？在充分應用有太多的列，合計創造的多個版本sumColA()，sumColB()等等。

MWE代碼：

library(shiny)

data <- data.frame(
  Period_1 = c("2020-01", "2020-02", "2020-03", "2020-01", "2020-02", "2020-03"),
  Period_2 = c(1, 2, 3, 3, 1, 2),
  ColA = c(10, 20, 30, 40, 50, 60),
  ColB = c(15, 25, 35, 45, 55, 65)
)

ui <-
  fluidPage(
    h3("Data table:"),
    tableOutput("data"),
    h3("Sum the data table columns:"),
    radioButtons(
      inputId = "dataView",
      label = NULL,
      choiceNames = c("By period 1", "By period 2"),
      choiceValues = c("Period_1", "Period_2"),
      selected = "Period_1",
      inline = TRUE
    ),
    tableOutput("totals")
  )

server <- function(input, output, session) {
  sumColA <- reactive({
    fmlaA <- as.formula(paste("ColA", input$dataView, sep = " ~ "))
    aggregate(fmlaA, data, sum)
  })

  sumColB <- reactive({
    fmlaB <- as.formula(paste("ColB", input$dataView, sep = " ~ "))
    aggregate(fmlaB, data, sum)
  })
  
  ### Create sumCol function ###
  # sumCol <- function (x) 
  #     {reactive({
  #       fmla <- as.formula(paste("x", input$dataView, sep = " ~ "))
  #       aggregate(fmla, data, sum)
  #     })
  # }
  ### End sumCol ###
  
  output$data <- renderTable(data)
  output$totals <- renderTable({
    totals <- as.data.frame(c(sumColA(), sumColB()[2]))
    # totals <- as.data.frame(c(sumCol(ColA), sumCol(ColB)[2]))
    
    colnames(totals) <- c(input$dataView, "Sum Col A", "Sum Col B")
    
    totals
  })
}

shinyApp(ui, server)

uj5u.com熱心網友回復：

只需創建一個反應物件data和另一個summed_data包含所有列總和的反應表：

library(shiny)
library(tidyverse)

ui <-
  fluidPage(
    h3("Data table:"),
    tableOutput("data"),
    h3("Sum the data table columns:"),
    radioButtons(
      inputId = "grouping",
      label = NULL,
      choiceNames = c("By period 1", "By period 2"),
      choiceValues = c("Period_1", "Period_2"),
      selected = "Period_1",
      inline = TRUE
    ),
    tableOutput("sums")
  )

server <- function(input, output, session) {
  data <- reactive({
    # example data. Might change dynamically
    data.frame(
      Period_1 = c("2020-01", "2020-02", "2020-03", "2020-01", "2020-02", "2020-03"),
      Period_2 = c(1, 2, 3, 3, 1, 2),
      ColA = c(10, 20, 30, 40, 50, 60),
      ColB = c(15, 25, 35, 45, 55, 65)
    )
  })

  summed_data <- reactive({
    data() %>%
      group_by(!!sym(input$grouping)) %>%
      select(matches("^Col")) %>%
      summarise(across(everything(), sum))
  })

  output$data <- renderTable(data())
  output$sums <- renderTable(summed_data())
}

shinyApp(ui, server)

uj5u.com熱心網友回復：

這是一個帶有dplyr和magrittr包的解決方案。

更改的詳細資訊在代碼注釋中。

library(shiny)
library(dplyr) # for data manipulation
library(magrittr) # for pipe operator

data <- data.frame(
  Period_1 = c("2020-01", "2020-02", "2020-03", "2020-01", "2020-02", "2020-03"),
  Period_2 = c(1, 2, 3, 3, 1, 2),
  ColA = c(10, 20, 30, 40, 50, 60),
  ColB = c(15, 25, 35, 45, 55, 65)
)

dataView_choices <- c("Period_1", "Period_2") # define choices for select input

ui <-
  fluidPage(
    h3("Data table:"),
    tableOutput("data"),
    h3("Sum the data table columns:"),
    radioButtons(
      inputId = "dataView",
      label = NULL,
      choiceNames = c("By period 1", "By period 2"),
      choiceValues = dataView_choices, # choices for select input
      selected = "Period_1",
      inline = TRUE
    ),
    tableOutput("totals")
  )

server <- function(input, output, session) {

  output$data <- renderTable(data)
  output$totals <- renderTable({
    totals <- data %>% 
      select(-setdiff(dataView_choices, input$dataView)) %>% # remove other periods in the select input
      group_by_(input$dataView) %>% # group by the selected period
      summarise(across(everything(), sum, .names = "Sum_{.col}")) # sum of all columns with a "Sum_" prefix
    
    totals
  })
}

shinyApp(ui, server)

標籤：r 功能 闪亮的 反应性

上一篇：JS重定向功能

下一篇：constint&是否傳遞了參考或副本