Javascript event in renderUI after the DOM has actually rendered

shiny

#1

Hello,

I am trying to run some custom Javascript code in a Shiny application using renderUI, after the DOM is actually updated. The issue is I haven't found a way to identify this event. Here is an example where I want to replace one column in a simple HTML table with sparklines:

library(shiny)
library(magrittr)
library(sparkline)
library(htmltools)

# build an HTML table from a data.frame
# x: data.frame
# spk: column index of data to display as sparklines
to_html_table <- function(x, spk = NULL) {
  
  col_names <- names(x)
  row.names(x) <- NULL
  
  head <- tags$thead(
    do.call(tags$tr, lapply(col_names, tags$th))
  )
  
  # UGLY
  body <- do.call(
    tags$tbody, 
    apply(
      unname(x), 
      1, 
      function(y) {
        do.call(
          tags$tr, 
          lapply(
            seq_along(y), 
            function(i) {
              res <- y[i]
              # add a span to identify the column to display as sparklines
              if (!is.null(spk)){
                if (i %in% spk) {
                  res <- tags$span(y[i], class = "spkln")
                }
              } 
              tags$td(res)
            })
        )
      }
    )
  )
  
  tags$table(head, body, class = "table", id = "test")
  
}

ui <- fluidPage(
  # load the Javascript to call sparkline on the desired column
  tags$head(singleton(tags$script(src = 'spk.js'))),
  # add the sparkline dependencies
  sparkline:::spk_dependencies()[3],
  # slider input for reactivity
  sliderInput("num", label = "Number of rows", value = 1, min = 1, max = 20),
  # table to display
  h3("uiOutput"),
  uiOutput("tbl")
)

server <- function(input, output, session) {
  
  tb <- reactive({
    # add random numbers as a comma-separated string
    sparklines <- seq_len(input$num) %>% 
      lapply(function(x) toString(sample(100, 10))) %>% 
      unlist()
    
    # add a column containing the data to display as sparklines
    cbind(
      iris[1:input$num,], 
      data.frame(spk = sparklines)
    )
  })
  
  output$tbl <- renderUI({
    # build the HTML structure 
    to_html_table(
      tb(),
      spk = 6
    )
  })
}

shinyApp(ui = ui, server = server)

Initially, my spk.js looked like this:

$(function() {
      
  // trigger redraw of sparklines after each event value
  
  //This does not work because the DOM is not yet updated when shiny:value is triggered, 
  // as evidenced by the number of #spkln elements.
  $(document).on({
    'shiny:value': function(event) {
      if (event.name === 'tbl') {
        console.log($('.spkln').length);
        $('.spkln').sparkline('html', {type: 'bar', barColor: 'red'});
      }
    }
  });
});

However, after looking around a bit, I added this workaround to use a promise to wait for a bit to draw the Sparklines and it works:

$(function() {
      
  // trigger redraw of sparklines after each event value
  
  function sleep(ms) {
    return new Promise(resolve => setTimeout(resolve, ms));
  };
  
  async function draw(event) {
    await sleep(1);
    if (event.name === 'tbl') {
      $('.spkln').sparkline('html', {type: 'bar', barColor: 'red'});
    }
  };
  
  $('#test').on({
    'shiny:value': function(event) {
      draw(event)
    }
  });
});

My question is: am I missing something? Is there a way to wait for the DOM to be actually updated before executing some code ?
Thanks in advance,
Pierre


#2

Hi Pierre,

I can confirm the race case situation. I'll bring it up with the shiny team later today.

I was able to get around the event race case by wrapping the console.log and sparkline calculations in a setTimeout(update, 0).

$(function() {

  // trigger redraw of sparklines after each event value
  $(document).on({
    'shiny:value': function(event) {
      if (event.name === 'tbl') {
        // defer to next tick to add sparklines
        setTimeout(function() {
          console.log($('.spkln').length);
          $('.spkln').sparkline('html', {type: 'bar', barColor: 'red'});
        }, 0)
      }
    }
  });
});

Hope this helps!

Best,
Barret


#3

Reported issue here: https://github.com/rstudio/shiny/issues/2127