Tuesday, 26 November 2019

Port JavaScript async and igraph code to R?

I'm struggling to port some JavaScript code (which includes async and graph functionality) to R. Help please!

Here's what I'm trying to port:

import jsonpFetch from "./jsonpFetch"; import bus from '../bus';

/**
 * This function builds a graph from google's auto-suggestions.
 */
export default function buildGraph(entryWord, pattern, MAX_DEPTH, progress) {
  entryWord = entryWord && entryWord.trim();
  if (!entryWord) return;

  entryWord = entryWord.toLocaleLowerCase();

  const insertPosition = pattern.indexOf('...');
  if (insertPosition < 0) {
    throw new Error('Query pattern is missing "..."');
  }
  const queryPosition = pattern.indexOf('[query]');
  if (queryPosition < 0) {
    throw new Error('Query pattern is missing "[query]" keyword');
  }

  if (insertPosition < queryPosition) {
    throw new Error('[query] should come before ...');
  }

  let cancelled = false;
  let pendingResponse;
  let graph = require('ngraph.graph')();
  graph.maxDepth = MAX_DEPTH;
  let queue = [];
  let requestDelay = 300 + Math.random() * 100;
  progress.startDownload();

  startQueryConstruction();

  return {
    dispose,
    graph
  }

  function dispose() {
    cancelled = true;
    if (pendingResponse) {
      pendingResponse.cancel();
      pendingResponse = null;
    }
  }

  function startQueryConstruction() {
    graph.addNode(entryWord, {depth: 0});
    fetchNext(entryWord);
  }

  function loadSiblings(parent, results) {
    let q = fullQuery(parent).toLocaleLowerCase();
    var parentNode = graph.getNode(parent);

    if (!parentNode) {
      throw new Error('Parent is missing for ' + parent);
    }

    results.filter(x => x.toLocaleLowerCase().indexOf(q) === 0)
      .map(x => x.substring(q.length))
      .forEach(other => {
        const hasOtherNode = graph.hasNode(other);
        const hasOtherLink = graph.getLink(other, parent) || graph.getLink(parent, other);
        if (hasOtherNode) {
          if (!hasOtherLink) {
            graph.addLink(parent, other);
          }
          return;
        }

        let depth = parentNode.data.depth + 1;
        graph.addNode(other, {depth});
        graph.addLink(parent, other);
        if (depth < MAX_DEPTH) queue.push(other);
      });

    setTimeout(loadNext, requestDelay);
  }

  function loadNext() {
    if (cancelled) return;
    if (queue.length === 0) {
      bus.fire('graph-ready', graph);
      return;
    }

    let nextWord = queue.shift();
    fetchNext(nextWord);
    progress.updateLayout(queue.length, nextWord);
  }

  function fetchNext(query) {
    pendingResponse = getResponse(fullQuery(query));
    pendingResponse
      .then(res => onPendingReady(res, query))
      .catch((msg) => {
        const err = 'Failed to download ' + query + '; Message: ' + msg;
        console.error(err);
        progress.downloadError(err)
        loadNext();
      });
  }

  function onPendingReady(res, query) {
    if (res.length >= 2) {
      loadSiblings(query, res[1]);
    } else {
      console.error(res);
      throw new Error('Unexpected response');
    }
  }

  function fullQuery(query) {
    return pattern.replace('[query]', query).replace('...', '');
  }

  function getResponse(query) {
    return jsonpFetch('//suggestqueries.google.com/complete/search?client=firefox&q=' + encodeURIComponent(query));
  }
}

And this is what I have so far in R:

# This function builds a graph from Google's Auto-Suggestions

buildGraph <- function(entryWord, pattern) {

  graph <- igraph::make_empty_graph() # setup empty graph

  entryWord <- trimws(entryWord) #remove leading/trailing whitespace
  entryWord <- tolower(entryWord) # lowercase technology name

  requestDelay <- 0.3 + runif(1, 0, 1) * 0.1 # 300 milliseconds (0.3 seconds) + some number between 0 and 1 * 100 milliseconds (0.1 seconds)

  startQueryConstruction()

  dispose <- function() {
    cancelled <- TRUE
    if (pendingResponse) {
      # pendingResponse.cancel();
      # pendingResponse = null;
    }
  }

  startQueryConstruction <- function() {
    graph %>% igraph::add.vertices(entryWord)
    fetchNext(entryWord)
  }

  loadSiblings <- function(parent, results) {
    q = tolower(fullQuery(parent))
    parentNode <- igraph::vertex_attr(graph, parent)

    if (!parentNode) {
      # throw new Error('Parent is missing for ' + parent);
      stderr(paste0('Parent is missing for ', parent))
    }

    # results.filter(x => x.toLocaleLowerCase().indexOf(q) === 0)
  #     .map(x => x.substring(q.length))
  #     .forEach(other => {
  #       const hasOtherNode = graph.hasNode(other);
  #       const hasOtherLink = graph.getLink(other, parent) || graph.getLink(parent, other);
  #       if (hasOtherNode) {
  #         if (!hasOtherLink) {
  #           graph.addLink(parent, other);
  #         }
  #         return;
  #       }
  #       
  #       let depth = parentNode.data.depth + 1;
  #       graph.addNode(other, {depth});
  #       graph.addLink(parent, other);
  #       if (depth < MAX_DEPTH) queue.push(other);
  #       });
  #     
  #     setTimeout(loadNext, requestDelay);
  # }

  loadNext <- function() {
    # if (cancelled) return;
    if (length(queue) == 0) {
      # bus.fire('graph-ready', graph)
      # return;
    }

    nextWord <- queue.shift() # what is queue.shift in R?????
    fetchNext(nextWord)
    # progress.updateLayout(queue.length, nextWord) -- I think this is only for Vue UI
  }

  fetchNext <- function(query) {
    pendingResponse = getResponse(query)
    pendingResponse %...>%
       res = onPendingReady(res, query) %...!%
        (function(error) {
          print(paste("Failed to download: ", query, "; Message: ", error$message))
          loadNext()
        })
  }

  onPendingReady <- function(res, query) {
    if (length(res) >= 2) {
      loadSiblings(query, res[1])
    } else {
      # catch and print error
      # console.error(res)
      # throw error
      # throw new Error('Unexpected response');
    }
  }

  fullQuery <- function(query) {
    # return pattern.replace('[query]', query).replace('...', '')
  }

  getResponse <- function(query) {
    json_response <- future::future(jsonlite::fromJSON('//suggestqueries.google.com/complete/search?client=firefox&q=' + encodeURIComponent(query)))
    return(json_response)
  }


}

Please note that I've included some commented out some lines of JavaScript code where I'm not sure what the R equivalent is. Most of the murky code for me is focused on how to do stuff in igraph and how to do stuff asynchronously in R (using promises and/or futures).

Attribution: https://github.com/anvaka/vs/blob/master/src/lib/buildGraph.js

Thanks in advance!



from Port JavaScript async and igraph code to R?

No comments:

Post a Comment