I am developing a simple web app using the Interactive Document approach with R_Markdown and Shiny. I have a series of input UI objects that get the user options, each of these modifies the next in a chain, and the final one triggers the output (a chart). So I have
A map, which when clicked defines the
Seasons of data available, when one is selected it gives the
Soil types in the data, when one or more are selected it gives the
Elevation classes in the data, when one is selected we then calculate and draw the
Output chart of the selected data.
So for example there are drop down lists to choose the season and soil(s):
output$season_selector <- renderUI({
cat(file=stderr(), paste("render season selector"), "\n")
selectInput("season", h4("Season?"), my$season_here, selected=my$season_sel)
})
output$soil_selector <- renderUI({
cat(file=stderr(), paste("render soil selector"), "\n")
selectInput("soil", h4("Soils?"), my$soil_here, selected=my$soil_sel,
selectize=FALSE, multiple=TRUE)
})
I observe input$season, and this triggers an update of the "soil" UI element.
observeEvent(input$season, {
...
# reset soil list and default soil selected
my$soil_sel <- my$soil_here
updateSelectInput(session, "soil", choices=my$soil_here, selected=my$soil_sel)
})
However, this does invalidate input$soil (although the UI element options and selection have changed, the user has not made a selection), and so the next step in the cascade doesn't trigger:
observeEvent(input$soil, {
...
# reset elev list and default elev selected
my$soil_sel <- my$soil_here
updateSelectInput(session, "soil", choices=my$soil_here, selected=my$soil_sel)
})
How do I achieve a cascade of reactive UI elements like this? Each reaction needs to trigger either when the UI options and selection changes or when the user makes a different selection. Thanks.
Ok, I think I've fixed it. I needed to use the following pattern, which resets variables further down the chain, and doesn't respond to user inputs unless the value has changed. This avoids duplicate or missing events.
# reset selections
my$soil_default <- my$soil_here
my$soil <- my$soil_default
my$elev <- list(NA)
}) # end reaction to season changing
observeEvent(input$soil, {
req(input$soil, input$soil!="NA")
if (any(my$soil != input$soil)) {
my$soil <- input$soil
my$elev <- list(NA)
}
})
#### react to change of soil ####
observeEvent(my$soil, {
cat(file=stderr(), "\n")
cat(file=stderr(), paste("change of my$soil = "))
cat(file=stderr(), paste(my$soil), "\n")
req(my$soil, my$soil!="NA")
Related
I am having trouble transitioning my map from static to reactive so a user can select what data they want to look at. Somehow I'm not successfully connecting the input to the dataframe. My data is from a shapefile and looks roughly like this:
NAME Average Rate geometry
1 Alcona 119.7504 0.1421498 MULTIPOLYGON (((-83.88711 4...
2 Alger 120.9212 0.1204398 MULTIPOLYGON (((-87.11602 4...
3 Allegan 128.4523 0.1167062 MULTIPOLYGON (((-85.54342 4...
4 Alpena 114.1528 0.1410852 MULTIPOLYGON (((-83.3434 44...
5 Antrim 124.8554 0.1350004 MULTIPOLYGON (((-84.84877 4...
6 Arenac 127.8809 0.1413534 MULTIPOLYGON (((-83.7555 43...
In the server section below, you can see that I tried to use reactive to get the selected variable and when I write print(select) it does print the correct variable name, but when I try to put it into the colorNumeric() function it's clearly not being recognized. The map I get is all just the same shade of blue instead of different shades based on the value of the variable in that county.
ui <- fluidPage(
fluidRow(
selectInput(inputId="var",
label="Select variable",
choices=list("Average"="Average",
"Rate"="Rate"),
selected=1)
),
fluidRow(
leafletOutput("map")
)
)
server <- function(input, output, session) {
# Data sources
counties <- st_read("EITC_counties.shp") %>%
st_transform(crs="+init=epsg:4326")
counties_clean <- select(counties, NAME, X2020_Avg., X2020_Takeu)
counties_clean <- counties_clean %>%
rename("Average"="X2020_Avg.",
"Rate"="X2020_Takeu")
# Map
variable <- reactive({
input$var
})
output$map <- renderLeaflet({
select <- variable()
print(select)
pal <- colorNumeric(palette = "Blues", domain = counties_clean$select, na.color = "black")
color_pal <- counties_clean$select
leaflet()%>%
setView( -84.51, 44.18, zoom=5) %>%
addPolygons(data=counties_clean, layerId=~NAME,
weight = 1, smoothFactor=.5,
fillOpacity=.7,
fillColor=~pal(color_pal()),
highlightOptions = highlightOptions(color = "white",
weight = 2,
bringToFront = TRUE)) %>%
addProviderTiles(providers$CartoDB.Positron)
})
}
shinyApp(ui, server)
I've tried making the reaction into an event and also using the observe function using a leaflet proxy but it only produced errors. I also tried to skip the reactive definition and just put input$var directly into the palette (counties_clean$input$var), but it similarly did not show any color variation.
When I previously created a static map setting the palette using counties_clean$Average it came out correctly, but replacing Average with a user input is where I appear to be going wrong. Thanks in advance for any guidance you can provide and please let me know if I can share any additional clarification.
Unfortunately, your code is not reproducible without the data, but the mistake is most likely in this line
color_pal <- counties_clean$select
What this line does, is to extract a column named select from your data. This column is not existing, so it will return NULL.
What you want though, is to extract a column whose name is given by the content of select, so you want to try:
color_pal <- counties_clean[[select]]
I'm trying to use shiny to create a bar graph for a state that is selected via drop-down box. I'm quite new to R and I've tried a variety of examples to no avail. I have three variables (state, claim #, total $) and for each state there are five values. So something like this:
state <- c("PA", "TX", "NY")
claim_num <- c(1:15)
total <- sample(1000:5000, 15)
df <- (state, claim_num, total)
I want to have something similar to https://beta.rstudioconnect.com/jjallaire/shiny-embedding/#inline-app but I don't know if I can format my data in that was since I would have a lot of NAs.
Do you mean something like this (you can download and run the example)?
library(shiny)
ui <- shinyUI(
fluidPage(
titlePanel("Sample Shiny App"),
sidebarLayout(
sidebarPanel(
uiOutput("stateInput")
),
mainPanel(
plotOutput("statePlot")
)
)
))
server <- shinyServer(function(input, output) {
state <- sample(state.abb, 3, replace = FALSE)
total <- sample(1000:5000, 15)
claimNumber <- 1:15
data <- data.frame(state, total, claimNumber)
output$stateInput <- renderUI({
selectInput(
inputId = "state",
label = "Select a State:",
choices = levels(data$state)
)
})
output$statePlot <- renderPlot({
hist(data$total[data$state == input$state])
})
})
shinyApp(ui = ui, server = server)
What we're doing is taking the list of unique states available in our data frame and passing those to our selectInput that renders as a dropdown in the UI. From here, we can access whatever value the user has selected through the input$state object. More generally, we can access inputs based on whatever we define the inputId to be (in this particular case, we call it state).
Having grabbed the user input, we can then subset the data frame to only return values that correspond to the user-defined state and, in this case, pass those totals values to a plot that we render as output.
Given pseduo-like code:
dateRange <- reactive({
input$select_dates #action button
save_selected_date_range()
isolate(input$dateRange)
})
customerId <- reactive({
#check if customer has saved date range if so trigger
saved_info <- saved_preferences(input$customerId)
if(nrow(saved_info) > 0) {
flog.info(saved_info)
updateDateRangeInput(session, "dateRange", start = saved_info$start, end = saved_info$start)
}
input$customerId
})
The scenario:
Inputs:
A selected date range and customer selector. The date range is registered when the action button is pressed.
Desired Action:
We would like the ability to load saved date ranges if available when a customer is picked.
Question:
How do I trigger the input$select_dates as if the action button was pushed? Something like invalidateLater without the timer would be nice. Or if there is a manual way to mark or flag the input$select_dates as invalidated.
Define a reactive value
rv <- reactiveValues( v = 0)
put it inside your reactive expression
dateRange <- reactive({
rv$v
input$select_dates #action button
save_selected_date_range()
isolate(input$dateRange)
})
just change the value of rv$v (like rv$v <- rv$v + 1) in any part of your code and the dateRage expression will be invalidated.
I am trying to develop a very basic shiny app. The ui script is very simple
shinyUI(fluidPage(
titlePanel("Drawing a Dice"),
sidebarLayout(
sidebarPanel(
actionButton("action", label = "Draw"),
),
mainPanel(
textOutput("text1")
)
)
))
But i am not sure how to go about doing the server. R
I need the server.R to do the following: Every time the user clicks on draw,it draws a random number from 1:6 and fills the 1st cell of a 10 cell array. And for every click on done till 10 ,it repeats the job. The eventual outcome will be a length 10 vector with random numbers between 1 to 6. In need to give the user an option of exiting by clicking on finish. But i need to be able to retrieve the final resultant vector after closing the app.
Hence the server.R needs to perform the following operation in a one step increments
draw<-function(){
Dice<-c(1:6)
Mydraws<-numeric(10)
for(i in 1:10){
x<-sample(Dice,1,replace=TRUE)
Mydraws[i]=x
}
Mydraws
}
Hence ,i should be able to fetch the Mydraws vector even after user exits by clicking on finish(not included in ui.R)
I do not even know if its possible in shiny.
Here is one way to do it:
server.R
numbers <- list()
shinyServer(function(input, output)
{
output$array <- renderText({
# the presence of input$action will cause this to be evaluated each time the button is clicked
# the value gets incremented each time you click it, which is why we use it as the index of the list
random_number <- sample(1:6,1)
# add to the global variable
numbers[input$action] <<- random_number
return(random_number)
})
})
I developed a Shiny App with RStudio that takes input, performs a search of a look-up table, and then returns a value. The search is not supposed to be performed until the user hits the submit button. However, upon launch, the App automatically performs and returns the first set of values from the lookup table. After this initial search, the app works exactly as expected. Is it possible to suppress this initial search (or have a default value) and perform the search ONLY when the submit button is pressed? I can't present reproducible code, but here is the structure of my input (server.R) and my user-interface (ui.R) code:
#server.R snippet
output$Word <- renderText({
predictWord <- input$gram
predict.function(predictWord) #User-defined function in global.r file
})
#ui.R snippet
tabPanel("Word Prediction",
sidebarPanel(
textInput("gram", "Enter up to three words"),
submitButton("Predict")),
mainPanel(
h4("Word Prediction"),
textOutput("predictWord")))
One way would be to substitute actionButton in place of submitButton and wrap whichever component in an if statement. Here is a simple example to display a number only slightly modified from the Shiny Widget Gallery.
require(shiny)
runApp(list(
ui = pageWithSidebar(
headerPanel("actionButton test"),
sidebarPanel(
numericInput("n", "N:", min = 0, max = 100, value = 50),
br(),
actionButton("goButton", "Go!"),
p("Click the button to update the value displayed in the main panel.")
),
mainPanel(
verbatimTextOutput("nText")
)
),
server = function(input, output){
output$nText <- renderText({
# Take a dependency on input$goButton
if(input$goButton >= 1){
# Use isolate() to avoid dependency on input$n
isolate(input$n)
}
})
}
)
)