Question

我目前正在根据一些原始数据生成动态数据表。目的是为嵌套在子组中的动态子组提供汇总计数和百分比。

从原始数据来看，我已经能够使用静态子组列名称来执行此操作，但是到目前为止，尝试使用无功值和动态输入的尝试均无效。

我尝试过的一些事情包括：input $ typeselected，eval（input $ typeselected），get（input $ typeselected），eval（parse（text = input $ typeselected）。

library(shiny)
library(shinydashboard)
library(DT)
library(data.table)

# Define UI for dashboard
ui <- shinyUI(dashboardPage(
  dashboardHeader(title = "Shiny Dashboard"),
  # Dashboard Sidebar
  dashboardSidebar(# Sidebar Menu
    sidebarMenu(
      id = "tabs",
      # Menu for Summary
      menuItem("Summary", tabName = "Summary", icon = NULL)
    )),

  dashboardBody(tabItems(
    # Content for Summary
    tabItem(
      tabName = "Summary",
      fluidRow(column(
        6,
        selectInput(
          "typeselected",
          h4("Type"),
          choices = c("Type1", "Type2", "Type3"),
          selected = NULL,
          multiple = FALSE,
          width = "100%"
        )
      )),
      fluidRow(column(6, DT::dataTableOutput("table1"))),
      fluidRow(column(6, DT::dataTableOutput("table2")))
    )
  ))
))



# Define server logic
ShinyServer <- function(input, output, session) {

  # Dummy data
  table1 <- reactive({
    table1 <- data.table(
      c(1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3),
      c(1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 2, 2, 2, 3, 4, 2, 3, 4, 2, 3, 4, 3, 4),
      c(1, 2, 3, 1, 2, 3, 1, 2, 3, 3, 3, 2, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2),
      c(1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 2, 1, 1, 2, 2, 1, 2, 2, 1, 2, 2, 1, 2),
      c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
    )
    setnames(table1, c("Brand", "Type1", "Type2", "Type3", "Count"))
  })

这些是我现在在参数中使用“ Type1”的部分，虽然可以正常工作，但应将其更新为input $ typeselected，以便在我选择其他类型时-例如Type2会相应地更新表。

  counts <- reactive({
    initialcounts <-
      table1()[, lapply(.SD, sum), by = list(Brand, Type1)]
    counts <-
      dcast(initialcounts, Brand ~ Type1, value.var = "Count")
  })

  percentage <- reactive({
    initialpercentage <- table1()[, {
      total = .N
      .SD[, .(frac = .N / total), by = Type1]
    }, by = Brand]
    percentage <-
      dcast(initialpercentage, Brand ~ Type1, value.var = "frac")
  })

  # Output table
  output$table1 <- DT::renderDataTable(datatable(counts()))
  output$table2 <- DT::renderDataTable(datatable(percentage()))
}

shinyApp(ui, ShinyServer)

任何建议都将不胜感激。谢谢！

Answer 1

data.table在by参数中接受字符串，因此您无需将字符串转换为表达式；对于公式，您可以使用as.formula()将字符串转换为reshape2::dcast()中的公式

顺便说一句，由于您的所有输出都依赖于input$typeselected，因此您不需要那么多的反应性值，您只需执行observe或observeEvent。反应性值太多，很难跟踪依赖关系。

我在以下代码段中整理了您的服务器代码，因此它不会生成响应值，并且只有一个observeEvent()。

library(shiny)
library(shinydashboard)
library(DT)
library(data.table)


table1 <- data.table(
  c(1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3),
  c(1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 2, 2, 2, 3, 4, 2, 3, 4, 2, 3, 4, 3, 4),
  c(1, 2, 3, 1, 2, 3, 1, 2, 3, 3, 3, 2, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2),
  c(1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 2, 1, 1, 2, 2, 1, 2, 2, 1, 2, 2, 1, 2),
  c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
)
setnames(table1, c("Brand", "Type1", "Type2", "Type3", "Count"))

# Define UI for dashboard
ui <- shinyUI(dashboardPage(
  dashboardHeader(title = "Shiny Dashboard"),
  # Dashboard Sidebar
  dashboardSidebar(# Sidebar Menu
    sidebarMenu(
      id = "tabs",
      # Menu for Summary
      menuItem("Summary", tabName = "Summary", icon = NULL)
    )),

  dashboardBody(tabItems(
    # Content for Summary
    tabItem(
      tabName = "Summary",
      fluidRow(column(
        6,
        selectInput(
          "typeselected",
          h4("Type"),
          choices = c("Type1", "Type2", "Type3"),
          selected = NULL,
          multiple = FALSE,
          width = "100%"
        )
      )),
      fluidRow(column(6, DT::dataTableOutput("table1"))),
      fluidRow(column(6, DT::dataTableOutput("table2")))
    )
  ))
))



# Define server logic
ShinyServer <- function(input, output, session) {
  observeEvent(input$typeselected,{
    formula <- as.formula(paste0("Brand ~",input$typeselected))
    #table 1
    initialcounts <-
      table1[, lapply(.SD, sum), by = c('Brand', input$typeselected)]
    counts <- dcast(initialcounts, formula, value.var = "Count")
    output$table1 <- DT::renderDataTable(datatable(counts))
    #table 2
    initialpercentage <- table1[, {
      total = .N
      .SD[, .(frac = .N / total), by = c(input$typeselected)]
    }, by = Brand]
    percentage <- dcast(initialpercentage, formula, value.var = "frac")
    output$table2 <- DT::renderDataTable(datatable(percentage))

  })

}

shinyApp(ui, ShinyServer)

如果您仍然喜欢原始版本，请参见以下代码段：

library(shiny)
library(shinydashboard)
library(DT)
library(data.table)

# Define UI for dashboard
ui <- shinyUI(dashboardPage(
  dashboardHeader(title = "Shiny Dashboard"),
  # Dashboard Sidebar
  dashboardSidebar(# Sidebar Menu
    sidebarMenu(
      id = "tabs",
      # Menu for Summary
      menuItem("Summary", tabName = "Summary", icon = NULL)
    )),

  dashboardBody(tabItems(
    # Content for Summary
    tabItem(
      tabName = "Summary",
      fluidRow(column(
        6,
        selectInput(
          "typeselected",
          h4("Type"),
          choices = c("Type1", "Type2", "Type3"),
          selected = NULL,
          multiple = FALSE,
          width = "100%"
        )
      )),
      fluidRow(column(6, DT::dataTableOutput("table1"))),
      fluidRow(column(6, DT::dataTableOutput("table2")))
    )
  ))
))

# Define server logic
ShinyServer <- function(input, output, session) {

  # Dummy data
  table1 <- reactive({
    table1 <- data.table(
      c(1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3),
      c(1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 2, 2, 2, 3, 4, 2, 3, 4, 2, 3, 4, 3, 4),
      c(1, 2, 3, 1, 2, 3, 1, 2, 3, 3, 3, 2, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2),
      c(1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 2, 1, 1, 2, 2, 1, 2, 2, 1, 2, 2, 1, 2),
      c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
    )
    setnames(table1, c("Brand", "Type1", "Type2", "Type3", "Count"))
  })

  formula <- reactive(as.formula(paste0("Brand ~",input$typeselected)))
  Type = reactive(input$typeselected)


  counts <- reactive({
    initialcounts <-
      table1()[, lapply(.SD, sum), by = c("Brand", Type())]
    counts <-
      dcast(initialcounts, formula(), value.var = "Count")
  })

  percentage <- reactive({
    initialpercentage <- table1()[, {
      total = .N
      .SD[, .(frac = .N / total), by = c(Type())]
    }, by = Brand]
    percentage <-
      dcast(initialpercentage, formula(), value.var = "frac")
  })

  # Output table
  output$table1 <- DT::renderDataTable(datatable(counts()))
  output$table2 <- DT::renderDataTable(datatable(percentage()))
}

shinyApp(ui, ShinyServer)

在功能参数内使用动态输入

1 个答案: