R使用不同数据框的闪亮嵌套输入函数

Question

I have 3 measures in an nXm matrix representing n=500 and m=31(representing the same measure over 1 month including: ("Executive functioning", "working memory", "depression") for three different "trials"("Trial1", "Trial2", "Trial3"). I have 6 different matrices representing the combinations of these datasources (ie "Trial1_WM"). I also have a corresponding variable with the corresponding dates.

I am attempting to build an R Shiny app where I can select subsets of these datasets to graph them in a histogram (ie WM across all trials and across a date range, WM for Trial 1, etc.). I have built the widgets and have built the app to graph all the data. But I can't figure out how to use multiple widgets to segement the data as I want. Here is some working code with all the widgets I want to build that currently only works for agregrate data (ie all WM) with a slider to bin data:

library(shiny)

read in data

Date <- seq(as.Date("2018-01-01"), as.Date("2018-01-31"), by="days")
Date <- as.matrix(t(Date))

N<- 500
M<-31


T1_EF <- matrix( rnorm(N*M,mean=23,sd=3), N, M)
T1_WM <- matrix( rnorm(N*M,mean=30,sd=4), N, M) 
T1_DP <- matrix( rnorm(N*M,mean=30,sd=3.5), N, M)

T2_EF <- matrix( rnorm(N*M,mean=30,sd=3.5), N, M)
T2_WM <- matrix( rnorm(N*M,mean=40,sd=4), N, M) 
T2_DP <- matrix( rnorm(N*M,mean=34,sd=4), N, M)

T3_EF <- matrix( rnorm(N*M,mean=35,sd=3), N, M)
T3_WM <- matrix( rnorm(N*M,mean=35,sd=3), N, M) 
T3_DP <- matrix( rnorm(N*M,mean=40,sd=3), N, M)


Trial1_EF<- as.matrix(round(T1_EF, digits = 6))
Trial2_EF<- as.matrix(round(T2_EF, digits = 6))
Trial3_EF<- as.matrix(round(T3_EF, digits = 6))

Trial1_WM <-as.matrix(round(T1_WM,digits = 6))
Trial2_WM <-as.matrix(round(T2_WM,digits = 6))
Trial3_WM <-as.matrix(round(T3_WM, digits = 6))

Trial1_DP <-as.matrix(round(T1_DP, digits = 6))
Trial2_DP <-as.matrix(round(T2_DP, digits = 6))
Trial3_DP <-as.matrix(round(T3_DP = 6))


# Define UI  ----
ui <- fluidPage(
  titlePanel(code(strong("Tools"), style = "color:black")),
  sidebarLayout(
    sidebarPanel(
      strong("Tools:"),
      selectInput("Test", 
                  label = "Choose a measure to display",
                  choices = c("Executive Functioning", 
                              "Working Memory",
                              "Depression"
                  ),
                  selected = "Executive Functioning"),

      selectInput("Study", 
                  label = "Choose a Study to display",
                  choices = c("Trial1", 
                              "Trial2",
                              "Trial3",
                              "All"
                  ),
                  selected = "All"),
      selectInput("Uptake", 
                  label = "Uptake",
                  choices = c("Prior Week", 
                              "Prior Month",
                              "Study to Date"),
                  selected = "Study to Date"),

      dateRangeInput("dates", label= "Date range"),
      sliderInput(inputId="slider1", label = "Bins",
                  min = 1, max = 300, value = 200),
      downloadButton("downloadData", "Download")),
    mainPanel(
      code(strong("Study Readout")),
      plotOutput("distPlot")
    ))
)

# Define server logic ----
server <- function(input, output) {
  output$distPlot <- renderPlot({
    slider1 <- seq(floor(min(x)), ceiling(max(x)), length.out = input$slider1 + 1)
    x    <- switch(input$Test, 
                   "Executive Functioning" = cbind(Trial1_EF,Trial2_EF,Trial3_EF),
                   "Working Memory" = cbind(Trial1_WM,Trial2_EF,Trial3_WM), 
                   "Depression" = cbind(Trial1_DP,Trial2_EF,Trial3_DP)
    color <- switch(input$Test, 
                    "Executive Functioning" = "darkgreen",
                    "Working Memory" = "darkorange",
                    "Depression" = "darkviolet")

    legend <- switch(input$Test, 
                     "Executive Functioning" = "Executive Functioning",
                     "Working Memory" = "Working Memory",
                     "Depression" = "Depression")

    hist(x, breaks = slider1, col=color, main=legend)

  })
}


# Run ----
shinyApp(ui = ui, server = server)

Answer 1

One option is to use reactive() function inside your server. It enables you to make some manipulation on the matrix x , which will be the matrix used in the renderPlot() . For instance, a simple if statement will create a different matrix if Study = 'All' or if Study = 'Trial1'.

server <- function(input, output) {    

  filterData <- reactive({    
     if(input$Study == 'All')
        x <- switch(input$Test, 
               "Executive Functioning" = cbind(Trial1_EF, Trial2_EF, Trial3_EF),
               "Working Memory"        = cbind(Trial1_WM, Trial2_EF, Trial3_WM), 
               "Depression"            = cbind(Trial1_DP, Trial2_EF, Trial3_DP))

    if(input$Study == 'Trial1')
        x <- switch(input$Test, 
               "Executive Functioning" = cbind(Trial1_EF),
               "Working Memory"        = cbind(Trial1_WM), 
               "Depression"            = cbind(Trial1_DP))

    return(x)
  })    

  output$distPlot <- renderPlot({     

    x <- filterData()        
    slider1 <- seq(floor(min(x)), ceiling(max(x)), length.out = input$slider1 + 1)

    [...]

    hist(x, breaks = slider1, col = color, main = legend)
  })
}

You can create as many reactive() as you want.