网络图中的搜索框

我使用以下方法创建了一个蛋白质突变网络forceNetwork()的功能networkD3包裹。它在 RStudio 的“查看器”窗格上呈现。

然后我可以将其保存为 HTML 文件以供共享，同时保留动态特性（如单击节点、突出显示连接等）。

A png version of my network plot looks like below:

这是我原始数据中前 20% 的表示，完整的数据看起来更加庞大和复杂。

我需要能够向这个forceNetwork添加搜索，以便可以在复杂的网络中找到特定的节点。通过编辑包networkD3的副本并重新打包，可以轻松实现其中的javascript或jquery部分。但我的主要挑战是添加包含搜索框的 html 代码。

我的主要 R 代码如下所示：

library(networkD3)
library(XLConnect)

wb <- loadWorkbook("input.xlsx")
nodes <- readWorksheet(wb, sheet="Node", startRow = 1, startCol = 1, header = TRUE)
links <- readWorksheet(wb, sheet="Edges", startRow = 1, startCol = 1, header = TRUE)


fn <- forceNetwork(Links = links, Nodes = nodes,
                   Source = "Source", Target = "ID", Value = "Combo",
                   NodeID = "Mutation", linkDistance = JS('function(d){return d.value * 50;}'), 
                   Nodesize = "IF", Group = "Combo", radiusCalculation = JS("d.nodesize+6"),
                   zoom = T, bounded = F, legend = T, 
                   opacity = 0.8,
                   fontSize = 16 )

fn

我的灵感来自于jsfiddle作者：西蒙·雷珀。 在这种情况下包含搜索的最佳方式是什么？我想到的选项是首先将渲染保存为html。然后阅读并编辑 html 并插入用于搜索的代码段。 我尝试使用 Rhtml 来实现此目的，但这似乎并不简单。任何指示将不胜感激。

虽然我并不热衷于这种交互性，但我认为这将是一个展示如何使用的好机会htmltools with htmlwidgets。稍后，我将重新创建crosstalk，但现在，我将如何复制所提供的示例。

直接复制

library(htmltools)
library(networkD3)

data(MisLinks)
data(MisNodes)

# make a forceNetwork as shown in ?forceNetwork
fn <- forceNetwork(
  Links = MisLinks, Nodes = MisNodes, Source = "source",
  Target = "target", Value = "value", NodeID = "name",
  Group = "group", opacity = 0.4, zoom = TRUE
)

fn <- htmlwidgets::onRender(
  fn,
  '
function(el,x){
debugger;
  var optArray = [];
  for (var i = 0; i < x.nodes.name.length - 1; i++) {
    optArray.push(x.nodes.name[i]);
  }

  optArray = optArray.sort();

  $(function () {
    $("#search").autocomplete({
      source: optArray
    });
  });

  d3.select(".ui-widget button").node().onclick=searchNode;

  function searchNode() {
    debugger;
    //find the node

    var selectedVal = document.getElementById("search").value;
    var svg = d3.select(el).select("svg");
    var node = d3.select(el).selectAll(".node");

    if (selectedVal == "none") {
      node.style("stroke", "white").style("stroke-width", "1");
    } else {
      var selected = node.filter(function (d, i) {
        return d.name != selectedVal;
      });
      selected.style("opacity", "0");
      var link = svg.selectAll(".link")
      link.style("opacity", "0");
      d3.selectAll(".node, .link").transition()
        .duration(5000)
        .style("opacity", 1);
    }
  }
}  
  '
)

browsable(
  attachDependencies(
    tagList(
      tags$head(
        tags$link(
          href="http://code.jquery.com/ui/1.11.0/themes/smoothness/jquery-ui.css",
          rel="stylesheet"
        )
      ),
      HTML(
  '
  <div class="ui-widget">
      <input id="search">
      <button type="button">Search</button>
  </div>
  '     
      ),
      fn
    ),
    list(
      rmarkdown::html_dependency_jquery(),
      rmarkdown::html_dependency_jqueryui()
    )
  )
)

串扰版本

注意：串扰是实验性的，所以这可能会改变

我没有花时间去优化和完善，但这里有一个版本，它与示例做了同样的事情，但使用crosstalk而不是自定义代码和jquery-ui自动完成。

library(htmltools)
library(networkD3)


# demonstrate with experimental crosstalk
#  this will get much easier once we start converting
#  htmlwidgets to work natively with crosstalk

#devtoools::install_github("rstudio/crosstalk")
library(crosstalk)

data(MisLinks)
data(MisNodes)

# make a forceNetwork as shown in ?forceNetwork
fn <- forceNetwork(
  Links = MisLinks, Nodes = MisNodes, Source = "source",
  Target = "target", Value = "value", NodeID = "name",
  Group = "group", opacity = 0.4, zoom = TRUE
)

sd <- SharedData$new(MisNodes, key=~name, group="grp1" )

# no autocomplete so not the same
#  but will use this instead of writing something new
fs <- filter_select(
  id = "filter-node",
  label = "Search Nodes",
  sharedData = sd,
  group = ~name
)

fn <- htmlwidgets::onRender(
  fn,
'
function(el,x){
  // get the crosstalk group
  //  we used grp1 in the SharedData from R
  var ct_grp = crosstalk.group("grp1");
debugger;
  ct_grp
    .var("filter")
    .on("change", function(val){searchNode(val.value)});

  function searchNode(filter_nodes) {
    debugger;
    //find the node
    var selectedVal = filter_nodes? filter_nodes : [];
    var svg = d3.select(el).select("svg");
    var node = d3.select(el).selectAll(".node");

    if (selectedVal.length===0) {
      node.style("opacity", "1");
      svg.selectAll(".link").style("opacity","1");
    } else {
      var selected = node.filter(function (d, i) {
        return selectedVal.indexOf(d.name) >= 0;
      });
      node.style("opacity","0");
      selected.style("opacity", "1");
      var link = svg.selectAll(".link").style("opacity", "0");
      /*
      svg.selectAll(".node, .link").transition()
        .duration(5000)
        .style("opacity", 1);
      */
    }
  }
}  
'
)

browsable(
  tagList(
    fs,
    fn
  )
)