tests/testthat/test.graph.utility.R

library(HEMDAG);
source("make.test.data.R");

context("test graph utility functions");

test_that("root.node works", {
  g <- make.graph();
  root <- root.node(g);

  expect_equal(root, "A");
  expect_equal(length(root), 1);
})

test_that("compute.flipped.graph works", {
  if (!check.graph()){ skip("graph package cannot be loaded"); }

  g <- make.graph();
  ndg <- graph::numNodes(g);
  edg <- graph::numEdges(g);

  og <- compute.flipped.graph(g);
  ndog <- numNodes(og);
  edog <- numEdges(og);

  expect_s4_class(og,"graphNEL");
  expect_equal(ndg, 10);
  expect_equal(edg, 16);
  expect_equal(ndog, 10);
  expect_equal(edog, 16);
})

test_that("graph.levels works", {
  g <- make.graph();
  root <- root.node(g);
  lev <- graph.levels(g, root=root);

  expect_equal(lev[["level_0"]], "A");
  expect_equal(lev[["level_1"]], c("B","C","G"));
  expect_equal(lev[["level_2"]], c("D","E"));
  expect_equal(lev[["level_3"]], "F");
  expect_equal(lev[["level_4"]], c("H","I","J"));
  expect_equal(length(lev), 5);

  expect_error(graph.levels(g, root="R"), "root node not found in g. Insert the root node");
  expect_error(graph.levels(g, root="B"), "root is not the right root node of g. Use the function root.node\\(g\\) to find the root node of g");
})

test_that("build.parents works", {
  g <- make.graph();
  nd <- nodes(g);
  root <- root.node(g)
  parents <- build.parents(g, root=root);
  lev <- graph.levels(g, root=root);
  parents.tod <- build.parents.top.down(g, lev, root=root);
  parents.bup <- build.parents.bottom.up(g, lev, root=root);
  parents.tsort <- build.parents.topological.sorting(g, root=root);

  expect_equal(length(parents), 9);
  expect_equal(length(parents.tod), 9);
  expect_equal(length(parents.bup), 9);
  expect_equal(names(parents), c("B","C","D","E","F","G","H","I","J"));
  expect_equal(names(parents.tod), c("B","C","G","D","E","F","H","I","J"));
  expect_equal(names(parents.bup), c("J","I","H","F","E","D","G","C","B"));
  expect_equal(names(parents.tsort), c("G","E","C","B","D","F","J","I","H"));
  expect_equal(parents[["B"]], "A");
  expect_equal(parents[["C"]], "A");
  expect_equal(parents[["D"]], "B");
  expect_equal(parents[["E"]], c("A","G"));
  expect_equal(parents[["F"]], c("B","C","D"));
  expect_equal(parents[["G"]], "A");
  expect_equal(parents[["H"]], c("C","E","F","G"));
  expect_equal(parents[["I"]], c("D","F"));
  expect_equal(parents[["J"]], "F");

  expect_error(build.parents(g, root="R"), "root node not found in g. Insert the root node");
  expect_error(build.parents(g, root="B"), "root is not the right root node of g. Use the function root.node\\(g\\) to find the root node of g");
  expect_error(build.parents.top.down(g, root="R"), "root node not found in g. Insert the root node");
  expect_error(build.parents.top.down(g, root="B"), "root is not the right root node of g. Use the function root.node\\(g\\) to find the root node of g");
  expect_error(build.parents.bottom.up(g,root="R"), "root node not found in g. Insert the root node");
  expect_error(build.parents.bottom.up(g,root="B"), "root is not the right root node of g. Use the function root.node\\(g\\) to find the root node of g");
  expect_error(build.parents.topological.sorting(g,root="R"), "root node not found in g. Insert the root node");
  expect_error(build.parents.topological.sorting(g,root="B"),
    "root is not the right root node of g. Use the function root.node\\(g\\) to find the root node of g");
})

test_that("build.children works", {
  g <- make.graph();
  nd <- nodes(g);
  root <- root.node(g)
  children <- build.children(g);
  lev <- graph.levels(g, root=root);
  children.tod <- build.children.top.down(g,lev);
  children.bup <- build.children.bottom.up(g,lev);

  expect_equal(length(children), 10);
  expect_equal(length(children.tod), 10);
  expect_equal(length(children.bup), 10);
  expect_equal(names(children), c("A","B","C","D","E","F","G","H","I","J"));
  expect_equal(names(children.tod), c("A","B","C","G","D","E","F","H","I","J"));
  expect_equal(names(children.bup), c("J","I","H","F","E","D","G","C","B","A"));

  expect_equal(children[["A"]], c("B","C","G","E"));
  expect_equal(children[["B"]], c("D","F"));
  expect_equal(children[["C"]], c("F","H"));
  expect_equal(children[["D"]], c("F","I"));
  expect_equal(children[["E"]], "H");
  expect_equal(children[["F"]], c("H","I","J"));
  expect_equal(children[["G"]], c("H","E"));
  expect_equal(children[["H"]], character(0));
  expect_equal(children[["I"]], character(0));
  expect_equal(children[["J"]], character(0));
})

test_that("build.ancestors works", {
  g <- make.graph();
  nd <- nodes(g);
  root <- root.node(g);
  lev <- graph.levels(g, root=root);
  anc <- build.ancestors(g);
  anc.tod <- build.ancestors.per.level(g,lev);
  anc.bup <- build.ancestors.bottom.up(g,lev);

  expect_equal(length(anc), 10);
  expect_equal(length(anc.tod), 10);
  expect_equal(length(anc.bup), 10);
  expect_equal(names(anc), nd);
  expect_equal(names(anc.tod), c("A","B","C","G","D","E","F","H","I","J"));
  expect_equal(names(anc.bup), c("J","I","H","F","E","D","G","C","B","A"));
  expect_equal(anc[["A"]], "A");
  expect_equal(anc[["B"]], c("A","B"));
  expect_equal(anc[["C"]], c("A","C"));
  expect_equal(anc[["D"]], c("B","A","D"));
  expect_equal(anc[["E"]], c("A","G","E"));
  expect_equal(anc[["F"]], c("D","B","A","C","F"));
  expect_equal(anc[["G"]], c("A","G"));
  expect_equal(anc[["H"]], c("F","D","B","A","E","G","C","H"));
  expect_equal(anc[["I"]], c("F","D","B","A","C","I"));
  expect_equal(anc[["J"]], c("F","D","B","A","C","J"));
})

test_that("build.descendants works", {
  g <- make.graph();
  nd <- nodes(g);
  root <- root.node(g);
  desc <- build.descendants(g);
  lev <- graph.levels(g, root=root);
  desc.tod <- build.descendants.per.level(g,lev);
  desc.bup <- build.descendants.bottom.up(g,lev);

  expect_equal(length(desc), 10);
  expect_equal(length(desc.tod), 10);
  expect_equal(length(desc.bup), 10);
  expect_equal(names(desc), nd);
  expect_equal(names(desc.tod), c("A","B","C","G","D","E","F","H","I","J"));
  expect_equal(names(desc.bup), c("J","I","H","F","E","D","G","C","B","A"));
  expect_equal(desc[["A"]], c("G","E","H","C","F","J","B","D","I","A"));
  expect_equal(desc[["B"]], c("H","F","J","D","I","B"));
  expect_equal(desc[["C"]], c("H","F","J","I","C"));
  expect_equal(desc[["D"]], c("H","F","J","I","D"));
  expect_equal(desc[["E"]], c("H","E"));
  expect_equal(desc[["F"]], c("H","J","I","F"));
  expect_equal(desc[["G"]], c("E","H","G"));
  expect_equal(desc[["H"]], c("H"));
  expect_equal(desc[["I"]], c("I"));
  expect_equal(desc[["J"]], c("J"));
})

test_that("constraints.matrix works", {
  g <- make.graph();
  tmp <- tempfile();

  m <- constraints.matrix(g);
  write.table(m, row.names=TRUE, col.names=TRUE, quote=FALSE, file=tmp);
  m.tmp <- read.table(tmp, row.names=NULL);
  m.check <- as.matrix(m.tmp[,c("child", "parent")]);
  rownames(m.check) <- m.tmp[,1];
  expect_equal(constraints.matrix(g), m);
})

test_that("lexicographical.topological.sort works", {
  g <- make.graph();
  gL1 <- graph::addEdge(from="A",to="A",g);
  gL2 <- graph::addEdge(from="C",to="C",g);

  expect_equal(lexicographical.topological.sort(g), c("A","B","C","D","F","G","E","H","I","J"));
  expect_error(lexicographical.topological.sort(gL1), "input graph g contains self-loop");
  expect_error(lexicographical.topological.sort(gL2), "input graph g contains self-loop");
})

test_that("build.consistent.graph works", {
  g <- make.graph();
  root <- root.node(g);
  G <- graph::addNode("Z",g);

  expect_s4_class(build.consistent.graph(g, root=root),"graphNEL");
  expect_output(build.consistent.graph(G, root=root), "removed nodes not accessible from root:\\n1 \\t Z");
})

test_that("check.dag.integrity works", {
  g <- make.graph();
  root <- root.node(g);
  G <- graph::addNode("Z",g);
  G <- graph::addEdge(from="Z",to="C",G);
  G <- graph::addEdge(from="Z",to="Z",G);
  expect_output(check.dag.integrity(g, root=root), "dag is ok");
  expect_output(check.dag.integrity(G, root=root), "not all nodes accessible from root\nnodes not accessible from root:\nZ");
  expect_error(check.dag.integrity(g, root="R"), "root node not found in g. Insert the root node");
  expect_error(check.dag.integrity(g, root="B"),
    "the supplied root node is not the right root node of g. Use the function root.node\\(g\\) to find the root node of g");
})

test_that("find.leaves works", {
  g <- make.graph();
  expect_equal(find.leaves(g), c("H","I","J"));
})

test_that("distances.from.leaves works", {
  g <- make.graph();
  dist.leaves <- distances.from.leaves(g);

  nd <- c("A","B","C","D","E","F","G","H","I","J");
  dist <- c(2,2,1,1,1,1,1,0,0,0);
  names(dist) <- nd;
  expect_equal(dist.leaves, dist);
})

test_that("check.hierarchy.single.sample works", {
  S  <- make.scores();
  g <- make.graph();

  adj <- adj.upper.tri(g);
  Y <- S["pr1",];
  Y.gpav  <- gpav(Y, W=NULL, adj);
  root <- root.node(g);
  nd <- graph::nodes(g);
  nd.noroot <- nd[-which(nd==root)];

  ## hierarchy constraints satisfied
  broken <- rep(FALSE, length(nd.noroot));
  names(broken) <- nd.noroot;
  satisfied <- sum(broken==FALSE);
  names(satisfied) <- FALSE;
  check <- list(status="OK", hierarchy.constraints.broken=broken, hierarchy.constraints.satisfied=satisfied);

  ## check that gpav hierarchical algorithm respects hierarchical constraints
  S.gpav.check <- check.hierarchy.single.sample(Y.gpav, g, root);
  expect_equal(S.gpav.check, check);

  ## check that random flat scores violates hierarchical constraints
  Y.flat <- Y[nd.noroot];
  check.flat <- check.hierarchy.single.sample(Y.flat, g, root);
  broken <- c(FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE);
  names(broken) <- nd.noroot;
  satisfied <- c(7,2);
  names(satisfied) <- c(FALSE,TRUE);
  check <- list(status="NOTOK", hierarchy.constraints.broken=broken, hierarchy.constraints.satisfied=satisfied);
  expect_equal(check.flat, check);
})

test_that("check.hierarchy works", {
  S  <- make.scores();
  g <- make.graph();
  root <- root.node(g);
  nd <- graph::nodes(g);
  nd.noroot <- nd[-which(nd==root)];

  ## hierarchy constraints satisfied
  broken <- rep(FALSE, length(nd.noroot));
  names(broken) <- nd.noroot;
  satisfied <- sum(broken==FALSE);
  names(satisfied) <- FALSE;
  check <- list(status="OK", hierarchy.constraints.broken=broken, hierarchy.constraints.satisfied=satisfied);

  ## check that all hierarchical algorithms respect hierarchical constraints
  S.htd  <- htd(S, g, root);
  S.htd.check <- check.hierarchy(S.htd, g, root);
  expect_equal(S.htd.check, check);

  S.max  <- obozinski.max(S, g, root);
  S.max.check <- check.hierarchy(S.max, g, root);
  expect_equal(S.max.check, check);

  S.and  <- obozinski.and(S, g, root);
  S.and.check <- check.hierarchy(S.and, g, root);
  expect_equal(S.and.check, check);

  S.or  <- obozinski.or(S, g, root);
  S.or.check <- check.hierarchy(S.or, g, root);
  expect_equal(S.or.check, check);

  S.tprTF <- tpr.dag(S, g, root, positive="children", bottomup="threshold.free", topdown="htd");
  S.tprTF.check <- check.hierarchy(S.tprTF, g, root);
  expect_equal(S.tprTF.check, check);

  S.tprT <- tpr.dag(S, g, root, positive="children", bottomup="threshold", topdown="htd", t=0.5);
  S.tprT.check <- check.hierarchy(S.tprT, g, root);
  expect_equal(S.tprT.check, check);

  S.tprW <- tpr.dag(S, g, root, positive="children", bottomup="weighted.threshold.free", topdown="htd", w=0.5);
  S.tprW.check <- check.hierarchy(S.tprW, g, root);
  expect_equal(S.tprW.check, check);

  S.tprWT <- tpr.dag(S, g, root, positive="children", bottomup="weighted.threshold", topdown="htd", t=0.5, w=0.5);
  S.tprWT.check <- check.hierarchy(S.tprWT, g, root);
  expect_equal(S.tprWT.check, check);

  S.descensTF <- tpr.dag(S, g, root, positive="descendants", bottomup="threshold.free", topdown="htd");
  S.descensTF.check <- check.hierarchy(S.descensTF, g, root);
  expect_equal(S.descensTF.check, check);

  S.descensT <- tpr.dag(S, g, root, positive="descendants", bottomup="threshold", topdown="htd", t=0.5);
  S.descensT.check <- check.hierarchy(S.descensT, g, root);
  expect_equal(S.descensT.check, check);

  S.descensW <- tpr.dag(S, g, root, positive="descendants", bottomup="weighted.threshold.free", topdown="htd", w=0.5);
  S.descensW.check <- check.hierarchy(S.descensW, g, root);
  expect_equal(S.descensW.check, check);

  S.descensWT <- tpr.dag(S, g, root, positive="descendants", bottomup="weighted.threshold", topdown="htd", t=0.5, w=05);
  S.descensWT.check <- check.hierarchy(S.descensWT, g, root);
  expect_equal(S.descensWT.check, check);

  S.descensTAU <- tpr.dag(S, g, root, positive="descendants", bottomup="tau", topdown="htd", t=0.5);
  S.descensTAU.check <- check.hierarchy(S.descensTAU, g, root);
  expect_equal(S.descensTAU.check, check);

  S.ISOtprTF <- tpr.dag(S, g, root, positive="children", bottomup="threshold.free", topdown="gpav");
  S.ISOtprTF.check <- check.hierarchy(S.ISOtprTF, g, root);
  expect_equal(S.ISOtprTF.check, check);

  S.ISOtprT <- tpr.dag(S, g, root, positive="children", bottomup="threshold", topdown="gpav", t=0.5);
  S.ISOtprT.check <- check.hierarchy(S.ISOtprT, g, root);
  expect_equal(S.ISOtprT.check, check);

  S.ISOtprW <- tpr.dag(S, g, root, positive="children", bottomup="weighted.threshold.free", topdown="gpav", w=0.5);
  S.ISOtprW.check <- check.hierarchy(S.ISOtprW, g, root);
  expect_equal(S.ISOtprW.check, check);

  S.ISOtprWT <- tpr.dag(S, g, root, positive="children", bottomup="weighted.threshold", topdown="gpav", t=0.5, w=0.5);
  S.ISOtprWT.check <- check.hierarchy(S.ISOtprWT, g, root);
  expect_equal(S.ISOtprWT.check, check);

  S.ISOdescensTF <- tpr.dag(S, g, root, positive="descendants", bottomup="threshold.free", topdown="gpav");
  S.ISOdescensTF.check <- check.hierarchy(S.ISOdescensTF, g, root);
  expect_equal(S.ISOdescensTF.check, check);

  S.ISOdescensT <- tpr.dag(S, g, root, positive="descendants", bottomup="threshold", topdown="gpav", t=0.5);
  S.ISOdescensT.check <- check.hierarchy(S.ISOdescensT, g, root);
  expect_equal(S.ISOdescensT.check, check);

  S.ISOdescensW   <- tpr.dag(S, g, root, positive="descendants", bottomup="weighted.threshold.free", topdown="gpav", w=0.5);
  S.ISOdescensW.check <- check.hierarchy(S.ISOdescensW, g, root);
  expect_equal(S.ISOdescensW.check, check);

  S.ISOdescensWT  <- tpr.dag(S, g, root, positive="descendants", bottomup="weighted.threshold", topdown="gpav", t=0.5, w=0.5);
  S.ISOdescensWT.check <- check.hierarchy(S.ISOdescensWT, g, root);
  expect_equal(S.ISOdescensWT.check, check);

  S.ISOdescensTAU <- tpr.dag(S, g, root, positive="descendants", bottomup="tau", topdown="gpav", t=0.5);
  S.ISOdescensTAU.check <- check.hierarchy(S.ISOdescensTAU, g, root);
  expect_equal(S.ISOdescensTAU.check, check);

  ## check that random flat scores violates hierarchical constraints
  S <- S[,nd.noroot];
  check.flat <- check.hierarchy(S, g, root);
  broken <- c(FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, TRUE, TRUE);
  names(broken) <- nd.noroot;
  satisfied <- c(3,6);
  names(satisfied) <- c(FALSE,TRUE);
  check <- list(status="NOTOK", hierarchy.constraints.broken=broken, hierarchy.constraints.satisfied=satisfied);
  expect_equal(check.flat, check);
})

test_that("weighted.adjacency.matrix works", {
  file.zip <- system.file("extdata/edges.txt.gz", package="HEMDAG");
  file.txt <- paste0(tempdir(),"/","edges.txt");
  m.tupla <- read.table(gzfile(file.zip), colClasses="character", stringsAsFactors=FALSE);
  write.table(m.tupla, file=file.txt, row.names=FALSE, col.names=FALSE, quote=FALSE);

  m <- weighted.adjacency.matrix(file=file.zip);
  pr.names <- rownames(m);

  tmp <- tempfile();
  write.table(m, file=tmp, row.names=FALSE, col.names=FALSE, quote=FALSE);
  m.check <- as.matrix(read.table(tmp));
  dimnames(m.check) <- list(pr.names, pr.names);

  expect_equal(weighted.adjacency.matrix(file=file.txt), m.check);
  expect_equal(weighted.adjacency.matrix(file=file.zip), m.check);

  ## replace rows and columns names with random integer number (entrez gene-ID)
  entrez <- 1:length(pr.names);
  for(i in 1:length(pr.names)){
    m.tupla[which(m.tupla[,1]==pr.names[i]),1] <- entrez[i];
    m.tupla[which(m.tupla[,2]==pr.names[i]),2] <- entrez[i];
  }
  write.table(m.tupla, file=file.txt, row.names=FALSE, col.names=FALSE, quote=FALSE);

  m <- weighted.adjacency.matrix(file=file.txt);

  tmp <- tempfile();
  write.table(m, file=tmp, row.names=FALSE, col.names=FALSE, quote=FALSE);
  m.check <- as.matrix(read.table(tmp));
  dimnames(m.check) <- list(entrez, entrez);

  expect_equal(weighted.adjacency.matrix(file=file.txt), m.check);
})

test_that("tupla.matrix works", {
  ## store tupla matrix
  tmp <- tempfile();
  zip <- paste0(tempdir(),"/","tmp.gz");

  ## scores matrix
  m <- make.scores();
  tupla.matrix(m, output.file=tmp);
  m.check <- read.table(tmp);
  expect_equal(m.check, read.table(tmp));

  ## square symmetric matrix
  file <- system.file("extdata/edges.txt.gz", package="HEMDAG");
  j <- read.table(gzfile(file), colClasses="character", stringsAsFactors=FALSE);
  write.table(j, file=tmp, row.names=FALSE, col.names=FALSE, quote=FALSE);
  w <- weighted.adjacency.matrix(file=tmp);

  tupla.matrix(w, output.file=tmp);
  w.check <- read.table(tmp);
  expect_equal(w.check, read.table(tmp));

  ## degenerate case when w is symmetric and some interactions are zero
  w <- matrix(0, ncol=3, nrow=3);
  dimnames(w) <- list(LETTERS[1:3], LETTERS[1:3]);
  diag(w)[-1] <- 1;

  tupla.matrix(w, output.file=zip);
  w.check <- read.table(gzfile(zip));
  expect_equal(w.check, read.table(gzfile(zip)));
})

test_that("build.scores.matrix works", {
  tmp <- tempfile();

  ## read scores matrix from list
  file.list  <- system.file("extdata/scores.list.txt.gz", package="HEMDAG");
  S <- build.scores.matrix.from.list(file.list, split="[(\t,|)]");
  write.table(S, file=tmp, row.names=TRUE, col.names=TRUE, quote=FALSE);
  S.check <- read.table(tmp);
  expect_equal(S.check, read.table(tmp));

  ## name of rows are entrez-geneID (ie integer number)
  file.list.entrez <- tempfile();
  con <- gzfile(file.list);
  line <- readLines(con);
  close(con);
  entrez <- c(1, 10, 100, 1000);
  out <- c();
  li <- strsplit(line, split="\t");
  for(i in 1:length(li)){
    li[[i]][1] <- entrez[i];
    out <- c(out, paste0(li[[i]], collapse="\t"));
  }
  writeLines(out, file.list.entrez);
  S <- build.scores.matrix.from.list(file.list.entrez, split="[(\t,|)]");
  write.table(S, file=tmp, row.names=TRUE, col.names=TRUE, quote=FALSE);
  S.check <- read.table(tmp);
  expect_equal(S.check, read.table(tmp));

  ## read scores matrix from tupla
  file.tupla <- system.file("extdata/scores.tupla.txt.gz", package="HEMDAG");
  S <- build.scores.matrix.from.tupla(file.tupla);
  write.table(S, file=tmp, row.names=TRUE, col.names=TRUE, quote=FALSE);
  S.check <- read.table(tmp);
  expect_equal(S.check, read.table(tmp));

  ## name of rows are entrez geneID (integer number)
  file.tupla.entrez <- tempfile();
  m <- read.table(gzfile(file.tupla), stringsAsFactors=FALSE);
  entrez <- c(1, 10, 100, 1000);
  prs <- unique(m[,1]);
  for(i in 1:length(prs))
    m[which(m[,1]==prs[i]),1] <- entrez[i];
  write.table(m, file=file.tupla.entrez, row.names=TRUE, col.names=TRUE, quote=FALSE);
  S <- build.scores.matrix.from.tupla(file.tupla.entrez);
  write.table(S, file=tmp, row.names=TRUE, col.names=TRUE, quote=FALSE);
  S.check <- read.table(tmp);
  expect_equal(S.check, read.table(tmp));
})

test_that("build.edges.from.hpo.obo works", {
  ## take a while and require internet connection ...
  not_on_cran <- function(){identical(Sys.getenv("NOT_CRAN"), "TRUE");}  ## set NOT_CRAN environment variable to TRUE
  if(not_on_cran()){
    ## ## read and save plain hp.obo file
    tmp <- tempfile();
    hpobo <- "http://purl.obolibrary.org/obo/hp.obo";

    build.edges.from.hpo.obo(obofile=hpobo, file=tmp);
    obo.check <- read.table(tmp);
    expect_equal(obo.check, read.table(tmp));

    ## read and save zipped hp.obo file
    lines <- readLines(hpobo);
    obozip <- paste0(tempdir(),"/","hp.obo.gz")
    con <- gzfile(obozip, "w");
    writeLines(lines, con);
    close(con);
    edgzip <- paste0(tempdir(),"/","hp.edges.txt.gz");

    build.edges.from.hpo.obo(obofile=obozip, file=edgzip);
    obo.check <- read.table(gzfile(edgzip));
    expect_equal(obo.check, read.table(gzfile(edgzip)));
  }else{
    skip_on_cran(); ## skip test on CRAN
  }
})

test_that("write.graph works", {
  tmp <- tempfile();
  zip <- paste0(tempdir(),"/","tmp.gz");

  g <- make.graph();
  write.graph(g, file=tmp);
  write.graph(g, file=zip);

  tmp.check <- read.table(tmp);
  zip.check <- read.table(gzfile(zip));

  expect_equal(tmp.check, read.table(tmp));
  expect_equal(zip.check, read.table(gzfile(zip)));
})

test_that("read.graph works", {
  ## read from zipped file
  zip <- system.file("extdata/graph.edges.txt.gz", package= "HEMDAG");
  g <- read.graph(file=zip);
  expect_s4_class(g, "graphNEL");

  ## read from plain file
  tmp <- tempfile();
  write.table(read.table(gzfile(zip)), tmp);
  g <- read.graph(file=tmp);
  expect_s4_class(g, "graphNEL");
})

test_that("read.undirected.graph works", {
  ## read from zipped file
  zip <- system.file("extdata/edges.txt.gz", package="HEMDAG");
  g <- read.undirected.graph(file=zip);
  expect_s4_class(g, "graphNEL");

  ## read from plain file
  tmp <- tempfile();
  write.table(read.table(gzfile(zip)), tmp);
  g <- read.undirected.graph(file=tmp);
  expect_s4_class(g, "graphNEL");
})
marconotaro/hemdag documentation built on Nov. 21, 2024, 10:05 p.m.