I would like to add a warning message, in my shiny dashboard sidebar, if user enters something that is not recognized. I found something very informative: Check Shiny inputs and generate warning on sidebar layout
But it is not exactly what I need, and would like to hear what you think. Below is my code
library(shiny)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
selectizeInput('email', 'Email', c("NYC#gmail.com", "LA#gmail.com","SF#gmail.com"), multiple = FALSE,
options = list(
placeholder = 'Email addresss',
onInitialize = I('function() { this.setValue(""); }')
)),
uiOutput('email_text')
),
dashboardBody()
)
server <- function(input, output) {
output$email_text <-
renderUI({
if(input$email == ""){
return(p("Please add your gmail e-mail address."))
}
#Update: Below checks for "gmail" - I would something to search list and return.
if(!grepl("gmail", input$email)){
return(p("Your email is not a gmail e-mail address!"))
}
})
}
shinyApp(ui = ui, server = server)
Current sidebar selection performs well to recognize email format, as long as I select from the dropdown list
However, what I also want to add in is, if I enter something that is not expected (not in the list given), the system can capture that and warn me (E.g. "Your email is not an expected email address!"). Currently, if I just enter some something not in the list, the system does not do anything:
I feel that comparing with post I mentioned above, my version has issue with "selectizeInput" function. It is designed to intake elements from the list, not everything user enters. Is there a way to work around it? I try to use validate() but had no luck.
Thanks so much in advance for your help!
By default selecticizeInput does not allow the user to enter new values. You have to enable this with options = list(create = TRUE). Once you have this option, you can check whether the newly created email is in the pre-defined list of emails using %in% and report a custom error message in the sidebar.
Here is the updated code:
library(shiny)
library(shinydashboard)
list_of_emails <- c("NYC#gmail.com", "LA#gmail.com", "SF#gmail.com")
ui <- dashboardPage(dashboardHeader(),
dashboardSidebar(
selectizeInput(
'email',
'Email',
c("NYC#gmail.com", "LA#gmail.com", "SF#gmail.com"),
multiple = FALSE,
options = list(
create=TRUE,
placeholder = 'Email addresss',
onInitialize = I('function() { this.setValue(""); }')
)
),
uiOutput('email_text')
),
dashboardBody())
server <- function(input, output) {
output$email_text <-
renderUI({
# print the input email to the console to help with debugging
message(input$email)
if (input$email == "") {
return(p("Please add your gmail e-mail address."))
}
#Update: Below checks for "gmail" - I would something to search list and return.
if (!input$email %in% list_of_emails) {
return(p("Your email is not in the list of emails!"))
}
})
}
runApp(list(ui = ui, server = server))
Related
I am a little confused about the difference between req and validate in R shiny. The only real difference I can see is that validate gives a message to the user. I am building an interface and was using a bunch of hidden messages and conditional statements. I would like to condense my code and like the idea of using validate. I only want to show my message when the user tries to click the button and tries to continue to another part of the UI.
I provide a simplified version of the code, the message "Success" will only show when the text input for the id and the agreement button is clicked. If one or both are missing, a conditional panel will display the validation text.
I am concerned that displaying an output inside of an action button destroys the environment and essentially turns it into a reactive environment. I used the req after the validation check so that the success message will not display unless the input is provided for both. Is this the best way to do this? Or is there a more efficient/proper way? My main concern is that when I build up the complexity, I will break the app.
library(shiny)
ui <- fluidPage(
textInput(inputId = "id",
label = 'Please enter your id'
),
checkboxInput("agree", label = "I agree", value = FALSE),
conditionalPanel(condition = "input.id == '' || !input.agree",
textOutput('error_msg')
),
actionButton("submit_info", "Submit"),
textOutput('success_msg')
)
server <- function(input, output) {
observeEvent(input$submit_info, {
output$error_msg <- renderText({
shiny::validate(
shiny::need(input$id != '', 'You must enter your id above to continue.'
),
shiny::need(input$agree, "You must agree to continue")
)
})
shiny::req(input$id)
shiny::req(input$agree)
output$success_msg <- renderText({"Success"})
})
}
shinyApp(ui = ui, server = server)
Update: I have solved this issue. Essentially, I make the conditional panel only show once the button is clicked and moved the validate outside of the observe event. Here is the code:
library(shiny)
ui <- fluidPage(
textInput(inputId = "id",
label = 'Please enter your id'
),
checkboxInput("agree", label = "I agree", value = FALSE),
conditionalPanel(condition = "(input.submit_info >= 1) & ((input.id == '') || (!input.agree))",
textOutput('error_msg')
),
actionButton("submit_info", "Submit"),
textOutput('success_msg')
)
server <- function(input, output) {
output$error_msg <- renderText({
shiny::validate(
shiny::need(input$id != '', 'You must enter your id above to continue.'
),
shiny::need(input$agree, "You must agree to continue")
)
})
observeEvent(input$submit_info, {
shiny::req(input$id)
shiny::req(input$agree)
output$success_msg <- renderText({"Success"})
})
}
shinyApp(ui = ui, server = server)
I'm traying to create an app that reads some user and password and then create a tabsetPanel inside a renderUI.
The app is supposed to read a code and type number from a data base and if the type is 1 then hides some tabPanel, however all the tabpanels are always shown.
library(shiny)
library(RPostgreSQL)
con=dbConnect(........)
ui <- fluidPage(
textInput("user","User:"),
passwordInput("password", "Password:"),
actionButton("go", "Go",class = "btn-primary"),
uiOutput("panel")
)
server <- function(input, output, session) {
observeEvent({input$go}, {
code<-dbGetQuery(con,"SELECT type FROM table")[[1]]
#code is a number
if(dim(code)[1]==1){
type=reactive(dbGetQuery(con,"SELECT type FROM table2")[[1]])
#type() is a number
output$panel=renderUI(
tabsetPanel(id = "tab",
tabPanel("Tab1"),
tabPanel("Tab2")
)
)
observe({
if(type()==1){
hideTab(inputId = "tab", target = "Tab1")
}
})
}
})
}
shinyApp(ui, server)
The problem is that de observer is executed before the renderUI and doesn't re-execute, I think.
Generally speaking, you've mixed up 3 different processes.
Checking the user has access can be put in a separate function, outside of the scope of server, simply returning TRUE or FALSE (and possibly an error).
Dynamically loading the tabs. If this must only occur after the user has logged in, you can simply opt to not display Tab1. If the tabs has to be loaded regardless (but still dynamically), put it outside of the scope of observeEvent({input$go}, {...}). Consider, just for now, to setup the tabsetpanel with tabs in the ui.
Showing/hiding the tab.
Within a reactive/observe, you do not need to use additional reactives. They already are set to run. So type should be just be type = dbGetQuery(...), and the observe nested within an observe/observeEvent makes no sense.
Lastly, to debug why the tab is not hidden, use the good ol' fashioned print and look at your console. Try updating to
observe({
cat('Testing type: ', type(), '\n')
if(type()==1){
cat('Hiding tab...\n')
hideTab(inputId = "tab", target = "Tab1")
}
})
and watch out for those messages in your console. Are they printed? Then the fault might be on the client-side (perhaps you mispelled something). Are the messages missing? Then you know the code never executed, and you'll have to investigate why.
Update:
Looking further into the matters, try using the browsers Inspect-function. For the viewer in Rstudio (and Chrome), you can right-click and select "Inspect element". A new window appears (or is docked within the window), which allows you to inspect the HTML DOM and view the JavaScript console. Here, we notice an important message:
Uncaught There is no tabsetPanel (or navbarPage or navlistPanel) with id equal to 'tab'
Simply put, the hideTab command is sent before the client has finished loading the tabpanels.
One solution, that did not work, is as follows:
server <- function(input, output, session) {
type <- reactiveVal(0)
type_delayed <- debounce(type, Inf)
observeEvent({input$go}, {
code<-data.frame(code=1)
#code is a number
if(dim(code)[1]==1){
#type(dbGetQuery(con,"SELECT type FROM table2")[[1]])
type(1)
#type() is a number
output$panel=renderUI(
tabsetPanel(id = "tab",
tabPanel("Tab1"),
tabPanel("Tab2")
)
)
}
})
observe({
cat('Testing type: ', type_delayed(), '\n')
if( type_delayed() ==1){
cat('Hiding tab...\n')
hideTab(inputId = "tab", target = "Tab1")
}
})
}
I.e., we delay the execution of hiding the tab. Except it's a bad solution, because you have to choose a timing that is as soon as possible, but not so soon that the client isn't ready.
I suggest the following solution: Instead of hiding the panel, don't add it until you need it:
ui <- fluidPage(
textInput("user","User:"),
passwordInput("password", "Password:"),
actionButton("go", "Go",class = "btn-primary"),
actionButton("add", "Add tab"),
uiOutput("panel")
)
server <- function(input, output, session) {
i <- 1
observeEvent({input$go}, {
code<-data.frame(code=1)
#code is a number
if(dim(code)[1]==1){
#type <- dbGetQuery(con,"SELECT type FROM table2")[[1]]
type <- 1
#type() is a number
output$panel=renderUI({
if (type == 1) {
i <<- 1
tabsetPanel(
id = "tab",
tabPanel("Tab1")
)
} else {
i <<- 2
tabsetPanel(
id = "tab",
tabPanel("Tab1"),tabPanel("Tab2")
)
}
})
}
})
observeEvent(input$add, {
i <<- i + 1
appendTab('tab', tabPanel(paste0('Tab', i)))
})
}
I have a dialogue in shiny that allows the user to input credentials for a database.
The problem is that the module is opened inside of a called function, therefore somehow I need to pause the function from continuing until the user has put input the required fields. I have tried using req and can not make it work, observeEvent() also does not work since I can not return anything from that environment.
If I do not pause the program somehow, the function keeps on going without the username and password and will not get the data. The trigger to "un-pause" would be an input$Submit, the button in the Modal.
library(shiny)
ui<-
fluidPage(
sidebarLayout(position="left",
sidebarPanel("Parameters",width = 4,
radioButtons("Type","Test", choices= list("Test"="p",
"Test"="l")),
actionButton("GO","Open Modual")
),
mainPanel(
plotOutput("Test")
)))
server<- function(input,output){
Credential<-function(Test){
showModal(modalDialog(
title = "Credentials Required",
textInput("Username", "Enter User Name", value = ""),
textInput("Password", "Enter Password:", value = ""),
footer = actionButton("Submit", "Submit"),
modalButton("Cancel"))
)
#Use Assigned Username and Password to go fetch data.
#Note data must be returned, somehow need to pause or somthing here.
}
#Call Function
observeEvent(input$GO,{
data <- Credential("Test")
})
}
shinyApp(server=server,ui=ui)
Any ideas?
Thanks,
-Chaboes
In my shiny app I have several tabs as follows.
I have little complex functions running in this app. I think all the observe functions in the server function run when anything is done in any tab. So I need to run only relevant observe functions for relevant tab. As an example, when I am in Summary tab only the relevant observe function should run and all the other observe functions should not run. I have a code.
server <- function(input, output) {
summary <- observe({....})
occupancy<- observe({....})
Bookings<- observe({....})
Maps<- observe({....})
}
Is there any modification to the above code to run only the relevant observe function related to the tab opened in the app.?
Some approaches come to mind. But first; what do you want to do in your observers? If you are simply creating output to display to the user, don't forget to use reactive elements. They will automatically invalidate only when their output is used to display something to the user. Thus if reactive X uses input Y used to construct output for tab A, and input Y changes while we are looking at tab B, reactive X will not invalidate.
If you are using your observers to only create side-effects, such as updating inputs or showing modalDialogs, you could:
use observeEvent instead of observe to only listen to changes in a certain input or condition.
use isolate to make isolate certain dependencies.
build an if-statement in your observer, that checks which tab is selected. You can do that by giving your sidebarMenu an id (my_sidebarmenu in the example below), and check which tab is selected inside your observer by calling input$my_sidebarmenu.
Some examples given below, how this helps~
#UI.R
#loading shiny library
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(id='my_sidebarmenu',
menuItem('Tab 1', tabName='tab1'),
menuItem('Tab 2', tabName='tab2'),
actionButton(inputId = 'btn','Press me!')
)
),
dashboardBody(
tabItems(
tabItem('tab1',
p('Tab 1'),
actionButton('btn_tab1','Show message!')),
tabItem('tab2',
p('Tab 2'),
actionButton('btn_tab2','Show message!'))
)
)
)
server <- function(input, output,session)
{
observeEvent(input$btn,
{
if(input$my_sidebarmenu=='tab1')
{
updateTabItems(session,'my_sidebarmenu',selected='tab2')
}
if(input$my_sidebarmenu=='tab2')
{
updateTabItems(session,'my_sidebarmenu',selected='tab1')
}
})
observeEvent(input$btn_tab1,
{
showModal(modalDialog(
title = "One.",
"You are viewing tab 1!",
easyClose = TRUE,
footer = NULL
))
})
observeEvent(input$btn_tab2,
{
showModal(modalDialog(
title = "Two.",
"You are viewing tab 2!",
easyClose = TRUE,
footer = NULL
))
})
}
shinyApp(ui,server)
I have begun to create a web app using shiny where a user enters a search term and tweets containing that term are returned.
When I load this app the searchTwitter function begins automatically and on the main panel there is the error: Error: You must enter a query.
The search term is entered in the textInput box and there is a submitButton. You can enter a term and it works fine but I don't want the error to be the first thing the user sees.
ui.R:
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Twitter Generator"),
sidebarPanel(
textInput("search", "Search Twitter For:", value = ""),
submitButton("Search")
),
mainPanel(
h3(textOutput("search")),
tableOutput("view"),
)
))
server.R:
library(shiny)
library(twitteR)
shinyServer(function(input, output) {
datasetInput <- reactive(function(){
rawTweets <- twListToDF(searchTwitter(paste(input$search)))
rawTweets$cleanText <- as.vector(sapply(rawTweets$text, CleanTweet))
rawTweets[, colnames(rawTweets) != "created"]
})
output$search <- reactiveText(function() {
input$search
})
output$view <- reactiveTable(function() {
head(datasetInput())
})
})
Thanks for your help
This is a logical request for and from your application design, and you should think through how to do it.
One easy way would be to add a tickbutton providing a true/false and to skip the actual twitter search if the value is FALSE. You may need to cache the previous value of rawTweets, or set it to NULL, or ...
mainPanel(
h3(textOutput("search")),
tableOutput("view")
)
try it without the second ","