I am a Shiny novice with what seems to me to be a simple question. I have a test app.R that reads a data frame, asks the user for a start date and displays a time series area chart starting from that date. The app.R works, but when I expand the size of my screen window, the chart is fixed in the top-to-bottom dimension. The left-to-right dimension is flexible. How can I make the top-to-bottom dimension flexible too? I want me graphical object to fill the window. Here is my reprex:
#library(Shiny)
#library(ggplot2)
a <- c(seq.Date(as.Date("2019-01-01"),as.Date("2019-06-01"),by="month"))
b <- c(4,7,2,9,13,6)
df <- data.frame(a=a,b=b)
ui <- fluidPage(
titlePanel("Test example"),
fluidRow(
sidebarPanel(
dateInput(inputId="StartDate",label="Please enter a start date:",
value="2019-01-01",min="2019-01-01",max="2019-06-01")
)
),
fluidRow(
column(12),
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output) {
output$distPlot <- renderPlot({
FirstDate <- input$StartDate
ggplot(filter(df,a>=as.Date(FirstDate)))+
geom_area(aes(x=a,y=b,fill="red"),alpha=0.4)+
geom_line(aes(x=a,y=b,colour="red"),size=1)+
theme(legend.position="none")
})
}
shinyApp(ui = ui, server = server)
Thank you.
Philip
plotOutput("distPlot",
width ="80vw",
height="60vw")
(with help from nirgrahamuk on the RStudio Community forum).
Related
I have an issue with the waiter which I need for an app built with R shiny.
The example below (based on the fantastic website on the waiter package by John Coene: https://waiter.john-coene.com/#/waiter/examples#on-render) helps me illustrate my issue.
The app is made of two tabPanels, the first one which shows a table, and the second one that shows a chart. The table and the chart will appear after some waiting time, and the waiter spinner should, in the meantime, appear in the middle of the rendering areas of both tabPanels.
However, what actually happen is that the waiter spinner only shows up in the middle of the rendering area of the tabPanel I open first, whereas in the other tabPanel it is stuck in the top-left corner of the page.
Many thanks in advance for whoever can help me fix this problem!
library(shiny)
library(highcharter)
library(shinythemes)
library(waiter)
ui <- fluidPage(
theme = shinytheme("cyborg"),
useWaiter(),
actionButton("draw", "render stuff"),
fluidPage(
tabsetPanel(
tabPanel("Table", tableOutput("table")),
tabPanel("Chart", highchartOutput("hc"))
)
)
)
server <- function(input, output){
# specify the id
w <- Waiter$new(id = c("hc", "table"))
dataset <- reactive({
input$draw
w$show()
Sys.sleep(8)
head(cars)
})
output$table <- renderTable(dataset())
output$hc <- renderHighchart({
hchart(dataset(), "scatter", hcaes(speed, dist))
})
}
shinyApp(ui, server)
I would recommend you use shinycssloaders instead. The reason is that loaders' positions in waiter are calculated by current visible height and width. However, there is no visible position in the second tab or the hidden tabs, so waiter can't add the loader to the right spot. There is no fix we can do here. This is a feature that waiter doesn't support currently.
library(shiny)
library(highcharter)
library(shinythemes)
library(shinycssloaders)
ui <- fluidPage(
theme = shinytheme("cyborg"),
actionButton("draw", "render stuff"),
fluidPage(
tabsetPanel(
tabPanel("Table", withSpinner(tableOutput("table"), type = 3, color.background = "#060606", color = "#EEEEEE")),
tabPanel("Chart", withSpinner(highchartOutput("hc"), type = 3, color.background = "#060606", color = "#EEEEEE"))
)
)
)
server <- function(input, output){
dataset <- reactive({
input$draw
Sys.sleep(4)
head(cars)
})
output$table <- renderTable(dataset())
output$hc <- renderHighchart({
hchart(dataset(), "scatter", hcaes(speed, dist))
})
}
shinyApp(ui, server)
I have recently written a Shiny app that takes user data input, does some analysis on it, and then displays the results, including graphs. These graphs take a while to render, so I am using withSpinner to inform the users that Shiny is busy and to be patient and wait for the graphs to appear. The graphs are displayed within boxes that have titles informing the users what the graphs show.
What gets displayed to the users depends on the data they provide to the app (how many items of data are provided in their input file) and also which options they choose from within the app (using checkboxes).
The withSpinner function works well for the graphs when wrapped around plotOutput and called from within ui (see line 38 of the example code below).
However, to use this approach for all graphs would require me to know how many items of data the users are likely to provide and then want to view. I would like to just automatically produce a graph, with a spinner, for each data item, without knowing how many there are in advance.
Placing withSpinner within the server doesn’t work at all (lines 58-65), which makes sense. However, if I use it in the ui around the uiOutput object for all of the boxes and graphs (line 29), the spinner only shows until the boxes are rendered – the graphs then appear about a minute later…
Please can you help me to work out how to get the spinners to show until the graphs are rendered? Thank you for any help you can give!
library(shiny)
library(shinydashboard)
library(shinyjs)
library(shinycssloaders)
library(survival)
ui <- dashboardPage(
skin = "blue",
dashboardHeader(title = "My App"),
dashboardSidebar(
sidebarMenu(
useShinyjs(),
id = "tabs",
menuItem("User Choice", tabName = "uChoice", icon = icon("sliders-h"))
)
),
dashboardBody(
id = "dashboardBody",
tabItems(
tabItem(
tabName = "uChoice",
h2("You have a choice"),
# Check boxes to select choice
fluidRow(
uiOutput("userChoiceCheckbox")
),
fluidRow(
# Only show the data graphs that the user has chosen to look at
withSpinner(uiOutput('chosenGraphs'), type=4)
# this spinner only shows until the box containing the graph is rendered
),
fluidRow(
# Always show lung graph
box(
title = paste("Here's the lung graph"),
width = 12,
height="50px",
withSpinner(plotOutput("lungGraph"), type=4)
# This spinner shows until the graph is plotted
)
)
)
)
)
)
server <- function(input, output, session) {
output$userChoiceCheckbox <- renderUI({
column(6, checkboxGroupInput(inputId = "choices", label = "Which graph(s) would you like to view?", choices = c("Lung", "PBC")))
})
output$chosenGraphs <- renderUI({
lapply(input$choices, function(x) {
box(
title = paste("Graph for", x,"cancer"),
width = 12,
renderPlot({
withSpinner(
# This spinner doesn't seem to work at all
plotOutput({
Sys.sleep(2)
plot(survfit(Surv(time, status) ~ 1, data = eval(as.symbol(tolower(x)))),
xlab = "Days",
ylab = "Overall survival probability")
})
)
})
)
})
})
output$lungGraph <- renderPlot(
plot(survfit(Surv(time, status) ~ 1, data = lung),
xlab = "Days",
ylab = "Overall survival probability")
)
}
shinyApp(ui, server)
In case you didn't find an answer, I couldn't add a single spinner per plot but the whole renderUI region can be wrapped by withSpinner() if you add it after the lapply().
In your case it would be something like this:
output$chosenGraphs <- renderUI({
lapply(input$choices, function(x) {
box(
title = paste("Graph for", x,"cancer"),
width = 12,
renderPlot({
plotOutput({
Sys.sleep(2)
plot(survfit(Surv(time, status) ~ 1, data = eval(as.symbol(tolower(x)))),
xlab = "Days",
ylab = "Overall survival probability")
})
})
)
}) %>% withSpinner()
})
My shiny app generates a number of useful graphs. I would like to allow the user to download the graphs in various formats.
I have done this before for a single graph using How to save plots that are made in a shiny app as a guide. However, I am ending up creating more repeated code for each additional plot. I am not a programmer, but it really seems like I should be able to write one function to do this since I am just passing parameters to downloadHandler and ggsave, but I can't figure it out.
The MRE below represents a page with, say, ten different graphs. Is there a way to write a single function that receives the plot ID from a button (like a tag or something?) and the format from the selectInput to pass those parameters to downloadHandler and ggsave to save each of those graphs in the selected format? The function at the bottom shows my thinking, but I don't know where to go from here or if that is even the right direction.
Thanks!
library(shiny)
library(ggplot2)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show plots and download buttons
mainPanel(
plotOutput("distPlot"),
fluidRow(
column(3,
downloadButton("dl_plot1")
),
column(3,
selectInput("plot1_format",label = "Format",choices = c("SVG","PDF","JPEG","PNG"),width = "75px")
)
),
plotOutput("scat_plot"),
column(3,
downloadButton("dl_plot2")
),
column(3,
selectInput("plot2_format",label = "Format",choices = c("SVG","PDF","JPEG","PNG"),width = "75px")
)
)
)
)
# Define server logic required to draw a histogram and scatterplot
server <- function(input, output) {
output$distPlot <- renderPlot({
x <- faithful$waiting
binwidth<-(max(x)-min(x))/input$bins
p<-ggplot(faithful,aes(waiting))+
geom_histogram(binwidth = binwidth)
p
})
output$scat_plot<-renderPlot({
p<-ggplot(faithful,aes(x=waiting,y=eruptions))+
geom_point()
p
})
downloadPlot <- function(plot_name,file_name,file_format){#concept code
downloadHandler(
filename=function() { paste0(file_name,".",file_format)},
content=function(file){
ggsave(file,plot=plot_name,device=file_format)
}
)
}
}
# Run the application
shinyApp(ui = ui, server = server)
To achieve your desired result without duplicating code you could (or have to) use a Shiny module. Basically a module is a pair of an UI function and a server function. For more on modules I would suggest to have a look at e.g. Mastering shiny, ch. 19.
In the code below I use a module to take care of the download part. The job of downloadButtonUI and downloadSelectUI is to add a download button and a selectInput for the file format. The downloadServer does the hard work and saves the plot in the desired format.
Note: Besides the download module I moved the code for the plots to reactives so that the plots could be passed to the downloadHandler or the download module.
EDIT: Added a fix. We have to pass the reactive (e.g. dist_plot without parentheses) to the download server and use plot() inside the downloadServer instead to export the updated plots.
library(shiny)
library(ggplot2)
# Download Module
downloaButtondUI <- function(id) {
downloadButton(NS(id, "dl_plot"))
}
downloadSelectUI <- function(id) {
selectInput(NS(id, "format"), label = "Format", choices = c("SVG", "PDF", "JPEG", "PNG"), width = "75px")
}
downloadServer <- function(id, plot) {
moduleServer(id, function(input, output, session) {
output$dl_plot <- downloadHandler(
filename = function() {
file_format <- tolower(input$format)
paste0(id, ".", file_format)
},
content = function(file) {
ggsave(file, plot = plot())
}
)
})
}
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30
)
),
# Show plots and download buttons
mainPanel(
plotOutput("distPlot"),
fluidRow(
column(3, downloaButtondUI("distPlot")),
column(3, downloadSelectUI("distPlot"))
),
plotOutput("scat_plot"),
fluidRow(
column(3, downloaButtondUI("scatPlot")),
column(3, downloadSelectUI("scatPlot"))
),
)
)
)
server <- function(input, output) {
dist_plot <- reactive({
p <- ggplot(faithful, aes(waiting)) +
geom_histogram(bins = input$bins)
p
})
scat_plot <- reactive({
p <- ggplot(faithful, aes(x = waiting, y = eruptions)) +
geom_point()
p
})
output$distPlot <- renderPlot({
dist_plot()
})
output$scat_plot <- renderPlot({
scat_plot()
})
downloadServer("distPlot", dist_plot)
downloadServer("scatPlot", scat_plot)
}
shinyApp(ui = ui, server = server)
#>
#> Listening on http://127.0.0.1:4092
I am building a shinyApp to display COVID-19 data. I have a file in long format that displays the day, county, positive cases, recoveries, and deaths. I am attempting to make the app where a user can select a county from a drop down menu and it will display 3 graphs of positives, recoveries, and deaths on the page. The graphs will have x-axis be dates and y-axis as a variable. Attached is the script I have so far. I have tried many different approachers, but I have no idea what to do. I am still learning R and have no prior experience with ShinyApp. Any advice or help would be appreciated. I think I have the ggPlot and output/UI right, the server logic is what is throwing me for a loop. Even just a link to a good guide would be nice. Thanks!
7/23/2020: I have updated the code. I looked in ggplot some. When I run the app, I now have the dropdown menu I wanted, but the graphs are displaying. When I create the ggplot in the console to make sure the code works on its own, I am missing the middle protion of the graph? Any ideas/fixes?
library(shiny)
library(dplyr)
library(tidyr)
library(plotly)
library(ggplot2)
library(rsconnect)
df <- read.csv("C:/Users/Nathan May/Desktop/Research Files (ABI)/Covid/Data For Shiny/Appended_File/Appended_Scraped_Files.csv") #INSERT PATH SINGLE FILE OPTION
datapos <- df[c(2,6,3)]
rsconnect::setAccountInfo(name='nathanjmay', token='A3CF4CC3DE0112B8B9F8D0BA429223D3', secret='TNwC9hxwZt+BffOhFaXD3FQsMg3eQnfaPGr0eE8S')
#UI
ui <- fluidPage(
titlePanel("COVID-19 in Arkansas Counties"),
fluidRow(
column(
width=4,
selectizeInput("County", label=h5("County"), choices= data$Counties, width="100%")
)),
fluidRow(
plotOutput(outputId = "Positive")
),
fluidRow(
plotOutput(outputId = "Recoveries")
),
fluidRow(
plotOutput(outputId = "Deaths")
),)
#SERVER
server= function(input, output) {
data <- reactive({
datapos %>% filter(County == input$County)
#GGPLOT2 for Positive
output$Positive -> renderPlot(ggplot(data=datapos, aes(x=Day, y=Positive)) +
geom_bar(stat="identity"))
#Recoveries
output$Recoveries -> renderplot()
#Deaths
output$Deaths -> renderplot()
})
}
shinyApp(ui=ui, server=server)
You're assigning all reactive expressions to the data object in the server logic, look at where you close the curly bracket. So everything get wrapped into data and nothing about your plotOutput, i.e. output$Positive, output$Recoveries, output$Death are specified in your server logic. Also the way to use reactive() feel a little awkward at first. Here's my super simply app to illustrate what you ought to do wrt to using reactive(). Again notice where you open and close the curly bracket and parentheses.
So the chain of reactions defined here are: input$state >> dat via reactive() >> output$dummy via renderPlot().
library(shiny)
library(dplyr)
library(ggplot2)
#### Fake data
df <- data.frame(state = rep(c("FL", "GA"), each = 2),
x = rnorm(4),
y = rnorm(4))
#### UI
ui <- fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
selectInput("state", "Choose a state:",
list(`Florida` = "FL",
`Georgia` = "GA")
),
mainPanel(
plotOutput("dummy")
)
)
)
#### Server
server <- function(input, output) {
## Essential dat is the filtered df
dat <- reactive({
df %>%
filter(state == input$state)
})
## Use dat() to access the filtered df instead of dat
output$dummy <- renderPlot({
ggplot(dat()) +
geom_point(aes(x = x, y = y))
})
}
# Run the application
shinyApp(ui = ui, server = server)
I came across the video tutorial here.
http://blog.revolutionanalytics.com/2016/03/rtvs-preview.html
Right around minute 24:15 the instructor starts talking about the shiny app that he built. He has it pre-built, and simply runs it, so it's basically impossible for me to figure out how he actually went from nothing to a real working app. I watched a few tutorials on YouTube, and they were helpful to get me up to speed a little, but still can't get this working. As best as I can tell, these are (kind of) the steps, but again, I stil can't get this working.
RStudio > File > New File > Shiny Web App. Then name the app and crate a directory.
Now, I have a template that looks like this.
#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
# Define UI for application that draws a histogram
ui <- shinyUI(fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
))
# Define server logic required to draw a histogram
server <- shinyServer(function(input, output) {
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
})
# Run the application
shinyApp(ui = ui, server = server)
Based on the video, I created a template (with some basic R code). It looks like this.
library(shiny)
library(leaflet)
library(plyr)
ui <- fluidPage(
actionButton("recalc", "New points"),
mainPanel(
tabsetPanel(
tabPanel("Order Locations", leafletOutput("map",width="80%",height="400px")),
tabPanel("Markers", verbatimTextOutput("markers"))
)
)
)
server <- function(input, output, session) {
airports <- read.csv("https://raw.githubusercontent.com/jpatokal/openflights/master/data/airports.dat", header = FALSE)
colnames(airports) <- c("ID", "name", "city", "country", "IATA_FAA", "ICAO", "lat", "lon", "altitude", "timezone", "DST")
countries <- sort(unlist(lapply(unique(airports$country), as.character)))
}
shinyApp(ui, server)
This doesn't do anything at all. Ugh.
I believe the 'ui' is a function that calls arguments form the 'server'. Is that right? Am I close, or way off base? How can I get this working? It seems VERY useful. I'm trying to learn the nuts and bolts of this stuff so I can do it myself. Thank you!