I need to prepare a shiny app for a school project.
This is a link of what it is supposed to look like
https://yuvaln.shinyapps.io/olympics/
If you look at the app you see there is a checkbox named medals.When you
open the app they are all selected but in the event the user decides to uncheck them all there should be a small error and no graph should be drawn.
I am having trouble getting to this, when I uncheck all the boxes in my app
it draws an empty drawing
This is the important part of the code:
fluidRow(
column(3,checkboxGroupInput("Medals", label = strong("Medals"),
choices = list("Total" = "TOTAL", "Gold" = 'GOLD',
"Silver" = 'SILVER','Bronze'='BRONZE'),
selected = c('TOTAL','GOLD','SILVER','BRONZE')))),
fluidRow(
mainPanel(plotOutput('coolplot'),width = '40%'))
)
)
server <- function(input, output){output$coolplot<-renderPlot(plot.medals2(input$country,
input$Startingyear,input$Endingyear,input$Medals))}
shinyApp(ui = ui, server = server)
I am using a function plot.medals2 that gets a vector of medals ,start year, ending year, country and returns a drawing of the graph.
Since you didn't post the complete code, I have recreated an example using the Iris data set. I guess the code below answers your question...
library(shiny)
library(ggplot2)
library(dplyr)
ui <- shinyUI(fluidPage(
# Application title
titlePanel("Checkbox example"),
fluidRow(
column(3,checkboxGroupInput("example", label = strong("Species"),
choices = levels(iris$Species),
selected = levels(iris$Species)))),
fluidRow(
mainPanel(plotOutput('coolplot'),width = '40%'))
))
server <- shinyServer(function(input, output) {
irisSubset <- reactive({
validate(
need(input$example != "", 'Please choose at least one feature.')
)
filter(iris, Species %in% input$example)
})
output$coolplot<-renderPlot({
gg <- ggplot(irisSubset(), aes(x = Species, y = Sepal.Length))
gg <- gg + geom_boxplot()
print(gg)
})
})
# Run the application
shinyApp(ui = ui, server = server)
Related
I am having two columns in my data frame, one is "all_pass" which contains numeric values and other is "st_name" which contains string values name of states
The requirement of the plot is , when user give input of the state it will show the plot of that particular state which contains all_pass numbers
Following is the code in which I am trying to plot, where the user will input the name of the state and as per the input of the state name, the graph will plot as per the all_pass as per the related pass scores to that particular state. Kindly help in the following code, will be of great help.
Code is as mentioned below :
library(ggplot2)
library(plotly)
library(dplyr)
library(shiny)
ui <- basicPage(
h1("Total bills passed by state delegation , 110th Congress"),
selectizeInput(inputId = "bins",label = "Choose State",
choices = list("AK","AL","AR","AS","AZ","CA","CO","CT","DC","DE","FL","GA","GU","HI","IA","ID","IL","IN","KS","KY","LA","MA","MD","ME","MI","MN","MO","MS","MT","NC","NE","ND","NH","NJ","NM","NV","NY","OH","OK","OR","PA","PR","RI","SC","SD","TN","TX","UT","VA") ,multiple = TRUE ,plotOutput("plot"))
)
server <- function(input, output) {
data <- reactive({
require(input$bins)
df <- df7 %>% filter(st_name %in% input$bins)
})
output$plot <- renderPlot({
ggplot(df(), aes(y= all_pass,x=st_name ))+geom_bar(stat = "sum")
})
}
shinyApp(ui = ui, server = server)
in the UI definition you have plotOutput("plot") as an argument to selectizeInput() instead of basicPage(). Reformatting your code (Ctrl+Shift+A) would have made that more visible.
You can simplify the server code, as the renderPlot() already creates a reactive dependence on input$bins.
You can use the object datasets::state.abb to get a vector of US state abbreviations. This is loaded automatically in every R session.
Please see some working code below. I am using some mock data for df as you did not provide any data in your question.
library(ggplot2)
library(plotly)
library(dplyr)
library(shiny)
ui <- basicPage(
h1("Total bills passed by state delegation, 110th Congress"),
selectizeInput(inputId = "bins",
label = "Choose State",
choices = state.abb,
multiple = TRUE),
plotOutput("plot")
)
server <- function(input, output) {
df <-
tibble(all_pass = sample(1:500, 350),
st_name = rep(state.abb, 7))
output$plot <- renderPlot({
req(input$bins)
df |>
filter(st_name %in% input$bins) |>
ggplot(aes(y = all_pass,x=st_name )) +
geom_bar(stat = "sum")
})
}
shinyApp(ui = ui, server = server)
I am building a shiny application with several tabs, each tab takes a user input (unique(data_in$cat), and generates some type of graph. The problem occurs in the second tab--for some reason, it does not generate the graph that is specified by data2. The first graph on the first tab is being displayed correctly.I see no error when I run this code, so I don't know where to start debugging!
library(shiny)
library(openxlsx)
library(ggplot2)
data_in <- read.xlsx("www/dem_data_clean.xlsx")
ui <- navbarPage(title = "Data",
tabPanel(title = "Over-all trends",
plotOutput("Histall"),
selectInput("Indall","Demographic Variable of Interest",choices = unique(data_in$cat))
),
tabPanel(title = "2017-2018"),
plotOutput("Hist17"),
selectInput("Ind17","Demographic Variable of Interest",choices = unique(data_in$cat))
)
server <- function(input, output, session) {
data1 <- reactive({
a <- subset(data_in,cat==input$Indall)
return(a)
})
data2 <- reactive({
a <- subset(data_in,cat==input$Ind17)
return(a)
})
output$Histall <- renderPlot({
ggplot(data1(), aes(x=Year,y=value, group =name, color=name)) + geom_line(stat = "identity") +
ylab("Percent of Population")
})
output$Hist17 <- renderPlot({
data2() %>%
filter(Year=="2017-18") %>%
ggplot(aes(name, value)) + geom_bar(stat = "identity")
})
}
shinyApp(ui, server)
Any suggestions to what I am doing wrong? I've tried playing around with different things for a few hours now to no avail!
The UI code is not correct, second plotOutput and selectInput are not within second tabPanel. It works if you fix it :
ui <- navbarPage(title = "Data",
tabPanel(title = "Over-all trends",
plotOutput("Histall"),
selectInput("Indall",
"Demographic Variable of Interest",
choices = unique(data_in$cat))
),
tabPanel(title = "2017-2018",
plotOutput("Hist17"),
selectInput("Ind17",
"Demographic Variable of Interest",
choices = unique(data_in$cat)))
)
I have an interactive visualization that connects to a city government's police data API.
When certain combinations of inputs are selected, my API call comes back empty and I get a nasty red error message (as my plot inputs are unavailable).
Can someone tell me how to display a more informative error message along the lines of, "there are no incidents matching your selection, please try again"? I would like this error message to appear as a showNotification and my ggplot not to render.
Below is an extremely stripped down version of what I am doing. Note how when a combination like "AVONDALE" and "CHEMICAL IRRITANT" is selected, the chart renders, whereas when a combination like "ENGLISH WOODS" and "TASER-BEANBAG-PEPPERBALL-40MM FOAM" is selected, an error message is returned. This error message is what I would like to address with a showNotification alert.
Note that this uses the Socrata API, so the package RSocrata must be installed and loaded.
install.packages("RSocrata")
library(shiny)
library(reshape2)
library(dplyr)
library(plotly)
library(shinythemes)
library(tibble)
library(RSocrata)
# Define UI for application that draws a histogram
ui <- fluidPage(
navbarPage("Example",
theme = shinytheme("united"),
tabPanel("Plot",
sidebarLayout(
sidebarPanel(
# neighborhood selector
selectizeInput("neighbSelect",
"Neighborhoods:",
choices = c("AVONDALE", "CLIFTON", "ENGLISH WOODS"),
multiple = FALSE)),
# incident description selector
selectizeInput("incSelect",
"Incident Type:",
choices = c("CHEMICAL IRRITANT", "TASER-BEANBAG-PEPPERBALL-40MM FOAM"),
multiple = FALSE))
),
# Output plot
mainPanel(
plotlyOutput("plot")
)
)
)
# Define server logic
server <- function(input, output) {
forceInput <- reactive({
forceInput <- read.socrata(paste0("https://data.cincinnati-oh.gov/resource/e2va-wsic.json?$where=sna_neighborhood= '", input$neighbSelect, "' AND incident_description= '", input$incSelect, "'"))
})
# Render plot
output$plot <- renderPlotly({
ggplot(data = forceInput(), aes(x = sna_neighborhood)) +
geom_histogram(stat = "count")
})
}
# Run the application
shinyApp(ui = ui, server = server)
Thank you so much for any help anyone can offer!
Im going to give an example with the shinyalert library to have the popup. Here I added the sample choice TEST to indicate no data:
#install.packages("RSocrata")
library(shiny)
library(reshape2)
library(dplyr)
library(plotly)
library(shinythemes)
library(tibble)
library(RSocrata)
library(shinyalert)
# Define UI for application that draws a histogram
ui <- fluidPage(
useShinyalert(),
navbarPage("Example",
theme = shinytheme("united"),
tabPanel("Plot",
sidebarLayout(
sidebarPanel(
# neighborhood selector
selectizeInput("neighbSelect",
"Neighborhoods:",
choices = c("AVONDALE", "CLIFTON", "ENGLISH WOODS","TEST"),
multiple = FALSE)),
# incident description selector
selectizeInput("incSelect",
"Incident Type:",
choices = c("CHEMICAL IRRITANT", "TASER-BEANBAG-PEPPERBALL-40MM FOAM"),
multiple = FALSE))
),
# Output plot
mainPanel(
plotlyOutput("plot")
)
)
)
# Define server logic
server <- function(input, output,session) {
forceInput <- reactive({
forceInput <- read.socrata(paste0("https://data.cincinnati-oh.gov/resource/e2va-wsic.json?$where=sna_neighborhood= '", input$neighbSelect, "' AND incident_description= '", input$incSelect, "'"))
if(nrow(forceInput)==0){
shinyalert("Oops!", "No data returned", type = "error")
forceInput <- NULL
}
forceInput
})
# Render plot
output$plot <- renderPlotly({
req(forceInput())
ggplot(data = forceInput(), aes(x = sna_neighborhood)) +
geom_histogram(stat = "count")
})
}
# Run the application
shinyApp(ui = ui, server = server)
I'm working on a shiny app that accepts a DNA sequence (e.g. "ACTGACTG"), does some calculations and plots the result when a button is clicked. When I store a Biostrings::DNAString in a reactiveValues object, my shiny app only reacts to changes if the number of characters of the sequence changes, e.g. if "AA" is entered first, the plot doesn't change if "CC" is then entered but does change if "AAAA" is entered. It responds to all changes if I store the object as a character. Here's a simplified example:
library(shiny)
library(shinyBS)
library(Biostrings)
library(ggplot2)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
ref_seqs <- textInput("ref_seqs", "Sequence", width = "100%",
value = NULL, placeholder = "ATGCTGCTGGTTATTAGATTAGT"),
run_guide <- bsButton("run", 'Run', type = "action",
style = "success", block = TRUE)
),
mainPanel(
plotOutput("reference")
)
)
)
server <- function(input, output) {
ref <- reactiveValues(sq = NULL)
dat <- reactive({
req(input$run)
chrs <- strsplit(as.character(ref$sq),"")[[1]]
data.frame(label = chrs, x = seq_along(chrs))
})
observeEvent(input$run, {
ref$sq <- Biostrings::DNAString(input$ref_seqs)
#ref$sq <- input$ref_seqs
})
output$reference <- renderPlot({
ggplot(dat(), aes(x = x, y = factor(1), label = label)) + geom_text(size = 12)
})
}
shinyApp(ui = ui, server = server)
If I comment out the line ref$sq <- Biostrings::DNAString(input$ref_seqs) and uncomment the line below it, the plot updates upon changes.
Can anyone explain why this happens? Do reactiveValues only work with base types? Thanks!
I have a task where i need to build an rShiny app that allows the user to choose which kind of R plotting package is used in-order to display a plot.
Currently the only way i have gotten it to work (semi-decently) is using package specific functions for each package on the server side and using a series of conditional panels on the UI side.
However the problem is that when the user enters the page for the first time then all plots are initialized. Second problem is when the user changes some plot input values and after that chooses another package then the old plot will be displayed until a new plot is created.
Questions:
Is this the only available approach?
I feel that there must be a way to use reactive functions for the package selection?
I feel that it should be possible to use a single rShiny's htmlOutput (or something similar) in the ui and therefore not needing the switchPanel?
I have created a small app to demonstrate my current implementation and both problems:
server.R
library(shiny)
#library(devtools)
#install_github("ramnathv/rCharts")
library(rCharts)
shinyServer(function(input, output) {
names(iris) = gsub("\\.", "", names(iris))
#Render the Generic plot
output$GenericPlot <- renderPlot({
data = iris[0:input$variable,]
plot(data$SepalLength ~ data$SepalWidth)
})
#Render the Polychart plot
output$PolychartPlot <- renderChart({
plotData <- rPlot(SepalLength ~ SepalWidth, data = iris[0:input$variable,], color = 'Species', type = 'point')
plotData$addParams(dom = 'PolychartPlot')
return(plotData)
})
#Render the NDV3 plot
output$NDV3Plot <- renderChart({
plotData <- nPlot(SepalLength ~ SepalWidth, data = iris[0:input$variable,], group = 'Species', type = 'scatterChart')
plotData$addParams(dom = 'NDV3Plot')
return(plotData)
})
})
ui.R
library(shiny)
library(rCharts)
shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("lib", label = "Library:",
choices = list("Generic", "rCharts Polychart", "rCharts NDV3"),
selected = "Generic"
),
numericInput("variable", "Observations:",
min = 5,
max = 150,
value = 10
)
),
mainPanel(
conditionalPanel(
condition = "input.lib == 'Generic'",
h3("Generic plot"),
plotOutput("GenericPlot")
),
conditionalPanel(
condition = "input.lib == 'rCharts Polychart'",
h3("rCharts Polychart plot"),
showOutput("PolychartPlot", "polycharts")
),
conditionalPanel(
condition = "input.lib == 'rCharts NDV3'",
h3("rCharts NDV3 plot"),
showOutput("NDV3Plot", "nvd3")
)
)
)
))
The final version will use a different dataset and more charting packages. The provided code is more of a toy example, with most of the stuff stripped out.
Make a single part in the output part of the app that includes some logic based on the input. For example,
library(shiny)
library(ggplot2)
data(cars)
server <- function(input, output) {output$plot<- renderPlot({
if (input$lib == "base") {
p <- plot(cars$speed, cars$dist)
} else if (input$lib == "ggplot") {
p <- ggplot(cars, aes(x = speed, y = dist)) + geom_point()
}
p
})
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("lib", "Library: ", choices = list("base", "ggplot"),
selected = "base")
),
mainPanel(plotOutput("plot"))
)
)
shinyApp(ui = ui, server = server)
This provides one plot and as soon as I change the lib option it regenerates.
Found a solution to my problem. The solution is basically to use uiOutput() in the ui.R and move the plotOutput(), showOutput() methods to the server.R.
The solution based on iacobus code:
ui.R
library(shiny)
library(rCharts)
shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("lib", "Library: ", choices = list("base", "ggplot", "Polychart"),
selected = "base")
),
mainPanel(uiOutput("plot"))
)
))
server.R
library(shiny)
library(ggplot2)
library(rCharts)
data(cars)
server <- function(input, output) {
output$plot<- renderUI({
if (input$lib == "base") {
plotOutput("base")
} else if (input$lib == "ggplot") {
plotOutput("ggplot")
} else if (input$lib == "Polychart") {
showOutput("polychart", "polycharts")
}
})
output$base <- renderPlot({
plot(cars$speed, cars$dist)
})
output$ggplot <- renderPlot({
ggplot(cars, aes(x = speed, y = dist)) + geom_point()
})
output$polychart <- renderChart({
p <- rPlot(speed ~ dist, data = cars, type = "point")
p$addParams(dom = 'plot')
p
})
}
The difficulty arose for me, because i assumed that plotOutput(), showOutput() etc methods can only be used in the ui.R. This however is not the case.
EDIT:
It turned out that this was not enough for pollyCharts to work properly along with other rCharts packages.
instead i am using renderUI and rCharts $show to display the chart inline. The following link was helpful for me: https://github.com/ramnathv/rCharts/issues/373. In the ui i'm using htmlOutput