CODEWITHSUNDEEP
rshinywidget
Isaac
Isaac

Reputation: 215

R Shiny nested input functions using different dataframes

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 (i.e. "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 (i.e. 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 (i.e. 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)

Upvotes: 0

Views: 291

Answers (1)

demarsylvain
demarsylvain

Reputation: 2185

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.

Upvotes: 1

Related Questions