isolate input in a module shiny when using insert ui - shiny

I'd like to create several ui which use an input parameter. The problem is that the new UI created are still reacting to the input even when I put an isolate()
The right behaviour would give a custom UI created and isolated from the new inputs coming from the selectInput()
For instance I'd like a first UI with the year 2019 selected and second UI with the year 2020.
Here we can see that adding 2020 will change in each UI which is wrong.
library(shiny)
customplotUI <- function(id){
ns <- NS(id)
fluidPage(
sidebarPanel(id=ns("sidebarpanel"),
actionButton(ns("add"),label = "Add"),
selectInput(inputId=ns("years"),label="Year :", choices = c(2019,2020),selected = 2019, multiple = TRUE)),
mainPanel(div(id=ns("placeholder"))
)
)
}
customplot <- function(input,output,session){
ns <- session$ns
output$res <- renderPrint({
data <- data.frame(year=c(2019,2020),value=c("mtcars2019","mtcars2020"))
data[data$year %in% input$years,]})
ctn <- reactiveVal(0)
Id <- reactive({
function(id){
paste0(id, ctn())
}
})
IdNS <- reactive({
function(id){
ns(paste0(id, ctn()))
}
})
observeEvent(input$add, {
ctn(ctn() + 1)
print(Id()('div'))
insertUI(
selector = paste0('#', ns('placeholder')),
ui = div(
id = Id()('div'),
verbatimTextOutput(IdNS()('chart'))
)
)
id <- Id()('chart')
output[[id]] <- renderPrint({
data <- data.frame(year=c(2019,2020),value=c("mtcars2019","mtcars2020"))
#data[data$year %in% isolate(input$years),]
data[data$year %in% input$years,]
})
})
}
ui <- fluidPage(
customplotUI(id="customplot")
)
server <- function(input, output, session){
callModule(customplot,id="customplot",session=session)
}
shinyApp(ui, server)

Perhaps I'm misunderstanding what you're trying to accomplish, but when I run the code, using the commented line with isolate seems to work as intended.
I'm guessing that in creating the minimal reprex (thank you for doing this btw!), you might have gone a little too minimal and removed another reactive that updates data. If you are trying to have the individual UI elements update based on some other input but keep the same filtering scheme, you need to capture the current value of input$years outside of the renderPrint statement.
Here you can see the subset of rows is unchanged, but the last column updates based on input box:
...
id <- Id()('chart')
targetYears <- input$years
output[[id]] <- renderPrint({
data <- data.frame(year=c(2019,2020),
value=c("mtcars2019","mtcars2020"),
yrInput = paste(input$years, collapse =" "))
data[data$year %in% targetYears, ]
...
isolate only prevents a change in the reactive from triggering an update. If the update is triggered by something else, the current/updated value of the reactive is still used. Through the wonders of R's scoping rules, by capturing the value of input$years in non-reactive variable, targetYears, outside of the renderPrint call and then using that in the renderPrint expression it will always use the the value of the input when output[[id]] was created. The isolate is not needed as you are using observeEvent which will prevent the observer from executing when you change the input.

Related

R shiny: Updating mulitple areas of the interface with single renderUI

I am creating a shiny dashboard. I have a single selectInput that will update multiple places in the UI. Currently I am having to us multiple renderUI functions to do this. I was wondering whether there was a way to only use 1. For example I have this:
output$fig_con_1 <- renderUI({
commodity_impact_graph(l_impact_val)
})
output$tab1 <- renderUI({
includeHTML(wetland_path)
})
output$tab2 <- renderUI({
includeHTML(river_path)
})
I wish to achieve something akin to this:
output[all areas of the UI] <- renderUI({
commodity_impact_graph(l_impact_val)
includeHTML(wetland_path)
includeHTML(river_path)
})
Try this
output$all <- renderUI({
tagList(
commodity_impact_graph(l_impact_val)
includeHTML(wetland_path)
includeHTML(river_path)
)
})

How do I access the date from an rShiny dateInput?

I am trying to write an input page that takes the date of a section's last training, then calculates the currency of that training (how many days since), but I seem to be having a problem accessing the date from the dateInput element. I'm currently just trying to get it to print, but it is eluding me. Is there something I'm missing, or how can I get this to work? I've commented out the code to (hopefully) calculate the date gap, as I haven't had a date to work through that just yet. If you see an issue there, I'd appreciate that pointer as well.
Thank you!
library(shiny)
ui <- fluidPage(
tags$h3("Section Training"),
dateInput("section_Last_Training",
"When was your last training course?",
daysofweekdisabled = c(0, 6),
max = Sys.Date()
),
)
server <- function(input, output, session) {
section_Last_Training <- reactive({
# dateGap = as.character(difftime(Sys.time(), input$section_Last_Training, units = "days"))
print(input$section_Last_Training)
})
}
shinyApp(ui, server)
It is working, just make sure the last value in reactive is the value you want to assign to the reactive. You can do print, but do it before your gap calculation. Another thing is reactive is "lazily" evaluated. It means if there is no downstream reactivity requires it, it will not be calculated. So you need to add some events that require this reactive to make it work. See the code below.
library(shiny)
ui <- fluidPage(
tags$h3("Section Training"),
dateInput("section_Last_Training",
"When was your last training course?",
daysofweekdisabled = c(0, 6),
max = Sys.Date()
),
)
server <- function(input, output, session) {
section_Last_Training <- reactive({
print(input$section_Last_Training)
as.character(difftime(Sys.time(), input$section_Last_Training, units = "days"))
})
observe(print(section_Last_Training()))
}
shinyApp(ui, server)

Click on marker to open plot / data table

I'm working on leaflet with shiny. The tools is basic, i have a map with some markers (coming from a table with LONG and LAT).
What I want to do is to open a table or a graph when i click on the marker.
Is there a simple way to do it?
Do you have a really simple example: you have a maker on a map, you click on the marker, and there is a plot or a table or jpeg that s opening?
Here is another example, taken from here and a little bit adapted. When you click on a marker, the table below will change accordingly.
Apart from that, a good resource is this manual here:
https://rstudio.github.io/leaflet/shiny.html
library(leaflet)
library(shiny)
myData <- data.frame(
lat = c(54.406486, 53.406486),
lng = c(-2.925284, -1.925284),
id = c(1,2)
)
ui <- fluidPage(
leafletOutput("map"),
p(),
tableOutput("myTable")
)
server <- shinyServer(function(input, output) {
data <- reactiveValues(clickedMarker=NULL)
# produce the basic leaflet map with single marker
output$map <- renderLeaflet(
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addCircleMarkers(lat = myData$lat, lng = myData$lng, layerId = myData$id)
)
# observe the marker click info and print to console when it is changed.
observeEvent(input$map_marker_click,{
print("observed map_marker_click")
data$clickedMarker <- input$map_marker_click
print(data$clickedMarker)
output$myTable <- renderTable({
return(
subset(myData,id == data$clickedMarker$id)
)
})
})
})
shinyApp(ui, server)
There is a leaflet example file here:
https://github.com/rstudio/shiny-examples/blob/ca20e6b3a6be9d5e75cfb2fcba12dd02384d49e3/063-superzip-example/server.R
# When map is clicked, show a popup with city info
observe({
leafletProxy("map") %>% clearPopups()
event <- input$map_shape_click
if (is.null(event))
return()
isolate({
showZipcodePopup(event$id, event$lat, event$lng)
})
})
Online demo (see what happens when you click on a bubble):
http://shiny.rstudio.com/gallery/superzip-example.html
On the client side, whenever a click on a marker takes place, JavaScript takes this event and communicates with the Shiny server-side which can handle it as input$map_shape_click.

Use Shiny to display bar graph by state

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.

How to get choices values of SelectInput in Shiny?

How can I get the list of choices in a SelectInpute?
ui.R
selectInput(inputId = "select_gender",
label = "Gender",
choices = c("Male","Female"),
width = 150
)
server.R
# Something like...
genders <- input$select_gender["choices"]
# So that the gender would be:
> genders
[1] Male Female
From the scoping rules of Shiny:
Objects defined in global.R are similar to those defined in app.R outside of the server function definition, with one important difference: they are also visible to the code in the ui object. This is because they are loaded into the global environment of the R session; all R code in a Shiny app is run in the global environment or a child of it.
However, this doesn't mean that objects defined in the app.R can't be used on both the UI and Server side, they just belong to a different environment.
For example:
library("shiny")
library("pryr")
# or in global.R
genders <- c("Male", "Female")
gen_env <- where("genders")
par_env <- parent.env(gen_env)
ui <- fluidPage(
selectInput("shiny_gender", "Select Gender", choices = genders),
verbatimTextOutput("selected_gender_index"),
p("The `genders` object belongs to the environment:"),
verbatimTextOutput("gen_env_print"),
p("Which is the child of the environment:"),
verbatimTextOutput("par_env_print")
)
server <- function(input, output) {
output$selected_gender_index <- renderPrint({
# use the 'genders' vector on the server side as well
which(genders %in% input$shiny_gender)
})
output$gen_env_print <- renderPrint(gen_env)
output$par_env_print <- renderPrint(par_env)
}
shinyApp(ui = ui, server = server)
I've looked for get choices of selectinput but without recompute the choices. For example if the datas come from database, or file or other source.
And I didn't get answer. (I get this question but not the solution for me).
Here is ma solution which also could set the selectinput from the server:
set the choices list in a reactive function
build the selectinput in the server side (with the choices list reactive function)
set and get the selectinput in the server side
Here is the code
options(encoding = "UTF-8")
library("shiny")
library("pryr")
ui <- fluidPage(
uiOutput("shiny_gender.UI"),
verbatimTextOutput("selected_gender_index"),
p("The `genders` object belongs to the environment:"),
verbatimTextOutput("gen_env_print"),
p("Which is the child of the environment:"),
verbatimTextOutput("par_env_print"),
p(""),
textInput("set_input_txt","Set the car in letter (for example `Datsun 710`)",
#" Set the Select Input Male / Female ",
""),
actionButton("submit","submit")
)
server <- function(input, output, session) {
observeEvent(
c(input$submit),
{
if (input$submit>0) {
updateSelectInput(session, "shiny_gender",
# server = TRUE, if updateSelectizeInput
choices =shiny_gender.list(),
selected = input$set_input_txt
)
}
}
)
shiny_gender.list <- reactive ({
#c("Male", "Female")
rownames(mtcars)
})
output$shiny_gender.UI <- renderUI({
selectInput( "shiny_gender",
label="Select car",#"Select Gender",
choices =shiny_gender.list()
)
})
output$selected_gender_index <- renderPrint({
which(shiny_gender.list() %in% input$shiny_gender)
})
output$gen_env_print <- renderPrint(where("shiny_gender.list"))
output$par_env_print <- renderPrint(parent.env( where("shiny_gender.list")))
}
shinyApp(ui = ui, server = server)