R/renderWordcloud2.R

In Lchiffon/wordcloud2: Create Word Cloud by htmlWidget

##' Plot wordcloud2 in shiny
##'
##' @description
##' Function for plotting wordcloud2 in shiny
##'
##' @usage
##' wordcloud2Output(outputId, width = "100\%", height = "400px")
##' 
##' renderWordcloud2(expr, env = parent.frame(), quoted = FALSE)
##'
##' @param outputId output variable to read from
##' @param width,height Must be a valid CSS unit (like \code{"100\%"},
##'   \code{"400px"}, \code{"auto"}) or a number, which will be coerced to a
##'   string and have \code{"px"} appended.
##' @param expr An expression that generates a networkD3 graph
##' @param env The environment in which to evaluate \code{expr}.
##' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This
##'   is useful if you want to save an expression in a variable.
##'
##'
##' @details
##' Use renderWordcloud2 to render an wordcloud2 object and use wordcloud2Output
##' output an wordcloud2 object. See more details in shiny package.
##'
##' This will be the same value as shown in the hover information (example: \code{super:32}).
##' clickedWordInputId is automatically generated by: paste0(outputId, "_clicked_word"))
##'
##' @name wordcloud2-shiny
NULL

getClickedWord <- function(WordInputId) {
  #OUPUT
  #       - referencing input in server will return a string of form word:freq (same as hover info shown in wordcloud; ie 'super:32')
  shiny::tags$script(shiny::HTML(
    "$(document).on('click', '#canvas', function(evt) {",
    'var id = evt.target.nextElementSibling.firstChild.id;',
    'word = document.getElementById(id).innerHTML;',
    'console.log(id);',
    "Shiny.onInputChange(id.replace('wcSpan','_clicked_word'), word);",
    #sprintf("Shiny.onInputChange(id'_%s', word);",WordInputId),
    "});"
  ))
}

#' @rdname wordcloud2-shiny
#' @export
wordcloud2Output <- function(outputId, width = "100%", height = "400px") {
  widget_out <- htmlwidgets::shinyWidgetOutput(outputId, "wordcloud2", width, height, package = "wordcloud2")

  shiny::div(getClickedWord(), widget_out)
}

#' @rdname wordcloud2-shiny
#' @export
renderWordcloud2 <- function(expr, env = parent.frame(), quoted = FALSE) {
  if (!quoted) { expr <- substitute(expr) } # force quoted
  htmlwidgets::shinyRenderWidget(expr, wordcloud2Output, env, quoted = TRUE)
}