I've recently started learning Shiny and am developing my first practice app. For some reason, my app doesn't take up the entire browser window but is cutoff about half way. The page can still scroll down to see the rest of the output but there is a high fold for some reason. Below is my code:
library(foreign)
library(dplyr)
library(shiny)
library(dplyr)
library(ggplot2)
library(shinythemes)
thesis <- read.csv("thesis.csv", stringsAsFactors = T)
ui <- fluidPage(theme = shinytheme("cerulean"),
# Application title
titlePanel("Annual Prices by City"),
# Sidebar with choice selected
sidebarLayout(
sidebarPanel(
selectInput("city","City",as.character(thesis$city)),
tableOutput("table")
),
# Show a time series line plot
mainPanel(
textOutput("cityheader"),
plotOutput("plot", width="100%")
)
)
)
server <- function(input, output, session) {
df <- reactive({
thesis %>%
select(city, year, price) %>%
filter(city == input$city)
})
output$plot <- renderPlot({
ggplot(df(), aes(x=year, y=price)) +
labs(title=input$city, x="Year", y="Annual Avg Price") +
geom_line(col="blue")
}, height=400, width = 700)
output$table <- renderTable({
df()
})
output$cityheader <- renderText({
input$city
})
}
shinyApp(ui=ui,server=server)
Here is a screenshot of the white space:
Screenshot of the Shiny App
UPDATE:
Here is what it looks like from within the viewer's pane in Rstudio:
Rstudio Screenshot
Thanks.
I had the same issue, try
shinyApp(ui = ui, server = server, options = list(height = 1080))
Related
I wonder if someone can explain the behavior of the progressBar().
I have trimmed my shiny app to the bare minimum to reproduce this post.
Now to the problem. When I select "AllRuns", the progress bar pops up and then goes away
before the graphic is displayed. But when I select "scatter", the progress bar nicely waits
until the scatter plot is displayed on the main panel. Is this a normal behavior?
How can I make the progress bar wait until the graphic displays when "AllRuns" is selected?
UPDATE The dataset can be read into R from google docs. it takes about 20 seconds to load into R.
library(shiny)
library(tidyverse)
library(DT)
library(data.table)
final <- fread("https://docs.google.com/spreadsheets/d/170235QwbmgQvr0GWmT-8yBsC7Vk6p_dmvYxrZNfsKqk/pub?output=csv")
runs<- c("AllRuns","scatter")
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput(inputId = "run",
label = "Chinook Runs",
choices = runs,
selected = "AllRuns"),
sliderInput(inputId = "Yearslider",
label="Years to plot",
sep="",
min=2000,
max=2014,
value=c(2010,2012))),
mainPanel(
plotOutput("plot")
)))
server <- function(input, output,session) {
session$onSessionEnded(function() {
stopApp()
})
plot_all <- reactive({
final[final$year >= input$Yearslider[1] & final$year <= input$Yearslider[2], ]
})
plotscatter <- reactive({
rnorm(100000)
})
dataInput <- reactive({
if (input$run == "AllRuns") {
plot_all()
}else{
plotscatter()
}
})
# Plot data
create_plots <- reactive({
withProgress(message="Creating graphic....",value = 0, {
n <- 10
for (i in 1:n) {
incProgress(1/n, detail = input$run)
Sys.sleep(0.1)
}
#Make the plots
theme_set(theme_classic())
switch(input$run,
"AllRuns" = ggplot(plot_all(),aes(SampleDate,Count,color = race2)) +
geom_point() + theme_bw() +
labs(x="",y="Number in thousands",title="All Salmon Runs combined"),
"scatter" = plot(plotscatter(),col="lightblue")
)
})#Progress bar closing brackets
})#create_plots closing brackets
output$plot <- renderPlot({
create_plots()
})
}
# Run the application
shinyApp(ui = ui, server = server)
It is simple that the progress bar is updated by the for-loop and the plot code only run after the for-loop. So the progress-bar reach the end, then plot code started. This kind of progress-bar would work if you are process something along with for-loop for example
list_of_files # assume you have a list of data file to read and process
max_progress <- length(list_of_files)
withProgress(message="Creating graphic....",value = 0, {
for (i in 1:max_progress) {
data <- read_csv(list_of_files[i])
... # doing something here
# once the processing code done next line of code will update the progress bar
incProgress(1/n, detail = input$run)
}
})
If you want to display loading one way to do it is using shinycssloaders::withSpinner() on the UI part which would show an animation of loading while UI is updating by server side.
The withProgress would be more useful when you have a list of items to process.
library(shiny)
library(tidyverse)
library(DT)
library(data.table)
library(shinycssloaders)
final <- fread("https://docs.google.com/spreadsheets/d/170235QwbmgQvr0GWmT-8yBsC7Vk6p_dmvYxrZNfsKqk/pub?output=csv")
runs<- c("AllRuns","scatter")
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput(inputId = "run",
label = "Chinook Runs",
choices = runs,
selected = "AllRuns"),
sliderInput(inputId = "Yearslider",
label="Years to plot",
sep="",
min=2000,
max=2014,
value=c(2010,2012))),
mainPanel(
withSpinner(plotOutput("plot"))
)))
server <- function(input, output,session) {
session$onSessionEnded(function() {
stopApp()
})
plot_all <- reactive({
final[final$year >= input$Yearslider[1] & final$year <= input$Yearslider[2], ]
})
plotscatter <- reactive({
rnorm(100000)
})
dataInput <- reactive({
if (input$run == "AllRuns") {
plot_all()
}else{
plotscatter()
}
})
# Plot data
create_plots <- reactive({
#Make the plots
theme_set(theme_classic())
switch(input$run,
"AllRuns" = ggplot(plot_all(),aes(SampleDate,Count,color = race2)) +
geom_point() + theme_bw() +
labs(x="",y="Number in thousands",title="All Salmon Runs combined"),
"scatter" = plot(plotscatter(),col="lightblue")
)
})#create_plots closing brackets
output$plot <- renderPlot({
create_plots()
})
}
# Run the application
shinyApp(ui = ui, server = server)
I am trying to use plotly_relayout to get the x-axis zoom limits of one plot, and apply them to another plot in Shiny. So far I can get the relevant plotly_relayout data from "plot1" (x-axis limits), transform it (from a numeric to a Date), and have it available right before plotting "plot2", however it does not actually set the zoom extents on "plot2".
In most cases, my RStudio crashes as soon as I attempt to zoom in on "plot1". Only in the small number of cases when RStudio does not crash, do I see that the "coord_cartesian" in "plot2" is not having the desired effect (after making a zoom in plot1).
I am also rather curious if the persistent crashing of my RStudio is normal given the code below, or if I may need to consider a fresh rebuild of RStudio. Any ideas on how to achieve this effect would be appreciated!
library(ggplot2)
library(plotly)
library(shinydashboard)
library(shinyWidgets)
#Data frame with dates and bogus data
a=data.frame(Date=seq.Date(as.Date("2000-01-01"),
as.Date("2000-12-31"),
"day"),
value=rnorm(366)
)
#Simple dashboard with two plots
ui <- dashboardPage(
dashboardHeader(title="Sample App"),
dashboardSidebar(
),
dashboardBody(
plotlyOutput("plot1"),
plotlyOutput("plot2")
)
)
server <- function(input, output, session){
#Create a reactive list, set zoomX1 and zoomX2 as NULL
reactiveList <- reactiveValues(zoomX1=NULL,zoomX2=NULL)
#Create a reactive function to update the reactive list every time the plotly_relayout changes
relayout_data <- reactive({
xvals=event_data("plotly_relayout",source="plot1")
if (is.null(xvals$`xaxis.range[0]`)){
} else {
reactiveList$zoomX1=as.Date(xvals$`xaxis.range[0]`,origin="1970-01-01")
reactiveList$zoomX2=as.Date(xvals$`xaxis.range[1]`,origin="1970-01-01")
}
})
#Plot1, just plot all the data
output$plot1 <- renderPlotly({
g1=ggplot(a,aes(x=Date,y=value))+
geom_point()
ggplotly(g1,source="plot1") %>% event_register("plotly_relayout")
})
#Plot 2, same as Plot1, but should set the coord_cartesian based on plot1's current zoom level taken from the event_data("plotly_relayout")
output$plot2 <- renderPlotly({
relayout_data()
g1=ggplot(a,aes(x=Date,y=value))+
geom_point()+
coord_cartesian(xlim=c(reactiveList$zoomX1,reactiveList$zoomX2))
ggplotly(g1,source="plot2")
})
}
shinyApp(ui = ui, server = server)
Actually, on my system your code is working fine.
However, you can reduce your code drastically by using plotly's subplot function and it's argument shareX. Please check the following example:
library(ggplot2)
library(plotly)
library(shinydashboard)
library(shinyWidgets)
a <- data.frame(Date = seq.Date(as.Date("2000-01-01"),
as.Date("2000-12-31"),
"day"),
value = rnorm(366))
ui <- dashboardPage(
dashboardHeader(title = "Sample App"),
dashboardSidebar(),
dashboardBody(plotlyOutput("plots", height = "80vh"))
)
server <- function(input, output, session) {
output$plots <- renderPlotly({
g2 <- g1 <- ggplot(a, aes(x = Date, y = value)) +
geom_point()
subplot(ggplotly(g1), ggplotly(g2), nrows = 2, shareX = TRUE)
})
}
shinyApp(ui = ui, server = server)
This is my first Shiny app, and I just got the basics working to where it allows the user to select from a dropdown menu of clients, then a dropdown menu of test codes to receive a plot of the results for the selected test.
I'd like the second dropdown menu to be updated with the available test codes for that client (all are not present for each client). Also, I would like to be able to hover over the point in the plot and receive more information from the row in the original dataframe.
I've looked into tooltips and the nearPoints() function, but I'm not sure if these can be used on this data since it is manipulated. I'm not sure if at this point it would be easier to import the data in a different way (it will ultimately need to accept either excel files or .csv). Thanks for any help that you would be able to provide, please let me know if there is any other supporting info I can give.
Here is my code:
library(shiny)
library(scales)
library(ggplot2)
labData <-
read.table("MockNLData.csv",
header=TRUE, sep=",")
#convert '<10' and '<20' results
labData$ModResult <- labData$Result
levels(labData$ModResult)[levels(labData$ModResult)=="<10"]
<- "0"
levels(labData$ModResult)[levels(labData$ModResult)=="<20"]
<- "0"
#convert results to scientific notation
SciNotResult <-
formatC(as.numeric(as.character(labData$ModResult)),
format="e", digits=2)
ui <- fluidPage(
headerPanel("Dilution History"),
sidebarLayout(
sidebarPanel(
selectInput(inputId="client", label="Select Client
Name", choices=levels(labData$Client.Name)
),
selectInput(inputId="test", label="Select Test Code",
choices=levels(labData$Analysis))
),
mainPanel(
plotOutput("line", hover="plot_hov"),
verbatimTextOutput("info"))
)
)
server <- function(input, output) {
#selected client into data frame
selDF <- reactive({labData[labData[,1]==input$client,]
})
#selected test code into data frame
subsetDF <- reactive({selDF()[selDF()[,5]==input$test,]
})
#points to be plotted
points <-
reactive({as.numeric(levels(subsetDF()$ModResult))
[subsetDF()$ModResult]
})
#plot
output$line <- renderPlot({
qplot(seq_along(points()), points(), xlab ="Index",
ylab ="Result")
})
#hover information
output$info <- renderText({
paste0("x=", input$plot_hov$x, "\ny=",
input$plot_hov$y)
})
}
shinyApp(ui = ui, server = server)
Here is what the data looks like:
MockNLData.csv
EDIT: I figured out updating the menu with updateSelectInput()
In the future, make sure you share a reproducible example :)
Since your code is not reproducible please find below something you can understand and adapt to your case.
On your first question, if I understand correctly, you want to programatically generate a dropdown (selectInput) which is perfectly do-able. *Inputs are, in essence, just HTML content which you can dynamically generate, just like your plots. You do so with uiOutput (in your ui) and renderUI in your server.
library(shiny)
ui <- fluidPage(
selectInput("dataset", "Select a dataset", choices = c("cars", "mtcars")),
uiOutput("column"), # dynamic column selector
verbatimTextOutput("selected_column")
)
server <- function(input, output, session){
data <- reactive({
if(input$dataset == "cars")
return(cars)
else
return(mtcars)
})
output$column <- renderUI({
# build your selectInput as you normally would
selectInput("column_selector", "Select a column", choices = colnames(data()))
})
output$selected_column <- renderPrint({
# use input$column_selector!
print(input$column_selector)
})
}
shinyApp(ui, server)
On your second question, what you want is an interactive plot. There are numerous packages that will let you do that in R and Shiny. Below are some examples, by no means a comprehensive list:
plotly which will also let you make your ggplot2 charts interactive
highcharter another great, well tested library
echarts4r ECharts for R.
billboarder billboard.js for R and Shiny
Below is an example using highcharter. They all follow the same principle within Shiny, an *Output function coupled with a render* function.
library(shiny)
library(highcharter)
ui <- fluidPage(
highchartOutput("chart")
)
server <- function(input, output, session){
output$chart <- renderHighchart({
hchart(mpg, "scatter", hcaes(x = displ, y = hwy, group = class))
})
}
shinyApp(ui, server)
EDIT
Following your question on the flashing error. You need to require (req) the required input. When launching the app below the error will flash, uncomment the req(input$y) line and it'll go away.
library(shiny)
ui <- fluidPage(
uiOutput("sel"),
plotOutput("plot")
)
server <- function(input, output){
output$sel <- renderUI({
numericInput("y", "N:", value = 200, min = 5, max = 1000, step = 100)
})
output$plot <- renderPlot({
# req(input$y)
hist(runif(input$y, 1, 10))
})
}
shinyApp(ui, server)
In essence, since your plot relies on a dynamically generating input for a fraction of second that input is not available as it is being rendered, using req prevents that.
What I understand from your problem above are:
You want to make next dropdown menu based on what the user have chosen from previous dropdown menu.
When the mouse over the point on the plot, it will show row value.
So, here i will give you reproducible example and i hope it is useful for you.
In this example I use Rabbit dataset from library MASS.
To filter data for next dropdown menu, I use filter from library
dplyr (See line 30).
I use reactive expression to manage next dropdown menu (See line
29).
I use nearPoints() to manage hover point (See line 55).
library(shiny)
library(MASS)
library(dplyr)
library(ggplot2)
ui <- fluidPage(
titlePanel("Rabbit dataset from MASS library"),
fluidRow(
column(4, selectInput("var",
"Animal:",
unique(sort(Rabbit$Animal)))),
column(4, uiOutput("selected_var")),
column(4, uiOutput("selected_var1")),
column(12, plotOutput("selected_var2", hover = "plot_hover")),
column(12, verbatimTextOutput("info"))
)
)
server <- function(input, output) {
###FILTER NEXT DROPDOWN MENU BASED ON PREVIOUS SELECTED BY USER
dataset3 <- reactive({
unique(Rabbit %>% filter(Animal == input$var) %>% select(Treatment))
})
output$selected_var <- renderUI({
selectInput("var1", "Treatment:", c(dataset3()))
})
dataset4 <- reactive({
Rabbit %>% filter(Animal == input$var) %>% filter(Treatment == input$var1) %>% select(Run)
})
output$selected_var1 <- renderUI({
selectInput("var2", "Run:", c(dataset4()))
})
####
output$selected_var2 <- renderPlot({
ggplot(Rabbit %>% filter(Animal == input$var) %>% filter(Treatment == input$var1) %>% filter(Run == input$var2), aes(x = BPchange, y = Dose)) + geom_point()
})
###HOVER POINT USING nearPoints()
output$info <- renderPrint({
nearPoints(Rabbit %>% filter(Animal == input$var) %>% filter(Treatment == input$var1) %>% filter(Run == input$var2), input$plot_hover)
})
}
shinyApp(ui = ui, server = server)
I know renderPlot produces plot that can be shown on Shiny plotOutput function. I also know autoinvalidate() helps to calculate data reactively.
I am displaying a radar chart (in fact can be any chart) using the below codes:
output$plot2 <- renderPlot({
autoInvalidate()
p2<<-ggradar(mtcars_radar[i,])
})
What I dont know is how to change the value of i from 1 to 300 during every event of autoinvalidate().
Or is there anyway I can change the row of data in plot so that the plot is dynamically animating every sec with a new row of data.
Can anyone help me plz?
The full code is here:
library(shiny)
library(ggplot2)
mtcars %>%
rownames_to_column( var = "group" ) %>%
mutate_at(vars(-group),funs(rescale)) %>%
tail(4) %>% select(1:10) -> mtcars_radar
ui <- fluidPage(
sidebarPanel(
actionButton("button", "Go!")
),
# Show the plot
mainPanel(
plotOutput("plot2")
)
)
server <- function(input, output) {
library(ggplot2)
library(ggradar)
suppressPackageStartupMessages(library(dplyr))
library(scales)
autoInvalidate <- reactiveTimer(2000)
plot2 <- NULL
output$plot2 <- renderPlot({
ggradar(mtcars_radar[1,])
})
observeEvent(input$button,{
output$plot2 <- renderPlot({
autoInvalidate()
p2<<-ggradar(mtcars_radar[i,])
p2
})
})
}
# Run the application
shinyApp(ui = ui, server = server)
Any help please?
This is where you need a reactive value that stores the row index and changes every second. I do not have the library ggradar, so I will just print out the current row index value instead. I also used invalidateLater instead of reactiveTimer as suggested by Shiny documentation.
library(shiny)
ui <- fluidPage(
verbatimTextOutput("debug")
)
server <- function(input, output) {
row_idx_max <- 15
row_idx <- reactiveVal(0)
observe({
isolate(row_idx(row_idx() + 1))
cur_row_idx <- isolate(row_idx())
if (cur_row_idx < row_idx_max) {
invalidateLater(1000)
}
})
output$debug <- renderPrint({
row_idx()
})
}
shinyApp(ui, server)
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)