I have found a major flaw with the bookmarkButton() in Shiny. If you have any text inputs and do not enter anything in them, when you go to bookmark your app's state and restore it, it gives you an error:
Error in RestoreContext initialization: Failed to parse URL parameter "txt"
This is because the URL that the bookmarkButton() creates always has the value of text inputs between %22s. When there's no input, the URL looks like this ...TextInputID=%22%22. If you enter something in the text input the URL will look something like ...TextInputID=%22foo%22.
See this example app to reproduce this error. Is there a way around this? Maybe a way to get in there and edit the URL that the bookmarkButton() produces?
ui <- function(request) {
fluidPage(
textInput("txt", "Enter text"),
checkboxInput("caps", "Capitalize"),
verbatimTextOutput("out"),br(),
sliderInput("slider", 'Choose a number:', 1, 100, 20),
verbatimTextOutput("sliderOut"),
bookmarkButton()
)
}
server <- function(input, output, session) {
output$out <- renderText({
if (input$caps)
toupper(input$txt)
else
input$txt
})
output$sliderOut <- renderText({
input$slider
})
}
shinyApp(ui, server, enableBookmarking = "url")
Related
In my shiny server I am figuring out the name of a markdown file which I want to show in the UI. I know how to pass the file name, as a string, back to the UI but I don't now how to tell includeMarkdown() to treat the string as a file name.
My code so far is below. Any advice?
library(shiny)
fileConn<-file("hello.md")
writeLines(c("# Hello","# World"), fileConn)
close(fileConn)
ui <- fluidPage(
includeMarkdown("hello.md"),
br(),
div("File name text:", textOutput("fileNameText", inline = TRUE)),
#includeMarkdown(fileNameText) # this needs help
)
server <- function(input, output, session) {
selectedName <- reactive({
paste0("hello.md") # this is actually more complicated...
})
output$fileNameText <- renderText(
paste0(selectedName())
)
}
shinyApp(ui = ui, server = server)
Your example code works fine, but from your description, I am thinking your asking how to pass a different filename to includeMarkdown() that was created somewhere else in the app, correct?
The first step is to understand includeMarkdown() as a UI element that will change depending on other UI elements (and stuff that happens in server). The solution is to use a placeholder in the ui to hold the place for the includeMarkdown() element, and create that particular element in server using renderUI.
Hopefully you can follow this example. I'm using uiOutput('displayFile') to hold the place for the element that's created in server.
library(shiny)
fileConn<-file("hello.md")
writeLines(c("# Hello","# World"), fileConn)
close(fileConn)
fileConn1<-file("goodbye.md")
writeLines(c("# Goodbye","# Everyone!"), fileConn1)
close(fileConn1)
ui <- fluidPage(
selectInput('file_selection', 'Choose Markdown File:', choices=c('hello.md','goodbye.md')),
uiOutput('displayFile')
)
server <- function(input, output, session) {
output$displayFile <- renderUI({
includeMarkdown(input$file_selection)
})
}
shinyApp(ui = ui, server = server)
I am trying to access the last clicked checkbox or button id from inside a Shiny module.
I have found the great response from this post helpful: R shiny - last clicked button id and have adapted the code to my question. I also took a hint from this post: https://github.com/datastorm-open/visNetwork/issues/241 but still can't get it working.
user_inputUI <- function(id){
# Create a namespace function using the provided id
ns <- NS(id)
tagList(
tags$head(tags$script(HTML("$(document).on('click', '.needed', function () {
Shiny.onInputChange('", ns("last_btn"), "', this.id);
});"))),
tags$span(HTML('<div><input id="first" type="checkbox" class="needed"></div>')),
actionButton(ns("second"), "Second",class="needed"),
actionButton(ns("third"), "Third",class="needed"),
actionButton(ns("save"), "save"),
selectInput(ns("which_"),"which_",c("first","second","third"))
)
}
update_options <- function(input, output, session) {
observeEvent(input$save,{
updateSelectInput(session,"which_",selected = input$last_btn)
})
return(reactive(input$last_btn))
}
ui <- shinyUI(fluidPage(
titlePanel("Track last clicked Action button"),
sidebarLayout(
sidebarPanel(
user_inputUI("link_id")
),
mainPanel(
textOutput("lastButtonCliked")
)
)
))
server <- shinyServer(function(input, output,session) {
last_id <- callModule(update_options, "link_id")
output$lastButtonCliked=renderText({last_id()})
})
# Run the application
shinyApp(ui = ui, server = server)
I would expect the input$last_btn value (the id name of the last button clicked) to be created and returned at the bottom of the app as well as becoming the updated input in the selectize. However, the input$last_btn is not being created, I have checked this using the debugging browser() as well.
You were almost there, but there were some minor formatting issues. The updated code is listed below.
You mainly misused HTML (I changed it to JS but thats not the problem) in the way that you just comma separated the ns("last_btn"). If you had inspected the output of your original HTML(...) statement, you would have seen that the resulting JavaScript string was
Shiny.onInputChange(' link_id-last_btn ', this.id);
And I mean the spaces around the input id. Because of the extra spaces, the input was not properly mapped on input$last_btn. I used paste0 in my example to correctly glue the strings together.
Second, there are some missing ns calls which I corrected, but that you would for sure have found out yourself once the input blocker was gone.
user_inputUI <- function(id){
# Create a namespace function using the provided id
ns <- NS(id)
tagList(
tags$head(
tags$script(
JS(paste0("$(document).on('click', '.needed', function () {debugger;
Shiny.onInputChange('", ns("last_btn"), "', this.id);
});"))
)
),
tags$span(HTML(paste0('<div><input id="', ns("first"), '" type="checkbox" class="needed"></div>'))),
actionButton(ns("second"), "Second", class="needed"),
actionButton(ns("third"), "Third", class="needed"),
actionButton(ns("save"), "save"),
selectInput(ns("which_"), "which_", c(ns("first"), ns("second"), ns("third")))
)
}
update_options <- function(input, output, session) {
observeEvent(input$last_btn, {
print(input$last_btn)
})
observeEvent(input$save, {
updateSelectInput(session, "which_", selected = input$last_btn)
})
return(reactive(input$last_btn))
}
ui <- shinyUI(fluidPage(
titlePanel("Track last clicked Action button"),
sidebarLayout(
sidebarPanel(
user_inputUI("link_id")
),
mainPanel(
textOutput("lastButtonCliked")
)
)
))
server <- shinyServer(function(input, output,session) {
last_id <- callModule(update_options, "link_id")
output$lastButtonCliked=renderText({last_id()})
})
# Run the application
shinyApp(ui = ui, server = server)
I have this app:
library(shiny)
ui <- fluidPage(
textInput("query_text","Type something:"),
actionButton(inputId='query_button',
label="Search",
icon = icon("th"),
onclick = paste("location.href='http://www.example.com?lookfor=",
input$query_text, "'", sep=""))
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
I'd like to update the url with the action button, so when the user types something (for example: paper), it updates the url like this:
http://www.example.com/?lookfor=paper
Any ideias how to do it? Maybe wrapping it on a observeEvent?
Based on your replies to my comment, what you're looking for is the updateQueryString function.
library(shiny)
ui <- fluidPage(
textInput("query_text", "Type something:"),
actionButton(inputId = 'query_button', label = "Search")
)
server <- function(input, output, session) {
observeEvent(input$query_button, {
updateQueryString(paste0("?lookfor=", input$query_text))
})
}
shinyApp(ui, server)
Hi I am trying to build a login page that contacts an API service and validates user credentials. If the credentials are correct then a new user interface appears and simply makes a plot. If it is not correct a message at the login screen should say "incorrect login". Currently, when I try to type in either of the fields at the login page (ui1.r) the field refreshes/wipes itself after a second or so, thus preventing me from passing on user input to the API. I have the following files
server.r:
rm(list = ls())
library(shiny)
library(dplyr)
library(shinyjs)
umls <- dbConnect(drv=RSQLite::SQLite(),
dbname="/media/sf_umls-2018AA-full/2018AA-full/2018AA/META/umls_browser.sqlite3")
licenseCode <- "mylicense"
shinyServer(function(input, output) {
source('ui1.R') #login page
output$page <- renderUI({ ui1 })
observe({
z<-system(paste("perl", "/media/sf_umls-2018AA-full/2018AA-full/2018AA/META/umls_auth.pl",
input$user, input$password),intern=TRUE)
if (grepl("false",z[22])) {
renderText("incorrect login")
}
if (grepl("true",z[22]))
{
output$page <- renderUI({ ui2 })
output$table <- renderTable({mtcars()})
}
})
})
ui1.r
ui1 <- shinyUI(fluidPage(
# Application title
titlePanel("UMLS Constraint Browser"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
textInput("user", "User",""),
textInput("password", "Password",""),
actionButton("login", "Login")
),
mainPanel(
tableOutput("table")
)
)
))
What appears to be the problem?
I think the problem comes from the observe function. Each time you write a letter, it sends a request to your credential database. You should try to use
ObserveEvent instead :
shinyServer(function(input, output) {
observeEvent(input$login, {
z<-system(paste("perl", "/media/sf_umls-2018AA-full/2018AA-full/2018AA/META/umls_auth.pl",
input$user, input$password),intern=TRUE)
if (grepl("false",z[22])) {
renderText("incorrect login")
}
if (grepl("true",z[22]))
{
output$page <- renderUI({ ui2 })
output$table <- renderTable({mtcars()})
} })
})
Here, a request is made only when the user clicks on the login button. Tell me if it works for you.
I'm trying to use the relatively new shinyAlert package to see if it offers better results than the sweetalert package but I'm unable to figure out how to get this:
Myvar <- shinyalert input text
from this minimal example.
library(shiny)
library(shinyjs)
library(shinyalert)
ui <- fluidPage(
shinyjs::useShinyjs(),
useShinyalert(),
actionButton("run", "Run", class = "btn-success")
)
server <- function(input, output, session) {
shinyEnv <- environment()
observeEvent(input$run, {
shinyalert('hello', type='input')
})
}
shinyApp(ui = ui, server = server)
My thanks for any help from you geniouses out there.
Here is how you do it:
library(shiny)
library(shinyalert)
ui <- fluidPage(
useShinyalert(),
actionButton("run", "Run", class = "btn-success")
)
server <- function(input, output, session) {
observeEvent(input$run, {
shinyalert('hello', type='input', callbackR = mycallback)
})
mycallback <- function(value) {
cat(value)
}
}
shinyApp(ui = ui, server = server)
It's done using callbacks. You can assign the value to a reactive variable if you'd like.
I had fully documented the package last month and was about to release it, and then my computer crashed before I had a chance to push to github, and lost all progress. I haven't had a chance to work on it again. So sorry that the documentation isn't great yet, the package is still un-released so use at your own risk for now :)
(Notice that you don't need shinyjs for this)
I have no experience with the package shinyalert, but you can achieve what you want with the widely used and well documented modal dialogs from shiny. Maybe you there is a reason for you to stick with shinyalert that I am unaware off, but if not, example code for achieving what you want with modal dialogs:
ui <- fluidPage(
shinyjs::useShinyjs(),
actionButton("run", "Run", class = "btn-success"),
textOutput("output1")
)
server <- function(input, output, session) {
dataModal <- function(failed = FALSE) {
modalDialog(
textInput("input1", "Enter text:",
placeholder = 'Enter text here'
)
)
}
# Show modal when button is clicked.
observeEvent(input$run, {
showModal(dataModal())
})
output$output1 <- renderText({
input$input1
})
}
shinyApp(ui = ui, server = server)
Let me know if this helps!