Nothing
tests/test-gadget_file.R
In mfdb: MareFrame DB Querying Library
library(mfdb)
library(unittest, quietly = TRUE)
helpers <- c('utils/helpers.R', 'tests/utils/helpers.R') ; source(helpers[file.exists(helpers)])
cmp_gadget_file <- function(gf, ...) {
cmp(strsplit(as.character(gf), "\n"), list(c(...)))
}
# Write a string to a temporary file, reread it into a gadget_file
gadget_file_string <- function (..., file_type = c()) {
temp_file <- tempfile()
fh <- file(temp_file, "w")
on.exit(file.remove(temp_file))
writeLines(c(...), con = fh)
close(fh)
gf <- read.gadget_file(temp_file, file_type = file_type)
ok(gf$filename == basename(temp_file))
return(gf)
}
# Test we can go from string to object and back again
test_loopback <- function(..., file_type = c()) {
gf <- gadget_file_string(c(...), file_type = file_type)
ok(cmp(
strsplit(as.character(gf), "\n")[[1]],
c(...)))
}
ok_group("Can generate gadgetfile objects", {
ok(cmp_error(gadget_file(), "file_name"), "Can't make a gadget_file without filename")
ok("gadget_file" %in% class(gadget_file("wibble")))
})
ok_group("Can get a string representation", {
ok(cmp_gadget_file(
gadget_file("wobble", components = list(list(
cabbage = "yes",
potatoes = c("1 potato", "2 potato", "3 potato", "4!"),
sprouts = 'Like, "Eeeew!"'))),
ver_string,
"cabbage\tyes",
"potatoes\t1 potato\t2 potato\t3 potato\t4!",
'sprouts\tLike, "Eeeew!"'), "Generated string of gadget file")
})
ok_group("Can add components and preambles", {
ok(cmp_gadget_file(
gadget_file("wobble",
components = list(
structure(list(sprouts = 'Like, "Eeeew!"'), preamble = "Carrots"),
component = structure(list(name = "component1"), preamble = list("The first component", "I like it")),
component = structure(list(name = "component2"), preamble = "The second component (with the same name)"),
tea = structure(list(milk = 1, sugars = 2), preamble = "Tea, please"))
),
ver_string,
"; Carrots",
'sprouts\tLike, "Eeeew!"',
'; The first component',
'; I like it',
'[component]',
'name\tcomponent1',
'; The second component (with the same name)',
'[component]',
'name\tcomponent2',
'; Tea, please',
'[tea]',
'milk\t1',
'sugars\t2'), "Multiple components with preambles")
})
ok_group("Can include tabular data", {
ok(cmp_gadget_file(
gadget_file("wobble",
data = data.frame(a = c(1,3), b = c(2,5))),
ver_string,
"; -- data --",
"; a\tb",
"1\t2",
"3\t5"), "Tabular data")
})
ok_group("Can read gadget files", {
ok(cmp_error(read.gadget_file('/non/exist/ant'), "exist/ant"),
"Complain about missing file")
# Basic structure
gf <- gadget_file_string(c(
ver_string,
"a\t2",
"b\t4",
""))
ok(cmp(
gf$components,
list(list(a = 2, b = 4))), "Components read")
ok(is.null(gf$data), "gadget_file has no data")
# Strings / numbers
gf <- gadget_file_string(c(
ver_string,
"allnumber\t2\t4\t6\t8",
"allstring\twho\tdo\twe\tappreciate?",
"mix\t1\tpotato\t2\tpotato\t3\tpotato\t4!",
""))
expect_equal(
gf$components,
list(list(
allnumber = c(2,4,6,8),
allstring = c("who", "do", "we", "appreciate?"),
mix = c("1", "potato", "2", "potato", "3", "potato", "4!"))))
ok(is.null(gf$data), "gadget_file has no data")
# Comments and components
gf <- gadget_file_string(c(
ver_string,
"; This is a comment that should be preserved",
"a\t6",
"b\t8",
"; This is a comment associated with the component below",
"; So is this",
"[carrots]",
"; And this",
"like\tYes I do",
"; Not this",
"[carrots]",
"like\tNo thanks",
""))
expect_equal(
gf$components,
list(
structure(list(a = 6, b = 8), preamble = list("This is a comment that should be preserved")),
carrots = structure(
list(like = "Yes I do"),
preamble = list("This is a comment associated with the component below", "So is this", "And this")),
carrots = structure(
list(like = "No thanks"),
preamble = list("Not this"))))
ok(is.null(gf$data), "gadget_file has no data")
# Data
gf <- gadget_file_string(c(
ver_string,
"a\t99",
"; Preamble for data",
"; -- data --",
"; col\tcolm\tcolt\tcoal",
"3\t5\t9\t3",
"7\t5\t33\t3",
"3\t2\t9\t4",
""))
expect_equal(
gf$components,
list(list(a = 99)))
expect_equal(
gf$data,
structure(
data.frame(col = c(3,7,3), colm = c(5,5,2), colt = c(9,33,9), coal = c(3,3,4)),
preamble = list("Preamble for data")))
# Blank preamble lines get preserved
test_loopback(
ver_string,
"a\t45",
"; ",
"[component]",
"fish\tbattered")
# Can have multiple lines with the same key
test_loopback(
ver_string,
"a\t45",
"a\t46",
"a\t47")
# Can have empty initial components
test_loopback(
ver_string,
"[component]",
"a\t46",
"[component]",
"a\t47")
# Can have comments at the end of lines too
test_loopback(
ver_string,
"; This is a preamble comment",
"[component]",
"a\t46\t\t; This is a comment at the end of a line",
"a\t46\t47\t48\t49\t\t; This is a comment at the end of multiple values",
"a\t; This is a comment at the end of an empty line")
})
ok_group("Bare component labels", {
gf <- gadget_file_string(
ver_string,
"farmer\tgiles",
"cows",
"fresian\tdaisy",
"highland\tbessie",
"pigs",
"oldspot\tgeorge",
"pigs\thenry\tfreddie",
file_type = c())
ok(cmp(gf$components, list(list(
farmer = "giles",
fresian = "daisy",
highland = "bessie",
oldspot = "george",
pigs = c("henry", "freddie")
))), "By default, lines are just extra key/value fields")
gf <- gadget_file_string(
ver_string,
"farmer\tgiles",
"cows",
"fresian\tdaisy",
"highland\tbessie",
"pigs",
"oldspot\tgeorge",
"pigs\thenry\tfreddie",
file_type = c('bare_component'))
ok(cmp(gf$components, list(
list(farmer = "giles"),
cows = list(fresian = "daisy", highland = "bessie"),
pigs = list(oldspot = "george", pigs = c("henry", "freddie"))
)), "By default, lines are just extra key/value fields")
test_loopback(
ver_string,
"farmer\tgiles",
"cows",
"fresian\tdaisy",
"highland\tbessie",
"pigs",
"oldspot\tgeorge",
"pigs\thenry\tfreddie",
file_type = c('bare_component'))
})
ok_group("Implicit component labels", {
gf <- gadget_file_string(
ver_string,
"farmer\tgiles",
"cows\t2",
"fresian\tdaisy",
"highland\tbessie",
"pigs\t4",
"oldspot\tgeorge",
"gloucester\thenry\tfreddie",
file_type = c())
ok(cmp(gf$components, list(list(
farmer = "giles",
cows = 2,
fresian = "daisy",
highland = "bessie",
pigs = 4,
oldspot = "george",
gloucester = c("henry", "freddie")
))), "By default, lines are just extra key/value fields")
gf <- gadget_file_string(
ver_string,
"farmer\tgiles",
"cows\t2",
"fresian\tdaisy",
"highland\tbessie",
"pigs\t4",
"oldspot\tgeorge",
"gloucester\thenry\tfreddie",
file_type = c(implicit_component = "^(cows|pigs)$"))
ok(cmp(gf$components, list(
list(farmer = "giles"),
cows = list(cows = 2, fresian = "daisy", highland = "bessie"),
pigs = list(pigs = 4, oldspot = "george", gloucester = c("henry", "freddie"))
)), "Turn on implicit components, and they get divided")
test_loopback(
ver_string,
"farmer\tgiles",
"cows\t2",
"fresian\tdaisy",
"highland\tbessie",
"pigs\t4",
"oldspot\tgeorge",
"gloucester\thenry\tfreddie",
file_type = c(implicit_component = "^(cows|pigs)$"))
})
Try the mfdb package in your browser
Any scripts or data that you put into this service are public.
mfdb documentation built on June 21, 2022, 5:07 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
library(mfdb)
library(unittest, quietly = TRUE)
helpers <- c('utils/helpers.R', 'tests/utils/helpers.R') ; source(helpers[file.exists(helpers)])
cmp_gadget_file <- function(gf, ...) {
cmp(strsplit(as.character(gf), "\n"), list(c(...)))
}
# Write a string to a temporary file, reread it into a gadget_file
gadget_file_string <- function (..., file_type = c()) {
temp_file <- tempfile()
fh <- file(temp_file, "w")
on.exit(file.remove(temp_file))
writeLines(c(...), con = fh)
close(fh)
gf <- read.gadget_file(temp_file, file_type = file_type)
ok(gf$filename == basename(temp_file))
return(gf)
}
# Test we can go from string to object and back again
test_loopback <- function(..., file_type = c()) {
gf <- gadget_file_string(c(...), file_type = file_type)
ok(cmp(
strsplit(as.character(gf), "\n")[[1]],
c(...)))
}
ok_group("Can generate gadgetfile objects", {
ok(cmp_error(gadget_file(), "file_name"), "Can't make a gadget_file without filename")
ok("gadget_file" %in% class(gadget_file("wibble")))
})
ok_group("Can get a string representation", {
ok(cmp_gadget_file(
gadget_file("wobble", components = list(list(
cabbage = "yes",
potatoes = c("1 potato", "2 potato", "3 potato", "4!"),
sprouts = 'Like, "Eeeew!"'))),
ver_string,
"cabbage\tyes",
"potatoes\t1 potato\t2 potato\t3 potato\t4!",
'sprouts\tLike, "Eeeew!"'), "Generated string of gadget file")
})
ok_group("Can add components and preambles", {
ok(cmp_gadget_file(
gadget_file("wobble",
components = list(
structure(list(sprouts = 'Like, "Eeeew!"'), preamble = "Carrots"),
component = structure(list(name = "component1"), preamble = list("The first component", "I like it")),
component = structure(list(name = "component2"), preamble = "The second component (with the same name)"),
tea = structure(list(milk = 1, sugars = 2), preamble = "Tea, please"))
),
ver_string,
"; Carrots",
'sprouts\tLike, "Eeeew!"',
'; The first component',
'; I like it',
'[component]',
'name\tcomponent1',
'; The second component (with the same name)',
'[component]',
'name\tcomponent2',
'; Tea, please',
'[tea]',
'milk\t1',
'sugars\t2'), "Multiple components with preambles")
})
ok_group("Can include tabular data", {
ok(cmp_gadget_file(
gadget_file("wobble",
data = data.frame(a = c(1,3), b = c(2,5))),
ver_string,
"; -- data --",
"; a\tb",
"1\t2",
"3\t5"), "Tabular data")
})
ok_group("Can read gadget files", {
ok(cmp_error(read.gadget_file('/non/exist/ant'), "exist/ant"),
"Complain about missing file")
# Basic structure
gf <- gadget_file_string(c(
ver_string,
"a\t2",
"b\t4",
""))
ok(cmp(
gf$components,
list(list(a = 2, b = 4))), "Components read")
ok(is.null(gf$data), "gadget_file has no data")
# Strings / numbers
gf <- gadget_file_string(c(
ver_string,
"allnumber\t2\t4\t6\t8",
"allstring\twho\tdo\twe\tappreciate?",
"mix\t1\tpotato\t2\tpotato\t3\tpotato\t4!",
""))
expect_equal(
gf$components,
list(list(
allnumber = c(2,4,6,8),
allstring = c("who", "do", "we", "appreciate?"),
mix = c("1", "potato", "2", "potato", "3", "potato", "4!"))))
ok(is.null(gf$data), "gadget_file has no data")
# Comments and components
gf <- gadget_file_string(c(
ver_string,
"; This is a comment that should be preserved",
"a\t6",
"b\t8",
"; This is a comment associated with the component below",
"; So is this",
"[carrots]",
"; And this",
"like\tYes I do",
"; Not this",
"[carrots]",
"like\tNo thanks",
""))
expect_equal(
gf$components,
list(
structure(list(a = 6, b = 8), preamble = list("This is a comment that should be preserved")),
carrots = structure(
list(like = "Yes I do"),
preamble = list("This is a comment associated with the component below", "So is this", "And this")),
carrots = structure(
list(like = "No thanks"),
preamble = list("Not this"))))
ok(is.null(gf$data), "gadget_file has no data")
# Data
gf <- gadget_file_string(c(
ver_string,
"a\t99",
"; Preamble for data",
"; -- data --",
"; col\tcolm\tcolt\tcoal",
"3\t5\t9\t3",
"7\t5\t33\t3",
"3\t2\t9\t4",
""))
expect_equal(
gf$components,
list(list(a = 99)))
expect_equal(
gf$data,
structure(
data.frame(col = c(3,7,3), colm = c(5,5,2), colt = c(9,33,9), coal = c(3,3,4)),
preamble = list("Preamble for data")))
# Blank preamble lines get preserved
test_loopback(
ver_string,
"a\t45",
"; ",
"[component]",
"fish\tbattered")
# Can have multiple lines with the same key
test_loopback(
ver_string,
"a\t45",
"a\t46",
"a\t47")
# Can have empty initial components
test_loopback(
ver_string,
"[component]",
"a\t46",
"[component]",
"a\t47")
# Can have comments at the end of lines too
test_loopback(
ver_string,
"; This is a preamble comment",
"[component]",
"a\t46\t\t; This is a comment at the end of a line",
"a\t46\t47\t48\t49\t\t; This is a comment at the end of multiple values",
"a\t; This is a comment at the end of an empty line")
})
ok_group("Bare component labels", {
gf <- gadget_file_string(
ver_string,
"farmer\tgiles",
"cows",
"fresian\tdaisy",
"highland\tbessie",
"pigs",
"oldspot\tgeorge",
"pigs\thenry\tfreddie",
file_type = c())
ok(cmp(gf$components, list(list(
farmer = "giles",
fresian = "daisy",
highland = "bessie",
oldspot = "george",
pigs = c("henry", "freddie")
))), "By default, lines are just extra key/value fields")
gf <- gadget_file_string(
ver_string,
"farmer\tgiles",
"cows",
"fresian\tdaisy",
"highland\tbessie",
"pigs",
"oldspot\tgeorge",
"pigs\thenry\tfreddie",
file_type = c('bare_component'))
ok(cmp(gf$components, list(
list(farmer = "giles"),
cows = list(fresian = "daisy", highland = "bessie"),
pigs = list(oldspot = "george", pigs = c("henry", "freddie"))
)), "By default, lines are just extra key/value fields")
test_loopback(
ver_string,
"farmer\tgiles",
"cows",
"fresian\tdaisy",
"highland\tbessie",
"pigs",
"oldspot\tgeorge",
"pigs\thenry\tfreddie",
file_type = c('bare_component'))
})
ok_group("Implicit component labels", {
gf <- gadget_file_string(
ver_string,
"farmer\tgiles",
"cows\t2",
"fresian\tdaisy",
"highland\tbessie",
"pigs\t4",
"oldspot\tgeorge",
"gloucester\thenry\tfreddie",
file_type = c())
ok(cmp(gf$components, list(list(
farmer = "giles",
cows = 2,
fresian = "daisy",
highland = "bessie",
pigs = 4,
oldspot = "george",
gloucester = c("henry", "freddie")
))), "By default, lines are just extra key/value fields")
gf <- gadget_file_string(
ver_string,
"farmer\tgiles",
"cows\t2",
"fresian\tdaisy",
"highland\tbessie",
"pigs\t4",
"oldspot\tgeorge",
"gloucester\thenry\tfreddie",
file_type = c(implicit_component = "^(cows|pigs)$"))
ok(cmp(gf$components, list(
list(farmer = "giles"),
cows = list(cows = 2, fresian = "daisy", highland = "bessie"),
pigs = list(pigs = 4, oldspot = "george", gloucester = c("henry", "freddie"))
)), "Turn on implicit components, and they get divided")
test_loopback(
ver_string,
"farmer\tgiles",
"cows\t2",
"fresian\tdaisy",
"highland\tbessie",
"pigs\t4",
"oldspot\tgeorge",
"gloucester\thenry\tfreddie",
file_type = c(implicit_component = "^(cows|pigs)$"))
})
Try the mfdb package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.