网络图中的搜索框

Question

我使用包的forceNetwork()功能创建了蛋白质突变网络 networkD3.它将在RStudio的"Viewer"窗格中呈现.

然后我可以将其保存为HTML文件,用于共享,保留动态特性(如点击节点,突出显示连接等).

我的网络图的png版本如下所示:

这是我原始数据中前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

我的灵感来自Simon Raper 的jsfiddle.在这种情况下包含搜索的最佳方法是什么？我想到的选项是首先将渲染保存为html.然后阅读并编辑html并插入一段代码进行搜索.我尝试使用Rhtml,但这似乎并不重要.任何指针都将非常感激.

Answer 1

虽然我不是疯了这个互动,我认为这将是展示如何使用一个很好的机会htmltools有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
  )
)