New to R and Shiny and working on my first little app. The code below works as I want but now I need to extend it so that when it is loaded there is a parameter in the URL (something like http://127.0.0.1:6804/?Sta_ID=1ABIR000.76) which is used in that first query to set the wqmdata data frame. I've figured out how to use the parseQueryString function to grab that parameter out of the URL in the server code block, but I can't figure out how to use it in that initial data load of the wqmdata data frame? That data frame is used to populate a bunch of stuff in the UI which is based on the specific station (i.e. every station can have a different list of monitored water quality parameters).
A little background on what I'm trying to do. Eventually that pl45_wqm_data.csv file will be replaced with a call to a SQL server database to get the data for the app. That database has thousands of monitoring stations with millions of observations so I obviously just want to bring back the data that is needed in that initial call. The idea is to have a URL which can be called from an ArcGIS Portal app so users can use the interactive map (with a bunch of other data) to find a monitoring station then click on the station to launch the R Shiny app to visualize the monitoring data for that station.
Any ideas to try?
library(shiny)
library(ggplot2)
library(tidyverse)
#Get monitoring data
wqmdata <- arrange(subset(read.csv(file="~\\R\\ShinyApps\\WQMGraphURL\\pl45_wqm_data.csv"
, fileEncoding="UTF-8-BOM"),Sta_ID == "1ABIR000.76"),Parameter,Fdt_Date_Time)
# Define UI for application that allows user to select a Parameter then get a graph
ui <- fluidPage(
tags$style(type='text/css',
".selectize-input {font-size: 12px; line-height: 12px;}
.selectize-dropdown {font-size: 11px; line-height: 11px;}"),
# Give the page a title
titlePanel(paste("DEQ Water Quality Monitoring Station Data for ",unique(wqmdata$Sta_ID))),
hr(),
# Generate a row with a sidebar
sidebarLayout(
# Define the sidebar with one input
sidebarPanel(
#dropdown to select parameter to be graphed
selectInput("SelectedParameter", "Select Parameter for Graph:",
choices=unique(wqmdata$Parameter)),
hr(),
# Button
downloadButton("downloadData", "Download Station Data"),
helpText("Download file contains all monitoring data including field data parameters")
),
# Create a spot for the barplot
mainPanel(
plotOutput("ParameterPlot")
)
)
)
# Define server logic required to draw graph
server <- function(input, output, session) {
GraphRecords <- reactive({
filter(wqmdata, Parameter == input$SelectedParameter)
})
GraphRecordsRows <- reactive({nrow(filter(wqmdata, Parameter == input$SelectedParameter))})
# Fill in the spot we created for a plot
output$ParameterPlot <-
renderPlot({
# Render the graph
graph.title <- "Parameter Data Graph"
yaxis.label <- paste(unique(GraphRecords()$Parameter)," Value")
if (GraphRecordsRows() == 1)
{ ggplot(GraphRecords(), aes(Fdt_Date_Time, Parameter_Value, group = 1)) +
geom_point() +
labs(x = "Sample Date", y = yaxis.label, title = graph.title) +
theme(axis.text.x = element_text(angle = 90,vjust = 0.5, hjust = 1)) +
geom_text(aes(label = Parameter_Value), angle = 70, hjust = 0, vjust = -0.5, size = 3) }
else
{ ggplot(GraphRecords(), aes(Fdt_Date_Time, Parameter_Value, group = 1)) +
geom_point() +
geom_line()+
labs(x = "Sample Date", y = yaxis.label, title = graph.title) +
theme(axis.text.x = element_text(angle = 90,vjust = 0.5, hjust = 1)) +
geom_text(aes(label = Parameter_Value), angle = 70, hjust = 0, vjust = -0.5, size = 3) }
})
# Downloadable csv of selected dataset ----
output$downloadData <- downloadHandler(
filename = function() {
paste(unique(wqmdata$Sta_ID), "_StationData.csv", sep = "")
},
content = function(file) {
write.csv(wqmdata, file, row.names = FALSE)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
More or less figured it out. I'm getting a 'Warning: Error in : Aesthetics must be either length 1 or the same as the data (1): x, y' error when the page first loads (I guess because the plotOutput runs before there is any data supplied) but I'll figure out how to get that fixed. The whole idea of reactive data in R is very foreign to me but very cool.
Here is the updated code. I still need to clean it up a bit but this works:
library(shiny)
library(ggplot2)
library(tidyverse)
# Define UI for application that allows user to select a Parameter then get a graph
ui <- fluidPage(
tags$style(type='text/css',
".selectize-input {font-size: 12px; line-height: 12px;}
.selectize-dropdown {font-size: 11px; line-height: 11px;}"),
# Give the page a title
titlePanel(textOutput("titleText")),
hr(),
# Generate a row with a sidebar
sidebarLayout(
# # Define the sidebar with one input
sidebarPanel(
#dropdown to select parameter to be graphed
selectInput("graphParameters","Select Parameter for Graph:","graphParameters"),
hr(),
# Button
downloadButton("downloadData", "Download Station Data"),
helpText("Download file contains all monitoring data including field data parameters")
),
# # Create a spot for the barplot
mainPanel(
plotOutput("ParameterPlot")
)
)
)
# Define server logic required to draw graph
server <- function(input, output, session) {
stationidParameter <- reactive({
query <- parseQueryString(session$clientData$url_search)
query[["stationid"]]
})
wqmdata <- reactive({arrange(subset(read.csv(file="~\\R\\ShinyApps\\WQMGraphURL2\\pl45_wqm_data.csv"
, fileEncoding="UTF-8-BOM"),Sta_ID == stationidParameter()),Parameter,Fdt_Date_Time)})
output$titleText <- renderText({paste("DEQ Water Quality Monitoring Station Data for ",unique(wqmdata()$Sta_ID))})
observe({updateSelectInput(session, "graphParameters", choices = unique(wqmdata()$Parameter))})
GraphRecords <- reactive({filter(wqmdata(), Parameter == input$graphParameters)})
GraphRecordsRows <- reactive({nrow(filter(wqmdata(), Parameter == input$graphParameters))})
# Fill in the spot we created for a plot
output$ParameterPlot <-
renderPlot({
# Render the graph
graph.title <- "Parameter Data Graph"
yaxis.label <- paste(unique(GraphRecords()$Parameter)," Value")
if (GraphRecordsRows() == 1)
{ ggplot(GraphRecords(), aes(Fdt_Date_Time, Parameter_Value, group = 1)) +
geom_point() +
labs(x = "Sample Date", y = yaxis.label, title = graph.title) +
theme(axis.text.x = element_text(angle = 90,vjust = 0.5, hjust = 1)) +
geom_text(aes(label = Parameter_Value), angle = 70, hjust = 0, vjust = -0.5, size = 3) }
else
{ ggplot(GraphRecords(), aes(Fdt_Date_Time, Parameter_Value, group = 1)) +
geom_point() +
geom_line()+
labs(x = "Sample Date", y = yaxis.label, title = graph.title) +
theme(axis.text.x = element_text(angle = 90,vjust = 0.5, hjust = 1)) +
geom_text(aes(label = Parameter_Value), angle = 70, hjust = 0, vjust = -0.5, size = 3) }
})
# Downloadable csv of selected dataset ----
output$downloadData <- downloadHandler(
filename = function() {
paste(unique(wqmdata()$Sta_ID), "_StationData.csv", sep = "")
},
content = function(file) {
write.csv(wqmdata(), file, row.names = FALSE)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
Related
This is my first shiny, and i'm trying to use ggplot to plot a graph. It's working on a normal R code but it's not showing anything on the UI when the app is running.
I want to plot the graph for a specific user, the first column of my dataset is named "User" and Users$User (yeah not a good name but since it's working i kept it for the moment) is a dataframe with every "user" choosable.
Since the ggplot function is used correctly (working in R), i think that the mistake is somewhere else, but i don't know where !
Here's what i currently have :
Server
library(shiny)
library(tidyverse)
library(dplyr)
library(ggplot2)
Total_Hit <- reactive({
Global_Perf_Data |> filter(User == input$boxer) |> filter(sequenceOutput!="Touché") |>
group_by(User, sequenceOutput)|> summarise(TotalDef=(n()*100)/180)
})
shinyServer(function(input, output) {
output$Performance_Globale <- renderPlot({
ggplot(Total_Hit, aes(fill=sequenceOutput, y=User, x= TotalDef, label=round(TotalDef))) + geom_bar(position="stack", stat="identity")+
geom_col() + labs(x = "Défense réussie en %", y = "") +
scale_x_continuous(labels = scales::percent_format(scale=1), breaks =breaks_width(10, 10), limits = c(0, 100))+
scale_fill_manual(name = "Type de défense", values = c("#4682B4", "#2F4F4F"))+
geom_text(size = 3, position = position_stack(vjust = 0.5), colour="white")
})
})
UI
library(shiny)
library(rAmCharts)
# Define UI for application that draws a histogram
shinyUI(
# navbarPage
navbarPage("REVEA",
# First tab individuel
tabPanel("Individuel",
fluidRow(
column(width = 3, wellPanel(
# selection of the boxer
radioButtons(inputId = "boxer", label = "Boxeur : ", choices = Users$User)
)),
# Show a plot of what the coach/Annabelle asked above here
column(width = 9,
tabsetPanel(
tabPanel('Performance globale',
plotOutput("Performance_Globale"),
div(textOutput("Résultat du pourcentage de réussite globale de défense réussie (esquive + esquive contre attaque)."), align = "center")
),
)
))
)
)
)
I'm working on a Shiny application. Part of it is to recommend to users a gallery of ML generated ggplot2 plots based on their own data (or example data from R packages). There will be at least 50 plots generated and displayed every for users to choose from, possibly many more.
My problem is that all plots are displayed at one time, with huge waiting times.
I would like to find a way to have them displayed one by one, as soon as one has been generated.
In the simple example below, instead of all 4 plots showing at one time, I'd like to have them shown individually as soon as they're ready.
ui <- fluidPage(
fluidRow(
splitLayout(
style = "height: 160px; text-align:center",
plotOutput("Mosaic_Plot1"), plotOutput("Mosaic_Plot2"), plotOutput("Mosaic_Plot3"), plotOutput("Mosaic_Plot4")
),
splitLayout(
style = "height: 40px; text-align:center",
actionButton("mosEdit1", "Edit this plot"), actionButton("mosEdit2", "Edit this plot"), actionButton("mosEdit3", "Edit this plot"),
actionButton("mosEdit4", "Edit this plot")
)
)
)
server <- function(input, output, session) {
output$Mosaic_Plot1 <- renderPlot({ggplot(data = diamonds, aes(carat, price)) + geom_point()}, width = 280, height = 160)
output$Mosaic_Plot2 <- renderPlot({ggplot(data = diamonds, aes(x = color, y = price, color = color)) + geom_point() + geom_jitter()}, width = 280, height = 160)
output$Mosaic_Plot3 <- renderPlot({ggplot(data = diamonds, aes(carat)) + geom_histogram()}, width = 280, height = 160)
output$Mosaic_Plot4 <- renderPlot({ggplot(data = diamonds, aes(depth, table)) + geom_point()}, width = 280, height = 160)
}
shinyApp(ui, server)
I tried several options with embedded uiOutputs, fillPage, ... but nothing worked so far.
Many thanks for any suggestions on how to make this work.
Sure, the trick is take control of the reactivity. We can use observe and invalidateLater to create a loop, and then output charts 1 by 1. Below is a minimal example:
library(shiny)
ui <- fluidPage(
selectInput("input_1", label = "input_1", choices = c(10, 20, 30)),
column(6,
plotOutput("plot_1"),
plotOutput("plot_2")
),
column(6,
plotOutput("plot_3"),
plotOutput("plot_4")
)
)
server <- function(input, output, session) {
#Function which produces plots
func_plot <- function(id) {
#Simulate long random processing time
Sys.sleep(sample(1:4, 1))
#Produce bar plot
barplot(seq(from = 1, to = isolate(input$input_1)), main = paste("Chart", id))
}
#Loop that runs once per second
counter <- 1
observe({
if(counter <= 4) {
if(counter == 1) {output$plot_1 <- renderPlot({func_plot(id = 1)})}
if(counter == 2) {output$plot_2 <- renderPlot({func_plot(id = 2)})}
if(counter == 3) {output$plot_3 <- renderPlot({func_plot(id = 3)})}
if(counter == 4) {output$plot_4 <- renderPlot({func_plot(id = 4)})}
counter <<- counter + 1
}
invalidateLater(1000)
})
#Watch for changes to inputs
observeEvent(input$input_1, {
#Optional: Clear plots before updating, to avoid having a mix of updated and un-updated plots
output$plot_1 <- renderPlot({NULL})
output$plot_2 <- renderPlot({NULL})
output$plot_3 <- renderPlot({NULL})
output$plot_4 <- renderPlot({NULL})
counter <<- 1
}, ignoreInit = TRUE)
}
shinyApp(ui, server)
I prepared rather simple shiny application which resembles the problem in my much more complex application.
The three necessary components of my application are:
The number, i.e. year, can be changed in two different ways: by 1) adding a value in the textInput or 2) by clicking the action button
When the year is changed by the actionButtion, it must automatically change current value in the textInput box
When the year is changed by the textInput, reactive value for the
action button must reset to zero.
I have two observeEvents which both target two reactive values. The problem is, if I click the actionButton several times too quickly, this creates a loop of switching between those two events.
Is there any efficient tool available in Shiny which help in such situations? E.g. to prevent users to click on the button prior the execution of task.
# import libraries
library(shiny)
library(ggplot2)
library(dplyr)
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
uiOutput("ui_year"),
uiOutput("ui_plus")
),
mainPanel(
plotOutput("plot1")
)
)))
server <- shinyServer(function(input, output) {
# Generate random data
data <- data.frame(
year = seq(1900, 2000),
value = runif(n = 101, min = -3, max = 3)
)
# Define two reactive values: add and year
rv <- reactiveValues()
rv$add <- 0
rv$year <- 2000
# render actionButton
output$ui_plus <- renderUI({
actionButton(inputId = "add",
label = paste0(""),
icon = icon("plus"))
})
# render textInput
output$ui_year <- renderUI({
textInput(inputId = "year_1", label = NULL,
value = eval(parse( text = rv$year)),
width = "100%",
placeholder = NULL)
})
# Define two observe events, based on A) action button and B) textInput
observeEvent(input$year_1, {
rv$year <- input$year_1
rv$add <- 0
})
observeEvent(input$add, {
rv$add <- rv$add + 1
rv$year <- as.numeric(rv$year) + 1
})
# Render output
output$plot1 <- renderPlot({
sumValue <- as.numeric(rv$year) + as.numeric(rv$add)
ggplot(data, aes(x = year, y = value)) + geom_line()+ annotate("text", x = -Inf, y = Inf, hjust = -0.2, vjust = 1, label = sumValue )
})
})
shinyApp(ui = ui, server = server)
I'm working on a Shiny app for a project where a ggplot is the main interface for the user. Depending on input from the sidebar, I'd like the app to record coordinates for two events: a single click (which I have working), or a double click (which is where I'm stuck). Essentially, I'd like to be able to create a way to record a starting and ending point based on sidebar conditions. Here's a brief example:
library(shiny)
library(ggplot2)
ui = pageWithSidebar(
headerPanel("Example"),
sidebarPanel(
radioButtons("color", "Pick Color", c("Pink", "Green", "Blue")),
selectInput("shape", "Select Shape:", c("Circle", "Triangle"))
),
mainPanel(
fluidRow(column(width = 6,
h4("Click plot to add points"),
plotOutput("plot1", click = "plot_click"),
actionButton("rem_point", "Remove Last Point")),
column(width = 6,
h4("Table of points on plot"),
tableOutput("table")))
)
)
server = function(input, output){
values = reactiveValues()
values$DT = data.frame(x = numeric(),
y = numeric(),
color = factor(),
shape = factor())
output$plot1 = renderPlot({
ggplot(values$DT, aes(x = x, y = y)) +
geom_point(aes(color = color,
shape = shape), size = 5) +
lims(x = c(0, 100), y = c(0, 100)) +
theme(legend.position = "bottom") +
scale_color_discrete(drop = FALSE) +
scale_shape_discrete(drop = FALSE)
})
observeEvent(input$plot_click, {
add_row = data.frame(x = input$plot_click$x,
y = input$plot_click$y,
color = factor(input$color, levels = c("Pink", "Green", "Blue")),
shape = factor(input$shape, levels = c("Circle", "Triangle")))
values$DT = rbind(values$DT, add_row)
})
observeEvent(input$rem_point, {
rem_row = values$DT[-nrow(values$DT), ]
values$DT = rem_row
})
output$table = renderTable({
values$DT[, c('color', 'shape')]
})
}
shinyApp(ui, server)
In this example, when the user selects Green or Blue, I'd like to only record the single click as the starting point and record NA for the end point. When they select Pink, I'd like to record the single click as the starting point and the double click as the ending point. Any help would be greatly appreciated!
(Example created by #blondeclover on a question from earlier.)
Found a solution! Just create an observeEvent() to observe a double click and update values$DT with the new information.
Issue:
I'm interested in displaying three graphs in a shiny web app. I have written three functions to graph each type of plot for a specified range. The function's parameter takes a input parameter, region, and subsets the larger data.frame for that specified region and subsequently graphs it.
I'm having difficulty passing this function into an r-shiny reactive element.
Here is my function:
plot_30cumulative <- function(enter_region) {
subset <<- HPF[HPF$region == enter_region, ]
thirty_year_cumulative <<- ggplot(subset, aes(x=subset$date)) +
geom_line(aes(y = subset$BaseCumulative, color = "Base"), color = "green") +
geom_line(aes(y = subset$StressCumulative, color = "Adjusted"), color = "red", linetype = "dashed") +
theme_bw() +
scale_x_date(name = "",
date_labels = "%Y-%m-%d",
limits = as.Date(c("2014-02-15", "2044-02-15")),
breaks = seq(as.Date("2014-02-15"), as.Date("2044-02-15"), by = "1 year")) +
scale_y_continuous(name = "Cumulative Growth Rates",
breaks = seq(min(subset$StressCumulative),max(subset$BaseCumulative), .25),
limits = c(NA, 4), # Temporarily hard-coded for better visability.
labels = percent) +
theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
ggtitle("Cumulative 30-Year Growth Rates")
What I Want in Shiny:
library(shiny)
#Define UI for dataset
ui <- fluidPage(
#App title ----
titlePanel("Home Price Forecasting under Stress Scenarios"),
sidebarLayout(
sidebarPanel(
#Input: Stress Path Function Parameters ----
#Input: Numeric entry for region to plot ----
numericInput(inputId = "region",
label = "Enter Region Number:",
value = "1",
min = 1,
max = 110)
),
# Main panel for displaying outputs ----
mainPanel(plotOutput(outputId = "ThYrC"),
plotOutput(outputId = "FiYrC"),
plotOutput(outputId = "FoYrQtr")
)
)
)
#Define server logic to summarize and view selected dataset ----
server <- function(input, output){
output$ThYrC <- renderPlot({reactive(plot_30cumulative(enter_region == input$region)}))
}
# Run the application ----
shinyApp(ui = ui, server = server)
Problem:
I can't seem to pass the function parameter, enter_region, to the reactive element by input$region == enter_region.
Any insight into this issue would be much appreciated!