Adding more examples, a head method

DESCRIPTION

@@ -11,8 +11,8 @@ Authors@R: c(
   person("Joshua", "Kunst", role=c("ctb")),
   person("Raphaël", "Velt", role=c("cph"), comment="gexf-js library"),
   person(family="Gephi Consortium", role=c("cph"), comment="GEXF language"),
-  person("Cornelius", "Fritz", role = "rev", comment = c(what = "JOSS reviewer", ORCID = "")),
-  person("Jonathan", "Cardoso Silva", role = "rev", comment = c(what = "JOSS reviewer", ORCID = ""))
+  person("Cornelius", "Fritz", role = "rev", comment = c(what = "JOSS reviewer")),
+  person("Jonathan", "Cardoso Silva", role = "rev", comment = c(what = "JOSS reviewer"))
   )
 Description: Create, read and write 'GEXF' (Graph Exchange 'XML' Format) graph
     files (used in 'Gephi' and others). Using the 'XML' package, it allows the user to
@@ -31,10 +31,10 @@ Imports:
     servr
 License: MIT + file LICENSE
 LazyLoad: yes
-RoxygenNote: 7.0.2
+RoxygenNote: 7.1.1
 Suggests: knitr,
     rmarkdown,
     tinytest,
-    covr, tinytest
+    covr
 VignetteBuilder: knitr
 Roxygen: list(markdown = TRUE)

Makefile

@@ -23,7 +23,7 @@ check: $(PKGNAME)_$(VERSION).tar.gz
 	R CMD check --no-vignettes --no-manual $(PKGNAME)_$(VERSION).tar.gz
 
 checkfull: R/*.R inst/NEWS README.md
-	R CMD build . \&& 
+	R CMD build . && \
 		R CMD check --as-cran $(PKGNAME)_$(VERSION).tar.gz
 
 checkv: $(PKGNAME)_$(VERSION).tar.gz

NAMESPACE

@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(head,gexf)
 S3method(plot,gexf)
 S3method(print,gexf)
 S3method(summary,gexf)

R/gexf-js.R

@@ -197,7 +197,7 @@ gexf_js_config <- function(
 plot.gexf <- function(
   x, 
   y         = NULL,
-  graphFile    = "network.gexf",
+  graphFile = "network.gexf",
   dir       = tempdir(),
   overwrite = TRUE,
   httd.args = list(),

R/methods.R

@@ -151,3 +151,84 @@ build.and.validate.gexf <- function(
     ), class = "gexf")
 }
 
+
+#' `head` method for gexf objects
+#' 
+#' List the first `n_nodes` and `n_edges` of the [gexf] file.
+#' 
+#' @param x An object of class [gexf].
+#' @param n_nodes,n_edges Integers. Number of nodes and edges to print
+#' @param ... Ignored
+#' @examples 
+#' fn <- system.file("gexf-graphs/lesmiserables.gexf", package = "rgexf")
+#' g  <- read.gexf(fn)
+#' head(g, n_nodes = 5)
+#' @export
+head.gexf <- function(x, n_nodes = 6L, n_edges = n_nodes, ...) {
+
+  if (n_nodes == 0L | n_edges == 0L)
+    stop("n_nodes and n_edges should be a positive integer.")
+
+  # Splitting the XML
+  txt <- strsplit(x$graph, split = "\n")[[1L]]
+  ids <- 1L
+
+  # Finding the start and end point of nodes and edges
+  # nodes_start <- which(grepl("^\\s*<node[^>]*>", txt))
+  nodes_end <- which(grepl("^\\s*</node[^>]*>", txt))
+  n_nodes   <- min(length(nodes_end), n_nodes)
+
+  # Extending
+  if (n_nodes) {
+    ids <- ids:nodes_end[n_nodes]
+    nodes_end <- which(grepl("\\s*</nodes>", txt))
+  } else {
+    nodes_end <- which(grepl("\\s*<nodes/>", txt))
+    ids <- ids:nodes_end
+  }
+
+
+
+  # Checking edges now
+  edges_start <- which(grepl("^\\s*(<edge[^>]*>)", txt))
+  n_edges     <- min(length(edges_start), n_edges)
+
+  if (n_edges) {
+
+    if (n_edges > 1L)
+      edges_end <- c(edges_start[-1L], which(grepl("^\\s*</edges>", txt)))
+    else
+      edges_end <- edges_start
+
+    ids <- c(ids, nodes_end:edges_end[n_edges])
+    ids <- c(ids, edges_end[length(edges_end)]:length(txt))
+
+  } else 
+    ids <- c(ids, nodes_end:length(txt))
+
+  ids <- sort(unique(ids))
+
+  # Figuring out the print
+  txt <- txt[ids]
+  if (n_nodes && nrow(x$nodes) > n_nodes) {
+    where <- grepl("^\\s*</nodes>", txt)
+    txt[where] <- paste("\t\t\t...\n", txt[where])
+  }
+
+  if (n_edges && nrow(x$edges) > n_edges) {
+    where <- grepl("^\\s*</edges>", txt)
+    txt[where] <- paste("\t\t\t...\n", txt[where])
+  }
+
+  cat(txt, sep = "\n")
+
+  # cat(txt[1:(nodes_start_end[1L] + n - 1L)], sep = "\n")
+  # cat("...\n")
+  # cat(txt[nodes_start_end[2]:edges_start_end[1L]], sep = "\n")
+  # cat(txt[(edges_start_end[1L] + 1):(edges_start_end[1L] + n - 1L)], sep = "\n")
+  # cat("...\n")
+  # cat(txt[edges_start_end[2]:length(txt)], "\n")
+  # 
+  invisible(x)
+
+}

R/read.gexf.R

@@ -499,14 +499,30 @@ new.gexf.graph <- function(
   # Return  
 
   build.and.validate.gexf(
-    meta=meta,
-    mode=list(defaultedgetype=defaultedgetype, mode=mode),
-    atts.definitions = list(nodes = NULL, edges = NULL),
+    meta        = meta,
+    mode        = list(
+      defaultedgetype = defaultedgetype,
+      mode            = mode
+      ),
+    atts.definitions = list(
+      nodes = NULL,
+      edges = NULL
+      ),
     nodesVizAtt = NULL,
     edgesVizAtt = NULL,
-    nodes=data.frame(id=NULL, label=NULL, row.names=NULL),
-    edges=data.frame(id=NULL, source=NULL,target=NULL, weight=NULL, row.names=NULL),
-    graph=XML::saveXML(xmlFile, encoding="UTF-8")
+    nodes = data.frame(
+      id        = NULL,
+      label     = NULL, 
+      row.names = NULL)
+    ,
+    edges = data.frame(
+      id        = NULL,
+      source    = NULL,
+      target    = NULL,
+      weight    = NULL,
+      row.names = NULL
+      ),
+    graph       = XML::saveXML(xmlFile, encoding="UTF-8")
     )
 
 }

docker/Dockerfile

@@ -1,9 +1,11 @@
-FROM rocker/r-base:latest
+FROM rocker/drd
 
 RUN apt-get update && \
 	apt-get install -y --no-install-recommends \
-	r-cran-xml r-cran-igraph r-cran-rmarkdown r-cran-knitr \
-	r-cran-covr r-cran-tinytest
+	libssl-dev
+
+RUN Rscript -e 'utils::install.packages(c("XML", "igraph", "rmarkdown", "knitr", \
+	"covr", "tinytest")'
 
 RUN Rscript -e 'utils::install.packages("servr")'
 

docker/Makefile

@@ -1,4 +1,4 @@
 build:
-	docker build -t gvegayon/rgexf:release -f Dockerfile . 
+	docker build -t gvegayon/rgexf:latest -f Dockerfile . 
 push: build
-	docker push gvegayon/rgexf:release 
+	docker push gvegayon/rgexf:latest

inst/tinytest/test-bugs.r

@@ -1,6 +1,6 @@
-context("Checking functions")
+# context("Checking functions")
 
-test_that("check_and_map_colors", {
+# test_that("check_and_map_colors", {
   set.seed(11)
   net <- igraph::barabasi.game(20)
 
@@ -9,4 +9,4 @@ test_that("check_and_map_colors", {
   col[1,1] <- -1
   expect_error(igraph.to.gexf(net, nodesVizAtt = list(color=col)), "range")
 
-})
+# })

inst/tinytest/test-examples.r

@@ -0,0 +1,3 @@
+# context("Examples")
+# 
+# test_examples()

inst/tinytest/test-igraph.r

@@ -1,6 +1,6 @@
-context("igraph back and forth")
-
-test_that("viz attributes are kept", {
+# context("igraph back and forth")
+# 
+# test_that("viz attributes are kept", {
 
   set.seed(1)
   net <- igraph::barabasi.game(10)
@@ -41,4 +41,4 @@ test_that("viz attributes are kept", {
   expect_equal(layout[, 1:2], layout2[, 1:2])
 
 
-})
+# })

inst/tinytest/test-rgexf.r

@@ -1,7 +1,7 @@
-context("gexf function")
-
-# ------------------------------------------------------------------------------
-test_that("data.frame or matrix work OK", {
+# context("gexf function")
+# 
+# # ------------------------------------------------------------------------------
+# test_that("data.frame or matrix work OK", {
 
   nodes <- cbind(a=1:10, b=letters[1:10])
   edges <- matrix(sample(1:10, 20, TRUE), ncol=2)
@@ -10,10 +10,10 @@ test_that("data.frame or matrix work OK", {
   set.seed(1);ans1 <- gexf(nodes, edges)
 
   expect_equal(ans0,ans1)
-})
+# })
 
 # ------------------------------------------------------------------------------
-test_that("errors", {
+# test_that("errors", {
   nodes <- cbind(a=1:10, b=letters[1:10])
   edges <- matrix(sample(1:10, 20, TRUE), ncol=2)
 
@@ -33,4 +33,4 @@ test_that("errors", {
   expect_error(gexf(nodes, edges, nodeDynamic = list(1)),"should be a ")
   expect_error(gexf(nodes, edges, edgeDynamic = list(1)),"should be a ")
 
-})
+# })