Possible to Show Console Messages (Written with 'Message') in a Shiny Ui

Possible to show console messages (written with `message`) in a shiny ui?

Yihui suggested I use withCallingHandlers, and that indeed let me to a solution. I wasn't quite sure how to use that function in a way that would do exactly what I needed because my problem was that I had a function that printed out several messages one at a time and using a naive approach only printed the last message. Here is the my first attempt (which works if you only have one message to show):

foo <- function() {
  message("one")
  message("two")
}

runApp(shinyApp(
  ui = fluidPage(
    actionButton("btn","Click me"),
    textOutput("text")
  ),
  server = function(input,output, session) {
    observeEvent(input$btn, {
      withCallingHandlers(
        foo(),
        message = function(m) output$text <- renderPrint(m$message)
      )
    })
  }
))

Notice how only two\n gets outputted. So my final solution was to use the html function from shinyjs package (disclaimer: I wrote that package), which lets me change or append to the HTML inside an element. It worked perfectly - now both messages got printed out in real-time.

foo <- function() {
  message("one")
  Sys.sleep(0.5)
  message("two")
}

runApp(shinyApp(
  ui = fluidPage(
    shinyjs::useShinyjs(),
    actionButton("btn","Click me"),
    textOutput("text")
  ),
  server = function(input,output, session) {
    observeEvent(input$btn, {
      withCallingHandlers({
        shinyjs::html("text", "")
        foo()
      },
        message = function(m) {
          shinyjs::html(id = "text", html = m$message, add = TRUE)
      })
    })
  }
))

Shiny: What is the option setting to display in the console the messages between server and ui

I finally found it :

options(shiny.trace=TRUE)

Before running the app. I find it extremely useful to understand what is appending. I don't know why it is not more documented.

Utilizing Window Size Within Shiny Module

The issue is that input values accessed by modules are namespaced, while the input values set by Shiny.onInputChange are not.

So in the myPlot module, input$dimension gets myPlot-dimension but the input is actually just dimension.

One solution would be to make the namespaced id available to the script:

library(shiny)
library(plotly)

myPlotUI <- function(id, label = "My Plot") {
  ns <- NS(id)
  dimensionId <- ns("dimension")

  tagList(
    tags$head(tags$script(sprintf("
      var dimensionId = '%s';
      var dimension = [0, 0];

      $(document).on('shiny:connected', function(e) {
        dimension[0] = window.innerWidth;
        dimension[1] = window.innerHeight;
        Shiny.onInputChange(dimensionId, dimension);
      });

      $(window).resize(function(e) {
        dimension[0] = window.innerWidth;
        dimension[1] = window.innerHeight;
        Shiny.onInputChange(dimensionId, dimension);
      });
    ", dimensionId))),

    plotlyOutput(ns("myPlot"))
  )
}

myPlot <- function(input, output, session) {
  ns <- session$ns

  output$myPlot <- renderPlotly({
    plot_ly(midwest, x = ~percollege, color = ~state, type = "scatter",
            width = (0.6 * as.numeric(input$dimension[1])),
            height = (0.75 * as.numeric(input$dimension[2])))
  })

}

server <- function(input, output, session){
  callModule(myPlot, "myPlot")
}

ui <- fluidPage(
  navlistPanel(
    tabPanel("Dynamic Dimensions",
             myPlotUI("myPlot"))
  )
)

shinyApp(ui = ui, server = server)

---

Another solution that comes with a disclaimer: DANGER, undocumented, abuse-prone feature! You can actually get the root session from a module through session$rootScope(). Would not recommend unless you really have to, but just FYI.

library(shiny)
library(plotly)

myPlotUI <- function(id, label = "My Plot") {
  ns <- NS(id)

  tagList(
    tags$head(tags$script("
      var dimension = [0, 0];

      $(document).on('shiny:connected', function(e) {
        dimension[0] = window.innerWidth;
        dimension[1] = window.innerHeight;
        Shiny.onInputChange('dimension', dimension);
      });

      $(window).resize(function(e) {
        dimension[0] = window.innerWidth;
        dimension[1] = window.innerHeight;
        Shiny.onInputChange('dimension', dimension);
      });
  ")),

    plotlyOutput(ns("myPlot"))
  )
}

myPlot <- function(input, output, session) {
  ns <- session$ns
  rootInput <- session$rootScope()$input

  output$myPlot <- renderPlotly({
    plot_ly(midwest, x = ~percollege, color = ~state, type = "scatter",
            width = (0.6 * as.numeric(rootInput$dimension[1])),
            height = (0.75 * as.numeric(rootInput$dimension[2])))
  })

}

server <- function(input, output, session){
  callModule(myPlot, "myPlot")
}

ui <- fluidPage(
  navlistPanel(
    tabPanel("Dynamic Dimensions",
             myPlotUI("myPlot"))
  )
)

shinyApp(ui = ui, server = server)

---

Related Topics