tests/testthat/test-read.R

In rbgm: Tools for 'Box Geometry Model' (BGM) Files and Topology for the Atlantis Ecosystem Model

context("reading bgm")


## extract the number in a 
namenumber <- function(x) {
  x <- unlist(lapply(strsplit(x, "\\."), "[", 1))
  as.integer(gsub("[[:alpha:]]|[[:punct:]]", "", x))
}
removetrailing <- function(x) gsub("\\s+$", "", x)
removeleading <- function(x) gsub("^\\s+", "", x)
singlespace <- function(x) gsub("\\s+", " ", x)
addnewline <- function(x) sprintf("%s\n", x)
spaceseparate1 <- function(x) sort(unique(unlist(lapply(strsplit(singlespace(removetrailing(removeleading(x))), " "), function(a) gsub("[[:digit:]]", "", a[1L])))))
dotvertlines <- function(x, type, app) {
  grep(sprintf("^%s[0-9]+.%s\\s", type, app), x, value = TRUE)
}
vertlines <- function(x, type) {
  grep(sprintf("^%s", type), x, value = TRUE)
}
verts <- function(x, type, app = "") {
  x1 <- if (app == "") {vertlines(x, type)}  else {x <- dotvertlines(x, type, app)}
  x2 <- singlespace(x1)
  x3 <- removetrailing(x2)
  x4 <- removeleading(x3)
  x5 <- addnewline(x4)
  
  x6 <- setNames(read.delim(text = x5, sep= " ", header = FALSE, stringsAsFactors = FALSE), c("name", "x", "y"))
  if (!app == "") x6$number <- namenumber(x6$name)
  .as_tibble(x6)
}


library(dplyr)
files <- bgmfiles::bgmfiles()
basetoks <- c("#", "bnd_vert", "box.area", "box.botz", "box.horizmix", "box.ibox",
              "box.iface", "box.inside", "box.label", "box.nconn", "box.vert",
              "box.vertmix", "face.cs", "face.length", "face.lr", "face.p",
              "maxwcbotz", "nbox", "nface", "projection")


for (i in seq_along(files)) {
  f <- files[i]
  d <- .mk_tibble(tx = readLines(f))
  xtoks <- spaceseparate1(d$tx) 
  ## remove any lines that start with "##A"nyletter 
  bad <- grep("^##[[:alpha:]]", xtoks)
  if (length(bad) > 0)  xtoks <- xtoks[-bad]
  #print(all(xtoks == basetoks))
  
  test_that("known tokens are always the same", {
    ## this test
    ## removes leading and trailing whitespace
    ## converts all whitespace to single spaces (including tabs, not include new lines)
    ## removes any lines that begin with two hashes and a letter "^##[[:alpha:]]"
    ## splits every line in the file on " " and lists the unique first tokens and sorts them
    ## compares that list to basetoks above
    ## if this test fails it may mean we have a new kind of file
    ## with a new bit of information
    ## or without something the other files have
    testthat::expect_that(xtoks, testthat::is_identical_to(basetoks))
    
  })
  
  test_that("all vertices are read as data frames", {
    
    testthat::expect_that(bverts <- verts(d$tx, "box", "vert"), is_a("tbl_df"))
    testthat::expect_that(f1verts <- verts(d$tx, "face", "p1"), is_a("tbl_df"))
    testthat::expect_that(f2verts <- verts(d$tx, "face", "p2"), is_a("tbl_df"))
    testthat::expect_that(bndverts <- verts(d$tx, "bnd_vert", ""), is_a("tbl_df"))
    
  })
  
}