2

I am trying to use JohnCoene/marker package to highlight sections of text in a shiny app. My intend is to first generate the text using some server logic and display it with textOutput. However, I am struggeling with how to trigger the marker after the text appeared on the website. Putting it in the same observeEvent() does not work.

Here is my reprex

# remotes::install_github("johncoene/marker")
library(shiny)
library(marker)

ui <- fluidPage(
  use_marker(),
  actionButton("click", "click"),
  textOutput("text_to_mark")
)
server <- function(input, output) {
   observeEvent(input$click, 
                {
                  output$text <- renderText("My house is yellow")
                })
  # observeEvent() below does not work. This is just for illustration
  observeEvent(input$text_to_mark,
               {
                 marker <- marker$new("#text_to_mark.shiny-text-output.shiny-bound-output")
                 marker$
                   unmark()$ # unmark all before we mark
                   mark("My house")
               })
}

# Run the application 
shinyApp(ui = ui, server = server)

Created on 2019-10-10 by the reprex package (v0.3.0)

For illustration: I can get the marker to work, by adding a second button as in the code below, but I am look for a solution where it gets triggered when the text appears.

# remotes::install_github("johncoene/marker")
library(shiny)
library(marker)

ui <- fluidPage(
  use_marker(),
  actionButton("click", "click"),
  textOutput("text_to_mark"),
  actionButton("mark", "Mark!")
)

server <- function(input, output) {
  observeEvent(input$click, 
               {
                 output$text_to_mark <- renderText("My house is yellow")
               })
  observeEvent(input$mark,
               {
                 marker <- marker$new("#text_to_mark.shiny-text-output.shiny-bound-output")
                 marker$
                   unmark()$ # unmark all before we mark
                   mark("My house")
               })
}

# Run the application 
shinyApp(ui = ui, server = server)

Created on 2019-10-10 by the reprex package (v0.3.0)

Tonio Liebrand
  • 17,189
  • 4
  • 39
  • 59
Benjamin Schwetz
  • 624
  • 5
  • 17

2 Answers2

1

You could listen on DOM changes with javascript: Is there a JavaScript / jQuery DOM change listener?.

When a change happens you can check if your target element has text:

  hasText = document.getElementById("text_to_mark").innerHTML != ""

Note that i assume that your element has the id "text_to_mark".

The result you can "send to R" with

  Shiny.onInputChange("hasText", hasText);

On the R side you will know if the element has text via listening on input$hasText.

So you can add:

observeEvent(input$hasText,{
   ...
})

The javascript you can add to your app with tags$script(jsCode) or use shinyjs.

A reproducible example:

library(shiny)
library(marker)

jsCode <- '
MutationObserver = window.MutationObserver || window.WebKitMutationObserver;

var observer = new MutationObserver(function(mutations, observer) {
  console.log(mutations, observer);
  hasText = document.getElementById("text_to_mark").innerHTML != ""
  Shiny.onInputChange("hasText", hasText);
});

observer.observe(document, {
  subtree: true,
  attributes: true
});
'

ui <- fluidPage(
  use_marker(),
  tags$script(jsCode),
  actionButton("click", "click"),
  textOutput("text_to_mark"),
  actionButton("mark", "Mark!")
)

server <- function(input, output) {

  observeEvent(input$click, {
                 output$text_to_mark <- renderText("My house is yellow")
               })
  observeEvent(input$hasText,{
                 marker <- marker$new("#text_to_mark.shiny-text-output.shiny-bound-output")
                 marker$
                   unmark()$ # unmark all before we mark
                   mark("My house")
               })
}

# Run the application 
shinyApp(ui = ui, server = server)

Note that this only works on the first appearance of the text. If you also want to listen for changes of the text, one could send the text to R instead and check on the R side if the text was updated. Not sure if it is needed here.

Tonio Liebrand
  • 17,189
  • 4
  • 39
  • 59
  • Indeed I want to listen to changes of the text. I have changed it to something like `Text = document.getElementById("text_to_mark").innerHTML`. Seems to work fine. – Benjamin Schwetz Oct 14 '19 at 08:54
1

Listening on DOM changes is one option, but your approach already shows that there is a pure shiny (non-custom-JS) solution, it only takes one click more, so the question is how to do it with only one click. I suggest using invalidateLater and wrap it in an if statement to prevent it from running over and over again like seen here.

The trick is to run your marker calls in an observe statement. Include the invalidateLater here and wrap it in an if condition with a counter which counts how many times the statement has been executed. Play around with the number of milliseconds and counts, in my case it works fine with if(isolate(val$cnt) < 1) and invalidateLater(1000). Don't forget to wrap your counter in an isolate otherwise it will get stuck in a loop.

Note also that input$click not only writes the text into a reactiveValue but also resets the counter val$cnt to 0 so that you can use the invalidateLater again on a new text. The same procedure will help you if you want to update your text using an observeEvent or the like. Just make sure to also reset the counter to 0 and the highlighting works on your new text part.

# remotes::install_github("johncoene/marker")
library(shiny)
library(marker)

ui <- fluidPage(
  use_marker(),
  actionButton("click", "click"),
  textOutput("text_to_mark")
)

server <- function(input, output) {

  val <- reactiveValues(cnt = 0,
                        text = NULL)

  observeEvent(input$click, {
    val$text <- "My house is yellow"
    val$cnt <- 0

  })


  observe({
    if(isolate(val$cnt) < 1) {
      invalidateLater(1000)
    }

    marker <- marker$new("#text_to_mark.shiny-text-output.shiny-bound-output")
    marker$
      unmark()$ # unmark all before we mark
      mark("My house")

    val$cnt = isolate(val$cnt) + 1
    })

  output$text_to_mark <-renderText({
    val$text
  })
}

# Run the application 
shinyApp(ui = ui, server = server)
TimTeaFan
  • 17,549
  • 4
  • 18
  • 39
  • thanks for providing an alternative solution. I prefer the DOM variant over `invalidateLater`. I find it more readable &not depending on some arbitrary timing. – Benjamin Schwetz Oct 14 '19 at 08:52