Word Cloud not updating when using a subset of inputs

[wesslen]

Hi- First, thanks for a great widget. This is very helpful.

I've built a shiny app that interacts between visNetwork and d3wordcloud. I select a node (which is a topic, e.g. LDA) which will then populate the d3wordcloud.

The problem: after the first interaction, the wordcloud will not remove words that have not been used as a top word for new clicked nodes (topics).

The issue is because I do not use all words but only a subset -- the reason I need to limit is larger models when there's potentially 10,000+ words, I only want to plot the top 100 words.

Here's a simplified example, using a pre-created network and word-topic matrix consisting of 10 words and 6 topics (hence 10x6 matrix).

library(shiny); library(d3wordcloud); library(visNetwork)

# 6 topics
nodes <- data.frame(id = c(1,2,3,4,5,6))
edges <- data.frame(from = c(1,1,3,4,2,3), to = c(2,5,4,1,6,2))

# 10 words by 6 topics
probterms <- data.frame(x1 = c(0.05,0.1,0.2,0.2,0.20,0.05,0.05,0.05,0.05,0.05),
                      x2 = c(0.05,0.1,0.05,0.05,0.15,0.10,0.15,0.05,0.05,0.25),
                      x3 = c(0.1,0.15,0.05,0.05,0.05,0.05,0.15,0.10,0.25,0.05),
                      x4 = c(0.05,0.1,0.2,0.2,0.2,0.05,0.05,0.05,0.05,0.05),
                      x5 = c(0.05,0.2,0.05,0.2,0.15,0.05,0.05,0.15,0.05,0.05),
                      x6 = c(0.05,0.1,0.05,0.2,0.05,0.15,0.05,0.05,0.10,0.2))

rownames(probterms) <- c("ladder","hat","man","great","happy","dog","child","boy","hippo","football")

visNetwork(nodes, edges)

ui <- fluidPage(
  fluidRow(
  box(title = "Topic Network", 
      visNetworkOutput("topic.network", height = "400px"), width = 12)
),
fluidRow(
  box(d3wordcloudOutput("topic.wordcloud", height = "200px"), width = 12
  )
))

server <- function(input, output) {
  output$topic.network <- renderVisNetwork({
    visNetwork(nodes, edges) %>%
      visOptions(nodesIdSelection = T) # must allow ID selection
  })

  terms <- reactive({
    # selected topic
    select <- as.integer(input$topic.network_selected)
    # create data frame for selected topic probabilities
    data.frame(word = rownames(probterms), prob = probterms[,select])
  })

  output$topic.wordcloud <- renderD3wordcloud({
    w <- terms()
    # sort word list by topic probability of selected topic (node)
    w <- w[order(desc(w$prob)),]
    # take only top 5 words -- if comment out, this is not a problem
    w <- w[1:5,]

    x <- d3wordcloud(w$word,
                       w$prob,
                       size.scale = "linear",
                       color.scale = "linear",
                       rotate.max = 0,
                       rotate.min = 0
          )
  })
}
shinyApp(ui = ui, server = server)

Notice that there is not a problem if you comment out line w <- w[1:5,], as when you update all words it words.

However, as I mentioned, I will need to use a subset of inputs as there are usually too many words and I'll need to reduce to (say) top 100.

I spoke with a colleague who is more familiar with D3 and javascript and he recommended that this problem could be solved by adding the line

d3.select(e1).html = ""; 

to line 231 to "/inst/htmlwidgets/d3wordcloud.js" to reset the word cloud to blank before rerunning the word cloud each time.

Essentially, I do not think this would effect anyone else as this just clears the cloud before running each time.

Would it be possible to make this change? If not, do you have any suggestions?

Worst case, I can create my own fork but for my app I need users to have access to this library, and therefore they would pull from my fork.

[jbkunst]

Hi @wesslen !

We need to test if that line don't modify the actual widget behavior. A priori I don't know (I'm not a d3 js expert).

If you are sure about that line you can do a pull request ;)!

[wesslen]

Sounds good. I tried to test (forked the library) and it didn't work but I'll look into it. I'll try to solve on my and then do a pull request (I need to learn how to). Regardless, thanks for your time and your great package!

-Ryan

[jbkunst]

Any help you need just tell me ;)!

[nz-stefan]

I had a similar issue and solved it with the help of shinyjs: gist

[wesslen]

Wow! Thanks @nz-stefan!! Great add! Closing issue.

[jbkunst]

Thanks @nz-stefan!! I'm very glad you helped to @wesslen