The goal is to create an interactive (Single) plot that the user can select
the year of interest, the status of the member, and the service of interest
and each will select the correct data point. Each x,y coordinate is the
mean satisfaction and mean importance respectively. I have it working with
just the services (plot colm), but Id like to be able to have the user
have more selection. My attempt for multiple inputs is plotOutput("test")..
Any ideas how to get this code working?? THANK YOU!!
UI:
importance <- c(4.25, 3.08)
satisfaction <- c(3.90, 3.18)
dfGap <- data.frame(importance, satisfaction)
imp.A <- c("3.2","2.5","3.3","4.5","4","3.7")
sat.b <- c("2.2", "3.7","5","1.2","2.6","3")
yr.c <- c("2016","2016","2017","2016", "2016","2017")
status.d <- c("Student", "Not","Student", "Not","Student","Student")
service.e <- c("Huddle", "Web", "Test", "Web","Other","Huddle")
dfTest <- data.frame(imp.A,sat.b,yr.c,status.d, service.e)
colDepend = ("darkred")
range <- c("2016"=1,"2017"=2)
choices <- c("Web" = 1,"Huddle" = 2, "Other" = 3, "Test" = 4)
role <- c("Student" = 1, "Not" = 2)
library(shiny)
library(shinydashboard)
library(ggplot2)
ui <- dashboardPage(
dashboardHeader(title="Membership Satisfaction"),
dashboardSidebar(
sidebarMenu(
menuItem("Value Dashboard", tabName = "dashboard", icon =
icon("dashboard")),
menuItem("Services Dashboard", tabName = "service", icon =
icon("dashboard")),
menuItem("Demographics Dashboard", tabName = "demos", icon =
icon("dashboard"))
)
),
dashboardBody(
tabItems(
tabItem(tabName = "service",
sidebarPanel(checkboxGroupInput("vars","Select variables to
plot", choices = choices)),
fluidPage(
plotOutput("colm"),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
h6(strong("Gap Analysis: Plot points calculated as mean
importance and mean satisfaction."),
style = "font-family:'calibri"),
br(),
br(),
h6(strong("Strength: These are the primary strengths. We are
meeting highly important services with high satisfaction."),
style = "font-family:'calibri"),
h6(strong("Potential Advantages: Member satisfaction is being
met, however these services may not be as important for brand
equity."),
style = "font-family:'calibri"),
h6(strong("Secondary Opportunitites: These services are not
crucial (not highly important) and should not be a primary
focus."),
style = "font-family:'calibri"),
h6(strong("Target Issues: Targeting efforts here can improve
membership. These are services that are highly important
however are not meeting needs of members."),
style = "font-family:'calibri")
)),
tabItem(tabName = "demos",
sidebarPanel(
checkboxGroupInput("inpt","Select variables to plot", choices =
choices),
checkboxGroupInput("role",
"Select Primary Role of Interest",
choices = role),
checkboxGroupInput("yrs",
"Select year(S) of Interest",
choices = range)),
fluidPage(
plotOutput("test")
)
))
)
)
Server:
server <- function(input,output){
output$matrixValue<- renderTable({
matrixValue
},include.rownames=TRUE)
output$matrixRENEW<- renderTable({
matrixRENEW
},include.rownames=TRUE)
output$value_BP <- renderPlot({
barplot(matrixValue, beside = T,
legend.text=rownames(matrixValue),
args.legend=list(x="topleft"),
main = titleValue,col=cols)})
output$renew_BP<- renderPlot({
barplot(matrixRENEW, beside = T,
legend.text=rownames(matrixRENEW),
args.legend=list(x="topleft"),
main = titleRENEW,col=cols)})
output$colm <- (renderPlot({
ggplot(dfGap[input$vars,], aes(satisfaction,importance))+
theme(text=element_text(size=12))+
geom_point(colour =input$vars, shape = 17, size=5 )+
labs(x = "Mean Satisfaction", y = "Mean Importance") +
xlim(0,5) + ylim(0,5)+
geom_vline(xintercept=2.5) + geom_hline(yintercept = 2.5)+
annotate("text", x = 4.8, y = 5,
label = "Strengths",
color = "chartreuse4",
style = "font-family:'calibri",
size =6.5,
fontface =2)+
annotate("text", x = .3, y = 5,
label = "Target Issues",
color = "firebrick4",
style = "font-family:'calibri",
size =6.5,
fontface =2)+
annotate("text", x = .78, y = 0,
label = "Secondary Opportunities",
color = "dodgerblue3",
style = "font-family:'calibri",
size =6.5,
fontface =2)+
annotate("text", x = 4.4, y = 0,
label = "Potential Advantages",
color = "grey10",
style = "font-family:'calibri",
size =6.5,
fontface =2)
}))
output$test <- renderPlot({
ggplot(dfTest[service.e[service.e==input$inpt,],], aes(imp.A,sat.b))+
theme(text=element_text(size=12))+
geom_point(colour ="green", shape = 17, size=5 )+
labs(x = "Mean Satisfaction", y = "Mean Importance") +
xlim(0,5) + ylim(0,5)+
geom_vline(xintercept=2.5) + geom_hline(yintercept = 2.5)+
annotate("text", x = 4.8, y = 5,
label = "Strengths",
color = "chartreuse4",
style = "font-family:'calibri",
size =6.5,
fontface =2)+
annotate("text", x = .3, y = 5,
label = "Target Issues",
color = "firebrick4",
style = "font-family:'calibri",
size =6.5,
fontface =2)+
annotate("text", x = .78, y = 0,
label = "Secondary Opportunities",
color = "dodgerblue3",
style = "font-family:'calibri",
size =6.5,
fontface =2)+
annotate("text", x = 4.4, y = 0,
label = "Potential Advantages",
color = "grey10",
style = "font-family:'calibri",
size =6.5,
fontface =2)})
}
shinyApp (ui = ui, server = server)
The service tab is working how I'd like the demos tab to work, I'm just struggling with getting the different user inputs to map to a plot in a similar way. Any help is GREATLY appreciated!!
Related
I have an shiny dashboard that contains multiple tabpanels, boxes that has datatable and plots.
With in the first panel tab, I have a datatable followed by two plot objects. I have put the plots into separate collapsible boxes. The issue I have is the plot is overlapping. I tried adjusting the heights to the box/tab box but I still get the overlapping plot.
I am looking at the 'Drug' tabpanel and the two plot objects are: plotlyOutput("drug_cleveland_plot") and plotOutput("drug_forest_plot").
I set the height of the box : height = 3000
Height of the plot that is overlapping: height = 1000
UI:
tabItem(
tabName = "comorbidities",
box(title = p("Medical History",
div(class = "qv_buttons",
actionButton("run_med_history", "Generate Report", icon = icon("refresh")),
shinyWidgets::radioGroupButtons("med_history_pop", label = NULL,
choices = list(#"Previously & Newly Diagnosed",
"Previously Diagnosed",
"Newly Diagnosed"),
selected = "Previously Diagnosed")
)
),
status = "success",
solidHeader = TRUE,
width = 12,
box(
width = 12 ,
height = 3000,
br(),
tabBox(
id = "med_history_tab",
tabPanel(
"Drug",
pickerInput(
inputId = "drug_class_selection",
label = "Drug Class:",
choices = c('ATC 1st', 'ATC 2nd', 'ATC 3rd', 'ATC 4th', 'ATC 5th', 'Ingredient'),
width = '50%'
),
DT::dataTableOutput("truven_med_history_drug_table", width = "850px"),
box(title = "Expected vs Observed Proportion Cleveland Plot",
collapsible = TRUE,collapsed = TRUE, plotlyOutput("drug_cleveland_plot"),width = "100%"),
box(title = "Expected vs Observed Proportion Odds Ratio",
collapsible = TRUE,collapsed = TRUE, plotOutput("drug_forest_plot"),width = "100%")),
tabPanel(
"Condition",
pickerInput(
inputId = "condition_hrc_selection",
label = "Condition Level:",
choices = c(0,1),
choicesOpt = list(subtext = c(" : Acual"," : 1 Level Higher")),
width = '50%'
),
#verbatimTextOutput('sel.cond'),
DT::dataTableOutput("truven_med_history_condition_table"),
actionButton('resetSelection', label = "Click to reset row selection"),
plotlyOutput('cond_cleveland_plot')
),
tabPanel(
"Procedure",
pickerInput(
inputId = "procedure_hrc_selection",
label = "Procedure Level:",
choices = c(0,1),
choicesOpt = list(subtext = c(" : Acual"," : 1 Level Higher")),
width = '50%'
),
#verbatimTextOutput('sel.proc'),
DT::dataTableOutput("truven_med_history_procedure_table")
),
tabPanel(
"Charlson Cormobidity",
DT::dataTableOutput("truven_med_history_cci_table"),
plotlyOutput("truv_cci_bar_plotly"),
br(),
plotlyOutput("cci_bar_plotly")
),
#plotOutput("truven_atc1_plot"),
#plotOutput("truven_icd3_plot")#,
#DT::dataTableOutput("truven_med_history_drug_table")
width = 12,
height = 3000
)
)
Code to create the plot
Server:
# drug cleaveland plot
output$drug_cleveland_plot = renderPlotly({
df <- df_drug_plot()
df <- sqldf("select distinct concept_name,w_cond_rate as rate,'Diagnosed' as grp from df
union
select distinct concept_name,w_exp_rate as rate,'Expected' as grp from df
")
df <- df %>%
arrange(rate) %>% mutate(grp = factor(grp)) %>%
mutate(concept_name=factor(concept_name))
p <- df %>%
arrange(grp, rate, desc(concept_name)) %>%
ggplot(aes(rate, fct_inorder(concept_name))) +
geom_line(aes(group = concept_name)) +
geom_point(aes(color = grp)) +
scale_x_continuous(breaks = seq(0, 1.1, by = 0.1)) +
theme_bw() +
theme(panel.grid.major.x = element_line( linetype = "dotted", size = 0.2, color = 'grey' )) +
scale_colour_manual(values=c("#d91e4a", "#939597")) +
theme (legend.title=element_blank())
m <- list(
l = 200,
r = 100,
b = 100,
t = 100,
pad = 5
)
fig <- ggplotly(p,width = 1500, height = 1000) %>% layout(title = "Drugs: Observed vs Expected Proportion",
autosize = F,
margin = m,
yaxis = list(title = "",
automargin = TRUE),
legend = list(title=list(text='<b> Group </b>')))
fig
})
I am creating a dashboard that displays a graph based on the selected demographic combination. Since there are 3 main categories, one method that works is to use ifelse. cars is just a random plot used to demonstrate.
cars <- c(1,3,6,4,9)
header <- dashboardHeader(title = "Financial Independence")
sidebar <- dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem("Financial Independence Status", tabName = "finstat"),
menuItem("Expense Type", tabName = "expt")
),
actionButton('switchtab', 'Switch tab')
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "finstat",
h2("Amount of Financial Help Received From Parents in the Last 12 Months")
, "Created by Daniel Haw Rong Chen & Althea Laverne Muth"
, fluidRow(
column(width = 2, height = 3, wellPanel(radioButtons("finstat_all", "All Demographics",
c("Yes", "No")))),
column(width = 2, height = 3, wellPanel(radioButtons("finstat_sex", "Sex",
c("Male", "Female")))),
column(width = 3, height = 3, wellPanel(radioButtons("finstat_educ", "Education Level",
c("College Graduate+", "Some College"
, "H.S. Graduate or Less")))),
column(width = 3, height = 3, wellPanel(radioButtons("finstat_reth", "Race/Ethnicity",
c("White non-Hispanic", "Black non-Hispanic"
, "Hispanic", "Other")))),
),
mainPanel(
plotOutput("plot1")
)
),
tabItem(tabName = "expt",
h2("Types of Expense Financial Help Is Spent On")
, "Created by Daniel Haw Rong Chen & Althea Laverne Muth"
, fluidRow(
column(width = 2, style = "height:200px", wellPanel(radioButtons("expt_all", "All Demographics",
c("Yes", "No")))),
column(width = 2, style = "height:200px", wellPanel(radioButtons("expt_sex", "Sex",
c("Male", "Female")))),
column(width = 3, style = "height:200px", wellPanel(radioButtons("expt_educ", "Education Level",
c("College Graduate+", "Some College"
, "H.S. Graduate or Less")))),
column(width = 3, style = "height:200px", wellPanel(radioButtons("expt_reth", "Race/Ethnicity",
c("White non-Hispanic", "Black non-Hispanic"
, "Hispanic", "Other")))),
),
mainPanel(
plotOutput("plot2")
)
)
)
)
ui <- dashboardPage(
header,
sidebar,
body
)
server <- function(input, output, session) {
observeEvent(input$switchtab, {
newtab <- switch(input$tabs,
"finstat" = "expt",
"expt" = "finstat"
)
updateTabItems(session, "tabs", newtab)
})
tabItems(
tabItem(tabName = "finstat",
output$plot1 <- renderPlot({
if (input$finstat_sex == "Male") {
if (input$finstat_educ == "College Graduate+") {
if (input$finstat_reth == "White non-Hispanic") {
plot(cars)
}
}
}
})
),
tabItem(tabName = "expt",
output$plot2 <- renderPlot({
if(input$expt_all == "Yes"){
ggplot(data = help_type_all, aes(x = type, y = perc, fill = ans, label = round(perc, 4)*100)) +
geom_col(position = "stack") +
geom_text(size = 3, color = "white", position = position_stack(vjust = 0.5)) +
labs(x = "Expense Type", y = "Proportion"
, title = "Type of Expense the Financial Help Is Related To") +
scale_x_discrete(labels=c("Education"
, "Household"
, "Med"
, "Rent or\nMortgage")) +
guides(fill = guide_legend(title = "Response")) + # to rename legend
scale_fill_manual(labels = c("Related", "Unrelated"), values = c("deepskyblue3", "darksalmon")) +
scale_y_continuous(labels = scales::percent) +
theme(legend.title = element_text(size = 10, face = "bold")
, legend.title.align = 0.5
, plot.title = element_text(face = "bold", hjust = 0.5)
, axis.title.x = element_text(face = "bold", hjust = 0.5)
, axis.title.y = element_text(face = "bold", hjust = 0.5))
}
if (input$expt_sex == "Male"
& input$expt_educ == "College Graduate+"
& input$expt_reth == "White non-Hispanic") {
ggplot(data = help_type_m_c_w, aes(x = type, y = perc, fill = ans, label = round(perc, 4)*100)) +
geom_col(position = "stack") +
geom_text(size = 3, color = "white", position = position_stack(vjust = 0.5)) +
labs(x = "Expense Type", y = "Proportion"
, title = "Type of Expense the Financial Help Is Related To") +
scale_x_discrete(labels=c("Education"
, "Household"
, "Med"
, "Rent or\nMortgage")) +
guides(fill = guide_legend(title = "Response")) + # to rename legend
scale_fill_manual(labels = c("Related", "Unrelated"), values = c("deepskyblue3", "darksalmon")) +
scale_y_continuous(labels = scales::percent) +
theme(legend.title = element_text(size = 10, face = "bold")
, legend.title.align = 0.5
, plot.title = element_text(face = "bold", hjust = 0.5)
, axis.title.x = element_text(face = "bold", hjust = 0.5)
, axis.title.y = element_text(face = "bold", hjust = 0.5))
}
})
)
)
}
shinyApp(ui, server)
The problem, however, is that I need to create a graph for each possible combination, so using ifelse will create a code that is overwhelmingly large.
Are there good alternatives to ifelse in this case?
The specific section that I need help with is the following:
tabItem(tabName = "finstat",
output$plot1 <- renderPlot({
if (input$finstat_sex == "Male") {
if (input$finstat_educ == "College Graduate+") {
if (input$finstat_reth == "White non-Hispanic") {
plot(cars)
}
}
}
})
)
How the dashboard look like for more context
I try to display interactive plots by using R shiny. I can successfully make the GUI and published, but the plots in tabPanel shows nothing, just like the picture shows below. There is the data I used (have been downloaded into my laptop).
I think problem may caused by the way how I preprocessing my data in server.R, but whatever I tried, it still display nothing. No Error shows when I run the app.
enter image description here
My code in ui.R:
library(shiny)
shinyUI(fluidPage(
titlePanel("Data Viz Lab"),
sidebarLayout(
sidebarPanel(
## Add X-Variable select element
selectInput(inputId = "var_x",
label = h5("X-Variable"),
choices = c("Structure.Cost", "Land.Value", "Home.Value", "Home.Price.index"),
selected = "Land.Value"),
## Add Fill Color select element
selectInput(inputId = "color",
label = h5("Fill Color"),
choices = c("brown", "yellow", "green", "blue", "red"),
selected = "brown"),
## Add log-scale check box
checkboxInput(inputId = "log",
label = "log-sclae for X-variable in Scatterplot?",
value = FALSE),
## Add Y-Variable select element
selectInput(inputId = "var_y",
label = h5("Y-Variable"),
choices = c("Structure.Cost", "Land.Value", "Home.Value", "Home.Price.index"),
selected = "Structure.Cost"),
## Add Circle-Size side bar
sliderInput(inputId = "size",
label = h5("Circle-Size"),
min = 1,
max = 10,
value = 3),
## Add Outlier color select element
selectInput(inputId = "color_out",
label = h5("Outlier Color"),
choices = c("white", "yellow", "green", "blue", "red"),
selected = "white")
),
mainPanel(
tabsetPanel( # Establish tabset panel
tabPanel(
# Tab1
title = "Histogram",
value = plotOutput(outputId = "hist") # Add an figure in tab1
),
tabPanel(
# Tab2
title = "Scatterplot",
value = plotOutput(outputId = "scatter") # Add an figure in tab2
)
)
)
)
))
My code in server.R:
library(shiny)
library(ggplot2)
library(sp)
library(dplyr)
# setwd()
landdata = read.csv("landdata.csv")
options(scipen = 999)
shinyServer(function(input, output) {
## Plotting Histogram
output$hist = renderPlot({
# Plotting
if (input$log == FALSE){
ggplot(landdata, aes_string(x = input$var_x)) +
geom_histogram(color = input$color)
}else{
ggplot(landdata, aes_string(x = input$var_x)) +
geom_histogram(color = input$color) +
scale_x_log10(input$var_x)
}
})
## Plotting Scatter plot
output$scatter = renderPlot({
# Data pre-processing
p = ggplot(data = landdata, aes_string(x = input$var_x, y = input$var_y)) +
geom_point() +
stat_ellipse(type = "norm", level = 0.95, color = "black")
build = ggplot_build(p)$data
pts = build[[1]]
elli = build[[2]]
Outlier = point.in.polygon(pts$x, pts$y, elli$x, elli$y)
landdata = cbind(landdata, Outlier)
landdata$Outlier = ifelse(landdata$Outlier == 0, yes = "Y", no = "N") %>% factor(level = c("Y", "N"))
# Plotting
if (input$log == FALSE){
ggplot(landdata, aes_string(x = input$var_x, y = input$var_y)) +
geom_point(aes(color = Outlier), size = input$size) +
scale_color_manual(values = c(input$color, input$color_out))
}else{
ggplot(landdata, aes_string(x = input$var_x, y = input$var_y)) +
geom_point(aes(color = Outlier), size = input$size) +
scale_color_manual(values = c(input$color, input$color_out)) +
scale_x_log10(input$var_x)
}
})
})
The mistake lies in the tabPanel setup. value is not the correct argument for the plot. value is "the value that should be sent when tabsetPanel reports that this tab is selected" (taken from the manual). That means, value has the role of an id (like id argument of tabsetPanel or outputId of plotOutput).
Remove value = to make it work (the code snippet below gave me an output on my system).
tabsetPanel( # Establish tabset panel
tabPanel(
# Tab1
title = "Histogram",
plotOutput(outputId = "hist") # Add an figure in tab1
),
tabPanel(
# Tab2
title = "Scatterplot",
plotOutput(outputId = "scatter") # Add an figure in tab2
)
)
Hello I'm doing this Shiny app for a class project and I was wondering why my graph isn't appearing at all. It runs without giving me an error and shows the side panels, but the graph is appearing blank. I've attached the code below. I've seen other posts on here that deal with us and I've tried them out, but nothing has been giving me the results I need. I just need this to show up by Tuesday, so I can present it on Thursday morning. Thank you!
#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
# Load Libraries
library(shiny)
library(tidyverse)
library(ggrepel)
library(dplyr)
library(magrittr)
library(quantmod)
# Load and Merge Data
wordbank = read_csv("/Users/Dohyun/Desktop/school stuff/year3/stat41/final project/administration_data.csv")
wordbank
# Define UI
ui <- fluidPage(
# Application title
titlePanel("Word Bank"),
# Sidebar layout with a input and output definitions
sidebarLayout(
# Inputs: Select variables to plot
sidebarPanel(
selectInput(inputId = "x",
label = "X-axis:",
choices = c("Age" = "age")),
selectInput(inputId = "y",
label = "Y-axis:",
choices = c("Word Size" = "comprehension")),
selectInput(inputId = 'language', 'Language: ',
choices = c("English (American)", "English (British)", "English (Australian)",
"American Sign Language","British Sign Language",
"Cantonese","Croatian","Czech", "Danish", "French (French)",
"French (Quebecois)", "German", "Greek (Cypriot)", "Hebrew",
"Italian", "Kigiriama", "Kiswahili", "Korean", "Latvian",
"Mandarin (Beijing)", "Mandarin (Taiwanese", "Norwegian",
"Portugeuse (European)", "Russian", "Slovak", "Spanish (European)",
"Spanish (Mexican)", "Swedish", "Turkish")),
sliderInput(inputId = "alpha",
label = "Alpha:",
min = 0, max = 1,
value = 0.5)
),
#Output
mainPanel(
plotOutput(outputId = "scatterplot"),
plotOutput(outputId = "boxplot"),
br(), # a little bit of visual separation
)
)
)
# Define server function --------------------------------------------
server <- function(input, output) {
lang_data <- reactive({
wordbank %>%
filter(language %in% input$language)
})
# Create scatterplot object the plotOutput function is expecting
output$lang_plot <- renderPlot({
# Creates base plot
p1 <-
ggplot(lang_data(), aes(x = input$x, y = input$y, fill = as.factor(age))) +
geom_boxplot(alpha = .6, outlier.shape = NA) +
geom_jitter(size = 0.2, alpha = input$alpha, width = 0.3, aes(color = as.factor(age))) +
scale_fill_viridis_d(end = .75, option = "D", guide=FALSE) +
scale_color_viridis_d(end = .75, option = "D", guide=FALSE) +
labs(x = str_to_title(str_replace_all(input$x, "_", " ")),
y = str_to_title(str_replace_all(input$y, "_", " "))) +
scale_x_continuous(breaks = seq(from = 16, to = 30, by = 2))
theme(panel.background = element_blank())
print(p1)
})
}
# Create the Shiny app object ---------------------------------------
shinyApp(ui, server)
I am trying to use a conditional withSpinner such that when users select Ohio, both sexes and the year of 2010, I want the spinner to come up. Otherwise, I do not want the spinner to be shown. Please see this image for more information. In other words, I want to disable the spinner when, for example, the year is changed to 2015. Is there any way to do this.
.
Here is the simplified version of my codes:
UI
ui <- fluidPage(
navbarPage(
collapsible = T,
fluid = T,
selected = "Population Projections",
windowTitle = "Scripps Interactive Data Center",
"",
tabPanel(("Population Projections"),
# tags$hr(), #add a line between above command and the below one
tags$h5 (
strong("Current and Projected Population by County, Age Group, and Sex, 2010-2050"),
align = 'left'
),
br(),
#a line break
sidebarLayout(
sidebarPanel(
#"sidebar panel"),
helpText("Please select your county of interest"),
selectInput(
inputId = "county",
label = "Select County:",
selected = "Ohio",
selectize = FALSE,
multiple = FALSE,
choices = sort(unique(population$County))
),
radioButtons(
inputId = "sex",
label = strong("Select Sex:"),
selected = "Both Sexes",
choices = sort(unique(population$Sex))
),
sliderInput(
inputId = "years",
label = "Year",
min = 2010,
max = 2050,
value = 2010,
step = 5,
sep = "",
pre = "",
animate = animationOptions(
interval = 1000,
loop = F,
playButton = tags$button("Play", style =
"background-color: #B61E2E ; color:white; margin-top: 10px; border:solid"),
pauseButton = tags$button("Pause", style =
"background-color: #B61E2E !important; color:white; margin-top: 10px; border:solid")
),
round = T,
width = "150%",
ticks = T
),
# ### Download Button
downloadButton("downloadData", "Download Data"),
br(),
br()
# downloadButton("downloadPlot_1", "Download Bar Graph"),
# br(),
# br(),
# downloadButton("downloadPlot_2", "Download Pyramid"),
# br(),
# br()
# the number of visitors
# h5(textOutput("counter"))
),
######################
mainPanel(
tabsetPanel(
type = "tabs",
tabPanel(
"Plot",
plotOutput("bar") %>% withSpinner (color="#B61E2E"),
br(),
br(),
br(),
#a line break
(column (12, align="center", tableOutput("table")))
),
tabPanel(
"Pyramid",
plotOutput("pyramid", height=600)
#a line break
),
tabPanel("Data", tableOutput("data"))
)
)
Server
server <- function(input, output) {
bardata <- reactive ({
out <- population %>%
filter (County %in% input$county,
Year %in% input$years,
Sex %in% input$sex)
return(out)
})
blue.bold.14.text <- element_text(face = "bold", color = "black", size = 14)
blue.bold.10.text <- element_text(face = "bold", color = "black", size = 10)
blue.bold.12.text <- element_text(face = "bold", color = "black", size = 12)
bardataPlot <- reactive({
ggplot(bardata(), aes(x = Age_Group, y = Population)) + geom_bar(stat =
"identity",
position = "stack",
fill = "#B61E2E") +
geom_text(
aes(label = Percentage),
vjust = 1,
colour = "white",
position = position_dodge(width=0.9),
fontface = "bold",
size=5,
angle = 90,
hjust = 1
) +
labs(
x = "Age Groups",
y = "Population Size",
caption = (""),
face = "bold"
) +
theme_bw() + scale_y_continuous(labels = scales::comma) +
theme(plot.title = element_text(
hjust = 0.5,
size = 15,
colour = "Black",
face = "bold"
),axis.text=(blue.bold.12.text), axis.title=blue.bold.14.text, axis.text.x = element_text(angle = -75, vjust = 0, hjust=0)) +
ggtitle(
paste0(
input$sex,
" ",
"Population Size by 5-Year Age Groups in ",
input$county,
", ",
input$years
)
)
})
output$bar <- renderPlot ({
bardataPlot()
})
As your non-minimal example isn't working (parenthesis missing?) I made a new one showing a way to display a spinner conditionally:
library(shiny)
library(shinycssloaders)
ui <- fluidPage(
checkboxInput("toggle", "toggle"),
conditionalPanel(condition = "input.toggle", withSpinner(uiOutput("spinnerDummyID1"), type = 6))
)
server <- function(input, output, session) {}
shinyApp(ui, server)