I would like to control the phone number by showing a notification :
If the user type a wrong number (like "aaaa")
If the user type a long number (greater than 10 digits)
I used the function showNotification from shiny with closeButton = FALSE and duration = NULL.
When the user type a wrong number, the notification popped up but when he type a long number the the notification also popped up but the previous one does not disappear
I would like to show only one notification (wrong number or long number) but not the both at the same time. How can we do that ? Here's my apps :
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
############# UI ############
body <- dashboardBody(
tabItems(
tabItem(tabName = "tab1",
fluidRow(
tags$h1('my title'),
textInput("phone_number", "enter your phone number", value = ""),
actionButton("button", "go")
)
)
)
)
ui <- dashboardPage(
title = "Example",
options = list(sidebarExpandOnHover = TRUE),
header = dashboardHeader(disable = FALSE),
sidebar = dashboardSidebar(
minified = TRUE, collapsed = TRUE,
sidebarMenu(id="menu",
menuItem("first tab", tabName = "mytab", icon = icon("fas fa-acorn"),
menuSubItem('menu1',
tabName = 'tab1',
icon = icon('fas fa-hand-point-right'))
)
)
),
body
)
############# SERVER ############
server <- function(input, output) {
observeEvent(
input$button,
{
if(is.na(as.numeric(input$phone_number))) {
showNotification(type = "error",
duration = NULL,
closeButton = FALSE,
"wrong number")
} else if(nchar(input$phone_number)<10) {
showNotification(type = "error",
duration = NULL,
closeButton = FALSE,
"too long (10 digits required)")
}
}
)
}
############# RUN THE APP ############
shinyApp(ui = ui, server = server)
Some help would be appreciated
I would not use a notification here, because they will always be displayed for a fixed time duration and at a different position of the window, which might confuse the user. I would just render the message in using a textOutput:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
textInput("phone_number", "phone number"),
textOutput("phone_notification")
)
server <- function(input, output, session) {
output$phone_notification <- renderText({
if(input$phone_number == "") {
"" # empty is ok
}
else if(is.na(as.numeric(input$phone_number))) {
"wrong number"
} else if (nchar(input$phone_number) > 10) {
"too long"
} else {
"" # correct number
}
})
}
shinyApp(ui, server)
You can also style the text e.g. to make it red:
ui <- fluidPage(
useShinyjs(),
textInput("phone_number", "phone number"),
tagAppendAttributes(
textOutput("phone_notification"),
style = "color:red"
)
)
I needed the solution OP asked. I found the following code snippet to work in my case:
removeNotification(id = "onlyOnce", session = getDefaultReactiveDomain())
showNotification("Show me once", id = "onlyOnce")
See also: https://search.r-project.org/CRAN/refmans/shiny/html/showNotification.html
Related
Good days, I am programming in Rstudio, using shiny, and I wanted to generate an alert that is activated only when I want to leave a tabPanel without completing a condition, but not if I do not enter the tabPanel before, this is the way I found. The problem is that every time that I leave the Panel 1 without fulfilling the condition of completing text, alerts are generated that are accumulating (1 alert the first time, two the second, three the third, etc.) I wanted to consult if somebody knows why it is this and how to avoid it.
thank you very much
library(shiny)
library(ggplot2)
library(shinyalert)
ui <- fluidPage(
tabsetPanel(
id = "tabselected",
tabPanel("Tab2",""),
tabPanel("Tab1", textInput("requiredText", "Required Text"))
))
server <- function(input, output, session) {
observe({
req(input$tabselected == "Tab1")
observeEvent(
input$tabselected,
if (input$tabselected != "Tab1" & !isTruthy(input$requiredText)) {
shinyalert(title = "Save your work before changing tab",
type = "warning",
showConfirmButton = TRUE
)
updateTabsetPanel(session, inputId = "tabselected", selected = "Tab1")
}
)
}
)
}
shinyApp(ui = ui, server = server)
Is this the behavior you desire? Your example was recursive so you had reoccurring popup event. We can create a reactiveValues variable to keep track of the events, like so:
library(shiny)
library(ggplot2)
library(shinyalert)
ui <- fluidPage(
tabsetPanel(
id = "tabselected",
tabPanel("Tab2",""),
tabPanel("Tab1", textInput("requiredText", "Required Text"))
))
server <- function(input, output, session) {
v <- reactiveValues(to_alert = FALSE)
observeEvent(input$tabselected,{
if (input$tabselected != "Tab1" & !isTruthy(input$requiredText)) {
v$to_alert <- TRUE
}else{
v$to_alert <- FALSE
}
},ignoreInit = TRUE)
observeEvent(v$to_alert,{
if (v$to_alert){
shinyalert(title = "Save your work before changing tab", type = "warning",showConfirmButton = TRUE)
updateTabsetPanel(session, inputId = "tabselected", selected = "Tab1")
}
})
}
shinyApp(ui = ui, server = server)
This is a follow-up question to this question from 4 years ago: How to close embedded modalDialog
library(shiny)
library(DT)
library(shinyWidgets)
library(shinyalert)
ui = fluidPage(
fluidRow(
column(width = 6,
actionButton('button',
label = "Click me",
icon = icon("fas fa-check"),
width = '100%')
)
)
)
server = function(input, output) {
observeEvent(input$button, {
showModal(
modalDialog(
title = "Test two modalDialogs",
br(),
autonumericInput("numeric",
"Enter a number less than 69",
value = NULL,
width = '100%'),
actionButton("buttonA",
label = "Click to see what happens",
icon = icon("fas fa-save")
),
footer = NULL
)
)
})
observeEvent(input$buttonA, {
if(input$numeric < 69){
showModal(
modalDialog(
title = h2("You did not enter a number which is greater than 69. Please try again."),
actionButton("buttonB",
label = "Ok."),
footer = tagList(modalButton("Try again"))
)
)
}
})
observeEvent(input$buttonB, {
removeModal()
})
}
shinyApp(ui = ui, server = server)
Is it by now possible to close only the second modal-dialog which opens after the user entered a value smaller than 69? Both options, the modalButton and also the removeModal close both dialogs.
I have used this code for a simple app to receive system and site name from users. And I have problem for the second time press the "submit" button. For example, if user has pressed "submit" directly without select system/select site, it will pop up "Please make sure system is not empty ." This is the first time press "submit" but when user has selected system and the site then pressed "submit" the second time, it does not work. Does any one know how to solve it?
Here is my code.
library(shiny)
library(shinyWidgets)
library(shinycssloaders)
library(shinythemes)
library(shinyTime)
library('tools')
# Define UI for application that draws a histogram
ui <- fluidPage(
theme = shinytheme("cyborg"),
# Application title
titlePanel("test"),
sidebarLayout(
sidebarPanel(
selectizeInput('system', '* Select System:', width = '100%',
choices = c("a","b","c"), multiple = FALSE,
options = list(
placeholder = 'Please Select Site',
onInitialize = I('function() { this.setValue(""); }')
)),
selectizeInput('site', '* Select Site:', width = '100%',
choices = c("A","B","C"), multiple = FALSE,
options = list(
placeholder = 'Please Select Site',
onInitialize = I('function() { this.setValue(""); }')
)),
hr(),
actionBttn(inputId = "submit", label= "Submit for Processing")
),
mainPanel(
h4("Test review")
)
)
)
server <- function(input, output, session) {
# observe submit
observeEvent(input$submit, {
print("test input submit button 2")
if (input$system=="") {
showModal(modalDialog(
title = "Error",
"Please make sure system is not empty."
))
}else if (input$site==""){
print("test1")
showModal(modalDialog(
title = "Error",
"Please make sure site is not empty."
))
}else {
showModal(modalDialog(
title = "Good",
"success"
))
}
}, once = TRUE)
}
# Run the application
shinyApp(ui = ui, server = server)
I'd like to create an HTML editor in a Shiny app, using the shinyMCE package.
This works well in the example below.
library(shiny)
library(shinyMCE)
library(shinyjs)
library(shinyWidgets)
library(shinydashboard)
ui <- dashboardPage(
useShinyjs(),
header = dashboardHeader(disable = T),
sidebar = dashboardSidebar(disable = T),
body = dashboardBody(
tags$script(src = "http://cdn.tinymce.com/4/tinymce.min.js",
referrerpolicy = "origin"),
tinyMCE("editor", "The content"),
actionButton("ok", "OK")
))
server <- function(input, output, session)
{
observeEvent(
input$ok,
{
print(input$editor)
}
)
observeEvent(
input$open,
{
showModal(myModal())
})
}
shinyApp(ui, server = server)
Indeed, if you press OK, the content of the editor is printed in the R console.
Now, I'd like to put the editor in a modal. If I do the following the editor appears, but if I press OK the content doesn't get updated. That is, the R console always shows "the content", independently of what is written in the textarea.
library(shiny)
library(shinyMCE)
library(shinyjs)
library(shinyWidgets)
library(shinydashboard)
ui <- dashboardPage(
useShinyjs(),
header = dashboardHeader(disable = T),
sidebar = dashboardSidebar(disable = T),
body = dashboardBody(
tags$script(src = "http://cdn.tinymce.com/4/tinymce.min.js",
referrerpolicy = "origin"),
flowLayout (
actionButton("open", "Open")
)))
myModal <- function()
{
modalDialog(size = "l",
title = "A modal dialog",
tinyMCE("tinyTxt", "the content"),
actionButton("ok", "OK"),
easyClose = T)
}
server <- function(input, output, session)
{
observeEvent(
input$ok,
{
print(input$tinyTxt)
}
)
observeEvent(
input$open,
{
showModal(myModal())
})
}
shinyApp(ui, server = server)
In the JS console I get
Uncaught TypeError: Cannot read property 'getContent' of null
at exports.InputBinding.getValue (<anonymous>:9:41)
at c (init_shiny.js:117)
at init_shiny.js:163
at eN.<anonymous> (<anonymous>:16:18)
at mp.c.fire (tinymce.min.js:2)
at eN.fire (tinymce.min.js:2)
at eN.<anonymous> (tinymce.min.js:2)
at mp.c.fire (tinymce.min.js:2)
at eN.fire (tinymce.min.js:2)
at Rp (tinymce.min.js:2)
Any idea of how to get around the problem?
EDIT: One further observation. In the first (working) example tinyMCE.editors contains one instance of an editor, while in the second it is empty (although the editor does display!).
I managed to solve this, by manually creating the TinyMCE editor (which solves the issue of the editor not appearing in tinymce.editors) and then use some custom JS to retrieve the value.
This seems a bit hacky to me, but it works...
Here's an example
library(shiny)
library(shinyjs)
library(shinyWidgets)
library(shinydashboard)
ui <- dashboardPage(
useShinyjs(),
header = dashboardHeader(disable = T),
sidebar = dashboardSidebar(disable = T),
body = dashboardBody(
singleton(tags$head(tags$script(src = "http://cdn.tinymce.com/4/tinymce.min.js",
referrerpolicy = "origin"))),
# Register a custom message handler that gets the content of the editor
# and forces update of the textarea
singleton(tags$head(tags$script("Shiny.addCustomMessageHandler('getTxt',
function(message) {
var content = tinyMCE.get('tinyTxt').getContent();
Shiny.onInputChange('tinyTxt', content);
})"))),
flowLayout (
actionButton("open", "Open"),
htmlOutput("content")
)))
myModal <- function()
{
modalDialog(size = "l",
title = "A modal dialog",
textAreaInput("tinyTxt", "the content"),
actionButton("ok", "OK"),
easyClose = T)
}
server <- function(input, output, session)
{
observeEvent(
input$ok,
{
# Retrieve the content of the editor
session$sendCustomMessage("getTxt", "")
removeModal()
})
output$content <- renderText(
input$tinyTxt
)
observeEvent(
input$open,
{
showModal(myModal())
# Create the tinyMCE editor
runjs("var ed = new tinymce.Editor('tinyTxt', {
selector: 'tinyTxt',
theme: 'modern'},
tinymce.EditorManager);
ed.render();")
})
}
shinyApp(ui, server = server)
For anyone looking at this in 2022, this is an updated solution working with version 6 of TinyMCE. You need to get an API key which is available on registration at https://www.tiny.cloud/
I also added a print to the R console with a delay() as the returned input was blank otherwise.
There are a few additional options compared to the original solution. I kept them there to show how it's done. Hopefully this is useful to someone!
library(shinyjs)
library(shinyWidgets)
library(shinydashboard)
ui <- dashboardPage(
useShinyjs(),
header = dashboardHeader(disable = T),
sidebar = dashboardSidebar(disable = T),
body = dashboardBody(
tags$head(tags$script(src = "https://cdn.tiny.cloud/1/--API-KEY-HERE--/tinymce/6/tinymce.min.js",
referrerpolicy = "origin")),
# Register a custom message handler that gets the content of the editor
# and forces update of the textarea
tags$head(tags$script("Shiny.addCustomMessageHandler('getTxt',
function(message) {
var content = tinymce.activeEditor.getContent();;
Shiny.onInputChange('tinyTxt', content);
})")),
flowLayout (
actionButton("open", "Open"),
htmlOutput("content")
)))
myModal <- function()
{
modalDialog(size = "l",
title = "A modal dialog",
textAreaInput("tinyTxt", "the content"),
actionButton("ok", "OK"),
easyClose = T)
}
server <- function(input, output, session)
{
observeEvent(
input$open,
{
showModal(myModal())
# Create the tinyMCE editor
runjs("var ed = new tinymce.Editor('tinyTxt', {
menubar: false,
branding: false,
plugins: 'lists, table, link',
contextmenu: 'lists, link, table',
toolbar1: 'bold italic forecolor backcolor | formatselect fontselect fontsizeselect | alignleft aligncenter alignright alignjustify',
toolbar2: 'undo redo removeformat bullist numlist table blockquote code superscript subscript strikethrough link'},
tinymce.EditorManager);
ed.render();")
})
observeEvent(
input$ok,
{
# Retrieve the content of the editor
session$sendCustomMessage("getTxt", "")
output$content <- renderText(
input$tinyTxt
)
delay(500, print(input$tinyTxt))
removeModal()
})
}
shinyApp(ui, server = server)
I'm building a Shiny app and for the last two days I'm being blocked on the following step: I've put a "Submit" button on a typeform and apparently there are no problems, but everytime I run the app I can't click on it because for the very beginning it shows me a "no trespassing" signal disallowing me to do nothing else.
Here's the code I'm using:
# Packages ----
if(require("pacman")=="FALSE"){
install.packages("pacman")
}
library(pacman)
pacman::p_load(dplyr, tidyr, shiny, shinydashboard)
# Global scope ----
dish <- c("Salad", "Spaghetti Carbonara", "Scrambled eggs")
allergens <- c("sesame", "lactose", "eggs")
keywords <- c("veggie", "pasta", "none")
dishes <- data.frame(dish, allergens, keywords)
# Function to label mandatory fields ----
labelMandatory <- function(label) {
tagList(
label,
span("*", class = "mandatory_star")
)
}
appCSS <- ".mandatory_star { color: red; }" #to make the asterisk red
MandatoryFields_dishes <- c(names(dishes[,-3]))
fields_dishes <- c(names(dishes))
ui <- dashboardPage(
dashboardHeader(title = "sample"),
dashboardSidebar(
sidebarMenu(
menuItem("Dishes", tabName = "dishes")
)
),
dashboardBody(
# Dishes
tabItems(
tabItem(tabName = "dishes",
tabsetPanel(
tabPanel("Typeform",
fluidPage(
shinyjs::useShinyjs(),
shinyjs::inlineCSS(appCSS),
titlePanel("Dish introduction"),
div(
id="form",
textInput("dish", labelMandatory("Dishes"), ""),
textInput("allergens", label = "Allergens",""),
textInput("keyword", label = "Keyword", ""),
actionButton("submit", "Submit", class="btn-primary")
)
))
))
))
)
server <- function(input, output) {
observe({
mandatoryFilled_dishes <-
vapply(MandatoryFields_dishes,
function(x) {
!is.null(input[[x]]) && input[[x]] != ""
},
logical(1))
mandatoryFilled_dishes <- all(mandatoryFilled_dishes)
shinyjs::toggleState(id = "submit", condition = mandatoryFilled_dishes)
})
}
shinyApp(ui, server)
I guess I'm missing something on the server. If someone could help me I'll be very grateful, lots of thanks in advance.