Develop Reference

Shiny plot not rendering in client-side dynamic UI

I'm trying to render some UI elements in Shiny on the client side using Javascript. I want the user to click a button which reveals a hidden panel. Once the panel is revealed, it should show a plot. When the button is clicked the panel becomes visible but the plot doesn't render.
I know this behaviour is achievable using server-side functions like observeEvent but the goal here is to leverage the client directly via JS.
Below is a reprex. For ease, I've inlined the JS and CSS.
library(shiny)
# Inline js to toggle display of element when button is clicked
js <- '
$(document).ready(function() {
document.getElementById("reveal").addEventListener("click", event => {
var panel = document.getElementById("init-hidden-panel");
panel.style.display = "block";
});
})
'
ui <- fluidPage(
tags$script(HTML(js)),
actionButton("reveal", "Reveal"),
div(
id = "init-hidden-panel",
plotOutput("plot"),
style = "display: none; background-color: darkgray" # initialize element as hidden
)
)
server <- function(input, output) {
output$plot <- renderPlot({
hist(iris$Sepal.Length)
})
}
# Run the application
shinyApp(ui = ui, server = server)
We can tell that the JS is in fact toggling the display because the gray background appears.

Perhaps you can use this method:
ui <- fluidPage(
actionButton("reveal", "Reveal"),
plotOutput("plot")
)
server <- function(input, output) {
plot_data <- reactiveValues(trigger = 0)
observe({
req(input$reveal)
isolate(plot_data$trigger <- plot_data$trigger + 1)
})
output$plot <- renderPlot({
input$reveal
if (plot_data$trigger %% 2 == 0) {
return(NULL)
} else {
hist(iris$Sepal.Length)
}
})
}
# Run the application
shinyApp(ui = ui, server = server)

Vectors of latitude and longitude in geolocation app in shiny

I am building and app, that includes geolocation captures using the geoloc package
This is an example app:
library(shiny)
library(leaflet)
library(geoloc)
ui <- fluidPage(
h2("Where Am I?"),
tags$p("Click the button to get your location"),
geoloc::button_geoloc("myBtn", "Get my Location"),
tags$br(),
textOutput("coords"),
textOutput("col"),
leafletOutput("lf")
)
server <- function(input, output) {
output$coords <- renderText(paste(input$myBtn_lat, input$myBtn_lon, sep = ", "))
Lats <- reactiveValues(Lat = NULL)
observeEvent(input$myBtn_lat, {
Lats$Lat <- append(Lats$Lat, input$myBtn_lat)
})
output$col <- renderText({
Lats$Lat
})
output$lf <- renderLeaflet({
req(input$myBtn_lon)
req(input$myBtn_lat)
leaflet() %>%
addTiles() %>%
setView(as.numeric(input$myBtn_lon), as.numeric(input$myBtn_lat), zoom = 17) %>%
addMarkers(as.numeric(input$myBtn_lon), as.numeric(input$myBtn_lat), label = "You're here!")
})
}
shinyApp(ui, server)
I have two questions for this:
How to get a vector of latitudes and longitudes with the button
I need this because usually, we like to take 4 or 5 times the location and then use the median.
This has been addressed in this question, however, there are some kinks I can't figure out since the button is a custom one, and the inputs are not input$myBtn, but input$myBtn_lat and input$myBtn_lon, I find it hard to compute. This is what I am trying to do with the observe events
How to transform this into shiny modules
This will go to a larger shiny app, so I would love to generate modules for this, but again, the facto that the input in ui is "myBtn", but then in the server I have 2 inputs (MyBtn_lon and MyBtn_lat), make it very hard to figure out
Any help is welcome

How about the following code with Shiny modules? I tested and it worked.
library(shiny)
library(leaflet)
library(geoloc)
mapUI <- function(id, label = "Location in map"){
ns <- NS(id)
tagList(
geoloc::button_geoloc(ns("myBtn"), "Get my Location"),
tags$br(),
textOutput(ns("coords")),
textOutput(ns("col")),
textOutput(ns("md")), # for median latitude
leafletOutput(ns("lf"))
)
}
mapServer <- function(id){
moduleServer(
id,
function(input, output, session){
output$coords <- renderText(paste(input$myBtn_lat, input$myBtn_lon, sep = ", "))
Lats <- reactiveValues(Lat = NULL)
observeEvent(input$myBtn, {
Lats$Lat <- c(Lats$Lat, input$myBtn_lat)
})
output$col <- renderText({
Lats$Lat
})
# add median latitude
output$md <- renderText({
req(input$myBtn_lat)
if(length(Lats$Lat) %% 5 == 0){
paste0("Median latitute is: ", median(Lats$Lat))
}
})
output$lf <- renderLeaflet({
req(input$myBtn_lon)
req(input$myBtn_lat)
leaflet() %>%
addTiles() %>%
setView(as.numeric(input$myBtn_lon), as.numeric(input$myBtn_lat), zoom = 17) %>%
addMarkers(as.numeric(input$myBtn_lon), as.numeric(input$myBtn_lat), label = "You're here!")
})
}
)
}
ui <- fluidPage(
h2("Where Am I?"),
tags$p("Click the button to get your location"),
mapUI("map1")
)
server <- function(input, output, session) {
mapServer("map1")
}
shinyApp(ui, server)

You should click "myBtn", not "myBtn_lat". So try change observeEvent(input$myBtn_lat to observeEvent(input$myBtn.
In addition, what is the purpose to take 4 or 5 times the location? The coordinates do not change or change very little every time you click the button.

R Shiny: Check a Regular expression in textInput on UI

Is this possible when a user input something on textInput to against a regular expression and give a warning.
Such that the textInput area expects: [1-5]GH[0-9]
But when the input is: 5UK8
The warning should be: Check your input
I think this can be done using JS inside UI, but is there any Shiny trick? Or if you can help with a java script.
ui <- fluidPage(
textInput("id", "Enter your ID",),
verbatimTextOutput("value")
)
server <- function(input, output) {
output$value <- renderText({ input$id })
}
shinyApp(ui, server)

Maybe with shinyFeedback ?
library(shiny)
library(shinyFeedback)
ui <- fluidPage(
useShinyFeedback(),
textInput("id", "Enter your ID",),
verbatimTextOutput("value")
)
server <- function(input, output) {
observeEvent(input$id, {
feedbackWarning(
"id",
condition = !grepl("[1-5]GH[0-9]", input$id)
)
})
output$value <- renderText({ input$id })
}
shinyApp(ui, server)

How to get the cursor position in a Shiny textareaInput

does anyone know how I can, inside a shiny application, get the cursor position inside a textAreaInput ?
library(shiny)
ui <- fluidPage(
textAreaInput("hop"
,label="textarea",value = "Supercalifragilisticexpialidocious"),
verbatimTextOutput("out")
)
server <- function(input, output, session) {
output$out <- renderText({
"here I would like to get the cursor position (an interger?) \n inside que textArea"
})
}
shinyApp(ui, server)
I think I have to use javascript, but I don't know where to start.
Regards

this is a solution I found :
library(shiny)
ui <- fluidPage(tags$head(tags$script(
'Shiny.addCustomMessageHandler("prout",
function(NULL) {
var ctl = document.getElementById("hop");
var startPos = ctl.selectionStart;
var endPos = ctl.selectionEnd;
alert(startPos + ", " + endPos);
});'
)),
textAreaInput("hop"
,label="textarea",value = "Supercalifragilisticexpialidocious"),
verbatimTextOutput("out"),
actionButton("hop","hop")
)
server <- function(input, output, session) {
output$out <- renderText({
"here I would like to get the cursor position (an interger?) \n inside que textArea"
})
observeEvent(input$hop,{
message("hop")
session$sendCustomMessage(type="prout",message=list(NULL))
})
}
shinyApp(ui, server)

Autoclose date range input shiny

I want the date picker to autoclose after a date is selected. I know how to do it when the daterangeinput is rendered directly in the ui but not when it is created in the server.
Here is my code.
library('shiny')
js_string <- "$('#dates input').bsDatepicker({autoclose: true});"
shinyApp(
ui = fluidPage(
tags$head(tags$script(HTML('Shiny.addCustomMessageHandler("jsCode", function(message) { eval(message.value); });'))),
includeScript("code.js"),
fluidRow(
column(4,
uiOutput(outputId = 'dateui'),
verbatimTextOutput("datesOut")
)
)
),
server = function(input, output, session) {
output$dateui <- renderUI({
dateRangeInput("dates", label = h3("Date range"))
})
session$onFlushed(function() {
session$sendCustomMessage(type = 'jsCode', list(value = js_string))
})
output$datesOut <- renderPrint({ names(session) })
}
)
$('#dates input').bsDatepicker({autoclose: true}); works well if the daterange is created in the ui directly as shown in following code. Besides this code also works well if I want to disable keyboard input with $('#dates').attr('onkeydown', 'return false');.
library('shiny')
shinyApp(
ui = fluidPage(
includeScript("code.js"),
fluidRow(
column(4,
dateRangeInput("dates", label = h3("Date range")),
verbatimTextOutput("datesOut")
)
)
),
server = function(input, output, session) {
output$datesOut <- renderPrint({ input$dates })
}
)
With the js code
$(document).ready(function(){
$('#dates input').bsDatepicker({autoclose: true});
});
My question is related to another question I posted.
I also tried $('#dates input').datepicker({autoclose: true}); but it does not work. I know that $(document).ready(function() ... cannot work as the code will be launched once the document is ready hence before the daterange is rendered.
Edit:
I also tried using shinyjs but it does not work either.
library('shiny')
library('shinyjs')
jsCode <- "shinyjs.changeDate = function(){
$('#dates input').bsDatepicker({autoclose: true});
$('#dates').attr('onkeydown', 'return false');
}"
shinyApp(
ui = fluidPage(
useShinyjs(),
extendShinyjs(text = jsCode),
fluidRow(
column(4,
uiOutput(outputId = 'dateui'),
verbatimTextOutput("datesOut")
)
)
),
server = function(input, output, session) {
output$dateui <- renderUI({
dateRangeInput("dates", label = h3("Date range"))
})
session$onFlushed(function() {
js$changeDate()
})
}
)
I am stuck here, any help is greatly appreciated.
Cheers
Edit2: Adding my session info
R version 3.4.4 (2018-03-15)
Platform: x86_64-apple-darwin15.6.0 (64-bit)
Running under: macOS High Sierra 10.13.3
Matrix products: default
BLAS: /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libBLAS.dylib
LAPACK: /Library/Frameworks/R.framework/Versions/3.4/Resources/lib/libRlapack.dylib
locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] shinyjs_1.0 shiny_1.0.5 V8_1.5
loaded via a namespace (and not attached):
[1] compiler_3.4.4 R6_2.2.2 htmltools_0.3.6 tools_3.4.4 curl_3.1
[6] yaml_2.1.18 Rcpp_0.12.16 digest_0.6.15 jsonlite_1.5 xtable_1.8-2
[11] httpuv_1.3.6.2 mime_0.5

This is a bit hacky but it works using JQuery:
tags$head(
tags$script(HTML("setInterval(
function checkContainer () {
if($('.datepicker-days').is(':visible')){ //if the container is visible on the page
$(function () {
$('td.day').click(function () {
$('.dropdown-menu').hide()
});
});
} else {
setTimeout(checkContainer, 50); //wait 50 ms, then try again
}
},
50 /* 10000 ms = 10 sec */
);"))
)
All you need to do is add this to the tags$head function within fluidpage of your ui.
This works if the last user input is selecting the day.
If your dateRangeInput is limited to choosing the month, then all you have to do is edit '.datepicker-days' to '.datepicker-months' and change '.td.day' to '.td.month'. If you're limiting to a year; change days to years and change day to year.
The reason as to why it's hacky is because the JQuery script is being redeployed every 50ms so as to check if the datepicker-days class is visible...but it works.