Conditional Output Shiny UI

Question

I have survey data. I want to use Shiny to share results of my univariate and bivariate analyses with collaborators. In the survey there are numeric and factor variables. Depending on whether the person viewing the Shiny applications is interested in univariate/bivariate summaries, and depending on the variable type(s) they want to summarize I want different output to appear.

Specifically,

i) If univariate and numeric then display:

• Item response rate: length() - sum(is.na())
• hist()
• summary()

ii) If univariate and factor then display:

• Item response rate
• barplot()
• table()
• prop.table()

iii) If bivariate and numeric*numeric then display:

• Item response rate
• Scatter graph: plot(x,y)
• summary(x)
• summary(y)
• cor(x,y,method="spearman")

iv) If bivariate and factor*factor then display:

• Item response rate
• Bar Chart...something like "rCharts nvd3 multiBarChart"
• table(x,y)
• prop.table(x,y)
• chisq.test(x,y)

v) If bivariate and (factor*numeric OR numeric*factor ) then display:

• Item response rate
• boxplot
• summary of numeric variable by factor variable: by(numeric, factor, summary)
• Kruskal Wallis Test kruskal.test(numeric ~ factor)

Currently, I have code to generate the desired output for all 5 steps as separate applications. I want to bring them together into 1 Shiny app. I am struggling conceptually with how to set up the mainPanel() display to be reactive to the different output that it will receive as a function of the choices the user is making on the sidebarPanel() UI.

Specifically,

• How to change mainPanel() UI headers to reflect different outputs
• How to conceptually expand my code below to include multiple pieces of output (i.e. Below code works for a single piece verbatimTextOutput() but I don't know how to proceed for the multiple pieces/types of output I want to display as discussed in (i-iv) above. e.g. Text, tables, plots.

Below is my code for the ui.R file:

library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Shiny Example"),
sidebarPanel(
wellPanel(
selectInput(inputId = "variable1",label = "Select First Variable:", 
choices = c("Binary Variable 1" = "binary1",
"Binary Variable 2" = "binary2", 
"Continuous Variable 1" = "cont1",
"Continuous Variable 2" = "cont2"),
selected = "Binary Variable 1"
)
),

wellPanel(
checkboxInput("bivariate", "Proceed to Bivariate Analysis", FALSE),
conditionalPanel(
condition="input.bivariate==true",
selectInput(inputId = "variable2", 
label = "Select Second Variable:",
choices = c("Binary Variable 1" = "binary1",
"Binary Variable 2" = "binary2", 
"Continuous Variable 1" = "cont1",
"Continuous Variable 2" = "cont2"),
selected = "Binary Variable 2"
)
)
)
),

mainPanel(
h5("Output"),
verbatimTextOutput("out")
)
))

Below is my simulated data and my server.R file:

binary1 <- rbinom(100,1,0.5)
binary2 <- rbinom(100,1,0.5)
cont1   <- rnorm(100)
cont2   <- rnorm(100)

dat <- as.data.frame(cbind(binary1, binary2, cont1, cont2))

dat$binary1 <- as.factor(dat$binary1)
dat$binary2 <- as.factor(dat$binary2)
dat$cont1 <- as.numeric(dat$cont1)
dat$cont2 <- as.numeric(dat$cont2)

library(shiny)
library(rCharts)

shinyServer(function(input, output) {

inputVar1 <- reactive({
parse(text=sub(" ","",paste("dat$", input$variable1)))
})

inputVar2 <- reactive({
parse(text=sub(" ","",paste("dat$", input$variable2)))
})

output$out <- renderPrint({

if ( (input$bivariate==FALSE) & (is.factor(eval(inputVar1()))==TRUE) ) {
table(eval(inputVar1()))
} else {

if ( (input$bivariate==FALSE) & (is.numeric(eval(inputVar1()))==TRUE) ) {
summary(eval(inputVar1()))
} else {

if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
table(eval(inputVar1()), eval(inputVar2()))
} else {

if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
cor(eval(inputVar1()), eval(inputVar2()))
} else {

if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
by(eval(inputVar2()), eval(inputVar1()), summary)
} else { 

if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
by(eval(inputVar1()), eval(inputVar2()), summary)
}
}
}
}
}
}

})

})

Any help you could provide would be greatly appreciated. Even simply showing how to adjust the code to render two pieces of desired output given choices of variables. And how to adjust headers to reflect named pieces of output.

Thanks in advance...Chris

Answer 1

Even if the question was a long time ago, I think maybe this approach is better, no need for additional code on the server side.

mainPanel(

  wellPanel(
    conditionalPanel(
        condition = "input.myInput == 'value'",
        ..... Your UI for this case ...........
    ),

    conditionalPanel(
        condition = "input.myInput == 'value2'",
        ..... Your UI for this case ...........
    )                 
  )
  )

Answer 2

I've continued working on the problem as described above. I have embedded a series of nested if else statements in the server.R file to generate captions conditionally based off of selected input. I make use of the textOutput() function in the ui.R file to display these captions in the mainPanel UI. This works pretty well, but not sure if its the best approach. Would love to hear thoughts on the approach?

As for the conditional output... depending on the choice of variables and analysis (univariate or bivariate) I want to generate at most 5 pieces of output. So again, I use a series of nested if else statements to generate these output. Then display in the ui.R files. My problem right now pertains to those variable combinations and analyses which do not require 5 pieces of output (the max possible). For them I return the NULL object. My problem is that Shiny does not print blank whitespace for these output. Rather shiny returns a grey box and word "NULL". It looks kind of ugly and I would very much appreciate any feedback on how this output could simply be turned into whitespace.

My new ui.R code is given below:

    library(shiny)
    shinyUI(pageWithSidebar(

headerPanel("Shiny Example"),

    sidebarPanel(

        wellPanel(

        selectInput(    inputId = "variable1",label = "Select First Variable:", 
                choices = c("Binary Variable 1" = "binary1",
                "Binary Variable 2" = "binary2", 
                "Continuous Variable 1" = "cont1",
                "Continuous Variable 2" = "cont2"),
                selected = "Binary Variable 1"
        )
        ),


        wellPanel(

            checkboxInput("bivariate", "Proceed to Bivariate Analysis", FALSE),
        conditionalPanel(
        condition="input.bivariate==true",
        selectInput(inputId = "variable2", 
        label = "Select Second Variable:",
        choices = c("Binary Variable 1" = "binary1",
        "Binary Variable 2" = "binary2", 
        "Continuous Variable 1" = "cont1",
        "Continuous Variable 2" = "cont2"),
        selected = "Binary Variable 2"
    )
    )
    )
    ),
    mainPanel(

    h5("Item Response Rate"),
    verbatimTextOutput("nitem"),

    h5(textOutput("caption2")),
    verbatimTextOutput("out2"),

    h5(textOutput("caption3")),
    verbatimTextOutput("out3"),

    h5(textOutput("caption4")),
    verbatimTextOutput("out4"),

    h5(textOutput("caption5")),
    plotOutput("out5")
    )
    ))

Below is the code for my server.R file:

    binary1 <- rbinom(100,1,0.5)
    binary2 <- rbinom(100,1,0.5)
    cont1   <- rnorm(100)
    cont2   <- rnorm(100)

    dat <- as.data.frame(cbind(binary1, binary2, cont1, cont2))

    dat$binary1 <- as.factor(dat$binary1)
    dat$binary2 <- as.factor(dat$binary2)
    dat$cont1 <- as.numeric(dat$cont1)
    dat$cont2 <- as.numeric(dat$cont2)

    library(shiny)

    shinyServer(function(input, output) {

    inputVar1 <- reactive({
    parse(text=sub(" ","",paste("dat$", input$variable1)))
    })

    inputVar2 <- reactive({
    parse(text=sub(" ","",paste("dat$", input$variable2)))
    })

    output$nitem <- renderPrint({


    if ( (input$bivariate==FALSE) & (is.factor(eval(inputVar1()))==TRUE) ) {
    n <- sum(table(eval(inputVar1())))
    p <- n/100
    out <- cat(paste(n,gsub(" ","",paste("(",round(as.numeric(p)*100,2),"%",")"))),"\n")
    } else {

    if ( (input$bivariate==FALSE) & (is.numeric(eval(inputVar1()))==TRUE) ) {
    n <- sum(table(eval(inputVar1())))
    p <- n/100
    out <- cat(paste(n,gsub(" ","",paste("(",round(as.numeric(p)*100,2),"%",")"))),"\n")
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    n <- sum(table(eval(inputVar1()),eval(inputVar2())))
    p <- n/100
    out <- cat(paste(n,gsub(" ","",paste("(",round(as.numeric(p)*100,2),"%",")"))),"\n")
    } else {

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    n <- sum(table(eval(inputVar1()),eval(inputVar2())))
    p <- n/100
    out <- cat(paste(n,gsub(" ","",paste("(",round(as.numeric(p)*100,2),"%",")"))),"\n")
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    n <- sum(table(eval(inputVar1()),eval(inputVar2())))
    p <- n/100
    out <- cat(paste(n,gsub(" ","",paste("(",round(as.numeric(p)*100,2),"%",")"))),"\n")
    } else { 

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    n <- sum(table(eval(inputVar1()),eval(inputVar2())))
    p <- n/100
    out <- cat(paste(n,gsub(" ","",paste("(",round(as.numeric(p)*100,2),"%",")"))),"\n")
    }
    }
    }
    }
    }
    }

    })

    output$caption2 <- renderText({

    if ( (input$bivariate==FALSE) & (is.factor(eval(inputVar1()))==TRUE) ) {
    caption2 <- "Univariate Table"
    } else {

    if ( (input$bivariate==FALSE) & (is.numeric(eval(inputVar1()))==TRUE) ) {
    caption2 <- "Univariate Summary"
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    captions2 <- "Bivariate Table"
    } else {

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    caption2 <- "Numeric Summary First Variable"
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    caption2 <- "Numeric Summary By Factor"
    } else { 

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    caption2 <- "Numeric Summary By Factor"
    }
    }
    }
    }
    }
    }

    })

    output$out2 <- renderPrint({

    if ( (input$bivariate==FALSE) & (is.factor(eval(inputVar1()))==TRUE) ) {
    table(eval(inputVar1()))
    } else {

    if ( (input$bivariate==FALSE) & (is.numeric(eval(inputVar1()))==TRUE) ) {
    summary(eval(inputVar1()))
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    table(eval(inputVar1()), eval(inputVar2()))
    } else {

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    summary(eval(inputVar1()))
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    by(eval(inputVar2()), eval(inputVar1()), summary)
    } else { 

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    by(eval(inputVar1()), eval(inputVar2()), summary)
    }
    }
    }
    }
    }
    }

    })

    output$caption3 <- renderText({

    if ( (input$bivariate==FALSE) & (is.factor(eval(inputVar1()))==TRUE) ) {
    caption3 <- "Univariate Table of Proportions"
    } else {

    if ( (input$bivariate==FALSE) & (is.numeric(eval(inputVar1()))==TRUE) ) {
    caption3 <- ""
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    captions3 <- "Bivariate Table of Row Proportions"
    } else {

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    caption3 <- "Numeric Summary Second Variable"
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    caption3 <- "Kruskal Wallis Test"
    } else { 

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    caption3 <- "Kruskal Wallis Test"
    }
    }
    }
    }
    }
    }

    })


    output$out3 <- renderPrint({

    if ( (input$bivariate==FALSE) & (is.factor(eval(inputVar1()))==TRUE) ) {
    prop.table(table(eval(inputVar1())))
    } else {

    if ( (input$bivariate==FALSE) & (is.numeric(eval(inputVar1()))==TRUE) ) {
    NULL
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    prop.table(table(eval(inputVar1()), eval(inputVar2())), margin=1)
    } else {

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    summary(eval(inputVar2()))
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    kruskal.test(eval(inputVar2()) ~ eval(inputVar1()))
    } else { 

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    kruskal.test(eval(inputVar1()) ~ eval(inputVar2()))
    }
    }
    }
    }
    }
    }

    })

    output$caption4 <- renderText({

    if ( (input$bivariate==FALSE) & (is.factor(eval(inputVar1()))==TRUE) ) {
    caption4 <- ""
    } else {

    if ( (input$bivariate==FALSE) & (is.numeric(eval(inputVar1()))==TRUE) ) {
    caption4 <- ""
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    captions4 <- "Pearsons Chi-Squared Test"
    } else {

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    caption4 <- "Spearmans Correlation Coefficient"
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    caption4 <- ""
    } else { 

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    caption4 <- ""
    }
    }
    }
    }
    }
    }

    })

    output$out4 <- renderPrint({

    if ( (input$bivariate==FALSE) & (is.factor(eval(inputVar1()))==TRUE) ) {
    NULL
    } else {

    if ( (input$bivariate==FALSE) & (is.numeric(eval(inputVar1()))==TRUE) ) {
    NULL
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    chisq.test(table(eval(inputVar1()), eval(inputVar2())))
    } else {

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    cor(eval(inputVar1()), eval(inputVar2()), method="spearman", use="pairwise.complete.obs")
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    NULL
    } else { 

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    NULL
    }
    }
    }
    }
    }
    }

    })

    output$caption5 <- renderText({

    if ( (input$bivariate==FALSE) & (is.factor(eval(inputVar1()))==TRUE) ) {
    caption5 <- "Univariate Barplot"
    } else {

    if ( (input$bivariate==FALSE) & (is.numeric(eval(inputVar1()))==TRUE) ) {
    caption5 <- "Univariate Histogram"
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    captions5 <- "Bivariate Barplot"
    } else {

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    caption5 <- "Bivariate Scatter Graph"
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    caption5 <- "Bivariate Boxplot"
    } else { 

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    caption5 <- "Bivariate Boxplot"
    }
    }
    }
    }
    }
    }

    })

    output$out5 <- renderPlot({

    if ( (input$bivariate==FALSE) & (is.factor(eval(inputVar1()))==TRUE) ) {
    barplot(table(eval(inputVar1())))
    } else {

    if ( (input$bivariate==FALSE) & (is.numeric(eval(inputVar1()))==TRUE) ) {
    hist(eval(inputVar1()),main="")
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    barplot(table(eval(inputVar1()), eval(inputVar2())), beside=TRUE)
    } else {

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    plot(eval(inputVar1()), eval(inputVar2()), main="")
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    boxplot(eval(inputVar2()) ~ eval(inputVar1()))
    } else { 

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    boxplot(eval(inputVar1()) ~ eval(inputVar2()))
    }
    }
    }
    }
    }
    }

    })

    })

As mentioned, my current problem is the printing of the "NULL" output. If anyone has any suggestions on how to suppress this output from appearing, I would greatly appreciate your feedback. Also, I welcome thoughts on the proposed solution, versus other viable solutions.