Окно поиска в сети Участок

Question

Я создал Сеть мутаций белка с использованием forceNetwork() функция networkD3 пакет. Он отображается на панели "Просмотрщик" RStudio.

Затем я могу сохранить его в виде файла HTML для совместного использования с сохранением динамической природы (например, щелчка по узлам, выделения соединений и т. Д.).

Png-версия моего сетевого графика выглядит следующим образом:

Это представление о верхних 20% в моих исходных данных, а полные данные выглядят еще более объемными и сложными.

Мне нужно иметь возможность добавить поиск в эту сеть ForceNetwork, чтобы конкретные узлы могли быть расположены в сложной сети. Javascript или jquery часть этого может быть легко достигнута путем редактирования копии пакета networkD3 и переупаковки. Но моя главная задача - добавить 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

Мое вдохновение пришло от Джейсона Рапера. Как лучше всего включить поиск в этой ситуации? Я подумал о том, чтобы сначала сохранить рендеринг как 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
  )
)