CODEWITHSUNDEEP
rshinydata.table
stormshadow
stormshadow

Reputation: 15

Using dynamic inputs within function parameters

I'm currently working to generate dynamic data tables based off some raw data. The aim is to provide summary counts and percentages for dynamic subgroups nested within subgroups.

From the raw data, i have been able to do so with a static subgroup column name, but attempts to use reactive values and dynamic inputs have not worked so far.

Some of the things i have tried include: 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"))
  })

These are the parts which i have used "Type1" within the parameters for now, which works but it should be updated to input$typeselected so that when i select different type - e.g. Type2 it update the table accordingly.

  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)

Any suggestions/advice would be greatly appreciated. Thanks!

Upvotes: 1

Views: 56

Answers (1)

Yifu Yan
Yifu Yan

Reputation: 6116

data.table accepts string in the by argument, so you don't need to convert string to expression; for formula, you can use as.formula() to convert string to formula in reshape2::dcast()

By the way, you don't need that many reactive values, since all your output is dependent on input$typeselected, you can simply do an observe or observeEvent. Too many reactive values makes it hard to track dependencies.

I organized your server code in the following snippet, so it doesn't generate reactive values and only has one 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)

If you still prefer your original version, see the snippet below:

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)

Upvotes: 1

Related Questions