闪亮的 htmlOutput 对第二次输入更改没有反应答案

【问题标题】：shiny htmlOutput doesn't react on second input change闪亮的 htmlOutput 对第二次输入更改没有反应
【发布时间】：2017-07-08 20:20:35
【问题描述】：

我有 shinyapp 来生成谷歌词树可视化。 shinyapp 界面有两个输入。文本和术语。我为所选文本子集 data.frame 并替换 html 模板中的所需内容。

模板在这里https://developers.google.com/chart/interactive/docs/gallery/wordtree

问题是，shinyapp 只更改一次。当我第二次更改文本或术语时，html 页面变白。当我检查文件夹上的文件时，我看到 html 文件内容发生了变化，但它没有显示在闪亮的页面上。

app.R

shinyApp(
  ui = fluidPage(
    fluidRow(
      column(width = 6,  selectInput("input.filter", label = "selec text", choices = mytexts$yazi.header, selected = "text 1")) ,
      column(width = 6,textInput("input.term", "type term", "today"))
      ),
    fluidRow(tags$head(titlePanel("title panel"))),
    fluidRow(htmlOutput("treehtml")) 
  ) ,
server = function(input, output, session) { 
  output$treehtml <- reactive({
    print(input$input.filter)
    print(input$input.term)
    xid <- subset(mytexts, yazi.header == if(is.null(input$input.filter)) {"text 1"} 
                  else {input$input.filter} ) 
    print(xid$L1)
    xxwt <- mytexts.cumle[mytexts.cumle$cumleid == xid$L1, ]
    xxwt <- paste("['", paste(xxwt$clean, collapse = "'], ['"), "'],", sep = "")
    wttemp <- paste(readLines("wordtree/_wordtree_tmp.html"), collapse="\n")
    wttemp <- gsub("today",input$input.term, wttemp, fixed = TRUE)
    wttemp <- gsub("['DEMO1 DEMO2 DEMO3'],",xxwt, wttemp, fixed = TRUE)
    write(wttemp, "wordtree/wttemp.html")
    wttemp
    })
})

wordtree/_wordtree_tmp.html

<html>
<head>
  <script type="text/javascript" src="https://www.gstatic.com/charts/loader.js"></script>
    <script type="text/javascript">
      google.charts.load('current', {packages:['wordtree']});
    google.charts.setOnLoadCallback(drawChart);

    function drawChart() {
      var data = google.visualization.arrayToDataTable(
        [ ['DEMO DEMO DEMO'], ]
      );

      var options = {
        wordtree: {
          format: 'implicit',
          type: 'double',
          word: 'today'
        }
      };

      var chart = new google.visualization.WordTree(document.getElementById('wordtree_basic'));
      chart.draw(data, options);
    }
    </script>
</head>
<body>
      <div id="wordtree_basic" style="width: 900px; height: 500px;"></div>
</body>
</html>

【问题讨论】：

只是评论：我不知道这是否是原因，但您应该避免输入 id 中的点（如input.term）。
谢谢，我以前没听说过。我试过了，但是没有用。
您没有在帖子中提供数据框 mytexts 和 mytexts.cumle。所以我们无法复制。而_wordtree_tmp.html 是一个“完整的” html 文件，带有html、head 和body 标签。您的应用程序将此 html 放在 div 中，并且应该呈现此 html。我不是 html 方面的专家，但如果可以做到这一点，我会感到惊讶。
无论如何，这也不是一种严肃的方式来呈现这个图表......我会告诉你如何干净利落地，但这需要一点时间。
另外，你可能对这个 R 包感兴趣（在页面中搜索“diagonalNetwork”）christophergandrud.github.io/networkD3

标签： r shiny

【解决方案1】：

例如可以使用shinyjs的函数runjs进行如下操作。

library(shiny)
library(shinyjs)
library(jsonlite)

sentences <- data.frame(
  group = c("A","A","A","A","A","A","A","A","A","A","B","B","B","B","B","B","B","B","B"),
  sentence = c("Phrases", "cats are better than dogs", "cats eat kibble", 
               "cats are better than hamsters", "cats are awesome", "cats are people too", 
               "cats eat mice", "cats meowing", "cats in the cradle", "cats eat mice", 
               "cats in the cradle lyrics", "cats eat kibble", "cats for adoption", 
               "cats are family", "cats eat mice", "cats are better than kittens", 
               "cats are evil", "cats are weird", "cats eat mice"),
  stringsAsFactors = FALSE
)    

drawChart <- function(sentences, word){
  sprintf("google.charts.load('current', {packages:['wordtree']});
google.charts.setOnLoadCallback(drawChart);

function drawChart() {
  var data = google.visualization.arrayToDataTable(
          %s
  );

  var options = {
    wordtree: {
      format: 'implicit',
      word: '%s'
    }
  };

  var chart = new google.visualization.WordTree(document.getElementById('wordtree_basic'));
  chart.draw(data, options);
}
", toJSON(sentences), word)
}

shinyApp(
  ui = fluidPage(
    tags$head(
      tags$script(src="https://www.gstatic.com/charts/loader.js")
    ),
    useShinyjs(),
    fluidRow(
      column(width=6, 
        selectInput("filter", label="select group", choices=c("A","B"), selected="A", selectize=FALSE)
      ),
      column(width=6, 
        textInput("word", "type word", "cats")
      )
    ),
    fluidRow(tags$head(titlePanel("title panel"))),
    fluidRow(tags$div(id="wordtree_basic", style="width: 900px; height: 500px;")) 
  ),

  server = function(input, output, session) { 
    observe({
      dat <- subset(sentences, group==input$filter)$sentence
      sentences <- array(dat, dim=c(length(dat),1))
      runjs(drawChart(sentences, input$word))
    })
  }
)

【讨论】：