karstenw

Shiny Buttons

Mar 3rd, 2022 (edited)
293
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
R 1.92 KB | None | 0 0
  1. #' Shiny Version of TryCatch
  2. #'
  3. #' Use in reactive context, i.e. inside a server function only.
  4. #'
  5. #' @param session the app session object
  6. #' @param expr R expression to evaluate safely
  7. #' @return NULL
  8. #' @export
  9. exec_safely <- function(session, expr) {
  10.  
  11.     tryCatch(
  12.         withCallingHandlers(
  13.             warning=function(cnd) {
  14.                 msg <- paste(conditionMessage(cnd), sep="\n")
  15.                 shiny::showNotification(
  16.                     ui=msg,
  17.                     duration=10,
  18.                     closeButton=TRUE,
  19.                     type="warning"
  20.                 )
  21.             },
  22.             message=function(cnd) {
  23.                 msg <- paste(conditionMessage(cnd), sep="\n")
  24.                 shiny::showNotification(
  25.                     ui=msg,
  26.                     duration=5,
  27.                     closeButton=TRUE,
  28.                     type="message"
  29.                 )
  30.             },
  31.             expr
  32.         ),
  33.  
  34.         error=function(cnd) {
  35.             msg <- paste(conditionMessage(cnd), sep="\n")
  36.             shiny::showNotification(
  37.                 ui=msg,
  38.                 duration=10,
  39.                 closeButton=TRUE,
  40.                 type="error"
  41.             )
  42.         }
  43.     )
  44. }
  45.  
  46. demo_exec_safely <- function() {
  47.     stopifnot(
  48.         require(shiny),
  49.         require(shinydashboard)
  50.     )
  51.    
  52.     nm <- "Demo: exec_safely"
  53.    
  54.     ui <- shinydashboard::dashboardPage(
  55.         header=shinydashboard::dashboardHeader(title=nm),
  56.         sidebar=shinydashboard::dashboardSidebar(),
  57.         body=shinydashboard::dashboardBody(
  58.             shiny::fluidRow(
  59.                 shiny::column(3, shiny::textInput("x", label="x:")),
  60.                 shiny::column(1, shiny::actionButton("btn","Click me", style = "margin-top:25px;")), # vertically aligned
  61.                 shiny::column(2, shiny::h2(shiny::textOutput("log_x_formatted")))
  62.             )
  63.         ),
  64.         title=nm
  65.     )
  66.  
  67.     server <- function(input, output, session) {
  68.         rv <- shiny::reactiveValues()
  69.        
  70.         shiny::observeEvent(input$btn, exec_safely(session,{ # redirect warnings etc. to ShowNotification
  71.             x <- suppressWarnings(as.numeric(input$x))
  72.             stopifnot(is.numeric(x) && !is.na(x))
  73.             rv[["log_x"]] <- log(x)
  74.         }))
  75.        
  76.         output$log_x_formatted <- shiny::renderText(sprintf("%.3f", rv[["log_x"]]))
  77.     }
  78.  
  79.     shiny::runApp(shiny::shinyApp(ui, server))
  80. }
  81.  
Add Comment
Please, Sign In to add comment