r语言 - 如何使用 shinyjs 将 graphviz 节点数据链接到 Shiny UI htmlOutput?

Question

我希望能够在我的图形可视化图中选择一个节点(带有工具提示(，并在闪亮的UI中输出与该节点关联的文本信息(例如htmlOutput/renderUI(。

这个问题是另一个问题(是否可以在闪亮的应用程序(renderGrViz(中选择图形可视化节点，然后链接到其他信息？尽管上一个问题部分成功(例如，我现在能够选择一个节点，然后在图形可视化图的底部生成相关信息(，但它没有用处，因为输出不是闪亮应用程序的一部分。作为该问题的一部分，函数Shiny.OnInputChanged(...)(或Shiny.setInputValue(被提及为产生类似结果(通过javascript附加html元素(的更方便的方法，我想知道这是否会导致与闪亮框架更兼容的结果，因此可以作为闪亮小部件输出的输入？ 不幸的是，我找不到任何描述类似问题的网站(例如，必须首先从 graphviz 节点中提取数据，然后将此输入连接到一个闪亮的输出(。因此，我整理了一个成功的基于javascript的代码示例，我希望用shinyjs重新创建它，并添加一个htmlOutput('info'(，这是"文本"数据将出现的地方，选择适当的节点。

library(DiagrammeR)
library(shiny)
library(shinyjs)
texts <- c("Great div for A", "Even better div for B")
jsCode <- paste0("
elem = document.getElementById('graphV');
var node = document.createElement('div');
var textnode = document.createTextNode('", texts,"');
node.appendChild(textnode);
elem.appendChild(node);
")
ui = shinyUI(
fluidPage(
useShinyjs(),
sidebarLayout(
sidebarPanel(htmlOutput('info')),
mainPanel(grVizOutput('graphV'))
))
) 
server = function(input, output, session) {
observe({
for(nodeNr in 1:length(jsCode)){
local({
jsToAdd <- jsCode[nodeNr]
shinyjs::onclick(paste0("node", nodeNr), runjs(jsToAdd)) 
})
}
})
output$graphV <- renderGrViz({ 
grViz( "digraph test{
A[tooltip='A word']; 
B[tooltip='Another word'];
A -> B;}" )
})}
shinyApp(ui = ui, server = server)

Answer 1

你可以将shinyjs与onclick一起使用，Oninputchanged和renderUI。

添加点击事件：

shinyjs::onclick(paste0("node", nodeNr), runjs(jsToAdd)) 

使用 javascript 在该 clickevent 中生成一个闪亮的输入：

jsCode <- paste0("Shiny.onInputChange('clickedElemNr',", 1:2,")")

(详见此处：https://shiny.rstudio.com/articles/js-send-message.html(,..

并呈现一个 UI 元素：

observeEvent(eventExpr = input$clickedElemNr,{
output$tooltip <- renderUI({
textInput(inputId = "x", label = "x", value = texts[input$clickedElemNr])
})
})

可重现的示例：

library(DiagrammeR)
library(shiny)
library(shinyjs)
texts <- c("Great div for A", "Even better div for B")
jsCode <- paste0("Shiny.onInputChange('clickedElemNr',", 1:2,")")
ui = shinyUI(
fluidPage(
useShinyjs(),
sidebarLayout(
sidebarPanel(htmlOutput('info'), uiOutput("tooltip")),
mainPanel(grVizOutput('graphV'))
))
) 
server = function(input, output, session) {
observeEvent(eventExpr = input$clickedElemNr,{
output$tooltip <- renderUI({
textInput(inputId = "x", label = "x", value = texts[input$clickedElemNr])
})
})
observe({
for(nodeNr in 1:length(jsCode)){
local({
jsToAdd <- jsCode[nodeNr]
shinyjs::onclick(paste0("node", nodeNr), runjs(jsToAdd)) 
})
}
})
output$graphV <- renderGrViz({ 
grViz( "digraph test{
A[tooltip='A word']; 
B[tooltip='Another word'];
A -> B;}" )
})}
shinyApp(ui = ui, server = server)