Reputation: 51
I am working on a simple web application using WHO's suicide statistics in which I am allowing for certain user inputs. The app then uses these inputs to plot the graphs and data tables. I have the entire code working but I wanted to add another thing. The first user input option is to choose the x variable. It can either be age group or year. What I want is to add an additional slider input when the user selects year as their x variable. I want this to appear only when year is selected and I want it below two other inputs I have besides the x variable one. I would then also have to update my server function so that it reacts accordingly when the slider is added and only plots the years selected by the user.
library(shiny)
library(dplyr)
library(ggplot2)
library(DT)
library(readr)
library(tools)
setwd("C:\\Users\\Lenovoi7\\Shrewsbury School\\IT\\Coursework")
who<-data.frame(read.csv("who.csv", stringsAsFactors = TRUE))
dput(head(who))
countries<-sort(unique(who$country))
countries<-union(countries, c("World"))
ui<-fluidPage(
titlePanel("Suicide statistics"),
br(),
sidebarLayout(
sidebarPanel(
h3("Plotting"),
selectInput(
inputId="x",
label="Please choose the x variable",
choices=c(
"Age group"="age",
"Year"="year")),
selectInput(
inputId = "gender",
label = "Please specify the gender characteristics",
choices = c("Gender neutral" = "gender_neutral",
"Gender specific" = "gender_specific"),
selected = NULL),
selectInput(
inputId = "country",
label = "Select a country:",
choices = countries,
selected = "Bosnia and Herzegovina")),
mainPanel(
tabsetPanel(
type="tabs",
id="tabsetpanel",
tabPanel(
title="Graph",
plotOutput(outputId = "graph"),
br()),
tabPanel(
title="Data Table",
br(),
DT::dataTableOutput(outputId = "country_table")
)
)
)
)
)
server <- function(input, output) {
x<-reactive({input$x})
gender<-reactive({input$gender})
country<-reactive({input$country})
country_table<-reactive({subset(who, country==input$country)})
output$country_table <- DT::renderDataTable(
DT::datatable(
data=country_table(),
options=list(pageLength=10),
rownames=FALSE
)
)
output$graph <- renderPlot(
#x axis = age group
if (x()=="age"){
if (gender()=="gender_neutral"){
if (country()=="World"){
ggplot(data=who, aes(x=age)) + geom_bar(aes(weights=suicides_no), position="dodge")}
else {
#create a new subset of data that will be used??
who_subset<-subset(who, country == input$country)
ggplot(data=who_subset, aes(x=age)) + geom_bar(aes(weights=suicides_no))}}
else if (gender()=="gender_specific"){
if (country()=="World"){
ggplot(data=who, aes(x=age)) + geom_bar(aes(weights=suicides_no, fill=sex), position="dodge")}
else {
#create a new subset of data that will be used??
who_subset<-subset(who, country==input$country)
ggplot(data=who_subset, aes(x=age)) + geom_bar(aes(weights=suicides_no, fill=sex), position="dodge")}}}
else if (x()=="year"){
if (gender()=="gender_neutral"){
if (country()=="World"){
who_all <- who %>%
group_by(year) %>%
summarize(suicides_no = sum(suicides_no),
population = sum(population)) %>%
mutate(rate = 100000 * suicides_no/population)
ggplot() +
geom_line(data = who_all, aes(year, rate))
}
else {
who_subset<-subset(who, country==input$country)
who_subset <- who_subset %>%
group_by(year) %>%
summarize(suicides_no = sum(suicides_no),
population = sum(population)) %>%
mutate(rate = 100000 * suicides_no/population)
ggplot() +
geom_line(data = who_subset, aes(year, rate))
}}
else if (gender()=="gender_specific"){
if (country()=="World"){
who_all <- who %>%
group_by(year) %>%
summarize(suicides_no = sum(suicides_no),
population = sum(population)) %>%
mutate(rate = 100000 * suicides_no/population)
ggplot() +
geom_line(data = who_all, aes(year, rate))
}
else {
#create a new subset of data that will be used??
who_subset<-subset(who, country==input$country)
who_sub_sex <- who_subset %>%
group_by(year, sex) %>%
summarize(suicides_no = sum(suicides_no),
population = sum(population)) %>%
mutate(rate = 100000 * suicides_no / population)
ggplot() +
geom_line(data = who_sub_sex, aes(year, rate, color = sex))}
}
}
)}
# Create a Shiny app object
shinyApp(ui = ui, server = server)
Could somebody please tell me how to tackle this? I tried with adding conditional panels but it did not seem to work for me as it kept erroring out and I could not fix the error. Thank you.
Upvotes: 2
Views: 2185
Reputation: 2261
You can achieve this with conditionalPanel
. You specify a condition in JavaScript when the panel should appear then simply put the slider you want within it.
library(shiny)
ui <- fluidPage(
selectInput("selection", "Select something", choices = c("group", "year")),
conditionalPanel(
"input.selection == 'year'",
sliderInput("slider", "Year slider", min = 1, max = 10, value = 5)
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
EDIT
Edit following your comment.
You can simply use the similar conditions on the server
side.
library(shiny)
library(ggplot2)
data <- data.frame(
x = 1:10,
y = runif(10)
)
ui <- fluidPage(
selectInput("selection", "Select something", choices = c("group", "year")),
conditionalPanel(
"input.selection == 'year'",
sliderInput("slider", "Year slider", min = 1, max = 10, value = 5)
),
plotOutput("plot")
)
server <- function(input, output, session) {
output$plot <- renderPlot({
df <- data
if(input$selection == "year")
df <- dplyr::filter(data, x < input$slider)
ggplot(df, aes(x = x, y = y)) +
geom_line()
})
}
shinyApp(ui, server)
Upvotes: 2