Nothing
tests/testthat/test-read.R
In gamstransfer: A Data Interface Between 'GAMS' and R
#
# GAMS - General Algebraic Modeling System R API
#
# Copyright (c) 2017-2024 GAMS Software GmbH <support@gams.com>
# Copyright (c) 2017-2024 GAMS Development Corp. <support@gams.com>
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in all
# copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
# SOFTWARE.
#
library(gamstransfer)
gams_checked = -1
skip_if_no_gams <- function() {
if (gams_checked == -1) {
ret = system2(command="gams", stdout=NULL, stderr=NULL)
if (ret == 127) {
gams_checked = 0
}
else {
gams_checked = 1
}
}
if (gams_checked == 0) {
testthat::skip("GAMS Unavailable")
}
}
test_that("readwritetest", {
skip_if_no_gams()
m = Container$new()
# read all symbols
m$read(testthat::test_path("testdata", "biggdxtest.gdx"))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "biggdxtest.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
# write everything
m$write(testthat::test_path("gt.gdx"))
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "biggdxtest.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# write everything
m$write(testthat::test_path("gt.gdx"), mode = "string")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "biggdxtest.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "biggdxtest.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# test the super call write from the read super call
writeGDX(rl, "gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "biggdxtest.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
}
)
test_that("test_num_1", {
skip_if_no_gams()
m <- Container$new()
expect_true(inherits(m, "Container"))
i <- Set$new(m, "i", records = c("a", "b"))
expect_true(is.data.frame(i$records))
expect_equal(nrow(i$records), 2)
j <- Set$new(m, "j", records = c("c", "d"))
expect_true(is.data.frame(j$records))
expect_equal(nrow(j$records), 2)
recs <- data.frame(list("i" = c("a", "b"),
"j" = c("c", "d"), "values" = c(1, 1)))
a <- Parameter$new(m, "a", c("i", "j"), records = recs)
expect_true(is.data.frame(a$records))
expect_equal(nrow(a$records), 2)
m$write("gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test1.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
m$write("gt.gdx", mode="string")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test1.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test1.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
}
)
test_that("test_num_2", {
skip_if_no_gams()
m <- Container$new()
expect_true(inherits(m, "Container"))
i <- Set$new(m, "i")
expect_true(is.null(i$records))
j <- Set$new(m, "j")
expect_true(is.null(j$records))
recs <- data.frame(list("i" = c("a", "b"),
"j" = c("c", "d"), "values" = c(1, 1)))
a <- Parameter$new(m, "a", c(i, j), recs, domainForwarding = TRUE)
expect_true(is.data.frame(i$records))
expect_equal(as.character(i$records$uni), c("a", "b"))
expect_true(is.data.frame(j$records))
expect_equal(as.character(j$records$uni), c("c", "d"))
m$write("gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test2.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
m$write("gt.gdx", mode="string")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test2.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test2.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
}
)
test_that("test_num_3", {
skip_if_no_gams()
m <- Container$new()
expect_true(inherits(m, "Container"))
i <- Set$new(m, "i")
expect_true(is.null(i$records))
j <- Alias$new(m, "j", i)
expect_true(is.null(j$records))
recs <- data.frame(list("i" = c("a", "b"),
"j" = c("a", "b"), "values" = c(1, 1)))
a <- Parameter$new(m, "a", c(i, j), recs, domainForwarding = TRUE)
expect_true(is.data.frame(i$records))
expect_equal(as.character(i$records$uni), c("a", "b"))
expect_true(is.data.frame(j$records))
expect_equal(as.character(j$records$uni), c("a", "b"))
expect_equal(nrow(a$records), 2)
m$write("gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test3.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
m$write("gt.gdx", mode="string")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test3.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test3.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
}
)
test_that("test_num_4", {
skip_if_no_gams()
m <- Container$new()
i <- Set$new(m, "i")
expect_true(is.null(i$records))
j <- Set$new(m, "j", i)
expect_true(is.null(j$records))
k <- Set$new(m, "k", j)
expect_true(is.null(k$records))
l = Set$new(m, "l", k, records = c("a", "b"), domainForwarding = TRUE )
expect_true(is.data.frame(i$records))
expect_equal(as.character(i$records$uni), c("a", "b"))
expect_true(is.data.frame(j$records))
expect_equal(as.character(j$records$i), c("a", "b"))
expect_true(is.data.frame(k$records))
expect_equal(as.character(k$records$j), c("a", "b"))
expect_true(is.data.frame(l$records))
expect_equal(as.character(l$records$k), c("a", "b"))
m$write("gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test4.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
m$write("gt.gdx", mode="string")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test4.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test4.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
}
)
test_that("test_num_5", {
skip_if_no_gams()
m <- Container$new()
expect_true(inherits(m, "Container"))
i <- Set$new(m, "i")
expect_true(is.null(i$records))
recs <- data.frame(list("i" = "c", "element_text" = "desc for elem 'c'"))
j <- Set$new(m, "j", i, records = recs, domainForwarding = TRUE)
expect_true(is.data.frame(i$records))
expect_equal(as.character(i$records$uni), c("c"))
expect_true(is.data.frame(j$records))
expect_equal(as.character(j$records$i), c("c"))
k <- Set$new(m, "k", j)
expect_true(is.data.frame(i$records))
expect_equal(as.character(i$records$uni), c("c"))
expect_true(is.data.frame(j$records))
expect_equal(as.character(j$records$i), c("c"))
expect_true(is.null(k$records))
l <- Set$new(m, "l", k, records = c("a", "b"), domainForwarding = TRUE)
expect_true(is.data.frame(i$records))
expect_equal(as.character(i$records$uni), c("c", "a", "b"))
expect_true(is.data.frame(j$records))
expect_equal(as.character(j$records$i), c("c", "a", "b"))
expect_true(is.data.frame(k$records))
expect_equal(as.character(k$records$j), c("a", "b"))
expect_true(is.data.frame(l$records))
expect_equal(as.character(l$records$k), c("a", "b"))
m$write("gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test5.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
m$write("gt.gdx", mode="string")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test5.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test5.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
}
)
test_that("test_num_6", {
m <- Container$new()
expect_true(inherits(m, "Container"))
i <- Set$new(m, "i", records = c("c", "a", "b"))
expect_true(is.data.frame(i$records))
m$write("gt.gdx")
m$write("gt.gdx", mode="string")
m2 = Container$new(testthat::test_path("testdata", "test6_uels.gdx"))
expect_true(inherits(m2, "Container"))
expect_true(is.data.frame(m2["foo"]$records))
expect_equal(as.character(m$getUELs()), as.character(m2["foo"]$records$uni))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "test6_uels.gdx"))
m3 = Container$new()
m3$readList(rl)
expect_equal(m2$equals(m3), TRUE)
}
)
test_that("test_num_7", {
m <- Container$new()
expect_true(inherits(m, "Container"))
i <- Set$new(m, "i", records = c("c", "a", "b"))
expect_true(is.data.frame(i$records))
m$write("gt.gdx", uelPriority = "a")
m$write("gt.gdx", uelPriority = "a", mode="string")
m2 = Container$new(testthat::test_path("testdata", "test7_uels.gdx"))
expect_true(inherits(m2, "Container"))
expect_true(is.data.frame(m2["foo"]$records))
expect_equal(c("a", "c", "b"), as.character(m2["foo"]$records$uni))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "test7_uels.gdx"))
m3 = Container$new()
m3$readList(rl)
expect_equal(m2$equals(m3), TRUE)
}
)
test_that("test_num_8", {
m <- Container$new()
expect_true(inherits(m, "Container"))
i <- Set$new(m, "i", records = c("a", "b"))
expect_equal(as.character(i$records$uni), c("a", "b"))
j <- Alias$new(m, "j", i)
expect_equal(as.character(j$records$uni), c("a", "b"))
expect_equal(j$aliasWith$name, "i")
k <- Alias$new(m, "k", j)
expect_equal(as.character(k$records$uni), c("a", "b"))
expect_equal(j$aliasWith$name, "i")
#try writing
m$write("out.gdx")
m$write("out.gdx", mode="string")
# test the super call write
writeList = m$asList()
writeGDX(writeList, "out.gdx")
}
)
test_that("test_num_9", {
m <- Container$new()
expect_true(inherits(m, "Container"))
i <- Set$new(m, "i", list("*", "*"), records =
data.frame(list("col1"=c("a","b"), "col2"=c("c","d"))))
j <- Parameter$new(m, "j", "*", records =
data.frame(list("col1" = c("e", "f"), "col2" = c(1, 1))))
expect_equal(as.character(i$records$col1), c("a", "b"))
expect_equal(as.character(i$records$col2), c("c", "d"))
expect_equal(as.character(m$getUELs()), c("a", "b", "c", "d", "e", "f"))
#just try writing to see if there are any errors
m$write("out.gdx")
m$write("out.gdx", mode="string")
# test the super call write
writeList = m$asList()
writeGDX(writeList, "out.gdx")
}
)
test_that("test_num_10", {
m <- Container$new()
expect_true(inherits(m, "Container"))
i <- Set$new(m, "i")
expect_true(is.null(i$records))
j <- Set$new(m, "j")
expect_true(is.null(j$records))
a <- Parameter$new(m, "a", list(i, j), domainForwarding=TRUE)
df <- data.frame("i"= c("a", "b"),
"j" = c("c", "d"), "value" = c(1, 1))
a$records <- df
expect_false(a$isValid())
df <- data.frame("i"= factor(c("a", "b")),
"j" = factor(c("c", "d")), "value" = c(1, 1))
a$records <- df
expect_true(a$isValid())
expect_equal(as.character(i$records$uni), c("a", "b"))
expect_equal(as.character(j$records$uni), c("c", "d"))
#try writing
m$write("out.gdx")
m$write("out.gdx", mode="string")
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
}
)
test_that("test_num_11", {
m <- Container$new()
expect_true(inherits(m, "Container"))
i <- Set$new(m, "i", records = c("a", "b", "c"))
expect_equal(as.character(i$records$uni), c("a", "b", "c"))
j <- Parameter$new(m, "j", i,
records = data.frame("j"=c("a", "c"), "val" = c(1, 2)))
expect_equal(as.character(j$records$j), c("a", "c"))
expect_equal(j$records$value, c(1, 2))
m$removeSymbols(c("i", "j"))
i <- Set$new(m, "i", records = c("a", "b", "c", "d"))
j <- Parameter$new(m, "j", i,
records = data.frame("i"= c("a", "c"), "val" = c(1, 2)))
expect_equal(j$toDense(), array(c(1,0,2,0)))
m$write("out.gdx")
m$write("out.gdx", mode="string")
# test the super call write
writeList = m$asList()
writeGDX(writeList, "out.gdx")}
)
test_that("test_num_12", {
testthat::expect_warning(Container$new(testthat::test_path("testdata", "test12.gdx")))
}
)
test_that("test_num_13", {
m = Container$new()
i = Set$new(m, "i", records=c("a", "b", "c"))
j = Set$new(m, "j", records=c("d", "e", "f"))
a = Parameter$new(m, "a", i, records=data.frame("i"=c("a","c"),"val"=c(1, 2) ))
b = Parameter$new(m, "b", j, records=data.frame("j"=c("e","f"),"val"=c(1, 2) ))
m$removeSymbols("i")
expect_equal(unlist(m$data$keys()), c("j", "a", "b"))
m$removeSymbols(c("a", "b"))
expect_equal(unlist(m$data$keys()), c("j"))
m$write("out.gdx")
m$write("out.gdx", mode="string")
# test the super call write
writeList = m$asList()
writeGDX(writeList, "out.gdx")
}
)
test_that("test_num_14", {
m = Container$new()
i = Set$new(m, "i", records=c("a", "b", "c"))
expect_equal(unlist(m$data$keys()), c("i"))
m$renameSymbol("i", "h")
expect_equal(unlist(m$data$keys()), c("h"))
m$write("out.gdx")
m$write("out.gdx", mode="string")
# test the super call write
writeList = m$asList()
writeGDX(writeList, "out.gdx")
}
)
# test_that("test_num_15", {
# m = Container$new()
# i = Set$new(m, "i", records=c("a", "b", "c"))
# a = Parameter$new(m, "a", i, records=data.frame(c("aa", "c"), c(1, 2)))
# expect_equal(a$findDomainViolations(), 1)
# expect_equal(a$isValid(), FALSE)
# }
# )
test_that("test_num_16", {
m = Container$new()
i = Set$new(m, "i")
j = Set$new(m, "j", i, records = c("a", "b"), domainForwarding = TRUE)
k = Set$new(m, "k")
l = Set$new(m, "l", k, records = c("c"), domainForwarding = TRUE)
a = Parameter$new(m, "a", l, records = data.frame(c("aa", "c"), c(1, 2)), domainForwarding = TRUE)
# check container
expect_equal(m$.requiresStateCheck, TRUE)
expect_equal(m$isValid(), TRUE)
expect_equal(m$.requiresStateCheck, FALSE)
expect_equal(as.character(m["l"]$records$k), c("c", "aa"))
expect_equal(as.character(m["k"]$records$uni), c("c", "aa"))
expect_equal(as.character(m["j"]$records$i), c("a", "b"))
expect_equal(as.character(m["i"]$records$uni), c("a", "b"))
expect_equal(as.character(m$getUELs()), c("a", "b", "c", "aa"))
expect_equal(a$isValid(), TRUE)
expect_equal(l$isValid(), TRUE)
}
)
test_that("test_num_17", {
m = Container$new()
m$addSet("i")
m$addSet("j", m["i"], records = c("a", "b"), domainForwarding = TRUE)
m$addSet("k")
m$addSet("l", m["k"], records = c("c"), domainForwarding = TRUE)
m$addParameter("a", m["l"], records = data.frame(c("aa", "c"), c(1, 2)), domainForwarding = TRUE)
# check container
expect_equal(m$.requiresStateCheck, TRUE)
expect_equal(m$isValid(), TRUE)
expect_equal(m$.requiresStateCheck, FALSE)
expect_equal(as.character(m["l"]$records$k), c("c", "aa"))
expect_equal(as.character(m["k"]$records$uni), c("c", "aa"))
expect_equal(as.character(m["j"]$records$i), c("a", "b"))
expect_equal(as.character(m["i"]$records$uni), c("a", "b"))
expect_equal(as.character(m$getUELs()), c("a", "b", "c", "aa"))
expect_equal(m$listSymbols(isValid = FALSE), NULL)
}
)
test_that("test_num_18", {
m = Container$new()
df = data.frame("domain"=c("i0"))
types = c(
"binary",
"integer",
"positive",
"negative",
"free",
"sos1",
"sos2",
"semicont",
"semiint"
)
for (i in types) {
varname = paste0("a_", i)
m$addVariable(varname, i, "*", records = df)
expect_equal(colnames(m[varname]$records),
c("domain"))
}
}
)
test_that("test_num_19", {
m = Container$new()
df = data.frame("domain"= c("i0"))
types = c(
"eq", "geq", "leq", "nonbinding", "cone", "external", "boolean"
)
for (i in types) {
eqname = paste0("a_", i)
m$addEquation(eqname, i, "*", records = df)
expect_equal(colnames(m[eqname]$records),
c("domain"))
}
}
)
test_that("test_num_20", {
m = Container$new()
df= data.frame(list("i0", 1, 1, 1, 1, 1))
colnames(df)= c("domain", "marginal", "lower", "scale", "upper", "level")
type = c(
"binary",
"integer",
"positive",
"negative",
"free",
"sos1",
"sos2",
"semicont",
"semiint"
)
for (i in type) {
varname = paste0("a_", i)
m$addVariable(varname, i, "*", records = df)
expect_equal(colnames(m[varname]$records),
c("domain", "level", "marginal", "lower", "upper", "scale"))
}
}
)
test_that("test_num_21", {
m = Container$new()
df= data.frame(list("i0", 1, 1, 1, 1, 1))
colnames(df)= c("domain", "marginal", "lower", "scale", "upper", "level")
type = c(
"eq", "geq", "leq", "nonbinding", "cone", "external", "boolean"
)
for (i in type) {
eqname = paste0("a_", i)
m$addEquation(eqname, i, "*", records = df)
expect_equal(colnames(m[eqname]$records),
c("domain", "level", "marginal", "lower", "upper", "scale"))
}
}
)
test_that("test_num_22", {
m = Container$new()
m$read(testthat::test_path("testdata", "trnsport.gdx"), records = FALSE)
# test supercall read
rl = readGDX(testthat::test_path("testdata", "trnsport.gdx"),
records=FALSE)
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
for (i in m$data$values()) {
expect_equal(m[i$name]$records, NULL)
}
}
)
test_that("test_num_23", {
m = Container$new()
m$read(testthat::test_path("testdata", "trnsport.gdx"), c("i", "j", "x"))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "trnsport.gdx"),
symbols = c("i", "j", "x"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
expect_equal(m["i"]$domainType, "none")
expect_equal(m["j"]$domainType, "none")
expect_equal(m["x"]$domainType, "regular")
}
)
test_that("test_num_24", {
m = Container$new()
m$read(testthat::test_path("testdata", "trnsport.gdx"), c("x"))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "trnsport.gdx"),
symbols = c("x"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
expect_equal(unlist(m$data$keys()), "x")
expect_equal(m["x"]$domainType, "relaxed")
}
)
test_that("test_num_25", {
m = Container$new(testthat::test_path("testdata", "test25.gdx"))
expect_equal(unlist(m$data$keys()), "i")
expect_equal(m["i"]$domain, c("i"))
expect_equal(m["i"]$domainType, "relaxed")
# test supercall read
rl = readGDX(testthat::test_path("testdata", "test25.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
}
)
test_that("test_num_26", {
m = Container$new()
i = Set$new(m, "i", "p")
expect_equal(i$domainType, "relaxed")
j = Set$new(m, "j", i, records =
data.frame(i=c("c"), c("desc for elem 'c'")), domainForwarding=TRUE)
df = data.frame("p" =c("c"))
df$p = factor(df$p, ordered = TRUE)
expect_equal(i$records, df)
df = data.frame("i" =c("c"), "element_text" = c("desc for elem 'c'"))
df$i = factor(df$i, ordered = TRUE)
expect_equal(j$records, df)
k = Set$new(m ,"k", "j")
expect_equal(k$records, NULL)
l = Set$new(m, "l", k, records = c("a", "b"), domainForwarding = TRUE)
# test l
df = data.frame("k"=c("a", "b"))
df$k = factor(df$k, ordered=TRUE)
expect_equal(l$records, df)
# test k
df = data.frame("j"=c("a", "b"))
df$j = factor(df$j, ordered = TRUE)
expect_equal(k$records, df)
# test j
df = data.frame("i"=c("c"), "element_text"=c("desc for elem 'c'"))
df$i = factor(df$i, ordered = TRUE)
expect_equal(j$records, df)
# test i
df = data.frame("p"=c("c"))
df$p = factor(df$p, ordered = TRUE)
expect_equal(i$records, df)
}
)
test_that("test_num_27", {
skip_if_no_gams()
m = Container$new()
m$read(testthat::test_path("testdata", "test27.gdx"))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "test27.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
# write everything
m$write(testthat::test_path("gt.gdx"))
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test27.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# write everything
m$write(testthat::test_path("gt.gdx"), mode="string")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test27.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test27.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
}
)
test_that("test_num_28", {
m = Container$new()
i = Set$new(m, "i")
a_eq = Equation$new(m, "a_eq", "eq", i)
a_geq = Equation$new(m, "a_geq", "geq", i)
a_leq = Equation$new(m, "a_leq", "leq", i)
a_nonbinding = Equation$new(m, "a_nonbinding", "nonbinding", i)
a_cone = Equation$new(m, "a_cone", "cone", i)
a_external = Equation$new(m, "a_external", "external", i)
a_boolean = Equation$new(m, "a_boolean", "boolean", i)
# try writing
expect_equal(m$write("gt.gdx"), NULL)
expect_equal(m$write("gt.gdx", mode="string"), NULL)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
}
)
test_that("test_num_29", {
m = Container$new()
i = Set$new(m, "i")
a_binary = Variable$new(m, "a_binary", "binary", i)
a_integer = Variable$new(m, "a_integer", "integer", i)
a_positive = Variable$new(m, "a_positive", "positive", i)
a_negative = Variable$new(m, "a_negative", "negative", i)
a_free = Variable$new(m, "a_free", "free", i)
a_sos1 = Variable$new(m, "a_sos1", "sos1", i)
a_sos2 = Variable$new(m, "a_sos2", "sos2", i)
a_semicont = Variable$new(m, "a_semicont", "semicont", i)
a_semiint = Variable$new(m, "a_semiint", "semiint", i)
# try writing
expect_equal(m$write("gt.gdx"), NULL)
expect_equal(m$write("gt.gdx", mode="string"), NULL)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
}
)
test_that("test_num_30", {
m = Container$new()
i = Set$new(m, "i")
a = Parameter$new(m, "a", i)
# try writing
expect_equal(m$write("gt.gdx"), NULL)
expect_equal(m$write("gt.gdx", mode="string"), NULL)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
}
)
test_that("test_num_31", {
m = Container$new()
i = Set$new(m, "i", "j")
j = Set$new(m, "j", "i")
a = Parameter$new(m, "a", c(i, j))
m$removeSymbols("j")
j = Set$new(m, "j", "i")
expect_true(a$isValid(verbose=TRUE))
}
)
test_that("test_num_32", {
m = Container$new()
i = Set$new(m, "i")
m$isValid()
expect_equal(m$.requiresStateCheck, FALSE)
j = Set$new(m, "j")
expect_true(m$.requiresStateCheck)
}
)
test_that("test_num_33", {
m = Container$new()
i = Set$new(m, "i")
j = Set$new(m, "j")
k = Set$new(m, "k")
i$domain = j
j$domain = k
k$domain = i
expect_error(m$.__enclos_env__$private$validSymbolOrder())
}
)
test_that("test_num_34", {
m = Container$new()
i = Set$new(m, "i")
j = Alias$new(m, "j", i)
j$setRecords(c("a", "b"))
df = data.frame("uni"=c("a", "b"))
df$uni = factor(df$uni, ordered=TRUE)
expect_equal(i$records, df)
}
)
test_that("test_num_35", {
m = Container$new()
i = Set$new(m, "i")
j = Alias$new(m, "j", i)
j$description = "just a test"
expect_equal(i$description, "just a test")
}
)
test_that("test_num_36", {
m = Container$new()
i = Set$new(m, "i")
k = Set$new(m, "k")
j = Alias$new(m, "j", i)
j$domain = c(k, k)
expect_equal(i$domainNames, c("k", "k"))
}
)
test_that("test_num_37", {
m = Container$new()
i = Set$new(m, "i")
j = Alias$new(m, "j", i)
j$isSingleton = TRUE
expect_equal(i$isSingleton, TRUE)
}
)
test_that("test_num_38", {
m = Container$new()
i = Set$new(m, "i")
expect_equal(i$dimension, 1)
expect_equal(i$domain, c("*"))
i$dimension = 2
expect_equal(i$dimension, 2)
expect_equal(i$domain, c("*", "*"))
i$dimension = 0
expect_equal(i$dimension, 0)
expect_equal(i$domain, list())
a = Parameter$new(m, "a")
expect_equal(a$dimension, 0)
expect_equal(a$domain, list())
expect_equal(a$isScalar, TRUE)
a$dimension = 2
expect_equal(a$domain, list("*", "*"))
expect_equal(a$isScalar, FALSE)
a$dimension = 0
expect_equal(a$domain, list())
expect_equal(a$isScalar, TRUE)
ip = Alias$new(m, "ip", i)
ip$dimension = 2
expect_equal(ip$dimension, 2)
expect_equal(i$dimension, 2)
expect_equal(ip$domain, list("*", "*"))
expect_equal(i$domain, list("*", "*"))
}
)
test_that("test_num_39", {
m = Container$new()
i = Set$new(m, "i")
expect_equal(i$numberRecords, 0)
m$removeSymbols("i")
i = Set$new(m, "i", records = c("a", "b"))
expect_equal(i$numberRecords, 2)
j = Set$new(m, "j", i, records = c("a", "c"))
# expect_true(is.na(j$numberRecords)) #because NA
}
)
test_that("test_num_40", {
m = Container$new(testthat::test_path("testdata", "test40.gdx"))
expect_true(m["a"]$domainType == "regular")
expect_true(is.null(m["a"]$records))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "test40.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
}
)
test_that("test_num_41", {
# test for matrix input of parameter records 2D
m = Container$new()
i = Set$new(m, "i", records = c("a","b"))
j = Set$new(m, "j", records = c("x","y","z"))
recs = matrix(c(1:6), nrow = 2, ncol=3)
d = Parameter$new(m, "d", c(i, j), records = recs)
df = data.frame(i = c("a","a", "a", "b","b","b"),
j = c("x", "y", "z", "x", "y", "z"),
value = c(1,3,5,2,4,6))
df[,1] = factor(df[,1], ordered = TRUE)
df[,2] = factor(df[,2], ordered = TRUE)
expect_equal(d$records, df)
# test for array input of parameter records 2D
m$removeSymbols("d")
recs = array(c(1:6), dim=c(2,3))
d = Parameter$new(m, "d", c(i, j), records = recs)
expect_equal(d$records, df)
#test for array 3D
recs = array(c(1:12), dim=c(2,3,2))
k = Set$new(m, "k", records = c("alpha", "beta"))
d3 = Parameter$new(m, "d3", c(i, j, k), records = recs)
df = data.frame(i = c("a","a", "a", "a","a","a", "b", "b","b","b", "b", "b"),
j = c("x", "x", "y", "y", "z", "z", "x", "x", "y", "y", "z", "z"),
k = c("alpha","beta","alpha","beta","alpha","beta",
"alpha","beta","alpha","beta","alpha","beta"),
value = c(1,7,3,9,5,11,2,8,4,10,6,12))
df[,1] = factor(df[,1], ordered = TRUE)
df[,2] = factor(df[,2], ordered = TRUE)
df[,3] = factor(df[,3], ordered = TRUE)
expect_equal(d3$records, df)
}
)
test_that("test_num_42", {
m = Container$new()
i = Set$new(m, "i", records = paste0("i", c(1:5)))
j = Set$new(m, "j", records = paste0("j", c(1:5)))
recs=data.frame("i"=c("i1","i2","i3","i4","i5"),
"j"=c("j1","j2","j3","j4","j5"), "val"=c(1,1,1,1,1))
a = Parameter$new(m, "a", domain=c(i, j), records = recs)
ap = Parameter$new(m, "ap", domain=c(i, j), records = a$toDense())
expect_equal(a$records, ap$records)
v = Variable$new(m, "v", domain=c(i, j), records = list("level"=a$toDense()))
df = data.frame(i=i$records[,1],
j=j$records[,1],
level= c(1,1,1,1,1)
)
expect_equal(v$records, df)
v2 = Variable$new(m, "v2", domain=c(i, j),
records = list(
"level" = a$toDense(),
marginal = a$toDense(),
lower = a$toDense(),
upper = a$toDense(),
scale = a$toDense()
)
)
e = Equation$new(m, "e", "eq", domain=c(i, j),
records = list(
"level" = a$toDense(),
marginal = a$toDense(),
lower = a$toDense(),
upper = a$toDense(),
scale = a$toDense()
)
)
df = data.frame(i=i$records[,1],
j=j$records[,1],
level= c(1,1,1,1,1),
marginal = replicate(5, 1),
lower = replicate(5, 1),
upper = replicate(5, 1),
scale = replicate(5, 1)
)
expect_equal(v2$records, df)
expect_equal(e$records, df)
}
)
# test converting arrays to records for Parameters, Varaibles, Equations
test_that("test_num_43", {
m = Container$new()
i = Set$new(m, "i", records = paste0("i", c(1:5)))
j = Set$new(m, "j", records = paste0("j", c(1:5)))
recs=data.frame("i"=c("i1","i2","i3","i4","i5"),
"j"=c("j1","j2","j3","j4","j5"), "val"=c(0,0,0,0,0))
recs[2,"val"] = 1
recs[4, "val"] = SpecialValues$EPS
recs = recs[-c(1,3,5),]
row.names(recs) <- NULL
recs2 = data.frame("i"=c("i1","i2","i3","i4","i5"),
"j"=c("j1","j2","j3","j4","j5"), "val"=c(0,0,0,0,0))
recs2["val"] = SpecialValues$EPS
a = Parameter$new(m, "a", domain=c(i, j), records = recs)
ap = Parameter$new(m, "ap", domain=c(i, j), records = recs2)
v = Variable$new(m, "v", domain=c(i, j),
records = list(
"level"=a$toDense(),
"marginal"= ap$toDense()
))
e = Equation$new(m, "e", "eq", domain=c(i, j),
records = list(
"level"=a$toDense(),
"marginal"= ap$toDense()
))
cols = v$domainLabels
cols = append(cols, c("level", "marginal", "lower", "upper", "scale"))
recs=data.frame("i"=c("i1","i2","i3","i4","i5"),
"j"=c("j1","j2","j3","j4","j5"), "level"=c(0,0,0,0,0),
"marginal"=replicate(5, SpecialValues$EPS))
recs[,1] = factor(recs[,1], ordered=TRUE)
recs[,2] = factor(recs[,2], ordered=TRUE)
recs[2,"level"] = 1
recs[4, "level"] = SpecialValues$EPS
expect_equal(v$records, recs)
recs=data.frame("i"=c("i1","i2","i3","i4","i5"),
"j"=c("j1","j2","j3","j4","j5"), "level"=c(0,0,0,0,0),
"marginal"=replicate(5, SpecialValues$EPS))
recs[,1] = factor(recs[,1], ordered=TRUE)
recs[,2] = factor(recs[,2], ordered=TRUE)
recs[2,"level"] = 1
recs[4, "level"] = SpecialValues$EPS
expect_equal(e$records, recs)
}
)
test_that("test_num_44", {
m = Container$new(testthat::test_path("testdata", "test44.gdx"))
expect_true(m["i"]$type == "free")
m$write("out.gdx")
# test supercall read
rl = readGDX(testthat::test_path("testdata", "test44.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
m2 = Container$new(testthat::test_path("out.gdx"))
expect_true(m2["i"]$type == "free")
m$write("out.gdx", mode="string")
m2 = Container$new(testthat::test_path("out.gdx"))
expect_true(m2["i"]$type == "free")
# test the super call write
writeList = m$asList()
writeGDX(writeList, "out.gdx", mode="string")
m2 = Container$new(testthat::test_path("out.gdx"))
expect_true(m2["i"]$type == "free")
}
)
test_that("test_num_45", {
m = Container$new()
i = Set$new(m, "i", records = paste0("i", 1:5))
j = Set$new(m, "j", i, records = paste0("i", 1:5))
m$removeSymbols("i")
expect_true(is.null(i$container))
expect_true(unlist(m$data$keys()) == c("j"))
expect_true(j$isValid())
expect_equal(j$domain, "*")
}
)
test_that("test_num_46", {
skip_if_no_gams()
h = Container$new()
h$read(testthat::test_path("testdata", "biggdxtest.gdx"))
m = Container$new(h)
# write everything
m$write(testthat::test_path("gt.gdx"))
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "biggdxtest.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# write everything
m$write(testthat::test_path("gt.gdx"), mode="string")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "biggdxtest.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "biggdxtest.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
}
)
test_that("test_num_47", {
m = Container$new(testthat::test_path("testdata", "test47.gdx"))
expect_true(m["a"]$domainType == "regular")
expect_true(is.null(m["a"]$records))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "test47.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
}
)
test_that("test_num_48", {
m = Container$new()
i = Set$new(m, "i", domain=c("k"), records = paste0("i", 1:5))
j = Set$new(m, "j", domain=c("*"), records = paste0("j", 1:5))
k = Set$new(m, "k", domain = c("*", "l"), records = data.frame(paste0("k", 1:5), paste0("l", 1:5)))
l = Set$new(m, "l", i, records=paste0("i", 1:2))
m$write("data.gdx")
m = Container$new("data.gdx")
expect_true(m["i"]$domainType == "relaxed")
expect_true(m["j"]$domainType == "none")
expect_true(m["k"]$domainType == "relaxed")
expect_true(m["l"]$domainType == "regular")
expect_true(!is.null(m["i"]$records))
expect_true(!is.null(m["j"]$records))
expect_true(!is.null(m["k"]$records))
expect_true(!is.null(m["l"]$records))
m$write("data.gdx", mode="string")
m = Container$new("data.gdx")
expect_true(m["i"]$domainType == "relaxed")
expect_true(m["j"]$domainType == "none")
expect_true(m["k"]$domainType == "relaxed")
expect_true(m["l"]$domainType == "regular")
expect_true(!is.null(m["i"]$records))
expect_true(!is.null(m["j"]$records))
expect_true(!is.null(m["k"]$records))
expect_true(!is.null(m["l"]$records))
# test the super call write
writeList = m$asList()
writeGDX(writeList, "data.gdx")
expect_true(m["i"]$domainType == "relaxed")
expect_true(m["j"]$domainType == "none")
expect_true(m["k"]$domainType == "relaxed")
expect_true(m["l"]$domainType == "regular")
expect_true(!is.null(m["i"]$records))
expect_true(!is.null(m["j"]$records))
expect_true(!is.null(m["k"]$records))
expect_true(!is.null(m["l"]$records))
}
)
test_that("test_num_49", {
m = Container$new(testthat::test_path("testdata", "test49.gdx"))
expect_equal(m["i"]$domainType, "relaxed")
# test supercall read
rl = readGDX(testthat::test_path("testdata", "test49.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
}
)
test_that("test_num_50", {
m = Container$new()
i = Set$new(m, "i", domain=c("k"), records = paste0("i", 1:5))
j = Set$new(m, "j", domain=c("*"), records = paste0("j", 1:5))
k = Set$new(m, "k", domain = c("*", "l"), records = data.frame(paste0("k", 1:5), paste0("l", 1:5)))
l = Set$new(m, "l", i, records=paste0("i", 1:2))
m$write("data.gdx")
m = Container$new()
m$read(testthat::test_path("data.gdx"), symbols="i")
expect_true(!is.null(m["i"]))
m = Container$new()
m$read(testthat::test_path("data.gdx"), symbols= c("i", "j"))
expect_true(!is.null(m["i"]))
expect_true(!is.null(m["j"]))
# test supercall read
rl = readGDX(testthat::test_path("data.gdx"),
symbols =c("i", "j"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
m = Container$new()
expect_error(m$read(testthat::test_path("data.gdx"), symbols= c("i", "j", "dummy")))
m = Container$new()
i = Set$new(m, "i", domain=c("k"), records = paste0("i", 1:5))
j = Set$new(m, "j", domain=c("*"), records = paste0("j", 1:5))
k = Set$new(m, "k", domain = c("*", "l"), records = data.frame(paste0("k", 1:5), paste0("l", 1:5)))
l = Set$new(m, "l", i, records=paste0("i", 1:2))
m$write("data.gdx", mode="string")
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
m = Container$new()
m$read(testthat::test_path("data.gdx"), symbols="i")
expect_true(!is.null(m["i"]))
m = Container$new()
m$read(testthat::test_path("data.gdx"), symbols= c("i", "j"))
expect_true(!is.null(m["i"]))
expect_true(!is.null(m["j"]))
m = Container$new()
expect_error(m$read(testthat::test_path("data.gdx"), symbols= c("i", "j", "dummy")))
}
)
test_that("test_num_51", {
expect_error(Container$new("dummy.gdx"))
m = Container$new()
expect_error(m$read("dummy.gdx"))
}
)
test_that("test_num_52", {
expect_error(Container$new(data.frame()))
m = Container$new()
expect_error(m$read(data.frame()))
}
)
test_that("test_num_53", {
expect_warning(Container$new(testthat::test_path("testdata", "test53.gdx")))
}
)
test_that("test_num_54", {
m = Container$new(testthat::test_path("testdata", "trnsport.gdx"))
for (i in unlist(m$data$keys())) {
expect_true(is.list(m[i]$summary))
}
expect_true(is.vector(m$listSymbols()))
expect_true(is.vector(m$listParameters()))
expect_true(is.vector(m$listSets()))
expect_true(is.null(m$listAliases()))
expect_true(is.vector(m$listVariables()))
expect_true(is.vector(m$listEquations()))
expect_equal(length(m$listVariables(types="free")), 1)
expect_equal(length(m$listVariables(types="positive")), 1)
expect_equal(length(m$listEquations(types="geq")), 1)
expect_equal(length(m$listEquations(types="eq")), 1)
expect_equal(length(m$listEquations(types="leq")), 1)
expect_equal(length(m$listEquations(types=c("geq", "leq"))), 2)
expect_true(is.data.frame(m$describeSets()))
expect_true(is.data.frame(m$describeParameters()))
expect_true(is.data.frame(m$describeVariables()))
expect_true(is.data.frame(m$describeEquations()))
expect_equal(nrow(m$describeEquations(m$listEquations(types = "geq"))), 1)
expect_equal(nrow(m$describeEquations(m$listEquations(types = "eq"))), 1)
expect_equal(nrow(m$describeEquations(m$listEquations(types = "leq"))), 1)
}
)
test_that("test_num_55", {
m = Container$new(testthat::test_path("testdata", "trnsport.gdx"))
old_names = unlist(m$data$keys())
for (i in unlist(m$data$keys())) {
expect_true(!is.null(m[i]$records))
}
m = Container$new()
m$read(testthat::test_path("testdata", "trnsport.gdx"))
for (i in unlist(m$data$keys())) {
expect_true(is.data.frame(m[i]$records))
}
m = Container$new(testthat::test_path("testdata", "test55.gdx"))
new_names = unlist(m$data$keys())
for (i in unlist(m$data$keys())) {
if (i != "ce") {
expect_true(!is.null(m[i]$records))
}
}
expect_true(!identical(old_names, new_names))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "test55.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
}
)
test_that("test_num_56", {
m = Container$new()
m$read(testthat::test_path("testdata", "trnsport.gdx"))
for (i in unlist(m$data$keys())) {
expect_true(is.data.frame(m[i]$records))
}
}
)
test_that("test_num_57", {
df = data.frame(expand.grid(c("a1","a2"),
c("b1","b2"), c("c1","c2"), c("d1","d2")),
stringsAsFactors=TRUE)
df$value = 1
m = Container$new()
t = Parameter$new(m, "t", domain=replicate(4, "*"))
t$records = df
expect_true(t$isValid())
}
)
# test read from another Container
test_that("test_num_59", {
m = Container$new(testthat::test_path("testdata", "trnsport_with_alias.gdx"))
expect_true(m$isValid())
m2 = Container$new(m)
expect_true(m2$isValid())
}
)
# test read from another Container with invalid symbols
test_that("test_num_60", {
m = Container$new()
i = Set$new(m, "i", records = paste0("i",1:10))
j = Set$new(m, "j", records = paste0("j",1:10))
a = Parameter$new(m, "a", c(i, j))
a$.__enclos_env__$private$.records = "ham"
expect_true(!a$isValid())
expect_error(Container$new(m))
m2 = Container$new()
m2$read(m, c("i", "j"))
expect_equal(unlist(m2$data$keys()), c("i", "j"))
expect_error(m2$read(m, "a"))
}
)
# test converting arrays with EPS (across several columns) values for Parameters, Variables, Equations
test_that("test_num_61", {
m = Container$new()
i = Set$new(m, "i", records = paste0("i", c(1:5)))
j = Set$new(m, "j", records = paste0("j", c(1:5)))
recs=data.frame("i"=c("i1","i2","i3","i4","i5"),
"j"=c("j1","j2","j3","j4","j5"), "val"=c(0,1,0,SpecialValues$EPS,0))
recs <- recs[-c(1,3,5),]
a = Parameter$new(m, "a", domain=c(i, j), records = recs)
recs=data.frame("i"=c("i1","i2","i3","i4","i5"),
"j"=c("j1","j2","j3","j4","j5"), "val"=replicate(5,SpecialValues$EPS))
ap = Parameter$new(m, "ap", domain=c(i, j), records = recs)
v = Variable$new(m, "v", domain=c(i, j), records =
list("level"=a$toDense(), "marginal"=ap$toDense()))
e = Equation$new(m, "e", "eq", domain=c(i, j),
records = list(
"level" = a$toDense(),
marginal = ap$toDense()
)
)
df = data.frame(i=i$records[,1],
j=j$records[,1],
level= c(0,1,0,SpecialValues$EPS,0),
marginal=replicate(5, SpecialValues$EPS)
)
expect_equal(v$records, df)
df = data.frame(i=i$records[,1],
j=j$records[,1],
level= c(0,1,0,SpecialValues$EPS,0),
marginal = replicate(5, SpecialValues$EPS)
)
expect_equal(e$records, df)
}
)
# test symbol isValid if categories are not set properly (directly)
test_that("test_num_62", {
df = data.frame(rev(expand.grid(rev(list(paste0("h", 1:10),
paste0("m", 1:10),paste0("s", 1:10))))), stringsAsFactors = TRUE)
colnames(df) = c("h_1", "m_2", "s_3")
df[["value"]] = runif(nrow(df), 0, 100)
m = Container$new()
hrs = Set$new(m, "h", records = unique(df$h_1))
mins = Set$new(m, "m", records = unique(df$m_2))
secs = Set$new(m, "s", records = unique(df$s_3))
a = Parameter$new(m, "a", c(hrs, mins, secs))
# set records directly
a$records = df
expect_true(a$isValid())
}
)
# test symbol isValid if categories are set properly (directly)
test_that("test_num_63", {
df = data.frame(rev(expand.grid(rev(list(paste0("h", 1:10),
paste0("m", 1:10),paste0("s", 1:10))))), stringsAsFactors = TRUE)
colnames(df) = c("h_1", "m_2", "s_3")
df[["value"]] = runif(nrow(df), 0, 100)
m = Container$new()
hrs = Set$new(m, "h", records = unique(df$h_1))
mins = Set$new(m, "m", records = unique(df$m_2))
secs = Set$new(m, "s", records = unique(df$s_3))
a = Parameter$new(m, "a", c(hrs, mins, secs))
df$h_1 = factor(df$h_1, levels=levels(hrs$records$uni), ordered = TRUE)
df$m_2 = factor(df$m_2, levels=levels(mins$records$uni), ordered = TRUE)
df$s_3 = factor(df$s_3, levels=levels(secs$records$uni), ordered = TRUE)
# set records directly
a$records = df
expect_true(a$isValid())
}
)
# test symbol isValid if categories are not linked to the proper set (directly)
test_that("test_num_64", {
df = data.frame(rev(expand.grid(rev(list(paste0("h", 1:10),
paste0("m", 1:10),paste0("s", 1:10))))), stringsAsFactors = TRUE)
colnames(df) = c("h_1", "m_2", "s_3")
df[["value"]] = runif(nrow(df), 0, 100)
m = Container$new()
hrs = Set$new(m, "h", records = unique(df$h_1))
mins = Set$new(m, "m", records = unique(df$m_2))
secs = Set$new(m, "s", records = unique(df$s_3))
a = Parameter$new(m, "a", c(hrs, mins, secs))
dumb_set = append(levels(df$h_1), "new_element")
df$h_1 = factor(df$h_1, levels=dumb_set, ordered = TRUE)
df$m_2 = factor(df$m_2, levels=levels(mins$records$uni), ordered = TRUE)
df$s_3 = factor(df$s_3, levels=levels(secs$records$uni), ordered = TRUE)
# set records directly
a$records = df
expect_true(a$isValid())
}
)
# test Exception when attempting to set a symbol name with invalid characters
test_that("test_num_65", {
m = Container$new()
expect_error(Set$new(m, "milk&meat"))
expect_error(Set$new(m, "_milk&meat"))
}
)
# test that name.setter (symbols and aliases) cannot set name if it already exists in container
test_that("test_num_66", {
m = Container$new()
i = Set$new(m, "i")
j = Set$new(m, "j")
ip = Alias$new(m, "ip", i)
jp = Alias$new(m, "jp", j)
expr <- function() j$name = "i"
expect_error(expr())
expr <- function() jp$name = "ip"
expect_error(expr())
}
)
# test utility functions
test_that("test_num_67", {
m = Container$new()
i = Set$new(m, "i", records = paste0("i", 1:10))
a = Parameter$new(m, "a", i, records=data.frame(i$records[,1], 1:10))
expect_equal(a$getMaxValue(), 10.0)
expect_equal(a$getMinValue(), 1.0)
expect_equal(a$getMeanValue(), 5.5)
expect_equal(a$getMaxAbsValue(), 10.0)
expect_equal(a$whereMax(), 10)
expect_equal(a$whereMaxAbs(), 10)
expect_equal(a$whereMin(), 1)
expect_equal(a$countNA(), 0)
expect_equal(a$countEps(), 0)
expect_equal(a$countUndef(), 0)
expect_equal(a$countPosInf(), 0)
expect_equal(a$countNegInf(), 0)
}
)
# test passing .toDense() of multiple dimensions to setRecords
test_that("test_num_68", {
m = Container$new()
i = Set$new(m, "i", records = paste0("i", 1:10))
j = Set$new(m, "j", records = paste0("j", 1:10))
a0 = Parameter$new(m, "a0", records=10)
a1 = Parameter$new(m, "a1", i, records=data.frame(i=paste0("i", 1:10), 1:10))
df = data.frame(rev(expand.grid(rev(list(paste0("i", 1:10),
paste0("j", 1:5))))), stringsAsFactors = TRUE)
values = replicate(50, 0)
count = 1
for (i1 in 1:10) {
for (j1 in 1:5) {
values[count] = i1 + j1
count = count + 1
}
}
df$values = values
a2 = Parameter$new(m, "a2", c(i, j), records=df)
df = data.frame(rev(expand.grid(rev(list(paste0("i", 1:10),
paste0("j", 1:5), paste0("i", 1:10))))), stringsAsFactors = TRUE)
values = replicate(500, 0)
count = 1
for (i1 in 1:10) {
for (j1 in 1:5) {
for (ip1 in 1:10) {
values[count] = i1 + j1 + ip1
count = count + 1
}
}
}
df$values = values
a3 = Parameter$new(m, "a3", c(i, j, i), records=df)
a0p = Parameter$new(m, "a0p", records=a0$toDense())
a1p = Parameter$new(m, "a1p", i, records = a1$toDense())
a2p = Parameter$new(m, "a2p", c(i, j), records = a2$toDense())
a3p = Parameter$new(m, "a3p", c(i, j, i), records = a3$toDense())
v0 = Variable$new(m, "v0", records = a0$toDense())
v1 = Variable$new(m, "v1", domain=i, records=a1$toDense())
v2 = Variable$new(m, "v2", domain=c(i, j), records= a2$toDense())
v3 = Variable$new(m, "v3", domain=c(i, j, i), records=a3$toDense())
v0p = Variable$new(m, "v0p", records = v0$toDense())
v1p = Variable$new(m, "v1p", domain=i, records=v1$toDense())
v2p = Variable$new(m, "v2p", domain=c(i, j), records= v2$toDense())
v3p = Variable$new(m, "v3p", domain=c(i, j, i), records=v3$toDense())
e0 = Equation$new(m, "e0", "eq", records = a0$toDense())
e1 = Equation$new(m, "e1", "eq", domain=i, records=a1$toDense())
e2 = Equation$new(m, "e2", "eq", domain=c(i, j), records= a2$toDense())
e3 = Equation$new(m, "e3", "eq", domain=c(i, j, i), records=a3$toDense())
e0p = Equation$new(m, "e0p", "eq", records = e0$toDense())
e1p = Equation$new(m, "e1p", "eq", domain=i, records=e1$toDense())
e2p = Equation$new(m, "e2p", "eq", domain=c(i, j), records= e2$toDense())
e3p = Equation$new(m, "e3p", "eq", domain=c(i, j, i), records=e3$toDense())
expect_equal(a0$records, a0p$records)
expect_equal(a1$records, a1p$records)
# expect_equal(as.numeric(a2$records), as.numeric(a2p$records))
# expect_equal(as.numeric(a3$records), as.numeric(a3p$records))
expect_equal(v0$records, v0p$records)
expect_equal(v1$records, v1p$records)
expect_equal(v2$records, v2p$records)
expect_equal(v3$records, v3p$records)
expect_equal(e0$records, e0p$records)
expect_equal(e1$records, e1p$records)
expect_equal(e2$records, e2p$records)
expect_equal(e3$records, e3p$records)}
)
# test passing .toDense() of multiple dimensions to setRecords (named list structure)
test_that("test_num_69", {
m = Container$new()
i = Set$new(m, "i", records = paste0("i", 1:10))
j = Set$new(m, "j", records = paste0("j", 1:10))
a0 = Parameter$new(m, "a0", records=10)
a1 = Parameter$new(m, "a1", i, records=data.frame(i=paste0("i", 1:10), 1:10))
df = data.frame(rev(expand.grid(rev(list(paste0("i", 1:10),
paste0("j", 1:5))))), stringsAsFactors = TRUE)
values = replicate(50, 0)
count = 1
for (i1 in 1:10) {
for (j1 in 1:5) {
values[count] = i1 + j1
count = count + 1
}
}
df$values = values
a2 = Parameter$new(m, "a2", c(i, j), records=df)
df = data.frame(rev(expand.grid(rev(list(paste0("i", 1:10),
paste0("j", 1:5), paste0("i", 1:10))))), stringsAsFactors = TRUE)
values = replicate(500, 0)
count = 1
for (i1 in 1:10) {
for (j1 in 1:5) {
for (ip1 in 1:10) {
values[count] = i1 + j1 + ip1
count = count + 1
}
}
}
df$values = values
a3 = Parameter$new(m, "a3", c(i, j, i), records=df)
a0dict = list(
level = a0$toDense(),
marginal = a0$toDense(),
lower = a0$toDense(),
upper = a0$toDense(),
scale = a0$toDense()
)
a1dict = list(
level = a1$toDense(),
marginal = a1$toDense(),
lower = a1$toDense(),
upper = a1$toDense(),
scale = a1$toDense()
)
a2dict = list(
level = a2$toDense(),
marginal = a2$toDense(),
lower = a2$toDense(),
upper = a2$toDense(),
scale = a2$toDense()
)
a3dict = list(
level = a3$toDense(),
marginal = a3$toDense(),
lower = a3$toDense(),
upper = a3$toDense(),
scale = a3$toDense()
)
a0p = Parameter$new(m, "a0p", records=a0$toDense())
a1p = Parameter$new(m, "a1p", i, records = a1$toDense())
a2p = Parameter$new(m, "a2p", c(i, j), records = a2$toDense())
a3p = Parameter$new(m, "a3p", c(i, j, i), records = a3$toDense())
v0 = Variable$new(m, "v0", records = a0dict)
v1 = Variable$new(m, "v1", domain=i, records=a1dict)
v2 = Variable$new(m, "v2", domain=c(i, j), records= a2dict)
v3 = Variable$new(m, "v3", domain=c(i, j, i), records=a3dict)
v0p = Variable$new(m, "v0p", records = a0dict)
v1p = Variable$new(m, "v1p", domain=i, records=a1dict)
v2p = Variable$new(m, "v2p", domain=c(i, j), records= a2dict)
v3p = Variable$new(m, "v3p", domain=c(i, j, i), records=a3dict)
e0 = Equation$new(m, "e0", "eq", records = a0dict)
e1 = Equation$new(m, "e1", "eq", domain=i, records=a1dict)
e2 = Equation$new(m, "e2", "eq", domain=c(i, j), records= a2dict)
e3 = Equation$new(m, "e3", "eq", domain=c(i, j, i), records=a3dict)
e0p = Equation$new(m, "e0p", "eq", records = a0dict)
e1p = Equation$new(m, "e1p", "eq", domain=i, records=a1dict)
e2p = Equation$new(m, "e2p", "eq", domain=c(i, j), records= a2dict)
e3p = Equation$new(m, "e3p", "eq", domain=c(i, j, i), records=a3dict)
expect_equal(a0$records, a0p$records)
expect_equal(a1$records, a1p$records)
# expect_equal(as.numeric(a2$records), as.numeric(a2p$records))
# expect_equal(as.numeric(a3$records), as.numeric(a3p$records))
expect_equal(v0$records, v0p$records)
expect_equal(v1$records, v1p$records)
expect_equal(v2$records, v2p$records)
expect_equal(v3$records, v3p$records)
expect_equal(e0$records, e0p$records)
expect_equal(e1$records, e1p$records)
expect_equal(e2$records, e2p$records)
expect_equal(e3$records, e3p$records)}
)
# shape test by passing eigen values and eigen vectors
test_that("test_num_70", {
m = Container$new(testthat::test_path("testdata", "test70.gdx"))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "test70.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
e = eigen(m["a"]$toDense())
val = e$values
vec = e$vectors
eval = Parameter$new(m, "eval", m["i"], records = val)
evec = Parameter$new(m, "evec", c(m["i"], m["j"]), records = vec)
expect_true(m$isValid())
}
)
test_that("test_num_71", {
arr0 = array(c(1:270), dim=c(5,6,9))
m = Container$new()
i = Set$new(m, "i", records=paste0("i",1:5))
j = Set$new(m, "j", records=paste0("j",1:6))
k = Set$new(m, "k", records=paste0("i",1:9))
h = Parameter$new(m, "h", c(i, j, k), records = arr0)
hp = Parameter$new(m, "hp", c(i, j, k), records = h$toDense())
expect_equal(h$shape, c(5,6,9))
expect_equal(hp$shape, c(5,6,9))
expect_equal(dim(h$toDense()), c(5, 6, 9))
expect_equal(dim(hp$toDense()), c(5, 6, 9))
expect_equal(h$records, hp$records)
expect_equal(arr0, h$toDense())
expect_equal(arr0, hp$toDense())
v = Variable$new(m, "v", "free", c(i, j, k), records=arr0)
vp = Variable$new(m, "vp", "free", c(i, j, k), records=v$toDense())
expect_equal(v$shape, c(5,6, 9))
expect_equal(vp$shape, c(5,6, 9))
expect_equal(dim(v$toDense()), c(5,6, 9))
expect_equal(dim(vp$toDense()), c(5,6, 9))
expect_equal(v$records, vp$records)
expect_equal(arr0, v$toDense())
expect_equal(arr0, vp$toDense())
e = Equation$new(m, "e", "eq", c(i, j, k), records = arr0)
ep = Equation$new(m, "ep", "eq", c(i, j, k), records = e$toDense())
expect_equal(e$shape, c(5,6, 9))
expect_equal(ep$shape, c(5,6, 9))
expect_equal(dim(e$toDense()), c(5,6, 9))
expect_equal(dim(ep$toDense()), c(5,6, 9))
expect_equal(e$records, ep$records)
expect_equal(arr0, e$toDense())
expect_equal(arr0, ep$toDense())
}
)
test_that("test_num_72", {
m = Container$new(testthat::test_path("testdata", "test72.gdx"))
expect_equal(m["dim0"]$shape, dim(m["dim0"]$toDense()))
expect_equal(m["dim1"]$shape, dim(m["dim1"]$toDense()))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "test72.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
}
)
test_that("test_num_73", {
m = Container$new(testthat::test_path("testdata", "test73.gdx"))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "test73.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
m["ProfitA"]$setRecords(cumsum(m["ProfitM"]$toDense()))
expect_equal(m["ProfitA"]$numberRecords, m["t"]$numberRecords)
}
)
test_that("test_num_74", {
m = Container$new()
d = Parameter$new(m, "d")
e = Parameter$new(m, "e")
expect_true(m$hasSymbols("d"))
expect_true(m$hasSymbols("e"))
expect_true(m$hasSymbols("D"))
expect_true(m$hasSymbols("E"))
expect_equal(m$hasSymbols(c("d", "e")), c(TRUE, TRUE))
expect_false(m$hasSymbols("f"))
expect_equal(m$hasSymbols(c("F", "g")), c(FALSE, FALSE))
expect_equal(m$getSymbolNames(c("D", "d")), c("d", "d"))
expect_equal(m$getSymbolNames("D"), "d")
expect_error(m$getSymbolNames("F"))
}
)
# test case sensitive rename and remove
test_that("test_num_75", {
m = Container$new()
d = Parameter$new(m, "d")
e = Parameter$new(m, "e")
# case insensitive remove
m$removeSymbols("D")
expect_equal(unlist(m$data$keys()), "e")
d = Parameter$new(m, "d")
# case insensitive rename
m$renameSymbol("D", "d_new")
expect_equal(unlist(m$data$keys()), c("e","d_new"))
# change case using rename
m$renameSymbol("d_new","D_neW")
expect_equal(tolower(unlist(m$data$keys())), tolower(c("e", "D_neW")))
}
)
#test getsymbols
test_that("test_num_76", {
m = Container$new()
d = Parameter$new(m, "d")
e = Parameter$new(m, "e")
expect_equal(length(m$getSymbols(m$listSymbols())), 2)
symbolobjects = m$getSymbols(m$listSymbols())
expect_true(inherits(symbolobjects[[1]], "Parameter"))
expect_true(inherits(symbolobjects[[2]], "Parameter"))
expect_error(m$getSymbols("f"))
symobject = m$getSymbols("d")
expect_true(inherits(symobject[[1]], "Parameter"))
symobject = m$getSymbols("D")
expect_true(inherits(symobject[[1]], "Parameter"))
expect_error(m$getSymbols(200))
}
)
#test listSymbols
test_that("test_num_76", {
m = Container$new()
i = Set$new(m, "i", records=c("a", "b", "c"))
a = Parameter$new(m, "a", i, records=data.frame(c("aa", "c"), c(1, 2)))
expect_equal(a$isValid(), TRUE)
# expect_equal(m$listSymbols(isValid=TRUE), "i")
# expect_equal(m$listSymbols(isValid=FALSE), "a")
}
)
#test symbol duplicate record methods
test_that("test_num_77", {
m = Container$new()
df = data.frame(matrix(NA, nrow=30, ncol=2))
df[1:10, 1] = paste0("i", 1:10)
df[11:20, 1] = paste0("j", 1:10)
df[21:30, 1] = paste0("i", 1:10)
df[1:10, 2] = 1:10
df[11:20, 2] = 1:10
df[21:30, 2] = 1:10
a = Parameter$new(m, "a", domain="*", records = df)
b = Parameter$new(m, "b", domain="*", records= data.frame(paste0("i",1:10), 1:10))
# expect_equal(a$isValid(), FALSE)
expect_equal(a$findDuplicateRecords(keep="first"), a$records[21:30, ])
expect_equal(a$findDuplicateRecords(keep="last"), a$records[1:10, ])
expect_equal(a$findDuplicateRecords(keep=FALSE), a$records[append(1:10, 21:30), ])
expect_equal(a$countDuplicateRecords(), 10)
expect_true(a$hasDuplicateRecords())
a$dropDuplicateRecords(keep="first")
expect_equal(as.character(a$records[,1]), append(paste0("i", 1:10), paste0("j", 1:10)))
m$removeSymbols("a")
a = Parameter$new(m, "a", domain="*", records= df)
a$dropDuplicateRecords(keep="last")
expect_equal(as.character(a$records[,1]), append(paste0("j", 1:10), paste0("i", 1:10)))
expect_true(b$isValid())
expect_equal(b$countDuplicateRecords(), 0)
expect_true(!b$hasDuplicateRecords())
bcopy = b
b$dropDuplicateRecords()
expect_equal(bcopy, b)
expect_true(m$isValid())
}
)
#test container duplicate record methods
test_that("test_num_78", {
m = Container$new()
df = data.frame(matrix(NA, nrow=30, ncol=2))
df[1:10, 1] = paste0("i", 1:10)
df[11:20, 1] = paste0("j", 1:10)
df[21:30, 1] = paste0("i", 1:10)
df[1:10, 2] = 1:10
df[11:20, 2] = 1:10
df[21:30, 2] = 1:10
a = Parameter$new(m, "a", "*", records=df)
b = Parameter$new(m, "b", "*", records=data.frame(paste0("i",1:10), 1:10))
c = Parameter$new(m, "c", "*", records=data.frame(paste0("j",1:10), 1:10))
expect_true(m$hasDuplicateRecords())
expect_equal(m$countDuplicateRecords(), list("a"=10))
m$dropDuplicateRecords()
expect_true(m$isValid())
}
)
#test getUELs method
test_that("test_num_79", {
m = Container$new()
i = Set$new(m, "i", domain=c("*", "*"), records=data.frame(c("i1","i2","i3"), c("i4","i5","i6")))
j = Set$new(m, "j", domain=c("*", "*"), records=data.frame(c("j1","j2","j3"), c("j4","j5","j6")))
expect_equal(i$getUELs(dimension=1), c("i1","i2","i3"))
expect_equal(i$getUELs(dimension=2), c("i4","i5","i6"))
expect_equal(i$getUELs(), paste0("i", 1:6))
expect_error(i$getUELs(dimension=3))
expect_error(i$getUELs(codes=0))
expect_equal(i$getUELs(dimension=1), paste0("i", 1:3))
expect_equal(i$getUELs(dimension=2), paste0("i", 4:6))
expect_error(i$getUELs(dimension=3))
expect_error(i$getUELs(codes=0))
expect_equal(i$getUELs(dimension=1, codes=1), "i1")
expect_equal(i$getUELs(dimension=1, codes=3), "i3")
expect_equal(i$getUELs(dimension=1, codes=c(1, 3)), c("i1", "i3"))
expect_error(i$getUELs(codes=100, dimension=0))
expect_equal(j$getUELs(dimension=1), paste0("j", 1:3))
expect_equal(j$getUELs(dimension=2), paste0("j", 4:6))
expect_equal(j$getUELs(), paste0("j", 1:6))
expect_error(j$getUELs(dimension=3))
expect_equal(m$getUELs("i"), i$getUELs())
expect_equal(m$getUELs("j"), j$getUELs())
expect_equal(m$getUELs(), append(i$getUELs(), j$getUELs()))
expect_error(m$getUELs("k"))
}
)
#test removeUELs method
test_that("test_num_80", {
m = Container$new()
i = Set$new(m, "i", domain=c("*", "*"), records=data.frame(c("i1","i2","i3"), c("i4","i5","i6")))
i$removeUELs("hi", 1)
i$removeUELs("hi", 2)
i$removeUELs("hi")
expect_equal(i$getUELs(), paste0("i", 1:6))
i$removeUELs("i1", 1)
expect_equal(i$getUELs(), paste0("i",2:6))
m = Container$new()
i = Set$new(m, "i", domain=c("*", "*"), records=data.frame(c("i1","i2","i3"), c("i4","i5","i6")))
ip = Alias$new(m, "ip", i)
ip$removeUELs("hi", 1)
ip$removeUELs("hi", 2)
ip$removeUELs("hi")
expect_equal(ip$getUELs(), paste0("i", 1:6))
ip$removeUELs("i1", 1)
expect_equal(ip$getUELs(), paste0("i",2:6))
m = Container$new()
i = Set$new(m, "i", domain=c("*", "*"), records=data.frame(c("i1","i2","i3"), c("i4","i5","i6")))
i$removeUELs("i4")
expect_equal(i$getUELs(), append(paste0("i", 1:3), c("i5", "i6")))
m = Container$new()
i = Set$new(m, "i", domain=c("*", "*"), records=data.frame(c("i1","i2","i3"), c("i4","i5","i6")))
ip = Alias$new(m, "ip", i)
ip$removeUELs("i4")
expect_equal(ip$getUELs(), append(paste0("i", 1:3), c("i5", "i6")))
m = Container$new()
i = Set$new(m, "i", domain=c("*", "*"), records=data.frame(c("i1","i2","i3"), c("i4","i5","i6")))
j = Set$new(m, "j", domain=c("*", "*"), records=data.frame(c("j1","j2","j3"), c("j4","j5","j6")))
ip = Alias$new(m, "ip", i)
m$removeUELs(c("i1","j4"))
expect_equal(m$getUELs(), append(paste0("i",2:6), paste0("j",c(1:3,5,6))))
}
)
#test renameUELs method
test_that("test_num_81", {
m = Container$new()
i = Set$new(m, "i", domain=c("*", "*"), records=data.frame(c("i1","i2","i5"), c("i4","i5","i6")))
i$renameUELs(c("jammin"="java"), 1)
i$renameUELs(c("jammin"="java"), 2)
i$renameUELs(c("jammin"="java"))
m$renameUELs(c("jammin"="java"))
i$renameUELs(c(i2="java"))
expect_equal(i$getUELs(1), c("i1", "java", "i5"))
m = Container$new()
i = Set$new(m, "i", domain=c("*", "*"), records=data.frame(c("i1","i2","i5"), c("i4","i5","i6")))
expect_equal(m$getUELs(), c("i1","i2","i5","i4","i6"))
m$renameUELs(c(i2="java"))
expect_equal(m$getUELs(), c("i1","java","i5","i4","i6"))
}
)
#test addUELs method
test_that("test_num_82", {
m = Container$new()
i = Set$new(m, "i", domain=c("*", "*"), records=data.frame(c("i1","i2","i5"), c("i4","i5","i6")))
i$addUELs("ham", 1)
expect_equal(i$getUELs(1), c("i1","i2","i5","ham"))
i$addUELs("cheese", 2)
expect_equal(i$getUELs(2), c("i4","i5","i6","cheese"))
m$removeUELs()
expect_equal(m$getUELs(), c("i1","i2","i5","i4","i6"))
}
)
#test reorderUELs method
test_that("test_num_83", {
m = Container$new()
i = Set$new(m, "i", records=c("i1","i2","i3"))
a = Parameter$new(m, "a",i, records=data.frame(paste0("i",c(1,3,2)), c(1,3,2)))
expect_equal(a$getUELs(1), c("i1","i3","i2"))
a$reorderUELs(i$getUELs(1), 1)
expect_equal(a$getUELs(), c("i1","i2","i3"))
}
)
#test setUELs method
test_that("test_num_84", {
m = Container$new()
i = Set$new(m, "i", records=c("a","b","c"))
j = Parameter$new(m, "j",i, records=data.frame(c("a","c"), c(1,2)))
expect_equal(j$getUELs(1), c("a","c"))
j$setUELs(c("j1","a","c","j4"), 1, rename=TRUE)
expect_equal(j$getUELs(1), c("j1","a","c","j4"))
expect_equal(as.character(j$records[, 1]), c("j1","a"))
m = Container$new()
i = Set$new(m, "i", records=c("a","b","c"))
j = Parameter$new(m, "j",i, records=data.frame(c("a","c"), c(1,2)))
expect_equal(j$getUELs(1), c("a","c"))
j$setUELs(c("j1","a","c","j4"), 1, rename=FALSE)
expect_equal(j$getUELs(1), c("j1","a","c","j4"))
expect_equal(as.character(j$records[, 1]), c("a","c"))
#multiple dimensions
m = Container$new()
i = Set$new(m, "i", records=c("a","b","c"))
j = Parameter$new(m, "j",c(i,i), records=data.frame(c("a","c"),c("b","a"), c(1,2)))
j$setUELs(c("j1","a","c","j4"), rename=FALSE)
expect_equal(j$getUELs(1), c("j1","a","c","j4"))
expect_equal(j$getUELs(2), c("j1","a","c","j4"))
expect_equal(as.character(j$records[, 1]), c("a","c"))
expect_true(is.na(j$records[1, 2]))
expect_equal(as.character(j$records[, 1]), c("a","c"))
}
)
#test getDomainViolations method
test_that("test_num_85", {
m = Container$new()
i = Set$new(m, "i", records=c("SeaTtle", "hamburg"))
j = Set$new(m, "j", i, records=c("seattle", "Hamburg"))
ip = Alias$new(m, "ip", i)
jp = Alias$new(m, "jp", j)
expect_true(i$isValid())
expect_true(j$isValid())
expect_equal(i$getDomainViolations(), NULL)
expect_equal(j$getDomainViolations(), NULL)
expect_equal(ip$getDomainViolations(), NULL)
expect_equal(jp$getDomainViolations(), NULL)
# test container getdomainviolations
expect_true(is.null(m$getDomainViolations()))
m = Container$new()
i = Set$new(m, "i", records=c("SeaTtle", "hamburg"))
j = Set$new(m, "j", i, records=c(" seattle", "Hamburg"))
ip = Alias$new(m, "ip", i)
jp = Alias$new(m, "jp", j)
expect_true(i$isValid())
expect_true(j$isValid())
expect_equal(i$getDomainViolations(), NULL)
expect_equal(j$getDomainViolations()[[1]]$violations, c(" seattle"))
expect_equal(ip$getDomainViolations(), NULL)
expect_equal(jp$getDomainViolations()[[1]]$violations, c(" seattle"))
expect_equal(length(m$getDomainViolations()), 2)
dv = m$getDomainViolations()
expect_equal(dv[[1]]$symbol, j)
expect_equal(dv[[1]]$dimension, 1)
expect_equal(dv[[1]]$domain, i)
expect_equal(dv[[1]]$violations, c(" seattle"))
# finddomainviolations for alias
df = jp$findDomainViolations()
expect_equal(as.character(df[[1]]), " seattle")
expect_true(jp$hasDomainViolations())
expect_equal(jp$countDomainViolations(), 1)
jp$dropDomainViolations()
expect_equal(as.character(j$records$i), "Hamburg")
}
)
#test findDomainViolations method
test_that("test_num_86", {
m = Container$new()
i = Set$new(m, "i", records=c("j1", "j2"))
a = Parameter$new(m, "a", i, records= data.frame(paste0("j",1:10), 1:10))
a2 = Parameter$new(m, "a2", c(i,i), records= data.frame(paste0("j",1:10),paste0("j",1:10), 1:10))
expect_true(a$isValid())
expect_true(is.data.frame(a$findDomainViolations()))
expect_equal(a$findDomainViolations(), a$records[3:10,])
expect_equal(a$countDomainViolations(), 8)
expect_true(a$hasDomainViolations())
#container hasDomainViolations()
expect_true(m$hasDomainViolations())
#container countDomainViolations()
expect_equal(m$countDomainViolations()$a, 8)
expect_equal(m$countDomainViolations()$a2, 8)
a$dropDomainViolations()
expect_equal(as.character(a$records[,1]), c("j1","j2") )
expect_false(a$hasDomainViolations())
expect_equal(a$countDomainViolations(), 0)
expect_equal(a$findDuplicateRecords(), data.frame())
expect_true(a$isValid())
# test dropdomainviolations for container
m = Container$new()
i = Set$new(m, "i", records=c("j1", "j2"))
a = Parameter$new(m, "a", i, records= data.frame(paste0("j",1:10), 1:10))
a2 = Parameter$new(m, "a2", c(i,i), records= data.frame(paste0("j",1:10),paste0("j",1:10), 1:10))
m$dropDomainViolations()
expect_equal(as.character(a$records[,1]), c("j1","j2") )
expect_false(m$hasDomainViolations())
empty_named_list = list()
names(empty_named_list) = character(0)
expect_equal(m$countDomainViolations(), empty_named_list)
}
)
#test overwriting sets
test_that("test_num_87", {
m = Container$new()
i = Set$new(m, "i", records=c("a", "b", "c"))
expect_true(inherits(m$addSet("i", records=c("f","b","c")), "Set"))
expect_error(m$addSet("i","a",records=c("f","b","c")))
expect_true(inherits(m$addSet("i",records=c("f","b","c"), description="hamburger"), "Set"))
expect_equal(m["i"]$description, "hamburger")
expect_true(inherits(m$addSet("i",records=c("f","b","c")), "Set"))
expect_equal(m["i"]$description, "hamburger")
expect_error(Set$new(m, "i", records=c("f","b","c")))
}
)
#test overwriting Parameters
test_that("test_num_88", {
m = Container$new()
i = Parameter$new(m, "i", "*", records=data.frame(paste0("i",1:5), 1:5))
expect_true(inherits(m$addParameter("i", "*", records=data.frame(paste0("i",1:5), 1:5)), "Parameter"))
expect_error(m$addParameter("i","a",records=data.frame(paste0("i",1:5), 1:5)))
expect_true(inherits(m$addParameter("i","*",records=data.frame(paste0("i",1:5), 1:5), description="hamburger"), "Parameter"))
expect_equal(m["i"]$description, "hamburger")
expect_true(inherits(m$addParameter("i","*",records=data.frame(paste0("i",1:5), 1:5)), "Parameter"))
expect_equal(m["i"]$description, "hamburger")
expect_error(Parameter$new(m, "i", records=data.frame(paste0("i",1:5), 1:5)))
# overwriting parameter with domain
m = Container$new()
i = Set$new(m, "i", records=paste0("i",1:5))
j = Set$new(m, "j", records=paste0("j",1:5))
d = Parameter$new(m, "d", domain=c(i, j), records=diag(5))
# test filtering zeros
expect_equal(as.character(d$records$i), paste0("i",1:5))
expect_equal(as.character(d$records$j), paste0("j",1:5))
expect_equal(as.numeric(d$records$value),replicate(5, 1))
# overwriting
m$addParameter("d", , domain=c(i, j), records=matrix(0, 5, 5))
expect_true(nrow(d$records) == 0)
}
)
#test overwriting Variables
test_that("test_num_89", {
m = Container$new()
recs= data.frame(paste0("i",1:5), 1:5)
colnames(recs) = c("1", "level")
i = Variable$new(m, "i", "free", "*", records=recs)
expect_true(inherits(m$addVariable("i", "free", "*", records=recs), "Variable"))
expect_error(m$addVariable("i", "free","a",records=recs))
expect_true(inherits(m$addVariable("i", "free","*",records=recs, description="hamburger"), "Variable"))
expect_equal(m["i"]$description, "hamburger")
expect_true(inherits(m$addVariable("i", "free","*",records=recs), "Variable"))
expect_equal(m["i"]$description, "hamburger")
expect_error(Variable$new(m, "i", "free", records=recs))
}
)
#test overwriting Equations
test_that("test_num_90", {
m = Container$new()
recs= data.frame(paste0("i",1:5), 1:5)
colnames(recs) = c("1", "level")
i = Equation$new(m, "i", "eq", "*", records=recs)
expect_true(inherits(m$addEquation("i", "eq", "*", records=recs), "Equation"))
expect_error(m$addEquation("i", "eq","a",records=recs))
expect_true(inherits(m$addEquation("i", "eq","*",records=recs, description="hamburger"), "Equation"))
expect_equal(m["i"]$description, "hamburger")
expect_true(inherits(m$addEquation("i", "eq","*",records=recs), "Equation"))
expect_equal(m["i"]$description, "hamburger")
expect_error(Equation$new(m, "i", "eq", records=recs))
}
)
#test overwriting Alias
test_that("test_num_91", {
m = Container$new()
i = Set$new(m, "i", records=c("a","b","c"))
j = Set$new(m, "j", records=c("i","j","k"))
ip = m$addAlias("ip", i)
expect_true(inherits(ip, "Alias"))
expect_equal(ip$aliasWith, i)
expect_error(m$addAlias("j", i))
ip = m$addAlias("ip", j)
expect_true(inherits(ip, "Alias"))
expect_equal(ip$aliasWith, j)
}
)
#change column headings when changing domain
test_that("test_num_92", {
m = Container$new()
i = Set$new(m, "i", records=paste0("i",1:5))
a = Parameter$new(m, "a", c(i,i), records=data.frame(p_1=paste0("i",1:5), p_2=paste0("i",1:5), 1:5))
a$domain = c("p","p")
expect_equal(a$domain, c("p","p"))
expect_true(a$isValid())
expect_equal(colnames(a$records), c("p_1","p_2","value"))
m = Container$new()
i = Set$new(m, "i", records=paste0("i",1:5))
ip = Alias$new(m, "ip", i)
a = Parameter$new(m, "a", c(i,ip), records=data.frame(p_1=paste0("i",1:5), p_2=paste0("i",1:5), 1:5))
a$domain = c("p","p")
expect_equal(a$domain, c("p","p"))
expect_true(a$isValid())
expect_equal(colnames(a$records), c("p_1","p_2","value"))
m = Container$new()
i = Set$new(m, "i", records=paste0("i",1:5))
r = Set$new(m, "r", records=paste0("r",1:5))
a = Parameter$new(m, "a", c(i,i), records=data.frame(r_1=paste0("i",1:5), r_2=paste0("i",1:5), 1:5))
a$domain = c(r,r)
expect_equal(a$domain, c(r,r))
expect_true(a$isValid())
expect_equal(colnames(a$records), c("r_1","r_2","value"))
}
)
# white space removal and user category survival
test_that("test_num_93", {
recs = data.frame(uni=paste0("i",1:3), stringsAsFactors = TRUE)
levels(recs[,1]) = append(levels(recs[,1]), "j1")
expect_equal(levels(recs[,1]), c("i1","i2","i3","j1"))
m = Container$new()
i = Set$new(m, "i", records=recs)
expect_equal(levels(i$records$uni), c("i1","i2","i3","j1"))
recs= data.frame(uni=paste0("i",1:3), value=1:3, stringsAsFactors = TRUE)
levels(recs[,1]) = append(levels(recs[,1]), "j1")
expect_equal(levels(recs[,1]), c("i1","i2","i3","j1"))
a = Parameter$new(m, "a", i, records=recs)
expect_equal(levels(a$records$uni), c("i1","i2","i3","j1"))
recs= data.frame(uni=paste0("i",1:3), level=1:3, stringsAsFactors = TRUE)
levels(recs[,1]) = append(levels(recs[,1]), "j1")
expect_equal(levels(recs[,1]), c("i1","i2","i3","j1"))
v = Variable$new(m, "v", "free", i, records=recs)
expect_equal(levels(v$records$uni), c("i1","i2","i3","j1"))
e = Equation$new(m, "e", "eq", i, records=recs)
expect_equal(levels(e$records$uni), c("i1","i2","i3","j1"))
}
)
test_that("test_num_94", {
m = Container$new()
i = Set$new(m, "i", records=c(" i1 ", "i2", "i3"))
expect_equal(i$getUELs(), c(" i1", "i2", "i3"))
i$setUELs(c(" i1 ", " i2 ", "i3"))
expect_equal(i$getUELs(), c(" i1", " i2", "i3"))
m = Container$new()
i = Set$new(m, "i", records=c(" i1 ", "i2", "i3"))
ip = Alias$new(m, "ip", i)
expect_equal(ip$getUELs(), c(" i1", "i2", "i3"))
ip$setUELs(c(" i1 ", " i2 ", "i3"))
expect_equal(i$getUELs(), c(" i1", " i2", "i3"))
expect_equal(i$getUELs(), ip$getUELs())
m = Container$new()
i = Set$new(m, "i", records=c(" i1 ", "i2", "i3"))
i$reorderUELs(c("i2", " i1", "i3"))
expect_equal(i$getUELs(), c("i2", " i1", "i3"))
m = Container$new()
i = Set$new(m, "i", records=c(" i1 ", "i2", "i3"))
ip = Alias$new(m, "ip", i)
ip$reorderUELs(c("i2", " i1", "i3"))
expect_equal(ip$getUELs(), c("i2", " i1", "i3"))
expect_equal(i$getUELs(), ip$getUELs())
m = Container$new()
i = Set$new(m, "i", records=c(" i1 ", "i2", "i3"))
i$renameUELs(c("i1 ", " i2 ", " i3 "))
expect_equal(i$getUELs(), c("i1", " i2", " i3"))
m$renameUELs(c("i1"="cheeseburgerz "))
expect_equal(i$getUELs(), c("cheeseburgerz", " i2", " i3"))
m = Container$new()
i = Set$new(m, "i", records=c(" i1 ", "i2", "i3"))
ip = Alias$new(m, "ip", i)
ip$renameUELs(c("i1 ", " i2 ", " i3 "))
expect_equal(ip$getUELs(), c("i1", " i2", " i3"))
expect_equal(i$getUELs(), ip$getUELs())
m = Container$new()
i = Set$new(m, "i", records=c(" i1 ", "i2", "i3"))
i$addUELs("i4 ")
expect_equal(i$getUELs(), c(" i1", "i2", "i3", "i4"))
m$renameUELs(c("i1"="cheeseburgerz "))
expect_equal(i$getUELs(), c(" i1", "i2", "i3", "i4"))
m = Container$new()
i = Set$new(m, "i", records=c(" i1 ", "i2", "i3"))
ip = Alias$new(m, "ip", i)
ip$addUELs("i4 ")
expect_equal(ip$getUELs(), c(" i1", "i2", "i3", "i4"))
m$renameUELs(c("i1"="cheeseburgerz "))
expect_equal(i$getUELs(), ip$getUELs())
}
)
# test reading and writing UniverseAlias with Container
test_that("test_num_95", {
skip_if_no_gams()
m = Container$new()
# read all symbols
m$read(testthat::test_path("testdata", "test95.gdx"))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "test95.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
# write everything
m$write(testthat::test_path("gt.gdx"))
expect_true(inherits(m["h"], "UniverseAlias"))
expect_true(inherits(m["ip"], "Alias"))
expect_true(inherits(m["i"], "Set"))
expect_equal(m$listSets(), "i")
expect_equal(m$listAliases(), c("ip", "h"))
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test95.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# write everything
m$write(testthat::test_path("gt.gdx"), mode="string")
expect_true(inherits(m["h"], "UniverseAlias"))
expect_true(inherits(m["ip"], "Alias"))
expect_true(inherits(m["i"], "Set"))
expect_equal(m$listSets(), "i")
expect_equal(m$listAliases(), c("ip", "h"))
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test95.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test95.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
}
)
# test reading and writing UniverseAlias with Container
test_that("test_num_96", {
skip_if_no_gams()
m = Container$new()
# read all symbols
# uses the same gdx from test95
m$read(testthat::test_path("testdata", "test95.gdx"))
m2 = Container$new(m)
# write everything
m2$write(testthat::test_path("gt.gdx"))
expect_true(inherits(m2["h"], "UniverseAlias"))
expect_true(inherits(m2["ip"], "Alias"))
expect_true(inherits(m2["i"], "Set"))
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test95.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# write everything
m2$write(testthat::test_path("gt.gdx"), mode="string")
expect_true(inherits(m2["h"], "UniverseAlias"))
expect_true(inherits(m2["ip"], "Alias"))
expect_true(inherits(m2["i"], "Set"))
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test95.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test95.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
}
)
# UniverseAlias UEL functions
test_that("test_num_97", {
m = Container$new()
i = Set$new(m, "i", records=paste0("i", 1:5))
ip = UniverseAlias$new(m, "ip")
p0 = Parameter$new(m, "p0", ip, records=data.frame(paste0("i",1:5), 1:5))
expect_equal(m$getUELs(), paste0("i",1:5))
m$renameUELs(c("i1" = "cheeseburgerz"))
expect_equal(m$getUELs(), c("cheeseburgerz", "i2","i3","i4", "i5"))
p0$addUELs("mustard")
expect_equal(p0$getUELs(), c("cheeseburgerz", "i2","i3","i4", "i5", "mustard"))
m$removeUELs()
expect_equal(m$getUELs(), c("cheeseburgerz", "i2","i3","i4", "i5"))
m$renameUELs(c("i2 " = "cheeseburgerz"))
expect_equal(m$getUELs(), c("cheeseburgerz", "i2","i3","i4", "i5"))
}
)
# UniverseAlias as domain
test_that("test_num_98", {
m = Container$new()
i = Set$new(m, "i", records=paste0("i", 1:5))
ip = UniverseAlias$new(m, "ip")
p0 = Parameter$new(m, "p0", ip, records=data.frame(paste0("i",1:5), 1:5))
expect_true(p0$isValid())
expect_equal(p0$domain[[1]], ip)
expect_equal(p0$domainType, "regular")
expect_equal(p0$dimension, 1)
expect_true(is.null(p0$getDomainViolations()))
expect_equal(nrow(p0$findDomainViolations()), 0)
expect_true(!p0$hasDomainViolations())
expect_equal(p0$countDomainViolations(), 0)
expect_true(!p0$hasDuplicateRecords())
expect_equal(p0$findDuplicateRecords(), data.frame())
expect_equal(p0$countDuplicateRecords(), 0)
expect_equal(p0$summary,
list(name="p0", description="", domain = "ip", domainType="regular",
dimension=1, numberRecords=5))
m$removeSymbols("ip")
expect_true(p0$isValid())
expect_equal(p0$domain[[1]], "*")
expect_equal(p0$domainType, "none")
expect_equal(p0$dimension, 1)
expect_true(is.null(p0$getDomainViolations()))
expect_true(!p0$hasDomainViolations())
expect_equal(nrow(p0$findDomainViolations()), 0)
expect_equal(p0$countDomainViolations(), 0)
expect_true(!p0$hasDuplicateRecords())
expect_equal(p0$findDuplicateRecords(), data.frame())
expect_equal(p0$countDuplicateRecords(), 0)
expect_equal(p0$summary,
list(name="p0", description="", domain = "*", domainType="none",
dimension=1, numberRecords=5))
expect_true(!ip$isValid())
expect_equal(ip$summary,
list("name" = "ip",
description = "Aliased with *",
aliasWith = "*"
))
}
)
# remove symbols including alias
test_that("test_num_99", {
m = Container$new()
i = Set$new(m, "i")
ii = Alias$new(m, "ii", i)
j = Set$new(m, "j", domain=ii)
m$removeSymbols("ii")
# should affect j
expect_equal(j$domain, "*")
ii = Alias$new(m, "ii", i)
m$removeSymbols("i")
expect_true(is.null(m["ii"]))
expect_equal(j$domain, "*")
}
)
# GDX read errors
test_that("test_num_100", {
m = Container$new()
i = Set$new(m, "i")
# read all symbols: expect error because i already exists
expect_error(m$read(testthat::test_path("testdata","test95.gdx")))
m2 = Container$new()
m2$read(testthat::test_path("testdata","test95.gdx"))
# read all symbols: expect error because i already exists
expect_error(m$read(m2))
#read container into container
m = Container$new(m2)
expect_equal(m$listSymbols(), m2$listSymbols())
# expect error on reading only alias
m = Container$new()
expect_error(m$read(testthat::test_path("testdata","test95.gdx"), symbols="ip"))
# expect error if user wants to read a symbol from another container but it doesn't exist
m = Container$new()
expect_error(m$read(m2, symols="j"))
# expect error on reading only alias
m2 = Container$new()
expect_error(m2$read(testthat::test_path("testdata","test95.gdx"), symols="ip"))
}
)
# alias duplicaterecords
test_that("test_num_101", {
m = Container$new()
i = Set$new(m, "i", records=replicate(5, "i1"))
ip = Alias$new(m, "ip", i)
expect_equal(ip$countDuplicateRecords(), 4)
expect_equal(ip$findDuplicateRecords(), ip$records[2:5, , drop=FALSE])
expect_true(ip$hasDuplicateRecords())
ip$dropDuplicateRecords()
expect_equal(nrow(i$records), 1)
}
)
#summary test
test_that("test_num_102", {
m = Container$new()
# expect_error(m$read(testthat::test_path("testdata", "trnsport_with_alias.gdx"), records="true"))
m = Container$new()
m$read(testthat::test_path("testdata", "trnsport_with_alias.gdx"))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "trnsport_with_alias.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
expect_equal(m["i"]$summary, list(
name = "i",
description = "canning plants",
isSingleton = FALSE,
domain = "*",
domainType = "none",
dimension = 1,
numberRecords = 2
))
expect_equal(m["d"]$summary, list(
name = "d",
description = "distance in thousands of miles",
domain = c("i","j"),
domainType = "regular",
dimension = 2,
numberRecords = 6
))
expect_equal(m["x"]$summary, list(
name = "x",
description = "shipment quantities in cases",
type = "positive",
domain = c("i","j"),
domainType = "regular",
dimension = 2,
numberRecords = 6
))
expect_equal(m["demand"]$summary, list(
name = "demand",
description = "satisfy demand at market j",
type = "geq",
domain = "j",
domainType = "regular",
dimension = 1,
numberRecords = 3
))
expect_equal(m["ip"]$summary, list(
name = "ip",
description = "canning plants",
aliasWith = "i",
isSingleton = FALSE,
domain = "*",
domainType = "none",
dimension = 1,
numberRecords = 2
))
# container
m = Container$new()
m = Container$new()
m$read(testthat::test_path("testdata", "trnsport_with_alias.gdx"))
expect_equal(m["i"]$summary, list(
name = "i",
description = "canning plants",
isSingleton = FALSE,
domain = "*",
domainType = "none",
dimension = 1,
numberRecords = 2
))
expect_equal(m["d"]$summary, list(
name = "d",
description = "distance in thousands of miles",
domain = c("i", "j"),
domainType = "regular",
dimension = 2,
numberRecords = 6
))
expect_equal(m["x"]$summary, list(
name = "x",
description = "shipment quantities in cases",
type = "positive",
domain = c("i","j"),
domainType = "regular",
dimension = 2,
numberRecords = 6
))
expect_equal(m["demand"]$summary, list(
name = "demand",
description = "satisfy demand at market j",
type = "geq",
domain = "j",
domainType = "regular",
dimension = 1,
numberRecords = 3
))
expect_equal(m["ip"]$summary, list(
name = "ip",
description = "canning plants",
aliasWith = "i",
isSingleton = FALSE,
domain = "*",
domainType = "none",
dimension = 1,
numberRecords = 2
))
}
)
#test partial write
test_that("test_num_103", {
m = Container$new(testthat::test_path("testdata", "trnsport.gdx"))
m$write("partial_write.gdx", symbols="a")
m1 = Container$new("partial_write.gdx")
expect_equal(m1["a"]$domain, "i")
expect_equal(m1["a"]$domainType, "relaxed")
m$write("partial_write.gdx", symbols="a", mode="string")
m1 = Container$new("partial_write.gdx")
expect_equal(m1["a"]$domain, "i")
expect_equal(m1["a"]$domainType, "relaxed")
# test the super call write
writeList = m$asList()
writeGDX(writeList, "partial_write.gdx", symbols="a")
m1 = Container$new("partial_write.gdx")
expect_equal(m1["a"]$domain, "i")
expect_equal(m1["a"]$domainType, "relaxed")
}
)
#test symbols argument container methods
test_that("test_num_104", {
m = Container$new()
i = Set$new(m, "i", records=paste0("i", 1:10))
j = Set$new(m, "j", records=paste0("j", 1:5))
p_dv = Parameter$new(m, "p_dv", domain=c(i, j), records = data.frame(c("i1","i12","i0","i5"), c("j2", "j6", "j1", "j0"), 11:14))
p_dup = Parameter$new(m, "p_dup", domain=c(i, j), records = data.frame(c("i1","i1","i3","i5"), c("j2", "j2", "j1", "j2"), c(11, 13, 12, 14)))
dv = m$getDomainViolations(symbols="p_dv")
expect_equal(length(dv), 2)
expect_true(m$hasDomainViolations())
expect_true(!m$hasDomainViolations(symbols="p_dup"))
expect_true(m$hasDomainViolations(symbols="p_dv"))
expect_true(m$hasDuplicateRecords())
expect_true(!m$hasDuplicateRecords(symbols="p_dv"))
expect_true(m$hasDuplicateRecords(symbols="p_dup"))
m$dropDomainViolations(symbols="p_dup") # should do nothing
expect_true(m$hasDomainViolations())
dv = m$getDomainViolations(symbols="p_dv")
expect_equal(length(dv), 2)
m$dropDuplicateRecords(symbols="p_dv") # should do nothing
dups = m$countDuplicateRecords(symbols="p_dup")
expect_equal(dups, list(p_dup=1))
m$dropDomainViolations(symbols="p_dv")
expect_true(!m$hasDomainViolations())
dv = m$getDomainViolations(symbols="p_dv")
expect_true(is.null(dv))
m$dropDuplicateRecords(symbols="p_dv") # should do nothing
dups = m$countDuplicateRecords(symbols="p_dup")
expect_equal(dups, list(p_dup=1))
}
)
# test equals
test_that("test_num_105", {
# set comparison
m = Container$new()
i = Set$new(m, "i")
j = Set$new(m, "j")
expect_false(i$equals(j))
expect_true(i$equals(j, checkMetaData = FALSE))
expect_error(i$equals(j, checkMetaData = FALSE, verbose=10))
# error because of domain type mismatch
m = Container$new()
i = Set$new(m, "i")
j = Set$new(m, "j", i)
expect_false(i$equals(j, checkMetaData = FALSE))
expect_error(v1$equals(v2, checkMetaData = FALSE, checkElementText=6))
# error because of validity
j$records = data.frame(i=c("j1","j2"), j= c("k1","k2"), k = c("l1","l2"))
expect_error(i$equals(j, checkMetaData = FALSE))
expect_error(j$equals(i, checkMetaData = FALSE))
# other type error
expect_error(i$equals(2))
#columns arg
p1 = Parameter$new(m, "p1")
p2 = Parameter$new(m, "p2")
v1 = Variable$new(m, "v1")
v2 = Variable$new(m, "v2")
expect_error(v1$equals(v2, checkUELs=2, checkMetaData=FALSE))
expect_error(v1$equals(v2, checkMetaData=6))
expect_error(v1$equals(v2, checkMetaData=FALSE, atol=TRUE))
expect_error(v1$equals(v2, checkMetaData=FALSE, rtol=TRUE))
expect_error(v1$equals(v2, checkMetaData=FALSE, atol= c(1, 2)))
expect_error(v1$equals(v2, columns=c("blah1", "blah2"), checkMetaData=FALSE, rtol= 0))
m = Container$new()
i = Set$new(m, "i", records=c("i1","i2"))
j = Set$new(m, "j", records=c("j1","j2"))
e0 = Equation$new(m, "e0", type = "eq", description="empty eq from m")
e1 = Equation$new(m, "e1", type = "eq", domain=c(i, j))
e2 = Equation$new(m, "e2", type = "eq", domain= i)
e2a = Equation$new(m, "e2a", type = "eq", domain= i, records=data.frame(i="i1", level=1))
e2b = Equation$new(m, "e2b", type = "eq", domain= i)
e3 = Equation$new(m, "e3", type = "eq", domain = j)
expect_false(e2$equals(e3))
expect_false(e2$equals(e2a))
expect_false(e2$equals(e2b))
expect_true(e2$equals(e2b, checkMetaData=FALSE))
m2 = Container$new()
e02 = Equation$new(m2, "e0", type="eq", description="empty eq from m2")
expect_true(e02$equals(e0, checkMetaData=FALSE))
expect_false(e02$equals(e0, checkMetaData=TRUE))
m2$removeSymbols("e0")
v02 = Variable$new(m2, "e0", description="empty var from m2")
expect_true(v02$equals(e0, checkMetaData=FALSE))
expect_false(v02$equals(e0, checkMetaData=TRUE))
m = Container$new()
i = Set$new(m, "i", records=c("i1","i2"))
i$setUELs(c("i1","i2","i3","i4"))
m2 = Container$new()
i2 = Set$new(m2, "i", records=c("i1","i2"))
expect_false(i$equals(i2, checkUELs=TRUE))
expect_true(i$equals(i2, checkUELs=FALSE))
# element text
m = Container$new()
i = Set$new(m, "i", records=data.frame(c("i1","i2")))
m2 = Container$new()
i2 = Set$new(m2, "i", records=data.frame(c("i1","i2"), c("first elemnt", "second element")))
expect_true(i$equals(i2, checkElementText=FALSE))
expect_false(i$equals(i2))
# compare records
m = Container$new()
i1 = Set$new(m, "i1", records=data.frame(c("i1","i2")))
i2 = Set$new(m, "i2", records=data.frame(c("i2","i3")))
expect_false(i1$equals(i2, checkMetaData=FALSE))
#parameter records comparison
m = Container$new()
p1 = Parameter$new(m, "p1", records=SpecialValues[["NA"]])
p2 = Parameter$new(m, "p2", records=SpecialValues[["NA"]])
p3 = Parameter$new(m, "p3", records=SpecialValues[["EPS"]])
expect_true(p1$equals(p2, checkMetaData=FALSE))
expect_false(p1$equals(p3, checkMetaData=FALSE))
m = Container$new()
p1 = Parameter$new(m, "p1", records=SpecialValues[["EPS"]])
p2 = Parameter$new(m, "p2", records=SpecialValues[["EPS"]])
p3 = Parameter$new(m, "p3", records=SpecialValues[["UNDEF"]])
expect_true(p1$equals(p2, checkMetaData=FALSE))
expect_false(p1$equals(p3, checkMetaData=FALSE))
m = Container$new()
p1 = Parameter$new(m, "p1", records=SpecialValues[["UNDEF"]])
p2 = Parameter$new(m, "p2", records=SpecialValues[["UNDEF"]])
p3 = Parameter$new(m, "p3", records=SpecialValues[["NA"]])
expect_true(p1$equals(p2, checkMetaData=FALSE))
expect_false(p1$equals(p3, checkMetaData=FALSE))
#scalar
m = Container$new()
p1 = Parameter$new(m, "p1", records=10)
p2 = Parameter$new(m, "p2", records=10)
p3 = Parameter$new(m, "p3", records=5)
expect_true(p1$equals(p2, checkMetaData=FALSE))
expect_false(p1$equals(p3, checkMetaData=FALSE))
# 1D param
m = Container$new()
i = Set$new(m, "i", records=c("i1","i2","i3"))
p1 = Parameter$new(m, "p1", domain=i, records=data.frame(c("i1","i2","i3"), c(2,4,5)))
p2 = Parameter$new(m, "p2", domain=i, records=data.frame(c("i1","i2","i3"), c(3,5,5)))
expect_false(p1$equals(p2, checkMetaData=FALSE))
# 2D param with special values
m = Container$new()
i = Set$new(m, "i", records=c("i1","i2","i3"))
j = Set$new(m, "j", records=c("j1","j2","j3"))
p1 = Parameter$new(m, "p1", domain=c(i, j), records=data.frame(c("i1","i2","i3"),c("j1","j2","j3"), c(SpecialValues[["NA"]],4,SpecialValues$UNDEF)))
p2 = Parameter$new(m, "p2", domain=c(i, j), records=data.frame(c("i1","i2","i3"),c("j1","j2","j3"), c(SpecialValues$UNDEF,4,SpecialValues[["NA"]])))
p3 = Parameter$new(m, "p3", domain=c(i, j), records=data.frame(c("i1","i2","i3"),c("j1","j2","j3"), c(SpecialValues[["NA"]],5,SpecialValues$UNDEF)))
expect_false(p1$equals(p2, checkMetaData=FALSE))
expect_false(p1$equals(p3, checkMetaData=FALSE))
# variable
m = Container$new()
v0 = Variable$new(m, "v0", records=data.frame(level=3))
v0p = Variable$new(m, "v0p", records=data.frame(level=2.99))
expect_true(v0$equals(v0p, checkMetaData=FALSE, atol=0.1))
expect_true(v0$equals(v0p, columns="level",checkMetaData=FALSE, atol=0.1))
expect_true(v0$equals(v0p, checkMetaData=FALSE, atol=0.1))
expect_true(v0$equals(v0p,columns=c("level", "marginal"), checkMetaData=FALSE, atol=0.1))
expect_false(v0$equals(v0p, columns=c("level", "marginal"), checkMetaData=FALSE, atol=0))
expect_error(v0$equals(v0p, checkMetaData=FALSE, atol=c(level=0, scale=0.1), rtol=c(marginal=0, scale=0.1)))
expect_error(v0$equals(v0p, checkMetaData=FALSE, atol=c(level=0, scale=0.1), verbose=TRUE))
m = Container$new()
i = Set$new(m, "i", records=paste0("i",1:5))
v1 = Variable$new(m, "v1", domain=i, records=data.frame(c("i1","i4","i5"), level=c(3, 4, 5)))
v1p = Variable$new(m, "v1p",domain=i, records=data.frame(c("i1","i4","i5"), level=c(2.95, 4.03, 5.09)))
expect_true(v1$equals(v1p, columns="level", checkMetaData=FALSE, atol=0.1))
expect_true(v1$equals(v1p, checkMetaData=FALSE, atol=0.1))
expect_false(v1$equals(v1p, columns=c("level", "marginal"), checkMetaData=FALSE, atol=0))
expect_error(v1$equals(v1p, checkMetaData=FALSE, atol=c(level=0, scale=0.1), rtol=c(marginal=0, scale=0.1)))
expect_error(v1$equals(v1p, checkMetaData=FALSE, atol=c(level=0, scale=0.1), verbose=TRUE))
m = Container$new()
i = Set$new(m, "i", records=paste0("i",1:5))
j = Set$new(m, "j", records=paste0("j",1:5))
v2 = Variable$new(m, "v2", domain=c(i, j), records=data.frame(c("i1","i4","i5"), c("j2","j4","j1"), level=c(3, NA, 5), marginal=c(NaN, 4, 5)))
v2p = Variable$new(m, "v2p",domain=c(i, j), records=data.frame(c("i1","i4","i5"), c("j2","j4","j1"), level=c(2.95, NA, 5.09), marginal=c(NaN, 4, 5)))
expect_true(v1$equals(v1p, columns="level", checkMetaData=FALSE, atol=0.1))
expect_true(v1$equals(v1p, checkMetaData=FALSE, atol=0.1))
expect_true(v1$equals(v1p, columns=c("level", "marginal"), checkMetaData=FALSE, atol=0.1))
expect_false(v1$equals(v1p, columns=c("level", "marginal"), checkMetaData=FALSE, atol=0))
expect_error(v1$equals(v1p, checkMetaData=FALSE, atol=c(level=0, scale=0.1), rtol=c(marginal=0, scale=0.1)))
expect_error(v1$equals(v1p, checkMetaData=FALSE, atol=c(level=0, scale=0.1), verbose=TRUE))
}
)
# test equals for alias and unialias
test_that("test_num_106", {
m = Container$new()
i = Set$new(m, "i", records=c("i1","i2","i3"))
j = Set$new(m, "j", records=c("i1","i2","i3"))
ip = Alias$new(m, "ip", i)
jp = Alias$new(m, "jp", j)
expect_true(i$equals(j, checkMetaData=FALSE))
expect_true(ip$equals(jp, checkMetaData=FALSE))
expect_false(ip$equals(jp, checkMetaData=TRUE))
expect_true(ip$equals(j, checkMetaData=FALSE))
expect_true(i$equals(jp, checkMetaData=FALSE))
u = UniverseAlias$new(m, "u")
up = UniverseAlias$new(m, "up")
expect_true(u$equals(up, checkMetaData=FALSE))
expect_false(u$equals(up))
}
)
# test equals for container and container
test_that("test_num_107", {
m = Container$new()
i = Set$new(m, "i")
m1 = Container$new()
i1 = Set$new(m1, "i")
expect_true(m$equals(m1))
j = Set$new(m1, "j")
expect_false(m$equals(m1))
expect_error(m$equals(m1, verbose=TRUE))
k = Set$new(m, "k")
expect_false(m$equals(m1))
expect_error(m$equals(m1,verbose=TRUE))
}
)
# test partial domain_forwarding
test_that("test_num_107", {
m = Container$new()
i = Set$new(m, "i")
j = Set$new(m, "j")
recs=data.frame(i=c("a","b","c"), j = c("d","e","f"), val=c(1,2,3))
d = Parameter$new(m, "d",domain=c(i, j), records= recs, domainForwarding=
c(TRUE, FALSE))
expect_true(is.null(j$records))
expect_equal(nrow(i$records), 3)
m = Container$new()
i = Set$new(m, "i")
j = Set$new(m, "j")
recs=data.frame(i=c("a","b","c"), j = c("d","e","f"), val=c(1,2,3))
expect_error(Parameter$new(m, "d1",domain=c(i, j), records= recs, domainForwarding=
2))
expect_error(Parameter$new(m, "d2",domain=c(i, j), records= recs, domainForwarding=
C(TRUE, TRUE, FALSE)))
d = Parameter$new(m, "d",domain=c(i, j), records= recs, domainForwarding=
c(FALSE, TRUE))
expect_true(is.null(i$records))
expect_equal(nrow(j$records), 3)
m = Container$new()
i = Set$new(m, "i")
j = Set$new(m, "j")
recs=data.frame(i=c("a","b","c"), j = c("d","e","f"), val=c(1,2,3))
d = Parameter$new(m, "d",domain=c(i, j), records= recs, domainForwarding=
TRUE)
expect_equal(nrow(i$records), 3)
expect_equal(nrow(j$records), 3)
m = Container$new()
i = Set$new(m, "i")
j = Set$new(m, "j")
recs=data.frame(i=c("a","b","c"), j = c("d","e","f"), val=c(1,2,3))
d = Parameter$new(m, "d",domain=c(i, j), records= recs, domainForwarding=
FALSE)
expect_true(is.null(i$records))
expect_true(is.null(j$records))
}
)
# test generateRecords
test_that("test_num_108", {
m = Container$new()
i = Set$new(m, "i", records=paste0("i",1:5))
isub = Set$new(m, "isub", domain=i)
isub$generateRecords()
expect_equal(nrow(isub$records), 5)
p = Parameter$new(m, "p",domain=i)
p$generateRecords(density=1)
expect_equal(nrow(p$records), 5)
p$generateRecords(density=0.5)
expect_equal(nrow(p$records), 2)
# error because runif expects argument n and not size
# expect_error(p$generateRecords(density=1, func=runif))
rg = function(size) {
return(runif(size))
}
p$generateRecords(density=1, func=rg)
expect_equal(nrow(p$records), 5)
rg_error = function() {
return(1)
}
# expect_error(p$generateRecords(func=runif))
j = Set$new(m, "j", records=paste0("j",1:3))
d = Parameter$new(m, "d", domain=c(i, j))
d$generateRecords()
expect_equal(nrow(d$records), 15)
}
)
# test generateRecords for variable and equation
test_that("test_num_109", {
m = Container$new()
i = Set$new(m, "i", records=paste0("i",1:5))
e = Equation$new(m, "e", "eq", domain=i)
e$generateRecords()
expect_equal(nrow(e$records), 5)
expect_true(all(e$records$marginal == 0))
expect_true(all(e$records$lower == 0))
expect_true(all(e$records$upper == 0))
expect_true(all(e$records$scale == 1))
rg = function(size) {
return(runif(n=size))
}
e$generateRecords(func=rg)
expect_equal(nrow(e$records), 5)
expect_true(all(e$records$marginal == 0))
expect_true(all(e$records$lower == 0))
expect_true(all(e$records$upper == 0))
expect_true(all(e$records$scale == 1))
e$generateRecords(func=list(scale=rg))
expect_equal(nrow(e$records), 5)
expect_true(all(e$records$marginal == 0))
expect_true(all(e$records$lower == 0))
expect_true(all(e$records$upper == 0))
expect_true(all(e$records$level == 0))
e$generateRecords(func=list(scale=rg, marginal=rg))
expect_equal(nrow(e$records), 5)
expect_true(all(e$records$lower == 0))
expect_true(all(e$records$upper == 0))
expect_true(all(e$records$level == 0))
expect_equal(colnames(e$records), c("i", "level", "marginal", "lower", "upper", "scale"))
#test the same for variables
m = Container$new()
i = Set$new(m, "i", records=paste0("i",1:5))
v = Variable$new(m, "v", "binary", domain=i)
v$generateRecords()
expect_equal(nrow(v$records), 5)
expect_true(all(v$records$marginal == 0))
expect_true(all(v$records$lower == 0))
expect_true(all(v$records$upper == 1))
expect_true(all(v$records$scale == 1))
rg = function(size) {
return(runif(n=size))
}
v$generateRecords(func=rg)
expect_equal(nrow(v$records), 5)
expect_true(all(v$records$marginal == 0))
expect_true(all(v$records$lower == 0))
expect_true(all(v$records$upper == 1))
expect_true(all(v$records$scale == 1))
v$generateRecords(func=list(scale=rg))
expect_equal(nrow(v$records), 5)
expect_true(all(v$records$marginal == 0))
expect_true(all(v$records$lower == 0))
expect_true(all(v$records$upper == 1))
expect_true(all(v$records$level == 0))
v$generateRecords(func=list(scale=rg, marginal=rg))
expect_equal(nrow(v$records), 5)
expect_true(all(v$records$lower == 0))
expect_true(all(v$records$upper == 1))
expect_true(all(v$records$level == 0))
expect_equal(colnames(v$records), c("i", "level", "marginal", "lower", "upper", "scale"))
# try scalar variables and equations
m = Container$new()
e0 = Equation$new(m, "e0", "eq")
v0 = Variable$new(m, "v0", "binary")
e0$generateRecords()
expect_equal(colnames(e0$records), c("level", "marginal", "lower", "upper", "scale"))
expect_true(all(e0$records$marginal == 0))
expect_true(all(e0$records$lower == 0))
expect_true(all(e0$records$upper == 0))
expect_true(all(e0$records$scale == 1))
v0$generateRecords()
expect_equal(colnames(v0$records), c("level", "marginal", "lower", "upper", "scale"))
expect_true(all(v0$records$marginal == 0))
expect_true(all(v0$records$lower == 0))
expect_true(all(v0$records$upper == 1))
expect_true(all(v0$records$scale == 1))
}
)
# test generateRecords for multidimensional
test_that("test_num_110", {
m = Container$new()
i = Set$new(m, "i", records=paste0("i", 1:50))
j = Set$new(m, "j", records=paste0("j", 1:50))
k = Set$new(m, "k", records=paste0("k", 1:50))
l = Set$new(m, "l", records=paste0("l", 1:50))
# create and define the symbol `a` with `regular` domains
a = Set$new(m, "a", c(i, j, k, l))
# generate the records
a$generateRecords(density = 0.05)
expect_equal(nrow(a$records), (50**4)/20)
}
)
# write empty gdx
test_that("test_num_111", {
skip_if_no_gams()
m = Container$new()
expect_true(is.null(m$write("empty.gdx")))
expect_true(is.null(m$write("empty.gdx", mode="string")))
# test the super call write
writeList = m$asList()
writeGDX(writeList, "empty.gdx")
# write empty gdx with uelPriority
m$write("gt.gdx", uelPriority = c("i1","i2","i3"))
system2(command="gdxdump", args=
"gt.gdx uelTable=foo",
stdout = "foo.gms")
system2(command="gams", args=
"foo.gms gdx=foo.gdx lo=0",
stdout = FALSE)
m = Container$new("foo.gdx")
expect_equal(m$getUELs(), c("i1","i2","i3"))
writeGDX(writeList, "gt.gdx", uelPriority = c("i1","i2","i3"))
system2(command="gdxdump", args=
"gt.gdx uelTable=foo",
stdout = "foo.gms")
system2(command="gams", args=
"foo.gms gdx=foo.gdx lo=0",
stdout = FALSE)
m = Container$new("foo.gdx")
expect_equal(m$getUELs(), c("i1","i2","i3"))
}
)
# test copy
test_that("test_num_112", {
m = Container$new()
i = Set$new(m, "i", records=paste0("i", 1:50))
p = Parameter$new(m, "p")
v = Variable$new(m, "v")
e = Equation$new(m, "e", type="eq")
m2 = Container$new()
i$copy(m2)
p$copy(m2)
v$copy(m2)
e$copy(m2)
m3 = Container$new()
i = Set$new(m3, "i")
p = Parameter$new(m3, "p")
v = Variable$new(m3, "v")
e = Equation$new(m3, "e", type="eq")
expect_error(i$copy(m2))
expect_true(is.null(i$copy(m2, overwrite=TRUE )))
expect_error(p$copy(m2))
expect_true(is.null(p$copy(m2, overwrite=TRUE )))
expect_error(v$copy(m2))
expect_true(is.null(v$copy(m2, overwrite=TRUE )))
expect_error(e$copy(m2))
expect_true(is.null(e$copy(m2, overwrite=TRUE )))
m = Container$new()
i = Set$new(m, "i")
m2 = Container$new()
i1 = Parameter$new(m2, "i")
p = Parameter$new(m2, "p")
expect_error(i$copy(m2))
expect_error(i$copy(i))
expect_error(p$copy(m, overwrite="true"))
m = Container$new()
i = Set$new(m, "i")
p = Parameter$new(m, "p", domain=i)
m2 = Container$new()
p$copy(m2)
expect_equal(m2["p"]$domain[[1]], "i")
expect_equal(m2["p"]$domainType, "relaxed")
i2 = Set$new(m2, "i", domain=c("*","*"))
i2$copy(m, overwrite=TRUE)
expect_equal(p$domain[[1]]$dimension, 2)
# todo
expect_equal(p$isValid(force=TRUE), FALSE)
m = Container$new()
i = Set$new(m, "i", records=c("i1","i2"))
m2 = Container$new()
i2 = Set$new(m2, "i", records=c("newi", "newi_1"))
i2$copy(m, overwrite=TRUE)
expect_equal(as.character(i$records[[1]]), c("newi", "newi_1"))
}
)
# test copy for alias and universe alias
test_that("test_num_113", {
m = Container$new()
i = Set$new(m, "i")
ii = Alias$new(m, "ii", i)
m2 = Container$new()
# ii$copy(m2)
# expect_equal(m2$listSymbols(), c("i","ii"))
u = UniverseAlias$new(m, "u")
u$copy(m2)
# expect_equal(m2$listSymbols(), c("i","ii","u"))
expect_equal(m2$listSymbols(), c("u"))
}
)
# test copy container method
test_that("test_num_114", {
m = Container$new(testthat::test_path("testdata", "trnsport.gdx"))
m2 = Container$new()
m$copy(m2)
expect_equal(m2$listSymbols(), m$listSymbols())
m2 = Container$new()
m$copy(m2, symbols=c("f","d"))
expect_equal(m2$listSymbols(), c("f","d"))
expect_error(m$copy(m2, "d"))
m$copy(m2, "d", overwrite=TRUE)
expect_equal(m2$listSymbols(), c("f","d"))
}
)
# test copy Container method
test_that("test_num_115", {
m = Container$new(testthat::test_path("testdata", "trnsport.gdx"))
m2 = Container$new()
m$copy(m2)
expect_equal(m2$listSymbols(), m$listSymbols())
m2 = Container$new()
m$copy(m2, symbols=c("f","d"))
expect_equal(m2$listSymbols(), c("f","d"))
expect_error(m$copy(m2, "d"))
m$copy(m2, "d", overwrite=TRUE)
expect_equal(m2$listSymbols(), c("f","d"))
}
)
# test copy for alias and universe alias
test_that("test_num_116", {
m = Container$new(testthat::test_path("testdata", "test95.gdx"))
m2 = Container$new()
m["h"]$copy(m2)
# expect_equal(m2$listSymbols(), c("i","ii","u"))
expect_equal(m2$listSymbols(), c("h"))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "test95.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
}
)
# test reading symbols with unused uels from gdx
test_that("test_num_117", {
m = Container$new()
i = Set$new(m, "i", records=paste0("i", 1:5))
isub = Set$new(m, "isub", domain=i, records=c("i1","i2"))
isub$setUELs(paste0("i",1:5))
m$write("gt.gdx")
m2 = Container$new(testthat::test_path("gt.gdx"))
expect_equal(m["isub"]$getUELs(), paste0("i",1:5))
m$write("gt.gdx", mode="string")
m2 = Container$new(testthat::test_path("gt.gdx"))
expect_equal(m["isub"]$getUELs(), paste0("i",1:5))
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
m2 = Container$new(testthat::test_path("gt.gdx"))
expect_equal(m["isub"]$getUELs(), paste0("i",1:5))
}
)
# test isScalar for symbols
test_that("test_num_118", {
m = Container$new()
p = Parameter$new(m, "p")
expect_true(p$isScalar)
v = Variable$new(m, "v", type="free")
expect_true(v$isScalar)
e = Equation$new(m, "e", type="eq")
expect_true(e$isScalar)
m$write("gt.gdx")
m2 = Container$new()
m2$read(testthat::test_path("gt.gdx"))
expect_true(m2["p"]$isScalar)
expect_true(m2["v"]$isScalar)
expect_true(m2["e"]$isScalar)
m$write("gt.gdx", mode="string")
m2 = Container$new()
m2$read(testthat::test_path("gt.gdx"))
expect_true(m2["p"]$isScalar)
expect_true(m2["v"]$isScalar)
expect_true(m2["e"]$isScalar)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
m2 = Container$new()
m2$read(testthat::test_path("gt.gdx"))
expect_true(m2["p"]$isScalar)
expect_true(m2["v"]$isScalar)
expect_true(m2["e"]$isScalar)
}
)
# test Scalars with more records isvalid
test_that("test_num_119", {
m = Container$new()
p = Parameter$new(m, "p")
p$setRecords(data.frame(value=c(1,2)))
expect_false(p$isValid())
v = Variable$new(m, "v", type="free")
v$setRecords(data.frame(level=c(1,2)))
expect_false(v$isValid())
e = Equation$new(m, "e", type="eq")
e$setRecords(data.frame(level=c(1,2)))
expect_false(e$isValid())
}
)
# test description of length > 255
test_that("test_num_119", {
m = Container$new()
i = Set$new(m, "i")
a = paste0(rep("m",255), collapse = "")
i$description = a
a = paste0(rep("m",256), collapse = "")
expect_error({i$description = a})
}
)
# reorderUELs with null argument
test_that("test_num_120", {
m = Container$new()
i = Set$new(m, "i", records = paste0("i", c(1,2,4,3)))
i$setUELs(paste0("i", 1:5))
expect_equal(i$getUELs(), paste0("i", 1:5))
i$reorderUELs()
expect_equal(i$getUELs(), paste0("i", c(1,2,4,3, 5)))
a = Parameter$new(m, "p", domain=c(i, i), records=data.frame(i=c("i1","i5","i3"), i=c("i2","i4","i1"), value=c(1,3,4)))
expect_equal(a$getUELs(1), c("i1","i5","i3"))
expect_equal(a$getUELs(2), c("i2","i4","i1"))
a$setUELs(uels=paste0("i", 1:5), dimension=1)
a$setUELs(uels=paste0("i", 1:5), dimension=2)
expect_equal(a$getUELs(1), paste0("i", 1:5))
expect_equal(a$getUELs(2), paste0("i", 1:5))
a$reorderUELs(dimension=1)
expect_equal(a$getUELs(1), c("i1","i5","i3", "i2","i4"))
a$reorderUELs(dimension=2)
expect_equal(a$getUELs(2), c("i2","i4","i1", "i3","i5"))
}
)
# todense uel checks
test_that("test_num_121", {
m = Container$new()
i = Set$new(m, "i", records = paste0("i", c(1,2,4,3)))
a = Parameter$new(m, "a", domain=i, records=data.frame(i = c("i1","i3"), value=c(1,3)))
expect_equal(a$toDense(), array(c(1, 0, 0, 3)))
i$setUELs(paste0("i", 1:5))
i$reorderUELs(paste0("i", c(1,2,4,3, 5)))
# unused uels at the end are okay
expect_equal(a$toDense(), array(c(1, 0, 0, 3)))
i$reorderUELs(paste0("i", c(1,2,5, 4,3)))
expect_error(a$toDense())
# now the order of UELs is different from that of the records
i$setUELs(paste0("i", 1:4))
expect_error(a$toDense())
}
)
# case insensitive check
test_that("test_num_122", {
m = Container$new()
m$read(testthat::test_path("testdata","trnsport.gdx"), "x")
expect_true(!is.null(m["x"]))
expect_true(!is.null(m["X"]))
expect_true(is.null(m["d"]))
}
)
# describe aliases
test_that("test_num_123", {
m = Container$new()
expect_error(m$read(testthat::test_path("testdata","trnsport_with_alias.gdx"), "ip"))
m$read(testthat::test_path("testdata","trnsport_with_alias.gdx"))
m$describeAliases()
}
)
# domain linking test on GDX read
test_that("test_num_124", {
m = Container$new()
m$read(testthat::test_path("testdata","trnsport.gdx"))
expect_equal(m["d"]$domain, c(m["i"], m["j"]))
# subset of symbols in a different order
m1 = Container$new()
m1$read(testthat::test_path("testdata","trnsport.gdx"), c("d","i","j"))
expect_equal(m1["d"]$domain, c(m1["i"], m1["j"]))
# check the same for container read
m1 = Container$new()
m1$read(m, c("d","i","j"))
expect_equal(m1["d"]$domain, c(m1["i"], m1["j"]))
# subset of symbols one string one regular
m1 = Container$new()
m1$read(testthat::test_path("testdata","trnsport.gdx"), c("d","i"))
expect_equal(m1["d"]$domain, c(m1["i"], "j"))
# check the same for container read
m1 = Container$new()
m1$read(m, c("d","i"))
expect_equal(m1["d"]$domain, c(m1["i"], "j"))
# ensure that symbols are not linked using names
m = Container$new()
j = Set$new(m, "j", records=paste0("j",1:10))
i = Set$new(m, "i", records=paste0("i",1:10))
p = Parameter$new(m, "p", domain=c("j"), records = data.frame(j=paste0("i",1:10), 1:10))
m$write("gt.gdx")
writeList = m$asList()
m = Container$new("gt.gdx")
expect_equal(m["p"]$domain, "j")
expect_false(m["p"]$hasDomainViolations())
# check the same for container read
m2 = Container$new()
m2$read(m)
expect_equal(m2["p"]$domain, "j")
expect_false(m2["p"]$hasDomainViolations())
m$write("gt.gdx", mode="string")
m = Container$new("gt.gdx")
expect_equal(m["p"]$domain, "j")
expect_false(m["p"]$hasDomainViolations())
# check the same for container read
m2 = Container$new()
m2$read(m)
expect_equal(m2["p"]$domain, "j")
expect_false(m2["p"]$hasDomainViolations())
writeGDX(writeList, "gt.gdx")
m = Container$new("gt.gdx")
expect_equal(m["p"]$domain, "j")
expect_false(m["p"]$hasDomainViolations())
# check the same for container read
m2 = Container$new()
m2$read(m)
expect_equal(m2["p"]$domain, "j")
expect_false(m2["p"]$hasDomainViolations())
}
)
# domain linking test on GDX read when domain symbol exists
# in the container but is not read from GDX
test_that("test_num_125", {
m = Container$new()
i = Set$new(m, "i")
m$read(testthat::test_path("testdata","trnsport.gdx"), "d")
expect_equal(m["d"]$domain, c("i", "j"))
}
)
# extensive partial column tests
test_that("test_num_126", {
# data frames with only domain - equation
for (t in c("eq","geq","leq","nonbinding", "cone", "external", "boolean")) {
m = Container$new()
e = Equation$new(m, "e", type=t, domain="*", records = data.frame(i=c("i1","i2","i3")))
expect_equal(m$listSymbols(), c("e"))
expect_equal(colnames(m["e"]$records), "i")
expect_equal(length(m["e"]$records), 1)
expect_true(m["e"]$isValid())
m$write("partial_equation.gdx")
m1 = Container$new("partial_equation.gdx")
expect_equal(m1$listSymbols(), "e")
expect_equal(colnames(m1["e"]$records), c("uni", "level", "marginal", "lower", "upper", "scale"))
expect_equal(length(m1["e"]$records), 6)
for (i in c("level", "marginal", "lower", "upper", "scale")) {
expect_equal(m1["e"]$records[,i], replicate(m["e"]$numberRecords, m["e"]$defaultValues[[i]]))
}
m$write("partial_equation.gdx", mode="string")
m1 = Container$new("partial_equation.gdx")
expect_equal(m1$listSymbols(), "e")
expect_equal(colnames(m1["e"]$records), c("uni", "level", "marginal", "lower", "upper", "scale"))
expect_equal(length(m1["e"]$records), 6)
for (i in c("level", "marginal", "lower", "upper", "scale")) {
expect_equal(m1["e"]$records[,i], replicate(m["e"]$numberRecords, m["e"]$defaultValues[[i]]))
}
# test the super call write
writeList = m$asList()
writeGDX(writeList, "partial_equation.gdx")
m1 = Container$new("partial_equation.gdx")
expect_equal(m1$listSymbols(), "e")
expect_equal(colnames(m1["e"]$records), c("uni", "level", "marginal", "lower", "upper", "scale"))
expect_equal(length(m1["e"]$records), 6)
for (i in c("level", "marginal", "lower", "upper", "scale")) {
expect_equal(m1["e"]$records[,i], replicate(m["e"]$numberRecords, m["e"]$defaultValues[[i]]))
}
}
# data frames with only domain - variable
for (t in c("binary", "integer", "positive", "negative", "free", "sos1", "sos2", "semicont", "semiint")) {
m = Container$new()
v = Variable$new(m, "v", type=t, domain="*", records = data.frame(i=c("i1","i2","i3")))
expect_equal(m$listSymbols(), c("v"))
expect_equal(colnames(m["v"]$records), "i")
expect_equal(length(m["v"]$records), 1)
expect_true(m["v"]$isValid())
m$write("partial_variable.gdx")
m1 = Container$new("partial_variable.gdx")
expect_equal(m1$listSymbols(), "v")
expect_equal(colnames(m1["v"]$records), c("uni", "level", "marginal", "lower", "upper", "scale"))
expect_equal(length(m1["v"]$records), 6)
for (i in c("level", "marginal", "lower", "upper", "scale")) {
expect_equal(m1["v"]$records[,i], replicate(m["v"]$numberRecords, m["v"]$defaultValues[[i]]))
}
m$write("partial_variable.gdx", mode="string")
m1 = Container$new("partial_variable.gdx")
expect_equal(m1$listSymbols(), "v")
expect_equal(colnames(m1["v"]$records), c("uni", "level", "marginal", "lower", "upper", "scale"))
expect_equal(length(m1["v"]$records), 6)
for (i in c("level", "marginal", "lower", "upper", "scale")) {
expect_equal(m1["v"]$records[,i], replicate(m["v"]$numberRecords, m["v"]$defaultValues[[i]]))
}
# test the super call write
writeList = m$asList()
writeGDX(writeList, "partial_variable.gdx")
m1 = Container$new("partial_variable.gdx")
expect_equal(m1$listSymbols(), "v")
expect_equal(colnames(m1["v"]$records), c("uni", "level", "marginal", "lower", "upper", "scale"))
expect_equal(length(m1["v"]$records), 6)
for (i in c("level", "marginal", "lower", "upper", "scale")) {
expect_equal(m1["v"]$records[,i], replicate(m["v"]$numberRecords, m["v"]$defaultValues[[i]]))
}
}
# data frames with only domain - parameter
m = Container$new()
p = Parameter$new(m, "p", domain="*", records = data.frame(i=c("i1","i2","i3")))
expect_equal(m$listSymbols(), c("p"))
expect_equal(colnames(m["p"]$records), "i")
expect_equal(length(m["p"]$records), 1)
expect_true(m["p"]$isValid())
m$write("partial_parameter.gdx")
m1 = Container$new("partial_parameter.gdx")
expect_equal(m1$listSymbols(), "p")
expect_equal(colnames(m1["p"]$records), c("uni", "value"))
expect_equal(length(m1["p"]$records), 2)
expect_equal(m1["p"]$records[,"value"], replicate(m["p"]$numberRecords, 0))
m$write("partial_parameter.gdx", mode="string")
m1 = Container$new("partial_parameter.gdx")
expect_equal(m1$listSymbols(), "p")
expect_equal(colnames(m1["p"]$records), c("uni", "value"))
expect_equal(length(m1["p"]$records), 2)
expect_equal(m1["p"]$records[,"value"], replicate(m["p"]$numberRecords, 0))
# test the super call write
writeList = m$asList()
writeGDX(writeList, "partial_parameter.gdx")
m1 = Container$new("partial_parameter.gdx")
expect_equal(m1$listSymbols(), "p")
expect_equal(colnames(m1["p"]$records), c("uni", "value"))
expect_equal(length(m1["p"]$records), 2)
expect_equal(m1["p"]$records[,"value"], replicate(m["p"]$numberRecords, 0))
# data frames with only domain - set
m = Container$new()
s = Set$new(m, "s", records = data.frame(i=c("i1","i2","i3")))
expect_equal(m$listSymbols(), c("s"))
expect_equal(colnames(m["s"]$records), "i")
expect_equal(length(m["s"]$records), 1)
expect_true(m["s"]$isValid())
m$write("partial_set.gdx")
m1 = Container$new("partial_set.gdx")
expect_equal(m1$listSymbols(), "s")
expect_equal(colnames(m1["s"]$records), c("uni", "element_text"))
expect_equal(length(m1["s"]$records), 2)
m$write("partial_set.gdx", mode="string")
m1 = Container$new("partial_set.gdx")
expect_equal(m1$listSymbols(), "s")
expect_equal(colnames(m1["s"]$records), c("uni", "element_text"))
expect_equal(length(m1["s"]$records), 2)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "partial_set.gdx")
m1 = Container$new("partial_set.gdx")
expect_equal(m1$listSymbols(), "s")
expect_equal(colnames(m1["s"]$records), c("uni", "element_text"))
expect_equal(length(m1["s"]$records), 2)
# data frames with domain + missing attribute columns - equation
for (t in c("eq","geq","leq","nonbinding", "cone", "external", "boolean")) {
m = Container$new()
e = Equation$new(m, "e", type=t, domain="*", records = data.frame(i=c("i1","i2","i3"), marginal=c(10, 10, 10)))
expect_equal(m$listSymbols(), c("e"))
expect_equal(colnames(m["e"]$records), c("i", "marginal"))
expect_equal(length(m["e"]$records), 2)
expect_true(m["e"]$isValid())
m$write("partial_equation.gdx")
m1 = Container$new("partial_equation.gdx")
expect_equal(m1$listSymbols(), "e")
expect_equal(colnames(m1["e"]$records), c("uni", "level", "marginal", "lower", "upper", "scale"))
expect_equal(length(m1["e"]$records), 6)
for (i in c("level", "lower", "upper", "scale")) {
expect_equal(m1["e"]$records[,i], replicate(m["e"]$numberRecords, m["e"]$defaultValues[[i]]))
}
expect_equal(m1["e"]$records[,"marginal"], replicate(m["e"]$numberRecords, 10))
m$write("partial_equation.gdx", mode="string")
m1 = Container$new("partial_equation.gdx")
expect_equal(m1$listSymbols(), "e")
expect_equal(colnames(m1["e"]$records), c("uni", "level", "marginal", "lower", "upper", "scale"))
expect_equal(length(m1["e"]$records), 6)
for (i in c("level", "lower", "upper", "scale")) {
expect_equal(m1["e"]$records[,i], replicate(m["e"]$numberRecords, m["e"]$defaultValues[[i]]))
}
expect_equal(m1["e"]$records[,"marginal"], replicate(m["e"]$numberRecords, 10))
# test the super call write
writeList = m$asList()
writeGDX(writeList, "partial_equation.gdx")
m1 = Container$new("partial_equation.gdx")
expect_equal(m1$listSymbols(), "e")
expect_equal(colnames(m1["e"]$records), c("uni", "level", "marginal", "lower", "upper", "scale"))
expect_equal(length(m1["e"]$records), 6)
for (i in c("level", "lower", "upper", "scale")) {
expect_equal(m1["e"]$records[,i], replicate(m["e"]$numberRecords, m["e"]$defaultValues[[i]]))
}
expect_equal(m1["e"]$records[,"marginal"], replicate(m["e"]$numberRecords, 10))
}
# data frames with domain + missing attribute columns - variable
for (t in c("binary", "integer", "positive", "negative", "free", "sos1", "sos2", "semicont", "semiint")) {
m = Container$new()
v = Variable$new(m, "v", type=t, domain="*", records = data.frame(i=c("i1","i2","i3"), marginal=c(10, 10, 10)))
expect_equal(m$listSymbols(), c("v"))
expect_equal(colnames(m["v"]$records), c("i", "marginal"))
expect_equal(length(m["v"]$records), 2)
expect_true(m["v"]$isValid())
m$write("partial_variable.gdx")
m1 = Container$new("partial_variable.gdx")
expect_equal(m1$listSymbols(), "v")
expect_equal(colnames(m1["v"]$records), c("uni", "level", "marginal", "lower", "upper", "scale"))
expect_equal(length(m1["v"]$records), 6)
for (i in c("level", "lower", "upper", "scale")) {
expect_equal(m1["v"]$records[,i], replicate(m["v"]$numberRecords, m["v"]$defaultValues[[i]]))
}
expect_equal(m1["v"]$records[,"marginal"], replicate(m["v"]$numberRecords, 10))
m$write("partial_variable.gdx", mode="string")
m1 = Container$new("partial_variable.gdx")
expect_equal(m1$listSymbols(), "v")
expect_equal(colnames(m1["v"]$records), c("uni", "level", "marginal", "lower", "upper", "scale"))
expect_equal(length(m1["v"]$records), 6)
for (i in c("level", "lower", "upper", "scale")) {
expect_equal(m1["v"]$records[,i], replicate(m["v"]$numberRecords, m["v"]$defaultValues[[i]]))
}
expect_equal(m1["v"]$records[,"marginal"], replicate(m["v"]$numberRecords, 10))
# test the super call write
writeList = m$asList()
writeGDX(writeList, "partial_variable.gdx")
m1 = Container$new("partial_variable.gdx")
expect_equal(m1$listSymbols(), "v")
expect_equal(colnames(m1["v"]$records), c("uni", "level", "marginal", "lower", "upper", "scale"))
expect_equal(length(m1["v"]$records), 6)
for (i in c("level", "lower", "upper", "scale")) {
expect_equal(m1["v"]$records[,i], replicate(m["v"]$numberRecords, m["v"]$defaultValues[[i]]))
}
expect_equal(m1["v"]$records[,"marginal"], replicate(m["v"]$numberRecords, 10))
}
}
)
# extensive partial column tests for scalars
test_that("test_num_127", {
#parameter
m = Container$new()
p = Parameter$new(m, "p", records=data.frame())
m$write("partial_scalar.gdx")
m1 = Container$new("partial_scalar.gdx")
expect_equal(m1["p"]$records$value, 0)
m$write("partial_scalar.gdx", mode="string")
m1 = Container$new("partial_scalar.gdx")
expect_equal(m1["p"]$records$value, 0)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "partial_scalar.gdx")
m1 = Container$new("partial_scalar.gdx")
expect_equal(m1["p"]$records$value, 0)
#variable
m = Container$new()
v = Variable$new(m, "v", records=data.frame())
m$write("partial_scalar_variable.gdx")
m1 = Container$new("partial_scalar_variable.gdx")
for (i in c("level", "marginal", "lower", "upper", "scale")) {
expect_equal(m1["v"]$records[[i]], m["v"]$defaultValues[[i]])
}
m$write("partial_scalar_variable.gdx", mode="string")
m1 = Container$new("partial_scalar_variable.gdx")
for (i in c("level", "marginal", "lower", "upper", "scale")) {
expect_equal(m1["v"]$records[[i]], m["v"]$defaultValues[[i]])
}
# test the super call write
writeList = m$asList()
writeGDX(writeList, "partial_scalar_variable.gdx")
m1 = Container$new("partial_scalar_variable.gdx")
for (i in c("level", "marginal", "lower", "upper", "scale")) {
expect_equal(m1["v"]$records[[i]], m["v"]$defaultValues[[i]])
}
#equation
m = Container$new()
e = Equation$new(m, "e", type="eq", records=data.frame())
m$write("partial_scalar_equation.gdx")
m1 = Container$new("partial_scalar_equation.gdx")
for (i in c("level", "marginal", "lower", "upper", "scale")) {
expect_equal(m1["e"]$records[[i]], m["e"]$defaultValues[[i]])
}
m$write("partial_scalar_equation.gdx", mode="string")
m1 = Container$new("partial_scalar_equation.gdx")
for (i in c("level", "marginal", "lower", "upper", "scale")) {
expect_equal(m1["e"]$records[[i]], m["e"]$defaultValues[[i]])
}
# test the super call write
writeList = m$asList()
writeGDX(writeList, "partial_scalar_equation.gdx")
m1 = Container$new("partial_scalar_equation.gdx")
for (i in c("level", "marginal", "lower", "upper", "scale")) {
expect_equal(m1["e"]$records[[i]], m["e"]$defaultValues[[i]])
}
#variable partial column
m = Container$new()
v = Variable$new(m, "v", records=data.frame(marginal=10))
m$write("partial_scalar_variable.gdx")
m1 = Container$new("partial_scalar_variable.gdx")
for (i in c("level", "lower", "upper", "scale")) {
expect_equal(m1["v"]$records[[i]], m["v"]$defaultValues[[i]])
}
expect_equal(m1["v"]$records[["marginal"]], 10)
writeList = m$asList()
writeGDX(writeList, "partial_scalar_variable.gdx")
for (i in c("level", "lower", "upper", "scale")) {
expect_equal(m1["v"]$records[[i]], m["v"]$defaultValues[[i]])
}
expect_equal(m1["v"]$records[["marginal"]], 10)
#equation
m = Container$new()
e = Equation$new(m, "e", type="eq", records=data.frame(marginal=10))
m$write("partial_scalar_equation.gdx")
m1 = Container$new("partial_scalar_equation.gdx")
for (i in c("level", "lower", "upper", "scale")) {
expect_equal(m1["e"]$records[[i]], m["e"]$defaultValues[[i]])
}
expect_equal(m1["e"]$records[["marginal"]], 10)
m$write("partial_scalar_equation.gdx", mode="string")
m1 = Container$new("partial_scalar_equation.gdx")
for (i in c("level", "lower", "upper", "scale")) {
expect_equal(m1["e"]$records[[i]], m["e"]$defaultValues[[i]])
}
expect_equal(m1["e"]$records[["marginal"]], 10)
}
)
# test count* and isvalid methods with partial columns
test_that("test_num_128", {
# count* methods
m = Container$new()
i = Set$new(m, "i", records=paste0("i", 1:10))
p = Parameter$new(m, "p", domain = i, records = data.frame(i=paste0("i", 2:6)))
expect_true(p$isValid())
flist = c(p$countNA, p$countEps, p$countNegInf, p$countPosInf, p$countUndef)
for (f in flist) {
expect_equal(f(), 0)
}
v = Variable$new(m, "v", domain = i, records = data.frame(i=paste0("i", 2:6)))
expect_true(v$isValid())
flist = c(v$countNA, v$countEps, v$countNegInf, v$countPosInf, v$countUndef)
for (f in flist) {
expect_equal(f(columns="level"), 0)
}
flist = c(v$countNA, v$countEps, v$countNegInf, v$countPosInf, v$countUndef)
for (f in flist) {
expect_equal(f(columns=c("level", "scale")), 0)
}
expect_equal(v$countPosInf(columns="upper"), 5)
expect_equal(v$countNegInf(columns="lower"), 5)
e = Equation$new(m, "e", type="eq", domain = i, records = data.frame(i=paste0("i", 2:6)))
expect_true(e$isValid())
flist = c(e$countNA, e$countEps, e$countNegInf, e$countPosInf, e$countUndef)
for (f in flist) {
expect_equal(f(columns="level"), 0)
}
expect_equal(e$countPosInf(columns="upper"), 0)
expect_equal(e$countNegInf(columns="lower"), 0)
#scalars count* methods
m = Container$new()
p = Parameter$new(m, "p", records=data.frame())
expect_true(p$isValid())
flist = c(p$countNA, p$countEps, p$countNegInf, p$countPosInf, p$countUndef)
for (f in flist) {
expect_equal(f(), 0)
}
v = Variable$new(m, "v", records = data.frame())
expect_true(v$isValid())
flist = c(v$countNA, v$countEps, v$countNegInf, v$countPosInf, v$countUndef)
for (f in flist) {
expect_equal(f(columns="level"), 0)
}
flist = c(v$countNA, v$countEps, v$countNegInf, v$countPosInf, v$countUndef)
for (f in flist) {
expect_equal(f(columns=c("level", "scale")), 0)
}
expect_equal(v$countPosInf(columns="upper"), 1)
expect_equal(v$countNegInf(columns="lower"), 1)
e = Equation$new(m, "e", type="eq", records = data.frame())
expect_true(e$isValid())
flist = c(e$countNA, e$countEps, e$countNegInf, e$countPosInf, e$countUndef)
for (f in flist) {
expect_equal(f(columns="level"), 0)
}
expect_equal(e$countPosInf(columns="upper"), 0)
expect_equal(e$countNegInf(columns="lower"), 0)
}
)
# test get* and isvalid methods with partial columns
test_that("test_num_129", {
# get* methods
m = Container$new()
i = Set$new(m, "i", records=paste0("i", 1:10))
p = Parameter$new(m, "p", domain = i, records = data.frame(i=paste0("i", 2:6)))
expect_true(p$isValid())
flist = c(p$getMaxValue, p$getMinValue, p$getMaxAbsValue, p$getMeanValue)
for (f in flist) {
expect_equal(f(), 0)
}
v = Variable$new(m, "v", domain = i, records = data.frame(i=paste0("i", 2:6)))
expect_true(v$isValid())
flist = c(v$getMaxValue, v$getMinValue, v$getMaxAbsValue, v$getMeanValue)
for (f in flist) {
expect_equal(f(columns="level"), 0)
}
flist = c(v$getMaxValue, v$getMinValue, v$getMaxAbsValue, v$getMeanValue)
for (f in flist) {
expect_equal(f(columns=c("level", "marginal")), 0)
}
expect_equal(v$getMaxValue(columns="upper"), Inf)
expect_equal(v$getMaxValue(columns="lower"), -Inf)
e = Equation$new(m, "e", type="eq", domain = i, records = data.frame(i=paste0("i", 2:6)))
expect_true(e$isValid())
flist = c(e$getMaxValue, e$getMinValue, e$getMaxAbsValue, e$getMeanValue)
for (f in flist) {
expect_equal(f(columns="level"), 0)
}
expect_equal(e$getMaxValue(columns="upper"), 0)
expect_equal(e$getMinValue(columns="lower"), 0)
#scalars get* methods
m = Container$new()
p = Parameter$new(m, "p", records=data.frame())
expect_true(p$isValid())
flist = c(p$getMaxValue, p$getMinValue, p$getMaxAbsValue, p$getMeanValue)
for (f in flist) {
expect_equal(f(), 0)
}
v = Variable$new(m, "v", records = data.frame())
expect_true(v$isValid())
flist = c(v$getMaxValue, v$getMinValue, v$getMaxAbsValue, v$getMeanValue)
for (f in flist) {
expect_equal(f(columns="level"), 0)
}
flist = c(v$getMaxValue, v$getMinValue, v$getMaxAbsValue, v$getMeanValue)
for (f in flist) {
expect_equal(f(columns=c("level", "marginal")), 0)
}
expect_equal(v$getMaxValue(columns="upper"), Inf)
expect_equal(v$getMaxValue(columns="lower"), -Inf)
e = Equation$new(m, "e", type="eq", records = data.frame())
expect_true(e$isValid())
flist = c(e$getMaxValue, e$getMinValue, e$getMaxAbsValue, e$getMeanValue)
for (f in flist) {
expect_equal(f(columns="level"), 0)
}
expect_equal(e$getMaxValue(columns="upper"), 0)
expect_equal(e$getMinValue(columns="lower"), 0)
}
)
# test where* and isvalid methods with partial columns
test_that("test_num_130", {
# where* methods
m = Container$new()
i = Set$new(m, "i", records=paste0("i", 1:10))
p = Parameter$new(m, "p", domain = i, records = data.frame(i=paste0("i", 2:6)))
expect_equal(p$getSparsity(), 0.5)
flist = c(p$whereMax, p$whereMaxAbs, p$whereMin)
for (f in flist) {
expect_equal(f(), 1)
}
v = Variable$new(m, "v", domain = i, records = data.frame(i=paste0("i", 2:6)))
expect_equal(v$getSparsity(), 0.5)
flist = c(v$whereMax, v$whereMaxAbs, v$whereMin)
for (f in flist) {
expect_equal(f(column="level"), 1)
}
expect_equal(v$whereMax(column="upper"), 1)
expect_equal(v$whereMaxAbs(column="lower"), 1)
e = Equation$new(m, "e", type="eq", domain = i, records = data.frame(i=paste0("i", 2:6)))
expect_equal(e$getSparsity(), 0.5)
flist = c(e$whereMax, e$whereMaxAbs, e$whereMin)
for (f in flist) {
expect_equal(f(column="level"), 1)
}
expect_equal(e$whereMax(column="upper"), 1)
expect_equal(e$whereMin(column="lower"), 1)
#scalars where* methods
m = Container$new()
p = Parameter$new(m, "p", records=data.frame())
expect_equal(p$getSparsity(), NA)
flist = c(p$whereMax, p$whereMaxAbs, p$whereMin)
for (f in flist) {
expect_equal(f(), 1)
}
v = Variable$new(m, "v", records = data.frame())
expect_equal(v$getSparsity(), NA)
flist = c(v$whereMax, v$whereMaxAbs, v$whereMin)
for (f in flist) {
expect_equal(f(column="level"), 1)
}
expect_equal(v$whereMax(column="upper"), 1)
expect_equal(v$whereMin(column="lower"), 1)
e = Equation$new(m, "e", type="eq", records = data.frame())
expect_equal(e$getSparsity(), NA)
flist = c(e$whereMax, e$whereMaxAbs, e$whereMin)
for (f in flist) {
expect_equal(f(column="level"), 1)
}
expect_equal(e$whereMaxAbs(column="upper"), 1)
expect_equal(e$whereMin(column="lower"), 1)
# toDense
}
)
# test toDense* and isvalid methods with partial columns
test_that("test_num_131", {
m = Container$new()
i = Set$new(m, "i", records=paste0("i", 1:10))
p = Parameter$new(m, "p", domain = i, records = data.frame(i=paste0("i", 2:6)))
expect_equal(p$toDense(), as.array(replicate(10, 0)))
v = Variable$new(m, "v", domain = i, records = data.frame(i=paste0("i", 2:6)))
expect_equal(v$toDense(), as.array(replicate(10, 0)))
expect_equal(v$toDense(column="upper"), as.array(c(0, replicate(5, Inf), 0, 0, 0, 0)))
expect_equal(v$toDense(column="lower"), as.array(c(0, replicate(5, -Inf), 0, 0, 0, 0)))
e = Equation$new(m, "e", type="eq", domain = i, records = data.frame(i=paste0("i", 2:6)))
expect_equal(e$toDense(), as.array(replicate(10, 0)))
expect_equal(e$toDense(column="upper"), as.array(replicate(10, 0)))
expect_equal(e$toDense(column="lower"), as.array(replicate(10, 0)))
}
)
# equals
# test equals method with partial columns
test_that("test_num_132", {
m = Container$new()
i = Set$new(m, "i", records=paste0("i", 1:10))
p = Parameter$new(m, "p", domain = i, records = data.frame(i=paste0("i", 2:6)))
m2 = Container$new()
i2 = Set$new(m2, "i", records=data.frame(uni=paste0("i", 1:10), element_text=""))
p2 = Parameter$new(m2, "p", domain=i2, records=data.frame(i=paste0("i", 2:6), replicate(5, 0)))
expect_true(p$equals(p2))
expect_true(p2$equals(p))
v = Variable$new(m, "v", domain = i, records = data.frame(i=paste0("i", 2:6)))
v2 = Variable$new(m2, "v", domain = i2, records = data.frame(i=paste0("i", 2:6), level=0))
expect_true(v$equals(v2))
expect_true(v2$equals(v))
e = Equation$new(m, "e", type="eq", domain = i, records = data.frame(i=paste0("i", 2:6)))
e2 = Equation$new(m2, "e", type="eq", domain = i2, records = data.frame(i=paste0("i", 2:6), level=0))
expect_true(e$equals(e2))
expect_true(e2$equals(e))
}
)
# dataframe with no rows still have column names and factors
test_that("test_num_133", {
m = Container$new()
i = Set$new(m, "i", records=paste0("i", 1:3))
p = Parameter$new(m, "p", domain=i, records=c(0, 0, 0))
expect_true(is.factor(p$records[,1]))
expect_equal(colnames(p$records), "i")
expect_equal(levels(p$records[, 1]), c("i1","i2","i3"))
v = Variable$new(m, "v", domain=i, records=c(0, 0, 0))
expect_true(is.factor(v$records[,1]))
expect_equal(colnames(v$records), "i")
expect_equal(levels(v$records[, 1]), c("i1","i2","i3"))
e = Equation$new(m, "e", type="eq", domain=i, records=c(0, 0, 0))
expect_true(is.factor(e$records[,1]))
expect_equal(colnames(e$records), "i")
expect_equal(levels(e$records[, 1]), c("i1","i2","i3"))
}
)
# dataframe with no rows still have column names and factors
test_that("test_num_134", {
skip_if_no_gams()
m = Container$new()
i = Set$new(m, "i", records=paste0("i", 1:3))
p = Parameter$new(m, "p", domain=i, records=c(0, 0, 0))
expect_true(is.factor(p$records[,1]))
expect_equal(colnames(p$records), "i")
expect_equal(levels(p$records[, 1]), c("i1","i2","i3"))
writeList = m$asList()
m$write("gt.gdx", symbols="p")
system2(command="gdxdump", args=
"gt.gdx uelTable=foo",
stdout = "foo.gms")
system2(command="gams", args=
"foo.gms gdx=foo.gdx lo=0",
stdout = FALSE)
m = Container$new("foo.gdx")
expect_equal(m$getUELs(), c("i1","i2","i3"))
writeGDX(writeList, "gt.gdx")
system2(command="gdxdump", args=
"gt.gdx uelTable=foo",
stdout = "foo.gms")
system2(command="gams", args=
"foo.gms gdx=foo.gdx lo=0",
stdout = FALSE)
m = Container$new("foo.gdx")
expect_equal(m$getUELs(), c("i1","i2","i3"))
m = Container$new()
i = Set$new(m, "i", records=paste0("i", 1:3))
p = Parameter$new(m, "p", domain=i, records=c(0, 0, 0))
expect_true(is.factor(p$records[,1]))
expect_equal(colnames(p$records), "i")
expect_equal(levels(p$records[, 1]), c("i1","i2","i3"))
writeList = m$asList()
m$write("gt.gdx", symbols="p", mode="string")
system2(command="gdxdump", args=
"gt.gdx uelTable=foo",
stdout = "foo.gms")
system2(command="gams", args=
"foo.gms gdx=foo.gdx lo=0",
stdout = FALSE)
m = Container$new("foo.gdx")
expect_equal(m$getUELs(), c("i1","i2","i3"))
writeGDX(writeList, "gt.gdx")
system2(command="gdxdump", args=
"gt.gdx uelTable=foo",
stdout = "foo.gms")
system2(command="gams", args=
"foo.gms gdx=foo.gdx lo=0",
stdout = FALSE)
m = Container$new("foo.gdx")
expect_equal(m$getUELs(), c("i1","i2","i3"))
}
)
# mapped write
test_that("test_num_135", {
m = Container$new(testthat::test_path("testdata", "trnsport.gdx"))
expect_error(m$write("gt.gdx", mode = 1))
m$write("gt.gdx", mode = "string")
ms = Container$new("gt.gdx")
m$write("gt.gdx", mode = "mapped")
mm = Container$new("gt.gdx")
expect_true(ms$equals(mm))
m = Container$new()
m$read(testthat::test_path("testdata", "trnsport.gdx"), records=FALSE)
m$write("gt.gdx", mode="mapped")
m$write("gt.gdx", mode="string")
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
})
# symbol shouldn't be added to the container if the constructor call fails
test_that("test_num_136", {
m = Container$new()
expect_error(Set$new(m, "i", domain = j, records=paste0("i", 1:3)))
expect_equal(length(m$listSymbols()), 0)
}
)
# get* methods
test_that("test_num_137", {
m = Container$new(testthat::test_path("testdata", "trnsport_with_alias.gdx"))
expect_equal(m$getSymbols(m$listSets()), m$getSets())
expect_equal(m$getSymbols(m$listAliases()), m$getAliases())
expect_equal(m$getSymbols(m$listParameters()), m$getParameters())
expect_equal(m$getSymbols(m$listVariables()), m$getVariables())
expect_equal(m$getSymbols(m$listEquations()), m$getEquations())
}
)
# get* methods
test_that("test_num_138", {
m = Container$new()
a = Parameter$new(m, "a", c("*","*"), records=data.frame(i=c("i1","i2"), j=c("j1","j2"), val=1:2))
a$setUELs(c("new","i1","i2"), 1)
expect_equal(a$getUELs(1), c("new","i1","i2"))
expect_error(a$toDense())
a$reorderUELs()
expect_equal(a$getUELs(1), c("i1","i2","new"))
}
)
# read test
test_that("test_num_139", {
m = Container$new(testthat::test_path("testdata", "trnsport.gdx"))
expect_equal(m["i"]$getUELs(), c("seattle","san-diego"))
expect_equal(m["j"]$getUELs(), c("new-york", "chicago", "topeka"))
expect_equal(m["d"]$toDense(), matrix(data = c(2.5, 1.7, 1.8, 2.5, 1.8, 1.4), nrow=2, ncol=3, byrow=TRUE))
}
)
# getUELs for NULL records
test_that("test_num_139", {
m = Container$new()
i = Set$new(m, "i")
j = Set$new(m, "j")
d = Parameter$new(m, "p", domain=c(i, j),
records=data.frame(i=c("i1","i2","i3"),
j=c("j1","j2","j3"), val=1:3))
dv = d$getDomainViolations()
expect_equal(length(dv), 2)
}
)
# getUELs order
test_that("test_num_140", {
m = Container$new(testthat::test_path("testdata", "universe_order.gdx"))
expect_equal(m["p"]$getUELs(), c("i2","i5","i9","i1","i3"))
expect_equal(m["p"]$getUELs(1), c("i2","i5","i9"))
expect_equal(m["p"]$getUELs(2), c("i1", "i2", "i3"))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "universe_order.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
}
)
# acronyms
test_that("test_num_141", {
f = function() {
return(Container$new(testthat::test_path("testdata", "acronym_test.gdx")))
}
expect_warning(m <- f())
expect_equal(m["shutdown"]$records[["value"]], replicate(5, as.numeric(NA)))
expect_equal(m["v"]$records[["level"]], c(1, NA, NA, NA, 2))
expect_equal(m["e"]$records[["marginal"]], c(1, NA, NA, NA, 2))
}
)
Try the gamstransfer package in your browser
Any scripts or data that you put into this service are public.
gamstransfer documentation built on June 22, 2024, 10:26 a.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.
#
# GAMS - General Algebraic Modeling System R API
#
# Copyright (c) 2017-2024 GAMS Software GmbH <support@gams.com>
# Copyright (c) 2017-2024 GAMS Development Corp. <support@gams.com>
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in all
# copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
# SOFTWARE.
#
library(gamstransfer)
gams_checked = -1
skip_if_no_gams <- function() {
if (gams_checked == -1) {
ret = system2(command="gams", stdout=NULL, stderr=NULL)
if (ret == 127) {
gams_checked = 0
}
else {
gams_checked = 1
}
}
if (gams_checked == 0) {
testthat::skip("GAMS Unavailable")
}
}
test_that("readwritetest", {
skip_if_no_gams()
m = Container$new()
# read all symbols
m$read(testthat::test_path("testdata", "biggdxtest.gdx"))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "biggdxtest.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
# write everything
m$write(testthat::test_path("gt.gdx"))
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "biggdxtest.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# write everything
m$write(testthat::test_path("gt.gdx"), mode = "string")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "biggdxtest.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "biggdxtest.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# test the super call write from the read super call
writeGDX(rl, "gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "biggdxtest.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
}
)
test_that("test_num_1", {
skip_if_no_gams()
m <- Container$new()
expect_true(inherits(m, "Container"))
i <- Set$new(m, "i", records = c("a", "b"))
expect_true(is.data.frame(i$records))
expect_equal(nrow(i$records), 2)
j <- Set$new(m, "j", records = c("c", "d"))
expect_true(is.data.frame(j$records))
expect_equal(nrow(j$records), 2)
recs <- data.frame(list("i" = c("a", "b"),
"j" = c("c", "d"), "values" = c(1, 1)))
a <- Parameter$new(m, "a", c("i", "j"), records = recs)
expect_true(is.data.frame(a$records))
expect_equal(nrow(a$records), 2)
m$write("gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test1.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
m$write("gt.gdx", mode="string")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test1.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test1.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
}
)
test_that("test_num_2", {
skip_if_no_gams()
m <- Container$new()
expect_true(inherits(m, "Container"))
i <- Set$new(m, "i")
expect_true(is.null(i$records))
j <- Set$new(m, "j")
expect_true(is.null(j$records))
recs <- data.frame(list("i" = c("a", "b"),
"j" = c("c", "d"), "values" = c(1, 1)))
a <- Parameter$new(m, "a", c(i, j), recs, domainForwarding = TRUE)
expect_true(is.data.frame(i$records))
expect_equal(as.character(i$records$uni), c("a", "b"))
expect_true(is.data.frame(j$records))
expect_equal(as.character(j$records$uni), c("c", "d"))
m$write("gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test2.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
m$write("gt.gdx", mode="string")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test2.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test2.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
}
)
test_that("test_num_3", {
skip_if_no_gams()
m <- Container$new()
expect_true(inherits(m, "Container"))
i <- Set$new(m, "i")
expect_true(is.null(i$records))
j <- Alias$new(m, "j", i)
expect_true(is.null(j$records))
recs <- data.frame(list("i" = c("a", "b"),
"j" = c("a", "b"), "values" = c(1, 1)))
a <- Parameter$new(m, "a", c(i, j), recs, domainForwarding = TRUE)
expect_true(is.data.frame(i$records))
expect_equal(as.character(i$records$uni), c("a", "b"))
expect_true(is.data.frame(j$records))
expect_equal(as.character(j$records$uni), c("a", "b"))
expect_equal(nrow(a$records), 2)
m$write("gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test3.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
m$write("gt.gdx", mode="string")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test3.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test3.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
}
)
test_that("test_num_4", {
skip_if_no_gams()
m <- Container$new()
i <- Set$new(m, "i")
expect_true(is.null(i$records))
j <- Set$new(m, "j", i)
expect_true(is.null(j$records))
k <- Set$new(m, "k", j)
expect_true(is.null(k$records))
l = Set$new(m, "l", k, records = c("a", "b"), domainForwarding = TRUE )
expect_true(is.data.frame(i$records))
expect_equal(as.character(i$records$uni), c("a", "b"))
expect_true(is.data.frame(j$records))
expect_equal(as.character(j$records$i), c("a", "b"))
expect_true(is.data.frame(k$records))
expect_equal(as.character(k$records$j), c("a", "b"))
expect_true(is.data.frame(l$records))
expect_equal(as.character(l$records$k), c("a", "b"))
m$write("gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test4.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
m$write("gt.gdx", mode="string")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test4.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test4.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
}
)
test_that("test_num_5", {
skip_if_no_gams()
m <- Container$new()
expect_true(inherits(m, "Container"))
i <- Set$new(m, "i")
expect_true(is.null(i$records))
recs <- data.frame(list("i" = "c", "element_text" = "desc for elem 'c'"))
j <- Set$new(m, "j", i, records = recs, domainForwarding = TRUE)
expect_true(is.data.frame(i$records))
expect_equal(as.character(i$records$uni), c("c"))
expect_true(is.data.frame(j$records))
expect_equal(as.character(j$records$i), c("c"))
k <- Set$new(m, "k", j)
expect_true(is.data.frame(i$records))
expect_equal(as.character(i$records$uni), c("c"))
expect_true(is.data.frame(j$records))
expect_equal(as.character(j$records$i), c("c"))
expect_true(is.null(k$records))
l <- Set$new(m, "l", k, records = c("a", "b"), domainForwarding = TRUE)
expect_true(is.data.frame(i$records))
expect_equal(as.character(i$records$uni), c("c", "a", "b"))
expect_true(is.data.frame(j$records))
expect_equal(as.character(j$records$i), c("c", "a", "b"))
expect_true(is.data.frame(k$records))
expect_equal(as.character(k$records$j), c("a", "b"))
expect_true(is.data.frame(l$records))
expect_equal(as.character(l$records$k), c("a", "b"))
m$write("gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test5.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
m$write("gt.gdx", mode="string")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test5.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test5.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
}
)
test_that("test_num_6", {
m <- Container$new()
expect_true(inherits(m, "Container"))
i <- Set$new(m, "i", records = c("c", "a", "b"))
expect_true(is.data.frame(i$records))
m$write("gt.gdx")
m$write("gt.gdx", mode="string")
m2 = Container$new(testthat::test_path("testdata", "test6_uels.gdx"))
expect_true(inherits(m2, "Container"))
expect_true(is.data.frame(m2["foo"]$records))
expect_equal(as.character(m$getUELs()), as.character(m2["foo"]$records$uni))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "test6_uels.gdx"))
m3 = Container$new()
m3$readList(rl)
expect_equal(m2$equals(m3), TRUE)
}
)
test_that("test_num_7", {
m <- Container$new()
expect_true(inherits(m, "Container"))
i <- Set$new(m, "i", records = c("c", "a", "b"))
expect_true(is.data.frame(i$records))
m$write("gt.gdx", uelPriority = "a")
m$write("gt.gdx", uelPriority = "a", mode="string")
m2 = Container$new(testthat::test_path("testdata", "test7_uels.gdx"))
expect_true(inherits(m2, "Container"))
expect_true(is.data.frame(m2["foo"]$records))
expect_equal(c("a", "c", "b"), as.character(m2["foo"]$records$uni))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "test7_uels.gdx"))
m3 = Container$new()
m3$readList(rl)
expect_equal(m2$equals(m3), TRUE)
}
)
test_that("test_num_8", {
m <- Container$new()
expect_true(inherits(m, "Container"))
i <- Set$new(m, "i", records = c("a", "b"))
expect_equal(as.character(i$records$uni), c("a", "b"))
j <- Alias$new(m, "j", i)
expect_equal(as.character(j$records$uni), c("a", "b"))
expect_equal(j$aliasWith$name, "i")
k <- Alias$new(m, "k", j)
expect_equal(as.character(k$records$uni), c("a", "b"))
expect_equal(j$aliasWith$name, "i")
#try writing
m$write("out.gdx")
m$write("out.gdx", mode="string")
# test the super call write
writeList = m$asList()
writeGDX(writeList, "out.gdx")
}
)
test_that("test_num_9", {
m <- Container$new()
expect_true(inherits(m, "Container"))
i <- Set$new(m, "i", list("*", "*"), records =
data.frame(list("col1"=c("a","b"), "col2"=c("c","d"))))
j <- Parameter$new(m, "j", "*", records =
data.frame(list("col1" = c("e", "f"), "col2" = c(1, 1))))
expect_equal(as.character(i$records$col1), c("a", "b"))
expect_equal(as.character(i$records$col2), c("c", "d"))
expect_equal(as.character(m$getUELs()), c("a", "b", "c", "d", "e", "f"))
#just try writing to see if there are any errors
m$write("out.gdx")
m$write("out.gdx", mode="string")
# test the super call write
writeList = m$asList()
writeGDX(writeList, "out.gdx")
}
)
test_that("test_num_10", {
m <- Container$new()
expect_true(inherits(m, "Container"))
i <- Set$new(m, "i")
expect_true(is.null(i$records))
j <- Set$new(m, "j")
expect_true(is.null(j$records))
a <- Parameter$new(m, "a", list(i, j), domainForwarding=TRUE)
df <- data.frame("i"= c("a", "b"),
"j" = c("c", "d"), "value" = c(1, 1))
a$records <- df
expect_false(a$isValid())
df <- data.frame("i"= factor(c("a", "b")),
"j" = factor(c("c", "d")), "value" = c(1, 1))
a$records <- df
expect_true(a$isValid())
expect_equal(as.character(i$records$uni), c("a", "b"))
expect_equal(as.character(j$records$uni), c("c", "d"))
#try writing
m$write("out.gdx")
m$write("out.gdx", mode="string")
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
}
)
test_that("test_num_11", {
m <- Container$new()
expect_true(inherits(m, "Container"))
i <- Set$new(m, "i", records = c("a", "b", "c"))
expect_equal(as.character(i$records$uni), c("a", "b", "c"))
j <- Parameter$new(m, "j", i,
records = data.frame("j"=c("a", "c"), "val" = c(1, 2)))
expect_equal(as.character(j$records$j), c("a", "c"))
expect_equal(j$records$value, c(1, 2))
m$removeSymbols(c("i", "j"))
i <- Set$new(m, "i", records = c("a", "b", "c", "d"))
j <- Parameter$new(m, "j", i,
records = data.frame("i"= c("a", "c"), "val" = c(1, 2)))
expect_equal(j$toDense(), array(c(1,0,2,0)))
m$write("out.gdx")
m$write("out.gdx", mode="string")
# test the super call write
writeList = m$asList()
writeGDX(writeList, "out.gdx")}
)
test_that("test_num_12", {
testthat::expect_warning(Container$new(testthat::test_path("testdata", "test12.gdx")))
}
)
test_that("test_num_13", {
m = Container$new()
i = Set$new(m, "i", records=c("a", "b", "c"))
j = Set$new(m, "j", records=c("d", "e", "f"))
a = Parameter$new(m, "a", i, records=data.frame("i"=c("a","c"),"val"=c(1, 2) ))
b = Parameter$new(m, "b", j, records=data.frame("j"=c("e","f"),"val"=c(1, 2) ))
m$removeSymbols("i")
expect_equal(unlist(m$data$keys()), c("j", "a", "b"))
m$removeSymbols(c("a", "b"))
expect_equal(unlist(m$data$keys()), c("j"))
m$write("out.gdx")
m$write("out.gdx", mode="string")
# test the super call write
writeList = m$asList()
writeGDX(writeList, "out.gdx")
}
)
test_that("test_num_14", {
m = Container$new()
i = Set$new(m, "i", records=c("a", "b", "c"))
expect_equal(unlist(m$data$keys()), c("i"))
m$renameSymbol("i", "h")
expect_equal(unlist(m$data$keys()), c("h"))
m$write("out.gdx")
m$write("out.gdx", mode="string")
# test the super call write
writeList = m$asList()
writeGDX(writeList, "out.gdx")
}
)
# test_that("test_num_15", {
# m = Container$new()
# i = Set$new(m, "i", records=c("a", "b", "c"))
# a = Parameter$new(m, "a", i, records=data.frame(c("aa", "c"), c(1, 2)))
# expect_equal(a$findDomainViolations(), 1)
# expect_equal(a$isValid(), FALSE)
# }
# )
test_that("test_num_16", {
m = Container$new()
i = Set$new(m, "i")
j = Set$new(m, "j", i, records = c("a", "b"), domainForwarding = TRUE)
k = Set$new(m, "k")
l = Set$new(m, "l", k, records = c("c"), domainForwarding = TRUE)
a = Parameter$new(m, "a", l, records = data.frame(c("aa", "c"), c(1, 2)), domainForwarding = TRUE)
# check container
expect_equal(m$.requiresStateCheck, TRUE)
expect_equal(m$isValid(), TRUE)
expect_equal(m$.requiresStateCheck, FALSE)
expect_equal(as.character(m["l"]$records$k), c("c", "aa"))
expect_equal(as.character(m["k"]$records$uni), c("c", "aa"))
expect_equal(as.character(m["j"]$records$i), c("a", "b"))
expect_equal(as.character(m["i"]$records$uni), c("a", "b"))
expect_equal(as.character(m$getUELs()), c("a", "b", "c", "aa"))
expect_equal(a$isValid(), TRUE)
expect_equal(l$isValid(), TRUE)
}
)
test_that("test_num_17", {
m = Container$new()
m$addSet("i")
m$addSet("j", m["i"], records = c("a", "b"), domainForwarding = TRUE)
m$addSet("k")
m$addSet("l", m["k"], records = c("c"), domainForwarding = TRUE)
m$addParameter("a", m["l"], records = data.frame(c("aa", "c"), c(1, 2)), domainForwarding = TRUE)
# check container
expect_equal(m$.requiresStateCheck, TRUE)
expect_equal(m$isValid(), TRUE)
expect_equal(m$.requiresStateCheck, FALSE)
expect_equal(as.character(m["l"]$records$k), c("c", "aa"))
expect_equal(as.character(m["k"]$records$uni), c("c", "aa"))
expect_equal(as.character(m["j"]$records$i), c("a", "b"))
expect_equal(as.character(m["i"]$records$uni), c("a", "b"))
expect_equal(as.character(m$getUELs()), c("a", "b", "c", "aa"))
expect_equal(m$listSymbols(isValid = FALSE), NULL)
}
)
test_that("test_num_18", {
m = Container$new()
df = data.frame("domain"=c("i0"))
types = c(
"binary",
"integer",
"positive",
"negative",
"free",
"sos1",
"sos2",
"semicont",
"semiint"
)
for (i in types) {
varname = paste0("a_", i)
m$addVariable(varname, i, "*", records = df)
expect_equal(colnames(m[varname]$records),
c("domain"))
}
}
)
test_that("test_num_19", {
m = Container$new()
df = data.frame("domain"= c("i0"))
types = c(
"eq", "geq", "leq", "nonbinding", "cone", "external", "boolean"
)
for (i in types) {
eqname = paste0("a_", i)
m$addEquation(eqname, i, "*", records = df)
expect_equal(colnames(m[eqname]$records),
c("domain"))
}
}
)
test_that("test_num_20", {
m = Container$new()
df= data.frame(list("i0", 1, 1, 1, 1, 1))
colnames(df)= c("domain", "marginal", "lower", "scale", "upper", "level")
type = c(
"binary",
"integer",
"positive",
"negative",
"free",
"sos1",
"sos2",
"semicont",
"semiint"
)
for (i in type) {
varname = paste0("a_", i)
m$addVariable(varname, i, "*", records = df)
expect_equal(colnames(m[varname]$records),
c("domain", "level", "marginal", "lower", "upper", "scale"))
}
}
)
test_that("test_num_21", {
m = Container$new()
df= data.frame(list("i0", 1, 1, 1, 1, 1))
colnames(df)= c("domain", "marginal", "lower", "scale", "upper", "level")
type = c(
"eq", "geq", "leq", "nonbinding", "cone", "external", "boolean"
)
for (i in type) {
eqname = paste0("a_", i)
m$addEquation(eqname, i, "*", records = df)
expect_equal(colnames(m[eqname]$records),
c("domain", "level", "marginal", "lower", "upper", "scale"))
}
}
)
test_that("test_num_22", {
m = Container$new()
m$read(testthat::test_path("testdata", "trnsport.gdx"), records = FALSE)
# test supercall read
rl = readGDX(testthat::test_path("testdata", "trnsport.gdx"),
records=FALSE)
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
for (i in m$data$values()) {
expect_equal(m[i$name]$records, NULL)
}
}
)
test_that("test_num_23", {
m = Container$new()
m$read(testthat::test_path("testdata", "trnsport.gdx"), c("i", "j", "x"))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "trnsport.gdx"),
symbols = c("i", "j", "x"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
expect_equal(m["i"]$domainType, "none")
expect_equal(m["j"]$domainType, "none")
expect_equal(m["x"]$domainType, "regular")
}
)
test_that("test_num_24", {
m = Container$new()
m$read(testthat::test_path("testdata", "trnsport.gdx"), c("x"))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "trnsport.gdx"),
symbols = c("x"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
expect_equal(unlist(m$data$keys()), "x")
expect_equal(m["x"]$domainType, "relaxed")
}
)
test_that("test_num_25", {
m = Container$new(testthat::test_path("testdata", "test25.gdx"))
expect_equal(unlist(m$data$keys()), "i")
expect_equal(m["i"]$domain, c("i"))
expect_equal(m["i"]$domainType, "relaxed")
# test supercall read
rl = readGDX(testthat::test_path("testdata", "test25.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
}
)
test_that("test_num_26", {
m = Container$new()
i = Set$new(m, "i", "p")
expect_equal(i$domainType, "relaxed")
j = Set$new(m, "j", i, records =
data.frame(i=c("c"), c("desc for elem 'c'")), domainForwarding=TRUE)
df = data.frame("p" =c("c"))
df$p = factor(df$p, ordered = TRUE)
expect_equal(i$records, df)
df = data.frame("i" =c("c"), "element_text" = c("desc for elem 'c'"))
df$i = factor(df$i, ordered = TRUE)
expect_equal(j$records, df)
k = Set$new(m ,"k", "j")
expect_equal(k$records, NULL)
l = Set$new(m, "l", k, records = c("a", "b"), domainForwarding = TRUE)
# test l
df = data.frame("k"=c("a", "b"))
df$k = factor(df$k, ordered=TRUE)
expect_equal(l$records, df)
# test k
df = data.frame("j"=c("a", "b"))
df$j = factor(df$j, ordered = TRUE)
expect_equal(k$records, df)
# test j
df = data.frame("i"=c("c"), "element_text"=c("desc for elem 'c'"))
df$i = factor(df$i, ordered = TRUE)
expect_equal(j$records, df)
# test i
df = data.frame("p"=c("c"))
df$p = factor(df$p, ordered = TRUE)
expect_equal(i$records, df)
}
)
test_that("test_num_27", {
skip_if_no_gams()
m = Container$new()
m$read(testthat::test_path("testdata", "test27.gdx"))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "test27.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
# write everything
m$write(testthat::test_path("gt.gdx"))
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test27.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# write everything
m$write(testthat::test_path("gt.gdx"), mode="string")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test27.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test27.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
}
)
test_that("test_num_28", {
m = Container$new()
i = Set$new(m, "i")
a_eq = Equation$new(m, "a_eq", "eq", i)
a_geq = Equation$new(m, "a_geq", "geq", i)
a_leq = Equation$new(m, "a_leq", "leq", i)
a_nonbinding = Equation$new(m, "a_nonbinding", "nonbinding", i)
a_cone = Equation$new(m, "a_cone", "cone", i)
a_external = Equation$new(m, "a_external", "external", i)
a_boolean = Equation$new(m, "a_boolean", "boolean", i)
# try writing
expect_equal(m$write("gt.gdx"), NULL)
expect_equal(m$write("gt.gdx", mode="string"), NULL)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
}
)
test_that("test_num_29", {
m = Container$new()
i = Set$new(m, "i")
a_binary = Variable$new(m, "a_binary", "binary", i)
a_integer = Variable$new(m, "a_integer", "integer", i)
a_positive = Variable$new(m, "a_positive", "positive", i)
a_negative = Variable$new(m, "a_negative", "negative", i)
a_free = Variable$new(m, "a_free", "free", i)
a_sos1 = Variable$new(m, "a_sos1", "sos1", i)
a_sos2 = Variable$new(m, "a_sos2", "sos2", i)
a_semicont = Variable$new(m, "a_semicont", "semicont", i)
a_semiint = Variable$new(m, "a_semiint", "semiint", i)
# try writing
expect_equal(m$write("gt.gdx"), NULL)
expect_equal(m$write("gt.gdx", mode="string"), NULL)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
}
)
test_that("test_num_30", {
m = Container$new()
i = Set$new(m, "i")
a = Parameter$new(m, "a", i)
# try writing
expect_equal(m$write("gt.gdx"), NULL)
expect_equal(m$write("gt.gdx", mode="string"), NULL)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
}
)
test_that("test_num_31", {
m = Container$new()
i = Set$new(m, "i", "j")
j = Set$new(m, "j", "i")
a = Parameter$new(m, "a", c(i, j))
m$removeSymbols("j")
j = Set$new(m, "j", "i")
expect_true(a$isValid(verbose=TRUE))
}
)
test_that("test_num_32", {
m = Container$new()
i = Set$new(m, "i")
m$isValid()
expect_equal(m$.requiresStateCheck, FALSE)
j = Set$new(m, "j")
expect_true(m$.requiresStateCheck)
}
)
test_that("test_num_33", {
m = Container$new()
i = Set$new(m, "i")
j = Set$new(m, "j")
k = Set$new(m, "k")
i$domain = j
j$domain = k
k$domain = i
expect_error(m$.__enclos_env__$private$validSymbolOrder())
}
)
test_that("test_num_34", {
m = Container$new()
i = Set$new(m, "i")
j = Alias$new(m, "j", i)
j$setRecords(c("a", "b"))
df = data.frame("uni"=c("a", "b"))
df$uni = factor(df$uni, ordered=TRUE)
expect_equal(i$records, df)
}
)
test_that("test_num_35", {
m = Container$new()
i = Set$new(m, "i")
j = Alias$new(m, "j", i)
j$description = "just a test"
expect_equal(i$description, "just a test")
}
)
test_that("test_num_36", {
m = Container$new()
i = Set$new(m, "i")
k = Set$new(m, "k")
j = Alias$new(m, "j", i)
j$domain = c(k, k)
expect_equal(i$domainNames, c("k", "k"))
}
)
test_that("test_num_37", {
m = Container$new()
i = Set$new(m, "i")
j = Alias$new(m, "j", i)
j$isSingleton = TRUE
expect_equal(i$isSingleton, TRUE)
}
)
test_that("test_num_38", {
m = Container$new()
i = Set$new(m, "i")
expect_equal(i$dimension, 1)
expect_equal(i$domain, c("*"))
i$dimension = 2
expect_equal(i$dimension, 2)
expect_equal(i$domain, c("*", "*"))
i$dimension = 0
expect_equal(i$dimension, 0)
expect_equal(i$domain, list())
a = Parameter$new(m, "a")
expect_equal(a$dimension, 0)
expect_equal(a$domain, list())
expect_equal(a$isScalar, TRUE)
a$dimension = 2
expect_equal(a$domain, list("*", "*"))
expect_equal(a$isScalar, FALSE)
a$dimension = 0
expect_equal(a$domain, list())
expect_equal(a$isScalar, TRUE)
ip = Alias$new(m, "ip", i)
ip$dimension = 2
expect_equal(ip$dimension, 2)
expect_equal(i$dimension, 2)
expect_equal(ip$domain, list("*", "*"))
expect_equal(i$domain, list("*", "*"))
}
)
test_that("test_num_39", {
m = Container$new()
i = Set$new(m, "i")
expect_equal(i$numberRecords, 0)
m$removeSymbols("i")
i = Set$new(m, "i", records = c("a", "b"))
expect_equal(i$numberRecords, 2)
j = Set$new(m, "j", i, records = c("a", "c"))
# expect_true(is.na(j$numberRecords)) #because NA
}
)
test_that("test_num_40", {
m = Container$new(testthat::test_path("testdata", "test40.gdx"))
expect_true(m["a"]$domainType == "regular")
expect_true(is.null(m["a"]$records))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "test40.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
}
)
test_that("test_num_41", {
# test for matrix input of parameter records 2D
m = Container$new()
i = Set$new(m, "i", records = c("a","b"))
j = Set$new(m, "j", records = c("x","y","z"))
recs = matrix(c(1:6), nrow = 2, ncol=3)
d = Parameter$new(m, "d", c(i, j), records = recs)
df = data.frame(i = c("a","a", "a", "b","b","b"),
j = c("x", "y", "z", "x", "y", "z"),
value = c(1,3,5,2,4,6))
df[,1] = factor(df[,1], ordered = TRUE)
df[,2] = factor(df[,2], ordered = TRUE)
expect_equal(d$records, df)
# test for array input of parameter records 2D
m$removeSymbols("d")
recs = array(c(1:6), dim=c(2,3))
d = Parameter$new(m, "d", c(i, j), records = recs)
expect_equal(d$records, df)
#test for array 3D
recs = array(c(1:12), dim=c(2,3,2))
k = Set$new(m, "k", records = c("alpha", "beta"))
d3 = Parameter$new(m, "d3", c(i, j, k), records = recs)
df = data.frame(i = c("a","a", "a", "a","a","a", "b", "b","b","b", "b", "b"),
j = c("x", "x", "y", "y", "z", "z", "x", "x", "y", "y", "z", "z"),
k = c("alpha","beta","alpha","beta","alpha","beta",
"alpha","beta","alpha","beta","alpha","beta"),
value = c(1,7,3,9,5,11,2,8,4,10,6,12))
df[,1] = factor(df[,1], ordered = TRUE)
df[,2] = factor(df[,2], ordered = TRUE)
df[,3] = factor(df[,3], ordered = TRUE)
expect_equal(d3$records, df)
}
)
test_that("test_num_42", {
m = Container$new()
i = Set$new(m, "i", records = paste0("i", c(1:5)))
j = Set$new(m, "j", records = paste0("j", c(1:5)))
recs=data.frame("i"=c("i1","i2","i3","i4","i5"),
"j"=c("j1","j2","j3","j4","j5"), "val"=c(1,1,1,1,1))
a = Parameter$new(m, "a", domain=c(i, j), records = recs)
ap = Parameter$new(m, "ap", domain=c(i, j), records = a$toDense())
expect_equal(a$records, ap$records)
v = Variable$new(m, "v", domain=c(i, j), records = list("level"=a$toDense()))
df = data.frame(i=i$records[,1],
j=j$records[,1],
level= c(1,1,1,1,1)
)
expect_equal(v$records, df)
v2 = Variable$new(m, "v2", domain=c(i, j),
records = list(
"level" = a$toDense(),
marginal = a$toDense(),
lower = a$toDense(),
upper = a$toDense(),
scale = a$toDense()
)
)
e = Equation$new(m, "e", "eq", domain=c(i, j),
records = list(
"level" = a$toDense(),
marginal = a$toDense(),
lower = a$toDense(),
upper = a$toDense(),
scale = a$toDense()
)
)
df = data.frame(i=i$records[,1],
j=j$records[,1],
level= c(1,1,1,1,1),
marginal = replicate(5, 1),
lower = replicate(5, 1),
upper = replicate(5, 1),
scale = replicate(5, 1)
)
expect_equal(v2$records, df)
expect_equal(e$records, df)
}
)
# test converting arrays to records for Parameters, Varaibles, Equations
test_that("test_num_43", {
m = Container$new()
i = Set$new(m, "i", records = paste0("i", c(1:5)))
j = Set$new(m, "j", records = paste0("j", c(1:5)))
recs=data.frame("i"=c("i1","i2","i3","i4","i5"),
"j"=c("j1","j2","j3","j4","j5"), "val"=c(0,0,0,0,0))
recs[2,"val"] = 1
recs[4, "val"] = SpecialValues$EPS
recs = recs[-c(1,3,5),]
row.names(recs) <- NULL
recs2 = data.frame("i"=c("i1","i2","i3","i4","i5"),
"j"=c("j1","j2","j3","j4","j5"), "val"=c(0,0,0,0,0))
recs2["val"] = SpecialValues$EPS
a = Parameter$new(m, "a", domain=c(i, j), records = recs)
ap = Parameter$new(m, "ap", domain=c(i, j), records = recs2)
v = Variable$new(m, "v", domain=c(i, j),
records = list(
"level"=a$toDense(),
"marginal"= ap$toDense()
))
e = Equation$new(m, "e", "eq", domain=c(i, j),
records = list(
"level"=a$toDense(),
"marginal"= ap$toDense()
))
cols = v$domainLabels
cols = append(cols, c("level", "marginal", "lower", "upper", "scale"))
recs=data.frame("i"=c("i1","i2","i3","i4","i5"),
"j"=c("j1","j2","j3","j4","j5"), "level"=c(0,0,0,0,0),
"marginal"=replicate(5, SpecialValues$EPS))
recs[,1] = factor(recs[,1], ordered=TRUE)
recs[,2] = factor(recs[,2], ordered=TRUE)
recs[2,"level"] = 1
recs[4, "level"] = SpecialValues$EPS
expect_equal(v$records, recs)
recs=data.frame("i"=c("i1","i2","i3","i4","i5"),
"j"=c("j1","j2","j3","j4","j5"), "level"=c(0,0,0,0,0),
"marginal"=replicate(5, SpecialValues$EPS))
recs[,1] = factor(recs[,1], ordered=TRUE)
recs[,2] = factor(recs[,2], ordered=TRUE)
recs[2,"level"] = 1
recs[4, "level"] = SpecialValues$EPS
expect_equal(e$records, recs)
}
)
test_that("test_num_44", {
m = Container$new(testthat::test_path("testdata", "test44.gdx"))
expect_true(m["i"]$type == "free")
m$write("out.gdx")
# test supercall read
rl = readGDX(testthat::test_path("testdata", "test44.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
m2 = Container$new(testthat::test_path("out.gdx"))
expect_true(m2["i"]$type == "free")
m$write("out.gdx", mode="string")
m2 = Container$new(testthat::test_path("out.gdx"))
expect_true(m2["i"]$type == "free")
# test the super call write
writeList = m$asList()
writeGDX(writeList, "out.gdx", mode="string")
m2 = Container$new(testthat::test_path("out.gdx"))
expect_true(m2["i"]$type == "free")
}
)
test_that("test_num_45", {
m = Container$new()
i = Set$new(m, "i", records = paste0("i", 1:5))
j = Set$new(m, "j", i, records = paste0("i", 1:5))
m$removeSymbols("i")
expect_true(is.null(i$container))
expect_true(unlist(m$data$keys()) == c("j"))
expect_true(j$isValid())
expect_equal(j$domain, "*")
}
)
test_that("test_num_46", {
skip_if_no_gams()
h = Container$new()
h$read(testthat::test_path("testdata", "biggdxtest.gdx"))
m = Container$new(h)
# write everything
m$write(testthat::test_path("gt.gdx"))
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "biggdxtest.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# write everything
m$write(testthat::test_path("gt.gdx"), mode="string")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "biggdxtest.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "biggdxtest.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
}
)
test_that("test_num_47", {
m = Container$new(testthat::test_path("testdata", "test47.gdx"))
expect_true(m["a"]$domainType == "regular")
expect_true(is.null(m["a"]$records))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "test47.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
}
)
test_that("test_num_48", {
m = Container$new()
i = Set$new(m, "i", domain=c("k"), records = paste0("i", 1:5))
j = Set$new(m, "j", domain=c("*"), records = paste0("j", 1:5))
k = Set$new(m, "k", domain = c("*", "l"), records = data.frame(paste0("k", 1:5), paste0("l", 1:5)))
l = Set$new(m, "l", i, records=paste0("i", 1:2))
m$write("data.gdx")
m = Container$new("data.gdx")
expect_true(m["i"]$domainType == "relaxed")
expect_true(m["j"]$domainType == "none")
expect_true(m["k"]$domainType == "relaxed")
expect_true(m["l"]$domainType == "regular")
expect_true(!is.null(m["i"]$records))
expect_true(!is.null(m["j"]$records))
expect_true(!is.null(m["k"]$records))
expect_true(!is.null(m["l"]$records))
m$write("data.gdx", mode="string")
m = Container$new("data.gdx")
expect_true(m["i"]$domainType == "relaxed")
expect_true(m["j"]$domainType == "none")
expect_true(m["k"]$domainType == "relaxed")
expect_true(m["l"]$domainType == "regular")
expect_true(!is.null(m["i"]$records))
expect_true(!is.null(m["j"]$records))
expect_true(!is.null(m["k"]$records))
expect_true(!is.null(m["l"]$records))
# test the super call write
writeList = m$asList()
writeGDX(writeList, "data.gdx")
expect_true(m["i"]$domainType == "relaxed")
expect_true(m["j"]$domainType == "none")
expect_true(m["k"]$domainType == "relaxed")
expect_true(m["l"]$domainType == "regular")
expect_true(!is.null(m["i"]$records))
expect_true(!is.null(m["j"]$records))
expect_true(!is.null(m["k"]$records))
expect_true(!is.null(m["l"]$records))
}
)
test_that("test_num_49", {
m = Container$new(testthat::test_path("testdata", "test49.gdx"))
expect_equal(m["i"]$domainType, "relaxed")
# test supercall read
rl = readGDX(testthat::test_path("testdata", "test49.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
}
)
test_that("test_num_50", {
m = Container$new()
i = Set$new(m, "i", domain=c("k"), records = paste0("i", 1:5))
j = Set$new(m, "j", domain=c("*"), records = paste0("j", 1:5))
k = Set$new(m, "k", domain = c("*", "l"), records = data.frame(paste0("k", 1:5), paste0("l", 1:5)))
l = Set$new(m, "l", i, records=paste0("i", 1:2))
m$write("data.gdx")
m = Container$new()
m$read(testthat::test_path("data.gdx"), symbols="i")
expect_true(!is.null(m["i"]))
m = Container$new()
m$read(testthat::test_path("data.gdx"), symbols= c("i", "j"))
expect_true(!is.null(m["i"]))
expect_true(!is.null(m["j"]))
# test supercall read
rl = readGDX(testthat::test_path("data.gdx"),
symbols =c("i", "j"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
m = Container$new()
expect_error(m$read(testthat::test_path("data.gdx"), symbols= c("i", "j", "dummy")))
m = Container$new()
i = Set$new(m, "i", domain=c("k"), records = paste0("i", 1:5))
j = Set$new(m, "j", domain=c("*"), records = paste0("j", 1:5))
k = Set$new(m, "k", domain = c("*", "l"), records = data.frame(paste0("k", 1:5), paste0("l", 1:5)))
l = Set$new(m, "l", i, records=paste0("i", 1:2))
m$write("data.gdx", mode="string")
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
m = Container$new()
m$read(testthat::test_path("data.gdx"), symbols="i")
expect_true(!is.null(m["i"]))
m = Container$new()
m$read(testthat::test_path("data.gdx"), symbols= c("i", "j"))
expect_true(!is.null(m["i"]))
expect_true(!is.null(m["j"]))
m = Container$new()
expect_error(m$read(testthat::test_path("data.gdx"), symbols= c("i", "j", "dummy")))
}
)
test_that("test_num_51", {
expect_error(Container$new("dummy.gdx"))
m = Container$new()
expect_error(m$read("dummy.gdx"))
}
)
test_that("test_num_52", {
expect_error(Container$new(data.frame()))
m = Container$new()
expect_error(m$read(data.frame()))
}
)
test_that("test_num_53", {
expect_warning(Container$new(testthat::test_path("testdata", "test53.gdx")))
}
)
test_that("test_num_54", {
m = Container$new(testthat::test_path("testdata", "trnsport.gdx"))
for (i in unlist(m$data$keys())) {
expect_true(is.list(m[i]$summary))
}
expect_true(is.vector(m$listSymbols()))
expect_true(is.vector(m$listParameters()))
expect_true(is.vector(m$listSets()))
expect_true(is.null(m$listAliases()))
expect_true(is.vector(m$listVariables()))
expect_true(is.vector(m$listEquations()))
expect_equal(length(m$listVariables(types="free")), 1)
expect_equal(length(m$listVariables(types="positive")), 1)
expect_equal(length(m$listEquations(types="geq")), 1)
expect_equal(length(m$listEquations(types="eq")), 1)
expect_equal(length(m$listEquations(types="leq")), 1)
expect_equal(length(m$listEquations(types=c("geq", "leq"))), 2)
expect_true(is.data.frame(m$describeSets()))
expect_true(is.data.frame(m$describeParameters()))
expect_true(is.data.frame(m$describeVariables()))
expect_true(is.data.frame(m$describeEquations()))
expect_equal(nrow(m$describeEquations(m$listEquations(types = "geq"))), 1)
expect_equal(nrow(m$describeEquations(m$listEquations(types = "eq"))), 1)
expect_equal(nrow(m$describeEquations(m$listEquations(types = "leq"))), 1)
}
)
test_that("test_num_55", {
m = Container$new(testthat::test_path("testdata", "trnsport.gdx"))
old_names = unlist(m$data$keys())
for (i in unlist(m$data$keys())) {
expect_true(!is.null(m[i]$records))
}
m = Container$new()
m$read(testthat::test_path("testdata", "trnsport.gdx"))
for (i in unlist(m$data$keys())) {
expect_true(is.data.frame(m[i]$records))
}
m = Container$new(testthat::test_path("testdata", "test55.gdx"))
new_names = unlist(m$data$keys())
for (i in unlist(m$data$keys())) {
if (i != "ce") {
expect_true(!is.null(m[i]$records))
}
}
expect_true(!identical(old_names, new_names))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "test55.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
}
)
test_that("test_num_56", {
m = Container$new()
m$read(testthat::test_path("testdata", "trnsport.gdx"))
for (i in unlist(m$data$keys())) {
expect_true(is.data.frame(m[i]$records))
}
}
)
test_that("test_num_57", {
df = data.frame(expand.grid(c("a1","a2"),
c("b1","b2"), c("c1","c2"), c("d1","d2")),
stringsAsFactors=TRUE)
df$value = 1
m = Container$new()
t = Parameter$new(m, "t", domain=replicate(4, "*"))
t$records = df
expect_true(t$isValid())
}
)
# test read from another Container
test_that("test_num_59", {
m = Container$new(testthat::test_path("testdata", "trnsport_with_alias.gdx"))
expect_true(m$isValid())
m2 = Container$new(m)
expect_true(m2$isValid())
}
)
# test read from another Container with invalid symbols
test_that("test_num_60", {
m = Container$new()
i = Set$new(m, "i", records = paste0("i",1:10))
j = Set$new(m, "j", records = paste0("j",1:10))
a = Parameter$new(m, "a", c(i, j))
a$.__enclos_env__$private$.records = "ham"
expect_true(!a$isValid())
expect_error(Container$new(m))
m2 = Container$new()
m2$read(m, c("i", "j"))
expect_equal(unlist(m2$data$keys()), c("i", "j"))
expect_error(m2$read(m, "a"))
}
)
# test converting arrays with EPS (across several columns) values for Parameters, Variables, Equations
test_that("test_num_61", {
m = Container$new()
i = Set$new(m, "i", records = paste0("i", c(1:5)))
j = Set$new(m, "j", records = paste0("j", c(1:5)))
recs=data.frame("i"=c("i1","i2","i3","i4","i5"),
"j"=c("j1","j2","j3","j4","j5"), "val"=c(0,1,0,SpecialValues$EPS,0))
recs <- recs[-c(1,3,5),]
a = Parameter$new(m, "a", domain=c(i, j), records = recs)
recs=data.frame("i"=c("i1","i2","i3","i4","i5"),
"j"=c("j1","j2","j3","j4","j5"), "val"=replicate(5,SpecialValues$EPS))
ap = Parameter$new(m, "ap", domain=c(i, j), records = recs)
v = Variable$new(m, "v", domain=c(i, j), records =
list("level"=a$toDense(), "marginal"=ap$toDense()))
e = Equation$new(m, "e", "eq", domain=c(i, j),
records = list(
"level" = a$toDense(),
marginal = ap$toDense()
)
)
df = data.frame(i=i$records[,1],
j=j$records[,1],
level= c(0,1,0,SpecialValues$EPS,0),
marginal=replicate(5, SpecialValues$EPS)
)
expect_equal(v$records, df)
df = data.frame(i=i$records[,1],
j=j$records[,1],
level= c(0,1,0,SpecialValues$EPS,0),
marginal = replicate(5, SpecialValues$EPS)
)
expect_equal(e$records, df)
}
)
# test symbol isValid if categories are not set properly (directly)
test_that("test_num_62", {
df = data.frame(rev(expand.grid(rev(list(paste0("h", 1:10),
paste0("m", 1:10),paste0("s", 1:10))))), stringsAsFactors = TRUE)
colnames(df) = c("h_1", "m_2", "s_3")
df[["value"]] = runif(nrow(df), 0, 100)
m = Container$new()
hrs = Set$new(m, "h", records = unique(df$h_1))
mins = Set$new(m, "m", records = unique(df$m_2))
secs = Set$new(m, "s", records = unique(df$s_3))
a = Parameter$new(m, "a", c(hrs, mins, secs))
# set records directly
a$records = df
expect_true(a$isValid())
}
)
# test symbol isValid if categories are set properly (directly)
test_that("test_num_63", {
df = data.frame(rev(expand.grid(rev(list(paste0("h", 1:10),
paste0("m", 1:10),paste0("s", 1:10))))), stringsAsFactors = TRUE)
colnames(df) = c("h_1", "m_2", "s_3")
df[["value"]] = runif(nrow(df), 0, 100)
m = Container$new()
hrs = Set$new(m, "h", records = unique(df$h_1))
mins = Set$new(m, "m", records = unique(df$m_2))
secs = Set$new(m, "s", records = unique(df$s_3))
a = Parameter$new(m, "a", c(hrs, mins, secs))
df$h_1 = factor(df$h_1, levels=levels(hrs$records$uni), ordered = TRUE)
df$m_2 = factor(df$m_2, levels=levels(mins$records$uni), ordered = TRUE)
df$s_3 = factor(df$s_3, levels=levels(secs$records$uni), ordered = TRUE)
# set records directly
a$records = df
expect_true(a$isValid())
}
)
# test symbol isValid if categories are not linked to the proper set (directly)
test_that("test_num_64", {
df = data.frame(rev(expand.grid(rev(list(paste0("h", 1:10),
paste0("m", 1:10),paste0("s", 1:10))))), stringsAsFactors = TRUE)
colnames(df) = c("h_1", "m_2", "s_3")
df[["value"]] = runif(nrow(df), 0, 100)
m = Container$new()
hrs = Set$new(m, "h", records = unique(df$h_1))
mins = Set$new(m, "m", records = unique(df$m_2))
secs = Set$new(m, "s", records = unique(df$s_3))
a = Parameter$new(m, "a", c(hrs, mins, secs))
dumb_set = append(levels(df$h_1), "new_element")
df$h_1 = factor(df$h_1, levels=dumb_set, ordered = TRUE)
df$m_2 = factor(df$m_2, levels=levels(mins$records$uni), ordered = TRUE)
df$s_3 = factor(df$s_3, levels=levels(secs$records$uni), ordered = TRUE)
# set records directly
a$records = df
expect_true(a$isValid())
}
)
# test Exception when attempting to set a symbol name with invalid characters
test_that("test_num_65", {
m = Container$new()
expect_error(Set$new(m, "milk&meat"))
expect_error(Set$new(m, "_milk&meat"))
}
)
# test that name.setter (symbols and aliases) cannot set name if it already exists in container
test_that("test_num_66", {
m = Container$new()
i = Set$new(m, "i")
j = Set$new(m, "j")
ip = Alias$new(m, "ip", i)
jp = Alias$new(m, "jp", j)
expr <- function() j$name = "i"
expect_error(expr())
expr <- function() jp$name = "ip"
expect_error(expr())
}
)
# test utility functions
test_that("test_num_67", {
m = Container$new()
i = Set$new(m, "i", records = paste0("i", 1:10))
a = Parameter$new(m, "a", i, records=data.frame(i$records[,1], 1:10))
expect_equal(a$getMaxValue(), 10.0)
expect_equal(a$getMinValue(), 1.0)
expect_equal(a$getMeanValue(), 5.5)
expect_equal(a$getMaxAbsValue(), 10.0)
expect_equal(a$whereMax(), 10)
expect_equal(a$whereMaxAbs(), 10)
expect_equal(a$whereMin(), 1)
expect_equal(a$countNA(), 0)
expect_equal(a$countEps(), 0)
expect_equal(a$countUndef(), 0)
expect_equal(a$countPosInf(), 0)
expect_equal(a$countNegInf(), 0)
}
)
# test passing .toDense() of multiple dimensions to setRecords
test_that("test_num_68", {
m = Container$new()
i = Set$new(m, "i", records = paste0("i", 1:10))
j = Set$new(m, "j", records = paste0("j", 1:10))
a0 = Parameter$new(m, "a0", records=10)
a1 = Parameter$new(m, "a1", i, records=data.frame(i=paste0("i", 1:10), 1:10))
df = data.frame(rev(expand.grid(rev(list(paste0("i", 1:10),
paste0("j", 1:5))))), stringsAsFactors = TRUE)
values = replicate(50, 0)
count = 1
for (i1 in 1:10) {
for (j1 in 1:5) {
values[count] = i1 + j1
count = count + 1
}
}
df$values = values
a2 = Parameter$new(m, "a2", c(i, j), records=df)
df = data.frame(rev(expand.grid(rev(list(paste0("i", 1:10),
paste0("j", 1:5), paste0("i", 1:10))))), stringsAsFactors = TRUE)
values = replicate(500, 0)
count = 1
for (i1 in 1:10) {
for (j1 in 1:5) {
for (ip1 in 1:10) {
values[count] = i1 + j1 + ip1
count = count + 1
}
}
}
df$values = values
a3 = Parameter$new(m, "a3", c(i, j, i), records=df)
a0p = Parameter$new(m, "a0p", records=a0$toDense())
a1p = Parameter$new(m, "a1p", i, records = a1$toDense())
a2p = Parameter$new(m, "a2p", c(i, j), records = a2$toDense())
a3p = Parameter$new(m, "a3p", c(i, j, i), records = a3$toDense())
v0 = Variable$new(m, "v0", records = a0$toDense())
v1 = Variable$new(m, "v1", domain=i, records=a1$toDense())
v2 = Variable$new(m, "v2", domain=c(i, j), records= a2$toDense())
v3 = Variable$new(m, "v3", domain=c(i, j, i), records=a3$toDense())
v0p = Variable$new(m, "v0p", records = v0$toDense())
v1p = Variable$new(m, "v1p", domain=i, records=v1$toDense())
v2p = Variable$new(m, "v2p", domain=c(i, j), records= v2$toDense())
v3p = Variable$new(m, "v3p", domain=c(i, j, i), records=v3$toDense())
e0 = Equation$new(m, "e0", "eq", records = a0$toDense())
e1 = Equation$new(m, "e1", "eq", domain=i, records=a1$toDense())
e2 = Equation$new(m, "e2", "eq", domain=c(i, j), records= a2$toDense())
e3 = Equation$new(m, "e3", "eq", domain=c(i, j, i), records=a3$toDense())
e0p = Equation$new(m, "e0p", "eq", records = e0$toDense())
e1p = Equation$new(m, "e1p", "eq", domain=i, records=e1$toDense())
e2p = Equation$new(m, "e2p", "eq", domain=c(i, j), records= e2$toDense())
e3p = Equation$new(m, "e3p", "eq", domain=c(i, j, i), records=e3$toDense())
expect_equal(a0$records, a0p$records)
expect_equal(a1$records, a1p$records)
# expect_equal(as.numeric(a2$records), as.numeric(a2p$records))
# expect_equal(as.numeric(a3$records), as.numeric(a3p$records))
expect_equal(v0$records, v0p$records)
expect_equal(v1$records, v1p$records)
expect_equal(v2$records, v2p$records)
expect_equal(v3$records, v3p$records)
expect_equal(e0$records, e0p$records)
expect_equal(e1$records, e1p$records)
expect_equal(e2$records, e2p$records)
expect_equal(e3$records, e3p$records)}
)
# test passing .toDense() of multiple dimensions to setRecords (named list structure)
test_that("test_num_69", {
m = Container$new()
i = Set$new(m, "i", records = paste0("i", 1:10))
j = Set$new(m, "j", records = paste0("j", 1:10))
a0 = Parameter$new(m, "a0", records=10)
a1 = Parameter$new(m, "a1", i, records=data.frame(i=paste0("i", 1:10), 1:10))
df = data.frame(rev(expand.grid(rev(list(paste0("i", 1:10),
paste0("j", 1:5))))), stringsAsFactors = TRUE)
values = replicate(50, 0)
count = 1
for (i1 in 1:10) {
for (j1 in 1:5) {
values[count] = i1 + j1
count = count + 1
}
}
df$values = values
a2 = Parameter$new(m, "a2", c(i, j), records=df)
df = data.frame(rev(expand.grid(rev(list(paste0("i", 1:10),
paste0("j", 1:5), paste0("i", 1:10))))), stringsAsFactors = TRUE)
values = replicate(500, 0)
count = 1
for (i1 in 1:10) {
for (j1 in 1:5) {
for (ip1 in 1:10) {
values[count] = i1 + j1 + ip1
count = count + 1
}
}
}
df$values = values
a3 = Parameter$new(m, "a3", c(i, j, i), records=df)
a0dict = list(
level = a0$toDense(),
marginal = a0$toDense(),
lower = a0$toDense(),
upper = a0$toDense(),
scale = a0$toDense()
)
a1dict = list(
level = a1$toDense(),
marginal = a1$toDense(),
lower = a1$toDense(),
upper = a1$toDense(),
scale = a1$toDense()
)
a2dict = list(
level = a2$toDense(),
marginal = a2$toDense(),
lower = a2$toDense(),
upper = a2$toDense(),
scale = a2$toDense()
)
a3dict = list(
level = a3$toDense(),
marginal = a3$toDense(),
lower = a3$toDense(),
upper = a3$toDense(),
scale = a3$toDense()
)
a0p = Parameter$new(m, "a0p", records=a0$toDense())
a1p = Parameter$new(m, "a1p", i, records = a1$toDense())
a2p = Parameter$new(m, "a2p", c(i, j), records = a2$toDense())
a3p = Parameter$new(m, "a3p", c(i, j, i), records = a3$toDense())
v0 = Variable$new(m, "v0", records = a0dict)
v1 = Variable$new(m, "v1", domain=i, records=a1dict)
v2 = Variable$new(m, "v2", domain=c(i, j), records= a2dict)
v3 = Variable$new(m, "v3", domain=c(i, j, i), records=a3dict)
v0p = Variable$new(m, "v0p", records = a0dict)
v1p = Variable$new(m, "v1p", domain=i, records=a1dict)
v2p = Variable$new(m, "v2p", domain=c(i, j), records= a2dict)
v3p = Variable$new(m, "v3p", domain=c(i, j, i), records=a3dict)
e0 = Equation$new(m, "e0", "eq", records = a0dict)
e1 = Equation$new(m, "e1", "eq", domain=i, records=a1dict)
e2 = Equation$new(m, "e2", "eq", domain=c(i, j), records= a2dict)
e3 = Equation$new(m, "e3", "eq", domain=c(i, j, i), records=a3dict)
e0p = Equation$new(m, "e0p", "eq", records = a0dict)
e1p = Equation$new(m, "e1p", "eq", domain=i, records=a1dict)
e2p = Equation$new(m, "e2p", "eq", domain=c(i, j), records= a2dict)
e3p = Equation$new(m, "e3p", "eq", domain=c(i, j, i), records=a3dict)
expect_equal(a0$records, a0p$records)
expect_equal(a1$records, a1p$records)
# expect_equal(as.numeric(a2$records), as.numeric(a2p$records))
# expect_equal(as.numeric(a3$records), as.numeric(a3p$records))
expect_equal(v0$records, v0p$records)
expect_equal(v1$records, v1p$records)
expect_equal(v2$records, v2p$records)
expect_equal(v3$records, v3p$records)
expect_equal(e0$records, e0p$records)
expect_equal(e1$records, e1p$records)
expect_equal(e2$records, e2p$records)
expect_equal(e3$records, e3p$records)}
)
# shape test by passing eigen values and eigen vectors
test_that("test_num_70", {
m = Container$new(testthat::test_path("testdata", "test70.gdx"))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "test70.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
e = eigen(m["a"]$toDense())
val = e$values
vec = e$vectors
eval = Parameter$new(m, "eval", m["i"], records = val)
evec = Parameter$new(m, "evec", c(m["i"], m["j"]), records = vec)
expect_true(m$isValid())
}
)
test_that("test_num_71", {
arr0 = array(c(1:270), dim=c(5,6,9))
m = Container$new()
i = Set$new(m, "i", records=paste0("i",1:5))
j = Set$new(m, "j", records=paste0("j",1:6))
k = Set$new(m, "k", records=paste0("i",1:9))
h = Parameter$new(m, "h", c(i, j, k), records = arr0)
hp = Parameter$new(m, "hp", c(i, j, k), records = h$toDense())
expect_equal(h$shape, c(5,6,9))
expect_equal(hp$shape, c(5,6,9))
expect_equal(dim(h$toDense()), c(5, 6, 9))
expect_equal(dim(hp$toDense()), c(5, 6, 9))
expect_equal(h$records, hp$records)
expect_equal(arr0, h$toDense())
expect_equal(arr0, hp$toDense())
v = Variable$new(m, "v", "free", c(i, j, k), records=arr0)
vp = Variable$new(m, "vp", "free", c(i, j, k), records=v$toDense())
expect_equal(v$shape, c(5,6, 9))
expect_equal(vp$shape, c(5,6, 9))
expect_equal(dim(v$toDense()), c(5,6, 9))
expect_equal(dim(vp$toDense()), c(5,6, 9))
expect_equal(v$records, vp$records)
expect_equal(arr0, v$toDense())
expect_equal(arr0, vp$toDense())
e = Equation$new(m, "e", "eq", c(i, j, k), records = arr0)
ep = Equation$new(m, "ep", "eq", c(i, j, k), records = e$toDense())
expect_equal(e$shape, c(5,6, 9))
expect_equal(ep$shape, c(5,6, 9))
expect_equal(dim(e$toDense()), c(5,6, 9))
expect_equal(dim(ep$toDense()), c(5,6, 9))
expect_equal(e$records, ep$records)
expect_equal(arr0, e$toDense())
expect_equal(arr0, ep$toDense())
}
)
test_that("test_num_72", {
m = Container$new(testthat::test_path("testdata", "test72.gdx"))
expect_equal(m["dim0"]$shape, dim(m["dim0"]$toDense()))
expect_equal(m["dim1"]$shape, dim(m["dim1"]$toDense()))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "test72.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
}
)
test_that("test_num_73", {
m = Container$new(testthat::test_path("testdata", "test73.gdx"))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "test73.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
m["ProfitA"]$setRecords(cumsum(m["ProfitM"]$toDense()))
expect_equal(m["ProfitA"]$numberRecords, m["t"]$numberRecords)
}
)
test_that("test_num_74", {
m = Container$new()
d = Parameter$new(m, "d")
e = Parameter$new(m, "e")
expect_true(m$hasSymbols("d"))
expect_true(m$hasSymbols("e"))
expect_true(m$hasSymbols("D"))
expect_true(m$hasSymbols("E"))
expect_equal(m$hasSymbols(c("d", "e")), c(TRUE, TRUE))
expect_false(m$hasSymbols("f"))
expect_equal(m$hasSymbols(c("F", "g")), c(FALSE, FALSE))
expect_equal(m$getSymbolNames(c("D", "d")), c("d", "d"))
expect_equal(m$getSymbolNames("D"), "d")
expect_error(m$getSymbolNames("F"))
}
)
# test case sensitive rename and remove
test_that("test_num_75", {
m = Container$new()
d = Parameter$new(m, "d")
e = Parameter$new(m, "e")
# case insensitive remove
m$removeSymbols("D")
expect_equal(unlist(m$data$keys()), "e")
d = Parameter$new(m, "d")
# case insensitive rename
m$renameSymbol("D", "d_new")
expect_equal(unlist(m$data$keys()), c("e","d_new"))
# change case using rename
m$renameSymbol("d_new","D_neW")
expect_equal(tolower(unlist(m$data$keys())), tolower(c("e", "D_neW")))
}
)
#test getsymbols
test_that("test_num_76", {
m = Container$new()
d = Parameter$new(m, "d")
e = Parameter$new(m, "e")
expect_equal(length(m$getSymbols(m$listSymbols())), 2)
symbolobjects = m$getSymbols(m$listSymbols())
expect_true(inherits(symbolobjects[[1]], "Parameter"))
expect_true(inherits(symbolobjects[[2]], "Parameter"))
expect_error(m$getSymbols("f"))
symobject = m$getSymbols("d")
expect_true(inherits(symobject[[1]], "Parameter"))
symobject = m$getSymbols("D")
expect_true(inherits(symobject[[1]], "Parameter"))
expect_error(m$getSymbols(200))
}
)
#test listSymbols
test_that("test_num_76", {
m = Container$new()
i = Set$new(m, "i", records=c("a", "b", "c"))
a = Parameter$new(m, "a", i, records=data.frame(c("aa", "c"), c(1, 2)))
expect_equal(a$isValid(), TRUE)
# expect_equal(m$listSymbols(isValid=TRUE), "i")
# expect_equal(m$listSymbols(isValid=FALSE), "a")
}
)
#test symbol duplicate record methods
test_that("test_num_77", {
m = Container$new()
df = data.frame(matrix(NA, nrow=30, ncol=2))
df[1:10, 1] = paste0("i", 1:10)
df[11:20, 1] = paste0("j", 1:10)
df[21:30, 1] = paste0("i", 1:10)
df[1:10, 2] = 1:10
df[11:20, 2] = 1:10
df[21:30, 2] = 1:10
a = Parameter$new(m, "a", domain="*", records = df)
b = Parameter$new(m, "b", domain="*", records= data.frame(paste0("i",1:10), 1:10))
# expect_equal(a$isValid(), FALSE)
expect_equal(a$findDuplicateRecords(keep="first"), a$records[21:30, ])
expect_equal(a$findDuplicateRecords(keep="last"), a$records[1:10, ])
expect_equal(a$findDuplicateRecords(keep=FALSE), a$records[append(1:10, 21:30), ])
expect_equal(a$countDuplicateRecords(), 10)
expect_true(a$hasDuplicateRecords())
a$dropDuplicateRecords(keep="first")
expect_equal(as.character(a$records[,1]), append(paste0("i", 1:10), paste0("j", 1:10)))
m$removeSymbols("a")
a = Parameter$new(m, "a", domain="*", records= df)
a$dropDuplicateRecords(keep="last")
expect_equal(as.character(a$records[,1]), append(paste0("j", 1:10), paste0("i", 1:10)))
expect_true(b$isValid())
expect_equal(b$countDuplicateRecords(), 0)
expect_true(!b$hasDuplicateRecords())
bcopy = b
b$dropDuplicateRecords()
expect_equal(bcopy, b)
expect_true(m$isValid())
}
)
#test container duplicate record methods
test_that("test_num_78", {
m = Container$new()
df = data.frame(matrix(NA, nrow=30, ncol=2))
df[1:10, 1] = paste0("i", 1:10)
df[11:20, 1] = paste0("j", 1:10)
df[21:30, 1] = paste0("i", 1:10)
df[1:10, 2] = 1:10
df[11:20, 2] = 1:10
df[21:30, 2] = 1:10
a = Parameter$new(m, "a", "*", records=df)
b = Parameter$new(m, "b", "*", records=data.frame(paste0("i",1:10), 1:10))
c = Parameter$new(m, "c", "*", records=data.frame(paste0("j",1:10), 1:10))
expect_true(m$hasDuplicateRecords())
expect_equal(m$countDuplicateRecords(), list("a"=10))
m$dropDuplicateRecords()
expect_true(m$isValid())
}
)
#test getUELs method
test_that("test_num_79", {
m = Container$new()
i = Set$new(m, "i", domain=c("*", "*"), records=data.frame(c("i1","i2","i3"), c("i4","i5","i6")))
j = Set$new(m, "j", domain=c("*", "*"), records=data.frame(c("j1","j2","j3"), c("j4","j5","j6")))
expect_equal(i$getUELs(dimension=1), c("i1","i2","i3"))
expect_equal(i$getUELs(dimension=2), c("i4","i5","i6"))
expect_equal(i$getUELs(), paste0("i", 1:6))
expect_error(i$getUELs(dimension=3))
expect_error(i$getUELs(codes=0))
expect_equal(i$getUELs(dimension=1), paste0("i", 1:3))
expect_equal(i$getUELs(dimension=2), paste0("i", 4:6))
expect_error(i$getUELs(dimension=3))
expect_error(i$getUELs(codes=0))
expect_equal(i$getUELs(dimension=1, codes=1), "i1")
expect_equal(i$getUELs(dimension=1, codes=3), "i3")
expect_equal(i$getUELs(dimension=1, codes=c(1, 3)), c("i1", "i3"))
expect_error(i$getUELs(codes=100, dimension=0))
expect_equal(j$getUELs(dimension=1), paste0("j", 1:3))
expect_equal(j$getUELs(dimension=2), paste0("j", 4:6))
expect_equal(j$getUELs(), paste0("j", 1:6))
expect_error(j$getUELs(dimension=3))
expect_equal(m$getUELs("i"), i$getUELs())
expect_equal(m$getUELs("j"), j$getUELs())
expect_equal(m$getUELs(), append(i$getUELs(), j$getUELs()))
expect_error(m$getUELs("k"))
}
)
#test removeUELs method
test_that("test_num_80", {
m = Container$new()
i = Set$new(m, "i", domain=c("*", "*"), records=data.frame(c("i1","i2","i3"), c("i4","i5","i6")))
i$removeUELs("hi", 1)
i$removeUELs("hi", 2)
i$removeUELs("hi")
expect_equal(i$getUELs(), paste0("i", 1:6))
i$removeUELs("i1", 1)
expect_equal(i$getUELs(), paste0("i",2:6))
m = Container$new()
i = Set$new(m, "i", domain=c("*", "*"), records=data.frame(c("i1","i2","i3"), c("i4","i5","i6")))
ip = Alias$new(m, "ip", i)
ip$removeUELs("hi", 1)
ip$removeUELs("hi", 2)
ip$removeUELs("hi")
expect_equal(ip$getUELs(), paste0("i", 1:6))
ip$removeUELs("i1", 1)
expect_equal(ip$getUELs(), paste0("i",2:6))
m = Container$new()
i = Set$new(m, "i", domain=c("*", "*"), records=data.frame(c("i1","i2","i3"), c("i4","i5","i6")))
i$removeUELs("i4")
expect_equal(i$getUELs(), append(paste0("i", 1:3), c("i5", "i6")))
m = Container$new()
i = Set$new(m, "i", domain=c("*", "*"), records=data.frame(c("i1","i2","i3"), c("i4","i5","i6")))
ip = Alias$new(m, "ip", i)
ip$removeUELs("i4")
expect_equal(ip$getUELs(), append(paste0("i", 1:3), c("i5", "i6")))
m = Container$new()
i = Set$new(m, "i", domain=c("*", "*"), records=data.frame(c("i1","i2","i3"), c("i4","i5","i6")))
j = Set$new(m, "j", domain=c("*", "*"), records=data.frame(c("j1","j2","j3"), c("j4","j5","j6")))
ip = Alias$new(m, "ip", i)
m$removeUELs(c("i1","j4"))
expect_equal(m$getUELs(), append(paste0("i",2:6), paste0("j",c(1:3,5,6))))
}
)
#test renameUELs method
test_that("test_num_81", {
m = Container$new()
i = Set$new(m, "i", domain=c("*", "*"), records=data.frame(c("i1","i2","i5"), c("i4","i5","i6")))
i$renameUELs(c("jammin"="java"), 1)
i$renameUELs(c("jammin"="java"), 2)
i$renameUELs(c("jammin"="java"))
m$renameUELs(c("jammin"="java"))
i$renameUELs(c(i2="java"))
expect_equal(i$getUELs(1), c("i1", "java", "i5"))
m = Container$new()
i = Set$new(m, "i", domain=c("*", "*"), records=data.frame(c("i1","i2","i5"), c("i4","i5","i6")))
expect_equal(m$getUELs(), c("i1","i2","i5","i4","i6"))
m$renameUELs(c(i2="java"))
expect_equal(m$getUELs(), c("i1","java","i5","i4","i6"))
}
)
#test addUELs method
test_that("test_num_82", {
m = Container$new()
i = Set$new(m, "i", domain=c("*", "*"), records=data.frame(c("i1","i2","i5"), c("i4","i5","i6")))
i$addUELs("ham", 1)
expect_equal(i$getUELs(1), c("i1","i2","i5","ham"))
i$addUELs("cheese", 2)
expect_equal(i$getUELs(2), c("i4","i5","i6","cheese"))
m$removeUELs()
expect_equal(m$getUELs(), c("i1","i2","i5","i4","i6"))
}
)
#test reorderUELs method
test_that("test_num_83", {
m = Container$new()
i = Set$new(m, "i", records=c("i1","i2","i3"))
a = Parameter$new(m, "a",i, records=data.frame(paste0("i",c(1,3,2)), c(1,3,2)))
expect_equal(a$getUELs(1), c("i1","i3","i2"))
a$reorderUELs(i$getUELs(1), 1)
expect_equal(a$getUELs(), c("i1","i2","i3"))
}
)
#test setUELs method
test_that("test_num_84", {
m = Container$new()
i = Set$new(m, "i", records=c("a","b","c"))
j = Parameter$new(m, "j",i, records=data.frame(c("a","c"), c(1,2)))
expect_equal(j$getUELs(1), c("a","c"))
j$setUELs(c("j1","a","c","j4"), 1, rename=TRUE)
expect_equal(j$getUELs(1), c("j1","a","c","j4"))
expect_equal(as.character(j$records[, 1]), c("j1","a"))
m = Container$new()
i = Set$new(m, "i", records=c("a","b","c"))
j = Parameter$new(m, "j",i, records=data.frame(c("a","c"), c(1,2)))
expect_equal(j$getUELs(1), c("a","c"))
j$setUELs(c("j1","a","c","j4"), 1, rename=FALSE)
expect_equal(j$getUELs(1), c("j1","a","c","j4"))
expect_equal(as.character(j$records[, 1]), c("a","c"))
#multiple dimensions
m = Container$new()
i = Set$new(m, "i", records=c("a","b","c"))
j = Parameter$new(m, "j",c(i,i), records=data.frame(c("a","c"),c("b","a"), c(1,2)))
j$setUELs(c("j1","a","c","j4"), rename=FALSE)
expect_equal(j$getUELs(1), c("j1","a","c","j4"))
expect_equal(j$getUELs(2), c("j1","a","c","j4"))
expect_equal(as.character(j$records[, 1]), c("a","c"))
expect_true(is.na(j$records[1, 2]))
expect_equal(as.character(j$records[, 1]), c("a","c"))
}
)
#test getDomainViolations method
test_that("test_num_85", {
m = Container$new()
i = Set$new(m, "i", records=c("SeaTtle", "hamburg"))
j = Set$new(m, "j", i, records=c("seattle", "Hamburg"))
ip = Alias$new(m, "ip", i)
jp = Alias$new(m, "jp", j)
expect_true(i$isValid())
expect_true(j$isValid())
expect_equal(i$getDomainViolations(), NULL)
expect_equal(j$getDomainViolations(), NULL)
expect_equal(ip$getDomainViolations(), NULL)
expect_equal(jp$getDomainViolations(), NULL)
# test container getdomainviolations
expect_true(is.null(m$getDomainViolations()))
m = Container$new()
i = Set$new(m, "i", records=c("SeaTtle", "hamburg"))
j = Set$new(m, "j", i, records=c(" seattle", "Hamburg"))
ip = Alias$new(m, "ip", i)
jp = Alias$new(m, "jp", j)
expect_true(i$isValid())
expect_true(j$isValid())
expect_equal(i$getDomainViolations(), NULL)
expect_equal(j$getDomainViolations()[[1]]$violations, c(" seattle"))
expect_equal(ip$getDomainViolations(), NULL)
expect_equal(jp$getDomainViolations()[[1]]$violations, c(" seattle"))
expect_equal(length(m$getDomainViolations()), 2)
dv = m$getDomainViolations()
expect_equal(dv[[1]]$symbol, j)
expect_equal(dv[[1]]$dimension, 1)
expect_equal(dv[[1]]$domain, i)
expect_equal(dv[[1]]$violations, c(" seattle"))
# finddomainviolations for alias
df = jp$findDomainViolations()
expect_equal(as.character(df[[1]]), " seattle")
expect_true(jp$hasDomainViolations())
expect_equal(jp$countDomainViolations(), 1)
jp$dropDomainViolations()
expect_equal(as.character(j$records$i), "Hamburg")
}
)
#test findDomainViolations method
test_that("test_num_86", {
m = Container$new()
i = Set$new(m, "i", records=c("j1", "j2"))
a = Parameter$new(m, "a", i, records= data.frame(paste0("j",1:10), 1:10))
a2 = Parameter$new(m, "a2", c(i,i), records= data.frame(paste0("j",1:10),paste0("j",1:10), 1:10))
expect_true(a$isValid())
expect_true(is.data.frame(a$findDomainViolations()))
expect_equal(a$findDomainViolations(), a$records[3:10,])
expect_equal(a$countDomainViolations(), 8)
expect_true(a$hasDomainViolations())
#container hasDomainViolations()
expect_true(m$hasDomainViolations())
#container countDomainViolations()
expect_equal(m$countDomainViolations()$a, 8)
expect_equal(m$countDomainViolations()$a2, 8)
a$dropDomainViolations()
expect_equal(as.character(a$records[,1]), c("j1","j2") )
expect_false(a$hasDomainViolations())
expect_equal(a$countDomainViolations(), 0)
expect_equal(a$findDuplicateRecords(), data.frame())
expect_true(a$isValid())
# test dropdomainviolations for container
m = Container$new()
i = Set$new(m, "i", records=c("j1", "j2"))
a = Parameter$new(m, "a", i, records= data.frame(paste0("j",1:10), 1:10))
a2 = Parameter$new(m, "a2", c(i,i), records= data.frame(paste0("j",1:10),paste0("j",1:10), 1:10))
m$dropDomainViolations()
expect_equal(as.character(a$records[,1]), c("j1","j2") )
expect_false(m$hasDomainViolations())
empty_named_list = list()
names(empty_named_list) = character(0)
expect_equal(m$countDomainViolations(), empty_named_list)
}
)
#test overwriting sets
test_that("test_num_87", {
m = Container$new()
i = Set$new(m, "i", records=c("a", "b", "c"))
expect_true(inherits(m$addSet("i", records=c("f","b","c")), "Set"))
expect_error(m$addSet("i","a",records=c("f","b","c")))
expect_true(inherits(m$addSet("i",records=c("f","b","c"), description="hamburger"), "Set"))
expect_equal(m["i"]$description, "hamburger")
expect_true(inherits(m$addSet("i",records=c("f","b","c")), "Set"))
expect_equal(m["i"]$description, "hamburger")
expect_error(Set$new(m, "i", records=c("f","b","c")))
}
)
#test overwriting Parameters
test_that("test_num_88", {
m = Container$new()
i = Parameter$new(m, "i", "*", records=data.frame(paste0("i",1:5), 1:5))
expect_true(inherits(m$addParameter("i", "*", records=data.frame(paste0("i",1:5), 1:5)), "Parameter"))
expect_error(m$addParameter("i","a",records=data.frame(paste0("i",1:5), 1:5)))
expect_true(inherits(m$addParameter("i","*",records=data.frame(paste0("i",1:5), 1:5), description="hamburger"), "Parameter"))
expect_equal(m["i"]$description, "hamburger")
expect_true(inherits(m$addParameter("i","*",records=data.frame(paste0("i",1:5), 1:5)), "Parameter"))
expect_equal(m["i"]$description, "hamburger")
expect_error(Parameter$new(m, "i", records=data.frame(paste0("i",1:5), 1:5)))
# overwriting parameter with domain
m = Container$new()
i = Set$new(m, "i", records=paste0("i",1:5))
j = Set$new(m, "j", records=paste0("j",1:5))
d = Parameter$new(m, "d", domain=c(i, j), records=diag(5))
# test filtering zeros
expect_equal(as.character(d$records$i), paste0("i",1:5))
expect_equal(as.character(d$records$j), paste0("j",1:5))
expect_equal(as.numeric(d$records$value),replicate(5, 1))
# overwriting
m$addParameter("d", , domain=c(i, j), records=matrix(0, 5, 5))
expect_true(nrow(d$records) == 0)
}
)
#test overwriting Variables
test_that("test_num_89", {
m = Container$new()
recs= data.frame(paste0("i",1:5), 1:5)
colnames(recs) = c("1", "level")
i = Variable$new(m, "i", "free", "*", records=recs)
expect_true(inherits(m$addVariable("i", "free", "*", records=recs), "Variable"))
expect_error(m$addVariable("i", "free","a",records=recs))
expect_true(inherits(m$addVariable("i", "free","*",records=recs, description="hamburger"), "Variable"))
expect_equal(m["i"]$description, "hamburger")
expect_true(inherits(m$addVariable("i", "free","*",records=recs), "Variable"))
expect_equal(m["i"]$description, "hamburger")
expect_error(Variable$new(m, "i", "free", records=recs))
}
)
#test overwriting Equations
test_that("test_num_90", {
m = Container$new()
recs= data.frame(paste0("i",1:5), 1:5)
colnames(recs) = c("1", "level")
i = Equation$new(m, "i", "eq", "*", records=recs)
expect_true(inherits(m$addEquation("i", "eq", "*", records=recs), "Equation"))
expect_error(m$addEquation("i", "eq","a",records=recs))
expect_true(inherits(m$addEquation("i", "eq","*",records=recs, description="hamburger"), "Equation"))
expect_equal(m["i"]$description, "hamburger")
expect_true(inherits(m$addEquation("i", "eq","*",records=recs), "Equation"))
expect_equal(m["i"]$description, "hamburger")
expect_error(Equation$new(m, "i", "eq", records=recs))
}
)
#test overwriting Alias
test_that("test_num_91", {
m = Container$new()
i = Set$new(m, "i", records=c("a","b","c"))
j = Set$new(m, "j", records=c("i","j","k"))
ip = m$addAlias("ip", i)
expect_true(inherits(ip, "Alias"))
expect_equal(ip$aliasWith, i)
expect_error(m$addAlias("j", i))
ip = m$addAlias("ip", j)
expect_true(inherits(ip, "Alias"))
expect_equal(ip$aliasWith, j)
}
)
#change column headings when changing domain
test_that("test_num_92", {
m = Container$new()
i = Set$new(m, "i", records=paste0("i",1:5))
a = Parameter$new(m, "a", c(i,i), records=data.frame(p_1=paste0("i",1:5), p_2=paste0("i",1:5), 1:5))
a$domain = c("p","p")
expect_equal(a$domain, c("p","p"))
expect_true(a$isValid())
expect_equal(colnames(a$records), c("p_1","p_2","value"))
m = Container$new()
i = Set$new(m, "i", records=paste0("i",1:5))
ip = Alias$new(m, "ip", i)
a = Parameter$new(m, "a", c(i,ip), records=data.frame(p_1=paste0("i",1:5), p_2=paste0("i",1:5), 1:5))
a$domain = c("p","p")
expect_equal(a$domain, c("p","p"))
expect_true(a$isValid())
expect_equal(colnames(a$records), c("p_1","p_2","value"))
m = Container$new()
i = Set$new(m, "i", records=paste0("i",1:5))
r = Set$new(m, "r", records=paste0("r",1:5))
a = Parameter$new(m, "a", c(i,i), records=data.frame(r_1=paste0("i",1:5), r_2=paste0("i",1:5), 1:5))
a$domain = c(r,r)
expect_equal(a$domain, c(r,r))
expect_true(a$isValid())
expect_equal(colnames(a$records), c("r_1","r_2","value"))
}
)
# white space removal and user category survival
test_that("test_num_93", {
recs = data.frame(uni=paste0("i",1:3), stringsAsFactors = TRUE)
levels(recs[,1]) = append(levels(recs[,1]), "j1")
expect_equal(levels(recs[,1]), c("i1","i2","i3","j1"))
m = Container$new()
i = Set$new(m, "i", records=recs)
expect_equal(levels(i$records$uni), c("i1","i2","i3","j1"))
recs= data.frame(uni=paste0("i",1:3), value=1:3, stringsAsFactors = TRUE)
levels(recs[,1]) = append(levels(recs[,1]), "j1")
expect_equal(levels(recs[,1]), c("i1","i2","i3","j1"))
a = Parameter$new(m, "a", i, records=recs)
expect_equal(levels(a$records$uni), c("i1","i2","i3","j1"))
recs= data.frame(uni=paste0("i",1:3), level=1:3, stringsAsFactors = TRUE)
levels(recs[,1]) = append(levels(recs[,1]), "j1")
expect_equal(levels(recs[,1]), c("i1","i2","i3","j1"))
v = Variable$new(m, "v", "free", i, records=recs)
expect_equal(levels(v$records$uni), c("i1","i2","i3","j1"))
e = Equation$new(m, "e", "eq", i, records=recs)
expect_equal(levels(e$records$uni), c("i1","i2","i3","j1"))
}
)
test_that("test_num_94", {
m = Container$new()
i = Set$new(m, "i", records=c(" i1 ", "i2", "i3"))
expect_equal(i$getUELs(), c(" i1", "i2", "i3"))
i$setUELs(c(" i1 ", " i2 ", "i3"))
expect_equal(i$getUELs(), c(" i1", " i2", "i3"))
m = Container$new()
i = Set$new(m, "i", records=c(" i1 ", "i2", "i3"))
ip = Alias$new(m, "ip", i)
expect_equal(ip$getUELs(), c(" i1", "i2", "i3"))
ip$setUELs(c(" i1 ", " i2 ", "i3"))
expect_equal(i$getUELs(), c(" i1", " i2", "i3"))
expect_equal(i$getUELs(), ip$getUELs())
m = Container$new()
i = Set$new(m, "i", records=c(" i1 ", "i2", "i3"))
i$reorderUELs(c("i2", " i1", "i3"))
expect_equal(i$getUELs(), c("i2", " i1", "i3"))
m = Container$new()
i = Set$new(m, "i", records=c(" i1 ", "i2", "i3"))
ip = Alias$new(m, "ip", i)
ip$reorderUELs(c("i2", " i1", "i3"))
expect_equal(ip$getUELs(), c("i2", " i1", "i3"))
expect_equal(i$getUELs(), ip$getUELs())
m = Container$new()
i = Set$new(m, "i", records=c(" i1 ", "i2", "i3"))
i$renameUELs(c("i1 ", " i2 ", " i3 "))
expect_equal(i$getUELs(), c("i1", " i2", " i3"))
m$renameUELs(c("i1"="cheeseburgerz "))
expect_equal(i$getUELs(), c("cheeseburgerz", " i2", " i3"))
m = Container$new()
i = Set$new(m, "i", records=c(" i1 ", "i2", "i3"))
ip = Alias$new(m, "ip", i)
ip$renameUELs(c("i1 ", " i2 ", " i3 "))
expect_equal(ip$getUELs(), c("i1", " i2", " i3"))
expect_equal(i$getUELs(), ip$getUELs())
m = Container$new()
i = Set$new(m, "i", records=c(" i1 ", "i2", "i3"))
i$addUELs("i4 ")
expect_equal(i$getUELs(), c(" i1", "i2", "i3", "i4"))
m$renameUELs(c("i1"="cheeseburgerz "))
expect_equal(i$getUELs(), c(" i1", "i2", "i3", "i4"))
m = Container$new()
i = Set$new(m, "i", records=c(" i1 ", "i2", "i3"))
ip = Alias$new(m, "ip", i)
ip$addUELs("i4 ")
expect_equal(ip$getUELs(), c(" i1", "i2", "i3", "i4"))
m$renameUELs(c("i1"="cheeseburgerz "))
expect_equal(i$getUELs(), ip$getUELs())
}
)
# test reading and writing UniverseAlias with Container
test_that("test_num_95", {
skip_if_no_gams()
m = Container$new()
# read all symbols
m$read(testthat::test_path("testdata", "test95.gdx"))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "test95.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
# write everything
m$write(testthat::test_path("gt.gdx"))
expect_true(inherits(m["h"], "UniverseAlias"))
expect_true(inherits(m["ip"], "Alias"))
expect_true(inherits(m["i"], "Set"))
expect_equal(m$listSets(), "i")
expect_equal(m$listAliases(), c("ip", "h"))
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test95.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# write everything
m$write(testthat::test_path("gt.gdx"), mode="string")
expect_true(inherits(m["h"], "UniverseAlias"))
expect_true(inherits(m["ip"], "Alias"))
expect_true(inherits(m["i"], "Set"))
expect_equal(m$listSets(), "i")
expect_equal(m$listAliases(), c("ip", "h"))
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test95.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test95.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
}
)
# test reading and writing UniverseAlias with Container
test_that("test_num_96", {
skip_if_no_gams()
m = Container$new()
# read all symbols
# uses the same gdx from test95
m$read(testthat::test_path("testdata", "test95.gdx"))
m2 = Container$new(m)
# write everything
m2$write(testthat::test_path("gt.gdx"))
expect_true(inherits(m2["h"], "UniverseAlias"))
expect_true(inherits(m2["ip"], "Alias"))
expect_true(inherits(m2["i"], "Set"))
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test95.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# write everything
m2$write(testthat::test_path("gt.gdx"), mode="string")
expect_true(inherits(m2["h"], "UniverseAlias"))
expect_true(inherits(m2["ip"], "Alias"))
expect_true(inherits(m2["i"], "Set"))
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test95.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
ret <- system2(command="gdxdiff", args=
paste0(testthat::test_path("testdata", "test95.gdx"), " ", testthat::test_path("gt.gdx")),
stdout = FALSE)
expect_equal(ret, 0)
}
)
# UniverseAlias UEL functions
test_that("test_num_97", {
m = Container$new()
i = Set$new(m, "i", records=paste0("i", 1:5))
ip = UniverseAlias$new(m, "ip")
p0 = Parameter$new(m, "p0", ip, records=data.frame(paste0("i",1:5), 1:5))
expect_equal(m$getUELs(), paste0("i",1:5))
m$renameUELs(c("i1" = "cheeseburgerz"))
expect_equal(m$getUELs(), c("cheeseburgerz", "i2","i3","i4", "i5"))
p0$addUELs("mustard")
expect_equal(p0$getUELs(), c("cheeseburgerz", "i2","i3","i4", "i5", "mustard"))
m$removeUELs()
expect_equal(m$getUELs(), c("cheeseburgerz", "i2","i3","i4", "i5"))
m$renameUELs(c("i2 " = "cheeseburgerz"))
expect_equal(m$getUELs(), c("cheeseburgerz", "i2","i3","i4", "i5"))
}
)
# UniverseAlias as domain
test_that("test_num_98", {
m = Container$new()
i = Set$new(m, "i", records=paste0("i", 1:5))
ip = UniverseAlias$new(m, "ip")
p0 = Parameter$new(m, "p0", ip, records=data.frame(paste0("i",1:5), 1:5))
expect_true(p0$isValid())
expect_equal(p0$domain[[1]], ip)
expect_equal(p0$domainType, "regular")
expect_equal(p0$dimension, 1)
expect_true(is.null(p0$getDomainViolations()))
expect_equal(nrow(p0$findDomainViolations()), 0)
expect_true(!p0$hasDomainViolations())
expect_equal(p0$countDomainViolations(), 0)
expect_true(!p0$hasDuplicateRecords())
expect_equal(p0$findDuplicateRecords(), data.frame())
expect_equal(p0$countDuplicateRecords(), 0)
expect_equal(p0$summary,
list(name="p0", description="", domain = "ip", domainType="regular",
dimension=1, numberRecords=5))
m$removeSymbols("ip")
expect_true(p0$isValid())
expect_equal(p0$domain[[1]], "*")
expect_equal(p0$domainType, "none")
expect_equal(p0$dimension, 1)
expect_true(is.null(p0$getDomainViolations()))
expect_true(!p0$hasDomainViolations())
expect_equal(nrow(p0$findDomainViolations()), 0)
expect_equal(p0$countDomainViolations(), 0)
expect_true(!p0$hasDuplicateRecords())
expect_equal(p0$findDuplicateRecords(), data.frame())
expect_equal(p0$countDuplicateRecords(), 0)
expect_equal(p0$summary,
list(name="p0", description="", domain = "*", domainType="none",
dimension=1, numberRecords=5))
expect_true(!ip$isValid())
expect_equal(ip$summary,
list("name" = "ip",
description = "Aliased with *",
aliasWith = "*"
))
}
)
# remove symbols including alias
test_that("test_num_99", {
m = Container$new()
i = Set$new(m, "i")
ii = Alias$new(m, "ii", i)
j = Set$new(m, "j", domain=ii)
m$removeSymbols("ii")
# should affect j
expect_equal(j$domain, "*")
ii = Alias$new(m, "ii", i)
m$removeSymbols("i")
expect_true(is.null(m["ii"]))
expect_equal(j$domain, "*")
}
)
# GDX read errors
test_that("test_num_100", {
m = Container$new()
i = Set$new(m, "i")
# read all symbols: expect error because i already exists
expect_error(m$read(testthat::test_path("testdata","test95.gdx")))
m2 = Container$new()
m2$read(testthat::test_path("testdata","test95.gdx"))
# read all symbols: expect error because i already exists
expect_error(m$read(m2))
#read container into container
m = Container$new(m2)
expect_equal(m$listSymbols(), m2$listSymbols())
# expect error on reading only alias
m = Container$new()
expect_error(m$read(testthat::test_path("testdata","test95.gdx"), symbols="ip"))
# expect error if user wants to read a symbol from another container but it doesn't exist
m = Container$new()
expect_error(m$read(m2, symols="j"))
# expect error on reading only alias
m2 = Container$new()
expect_error(m2$read(testthat::test_path("testdata","test95.gdx"), symols="ip"))
}
)
# alias duplicaterecords
test_that("test_num_101", {
m = Container$new()
i = Set$new(m, "i", records=replicate(5, "i1"))
ip = Alias$new(m, "ip", i)
expect_equal(ip$countDuplicateRecords(), 4)
expect_equal(ip$findDuplicateRecords(), ip$records[2:5, , drop=FALSE])
expect_true(ip$hasDuplicateRecords())
ip$dropDuplicateRecords()
expect_equal(nrow(i$records), 1)
}
)
#summary test
test_that("test_num_102", {
m = Container$new()
# expect_error(m$read(testthat::test_path("testdata", "trnsport_with_alias.gdx"), records="true"))
m = Container$new()
m$read(testthat::test_path("testdata", "trnsport_with_alias.gdx"))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "trnsport_with_alias.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
expect_equal(m["i"]$summary, list(
name = "i",
description = "canning plants",
isSingleton = FALSE,
domain = "*",
domainType = "none",
dimension = 1,
numberRecords = 2
))
expect_equal(m["d"]$summary, list(
name = "d",
description = "distance in thousands of miles",
domain = c("i","j"),
domainType = "regular",
dimension = 2,
numberRecords = 6
))
expect_equal(m["x"]$summary, list(
name = "x",
description = "shipment quantities in cases",
type = "positive",
domain = c("i","j"),
domainType = "regular",
dimension = 2,
numberRecords = 6
))
expect_equal(m["demand"]$summary, list(
name = "demand",
description = "satisfy demand at market j",
type = "geq",
domain = "j",
domainType = "regular",
dimension = 1,
numberRecords = 3
))
expect_equal(m["ip"]$summary, list(
name = "ip",
description = "canning plants",
aliasWith = "i",
isSingleton = FALSE,
domain = "*",
domainType = "none",
dimension = 1,
numberRecords = 2
))
# container
m = Container$new()
m = Container$new()
m$read(testthat::test_path("testdata", "trnsport_with_alias.gdx"))
expect_equal(m["i"]$summary, list(
name = "i",
description = "canning plants",
isSingleton = FALSE,
domain = "*",
domainType = "none",
dimension = 1,
numberRecords = 2
))
expect_equal(m["d"]$summary, list(
name = "d",
description = "distance in thousands of miles",
domain = c("i", "j"),
domainType = "regular",
dimension = 2,
numberRecords = 6
))
expect_equal(m["x"]$summary, list(
name = "x",
description = "shipment quantities in cases",
type = "positive",
domain = c("i","j"),
domainType = "regular",
dimension = 2,
numberRecords = 6
))
expect_equal(m["demand"]$summary, list(
name = "demand",
description = "satisfy demand at market j",
type = "geq",
domain = "j",
domainType = "regular",
dimension = 1,
numberRecords = 3
))
expect_equal(m["ip"]$summary, list(
name = "ip",
description = "canning plants",
aliasWith = "i",
isSingleton = FALSE,
domain = "*",
domainType = "none",
dimension = 1,
numberRecords = 2
))
}
)
#test partial write
test_that("test_num_103", {
m = Container$new(testthat::test_path("testdata", "trnsport.gdx"))
m$write("partial_write.gdx", symbols="a")
m1 = Container$new("partial_write.gdx")
expect_equal(m1["a"]$domain, "i")
expect_equal(m1["a"]$domainType, "relaxed")
m$write("partial_write.gdx", symbols="a", mode="string")
m1 = Container$new("partial_write.gdx")
expect_equal(m1["a"]$domain, "i")
expect_equal(m1["a"]$domainType, "relaxed")
# test the super call write
writeList = m$asList()
writeGDX(writeList, "partial_write.gdx", symbols="a")
m1 = Container$new("partial_write.gdx")
expect_equal(m1["a"]$domain, "i")
expect_equal(m1["a"]$domainType, "relaxed")
}
)
#test symbols argument container methods
test_that("test_num_104", {
m = Container$new()
i = Set$new(m, "i", records=paste0("i", 1:10))
j = Set$new(m, "j", records=paste0("j", 1:5))
p_dv = Parameter$new(m, "p_dv", domain=c(i, j), records = data.frame(c("i1","i12","i0","i5"), c("j2", "j6", "j1", "j0"), 11:14))
p_dup = Parameter$new(m, "p_dup", domain=c(i, j), records = data.frame(c("i1","i1","i3","i5"), c("j2", "j2", "j1", "j2"), c(11, 13, 12, 14)))
dv = m$getDomainViolations(symbols="p_dv")
expect_equal(length(dv), 2)
expect_true(m$hasDomainViolations())
expect_true(!m$hasDomainViolations(symbols="p_dup"))
expect_true(m$hasDomainViolations(symbols="p_dv"))
expect_true(m$hasDuplicateRecords())
expect_true(!m$hasDuplicateRecords(symbols="p_dv"))
expect_true(m$hasDuplicateRecords(symbols="p_dup"))
m$dropDomainViolations(symbols="p_dup") # should do nothing
expect_true(m$hasDomainViolations())
dv = m$getDomainViolations(symbols="p_dv")
expect_equal(length(dv), 2)
m$dropDuplicateRecords(symbols="p_dv") # should do nothing
dups = m$countDuplicateRecords(symbols="p_dup")
expect_equal(dups, list(p_dup=1))
m$dropDomainViolations(symbols="p_dv")
expect_true(!m$hasDomainViolations())
dv = m$getDomainViolations(symbols="p_dv")
expect_true(is.null(dv))
m$dropDuplicateRecords(symbols="p_dv") # should do nothing
dups = m$countDuplicateRecords(symbols="p_dup")
expect_equal(dups, list(p_dup=1))
}
)
# test equals
test_that("test_num_105", {
# set comparison
m = Container$new()
i = Set$new(m, "i")
j = Set$new(m, "j")
expect_false(i$equals(j))
expect_true(i$equals(j, checkMetaData = FALSE))
expect_error(i$equals(j, checkMetaData = FALSE, verbose=10))
# error because of domain type mismatch
m = Container$new()
i = Set$new(m, "i")
j = Set$new(m, "j", i)
expect_false(i$equals(j, checkMetaData = FALSE))
expect_error(v1$equals(v2, checkMetaData = FALSE, checkElementText=6))
# error because of validity
j$records = data.frame(i=c("j1","j2"), j= c("k1","k2"), k = c("l1","l2"))
expect_error(i$equals(j, checkMetaData = FALSE))
expect_error(j$equals(i, checkMetaData = FALSE))
# other type error
expect_error(i$equals(2))
#columns arg
p1 = Parameter$new(m, "p1")
p2 = Parameter$new(m, "p2")
v1 = Variable$new(m, "v1")
v2 = Variable$new(m, "v2")
expect_error(v1$equals(v2, checkUELs=2, checkMetaData=FALSE))
expect_error(v1$equals(v2, checkMetaData=6))
expect_error(v1$equals(v2, checkMetaData=FALSE, atol=TRUE))
expect_error(v1$equals(v2, checkMetaData=FALSE, rtol=TRUE))
expect_error(v1$equals(v2, checkMetaData=FALSE, atol= c(1, 2)))
expect_error(v1$equals(v2, columns=c("blah1", "blah2"), checkMetaData=FALSE, rtol= 0))
m = Container$new()
i = Set$new(m, "i", records=c("i1","i2"))
j = Set$new(m, "j", records=c("j1","j2"))
e0 = Equation$new(m, "e0", type = "eq", description="empty eq from m")
e1 = Equation$new(m, "e1", type = "eq", domain=c(i, j))
e2 = Equation$new(m, "e2", type = "eq", domain= i)
e2a = Equation$new(m, "e2a", type = "eq", domain= i, records=data.frame(i="i1", level=1))
e2b = Equation$new(m, "e2b", type = "eq", domain= i)
e3 = Equation$new(m, "e3", type = "eq", domain = j)
expect_false(e2$equals(e3))
expect_false(e2$equals(e2a))
expect_false(e2$equals(e2b))
expect_true(e2$equals(e2b, checkMetaData=FALSE))
m2 = Container$new()
e02 = Equation$new(m2, "e0", type="eq", description="empty eq from m2")
expect_true(e02$equals(e0, checkMetaData=FALSE))
expect_false(e02$equals(e0, checkMetaData=TRUE))
m2$removeSymbols("e0")
v02 = Variable$new(m2, "e0", description="empty var from m2")
expect_true(v02$equals(e0, checkMetaData=FALSE))
expect_false(v02$equals(e0, checkMetaData=TRUE))
m = Container$new()
i = Set$new(m, "i", records=c("i1","i2"))
i$setUELs(c("i1","i2","i3","i4"))
m2 = Container$new()
i2 = Set$new(m2, "i", records=c("i1","i2"))
expect_false(i$equals(i2, checkUELs=TRUE))
expect_true(i$equals(i2, checkUELs=FALSE))
# element text
m = Container$new()
i = Set$new(m, "i", records=data.frame(c("i1","i2")))
m2 = Container$new()
i2 = Set$new(m2, "i", records=data.frame(c("i1","i2"), c("first elemnt", "second element")))
expect_true(i$equals(i2, checkElementText=FALSE))
expect_false(i$equals(i2))
# compare records
m = Container$new()
i1 = Set$new(m, "i1", records=data.frame(c("i1","i2")))
i2 = Set$new(m, "i2", records=data.frame(c("i2","i3")))
expect_false(i1$equals(i2, checkMetaData=FALSE))
#parameter records comparison
m = Container$new()
p1 = Parameter$new(m, "p1", records=SpecialValues[["NA"]])
p2 = Parameter$new(m, "p2", records=SpecialValues[["NA"]])
p3 = Parameter$new(m, "p3", records=SpecialValues[["EPS"]])
expect_true(p1$equals(p2, checkMetaData=FALSE))
expect_false(p1$equals(p3, checkMetaData=FALSE))
m = Container$new()
p1 = Parameter$new(m, "p1", records=SpecialValues[["EPS"]])
p2 = Parameter$new(m, "p2", records=SpecialValues[["EPS"]])
p3 = Parameter$new(m, "p3", records=SpecialValues[["UNDEF"]])
expect_true(p1$equals(p2, checkMetaData=FALSE))
expect_false(p1$equals(p3, checkMetaData=FALSE))
m = Container$new()
p1 = Parameter$new(m, "p1", records=SpecialValues[["UNDEF"]])
p2 = Parameter$new(m, "p2", records=SpecialValues[["UNDEF"]])
p3 = Parameter$new(m, "p3", records=SpecialValues[["NA"]])
expect_true(p1$equals(p2, checkMetaData=FALSE))
expect_false(p1$equals(p3, checkMetaData=FALSE))
#scalar
m = Container$new()
p1 = Parameter$new(m, "p1", records=10)
p2 = Parameter$new(m, "p2", records=10)
p3 = Parameter$new(m, "p3", records=5)
expect_true(p1$equals(p2, checkMetaData=FALSE))
expect_false(p1$equals(p3, checkMetaData=FALSE))
# 1D param
m = Container$new()
i = Set$new(m, "i", records=c("i1","i2","i3"))
p1 = Parameter$new(m, "p1", domain=i, records=data.frame(c("i1","i2","i3"), c(2,4,5)))
p2 = Parameter$new(m, "p2", domain=i, records=data.frame(c("i1","i2","i3"), c(3,5,5)))
expect_false(p1$equals(p2, checkMetaData=FALSE))
# 2D param with special values
m = Container$new()
i = Set$new(m, "i", records=c("i1","i2","i3"))
j = Set$new(m, "j", records=c("j1","j2","j3"))
p1 = Parameter$new(m, "p1", domain=c(i, j), records=data.frame(c("i1","i2","i3"),c("j1","j2","j3"), c(SpecialValues[["NA"]],4,SpecialValues$UNDEF)))
p2 = Parameter$new(m, "p2", domain=c(i, j), records=data.frame(c("i1","i2","i3"),c("j1","j2","j3"), c(SpecialValues$UNDEF,4,SpecialValues[["NA"]])))
p3 = Parameter$new(m, "p3", domain=c(i, j), records=data.frame(c("i1","i2","i3"),c("j1","j2","j3"), c(SpecialValues[["NA"]],5,SpecialValues$UNDEF)))
expect_false(p1$equals(p2, checkMetaData=FALSE))
expect_false(p1$equals(p3, checkMetaData=FALSE))
# variable
m = Container$new()
v0 = Variable$new(m, "v0", records=data.frame(level=3))
v0p = Variable$new(m, "v0p", records=data.frame(level=2.99))
expect_true(v0$equals(v0p, checkMetaData=FALSE, atol=0.1))
expect_true(v0$equals(v0p, columns="level",checkMetaData=FALSE, atol=0.1))
expect_true(v0$equals(v0p, checkMetaData=FALSE, atol=0.1))
expect_true(v0$equals(v0p,columns=c("level", "marginal"), checkMetaData=FALSE, atol=0.1))
expect_false(v0$equals(v0p, columns=c("level", "marginal"), checkMetaData=FALSE, atol=0))
expect_error(v0$equals(v0p, checkMetaData=FALSE, atol=c(level=0, scale=0.1), rtol=c(marginal=0, scale=0.1)))
expect_error(v0$equals(v0p, checkMetaData=FALSE, atol=c(level=0, scale=0.1), verbose=TRUE))
m = Container$new()
i = Set$new(m, "i", records=paste0("i",1:5))
v1 = Variable$new(m, "v1", domain=i, records=data.frame(c("i1","i4","i5"), level=c(3, 4, 5)))
v1p = Variable$new(m, "v1p",domain=i, records=data.frame(c("i1","i4","i5"), level=c(2.95, 4.03, 5.09)))
expect_true(v1$equals(v1p, columns="level", checkMetaData=FALSE, atol=0.1))
expect_true(v1$equals(v1p, checkMetaData=FALSE, atol=0.1))
expect_false(v1$equals(v1p, columns=c("level", "marginal"), checkMetaData=FALSE, atol=0))
expect_error(v1$equals(v1p, checkMetaData=FALSE, atol=c(level=0, scale=0.1), rtol=c(marginal=0, scale=0.1)))
expect_error(v1$equals(v1p, checkMetaData=FALSE, atol=c(level=0, scale=0.1), verbose=TRUE))
m = Container$new()
i = Set$new(m, "i", records=paste0("i",1:5))
j = Set$new(m, "j", records=paste0("j",1:5))
v2 = Variable$new(m, "v2", domain=c(i, j), records=data.frame(c("i1","i4","i5"), c("j2","j4","j1"), level=c(3, NA, 5), marginal=c(NaN, 4, 5)))
v2p = Variable$new(m, "v2p",domain=c(i, j), records=data.frame(c("i1","i4","i5"), c("j2","j4","j1"), level=c(2.95, NA, 5.09), marginal=c(NaN, 4, 5)))
expect_true(v1$equals(v1p, columns="level", checkMetaData=FALSE, atol=0.1))
expect_true(v1$equals(v1p, checkMetaData=FALSE, atol=0.1))
expect_true(v1$equals(v1p, columns=c("level", "marginal"), checkMetaData=FALSE, atol=0.1))
expect_false(v1$equals(v1p, columns=c("level", "marginal"), checkMetaData=FALSE, atol=0))
expect_error(v1$equals(v1p, checkMetaData=FALSE, atol=c(level=0, scale=0.1), rtol=c(marginal=0, scale=0.1)))
expect_error(v1$equals(v1p, checkMetaData=FALSE, atol=c(level=0, scale=0.1), verbose=TRUE))
}
)
# test equals for alias and unialias
test_that("test_num_106", {
m = Container$new()
i = Set$new(m, "i", records=c("i1","i2","i3"))
j = Set$new(m, "j", records=c("i1","i2","i3"))
ip = Alias$new(m, "ip", i)
jp = Alias$new(m, "jp", j)
expect_true(i$equals(j, checkMetaData=FALSE))
expect_true(ip$equals(jp, checkMetaData=FALSE))
expect_false(ip$equals(jp, checkMetaData=TRUE))
expect_true(ip$equals(j, checkMetaData=FALSE))
expect_true(i$equals(jp, checkMetaData=FALSE))
u = UniverseAlias$new(m, "u")
up = UniverseAlias$new(m, "up")
expect_true(u$equals(up, checkMetaData=FALSE))
expect_false(u$equals(up))
}
)
# test equals for container and container
test_that("test_num_107", {
m = Container$new()
i = Set$new(m, "i")
m1 = Container$new()
i1 = Set$new(m1, "i")
expect_true(m$equals(m1))
j = Set$new(m1, "j")
expect_false(m$equals(m1))
expect_error(m$equals(m1, verbose=TRUE))
k = Set$new(m, "k")
expect_false(m$equals(m1))
expect_error(m$equals(m1,verbose=TRUE))
}
)
# test partial domain_forwarding
test_that("test_num_107", {
m = Container$new()
i = Set$new(m, "i")
j = Set$new(m, "j")
recs=data.frame(i=c("a","b","c"), j = c("d","e","f"), val=c(1,2,3))
d = Parameter$new(m, "d",domain=c(i, j), records= recs, domainForwarding=
c(TRUE, FALSE))
expect_true(is.null(j$records))
expect_equal(nrow(i$records), 3)
m = Container$new()
i = Set$new(m, "i")
j = Set$new(m, "j")
recs=data.frame(i=c("a","b","c"), j = c("d","e","f"), val=c(1,2,3))
expect_error(Parameter$new(m, "d1",domain=c(i, j), records= recs, domainForwarding=
2))
expect_error(Parameter$new(m, "d2",domain=c(i, j), records= recs, domainForwarding=
C(TRUE, TRUE, FALSE)))
d = Parameter$new(m, "d",domain=c(i, j), records= recs, domainForwarding=
c(FALSE, TRUE))
expect_true(is.null(i$records))
expect_equal(nrow(j$records), 3)
m = Container$new()
i = Set$new(m, "i")
j = Set$new(m, "j")
recs=data.frame(i=c("a","b","c"), j = c("d","e","f"), val=c(1,2,3))
d = Parameter$new(m, "d",domain=c(i, j), records= recs, domainForwarding=
TRUE)
expect_equal(nrow(i$records), 3)
expect_equal(nrow(j$records), 3)
m = Container$new()
i = Set$new(m, "i")
j = Set$new(m, "j")
recs=data.frame(i=c("a","b","c"), j = c("d","e","f"), val=c(1,2,3))
d = Parameter$new(m, "d",domain=c(i, j), records= recs, domainForwarding=
FALSE)
expect_true(is.null(i$records))
expect_true(is.null(j$records))
}
)
# test generateRecords
test_that("test_num_108", {
m = Container$new()
i = Set$new(m, "i", records=paste0("i",1:5))
isub = Set$new(m, "isub", domain=i)
isub$generateRecords()
expect_equal(nrow(isub$records), 5)
p = Parameter$new(m, "p",domain=i)
p$generateRecords(density=1)
expect_equal(nrow(p$records), 5)
p$generateRecords(density=0.5)
expect_equal(nrow(p$records), 2)
# error because runif expects argument n and not size
# expect_error(p$generateRecords(density=1, func=runif))
rg = function(size) {
return(runif(size))
}
p$generateRecords(density=1, func=rg)
expect_equal(nrow(p$records), 5)
rg_error = function() {
return(1)
}
# expect_error(p$generateRecords(func=runif))
j = Set$new(m, "j", records=paste0("j",1:3))
d = Parameter$new(m, "d", domain=c(i, j))
d$generateRecords()
expect_equal(nrow(d$records), 15)
}
)
# test generateRecords for variable and equation
test_that("test_num_109", {
m = Container$new()
i = Set$new(m, "i", records=paste0("i",1:5))
e = Equation$new(m, "e", "eq", domain=i)
e$generateRecords()
expect_equal(nrow(e$records), 5)
expect_true(all(e$records$marginal == 0))
expect_true(all(e$records$lower == 0))
expect_true(all(e$records$upper == 0))
expect_true(all(e$records$scale == 1))
rg = function(size) {
return(runif(n=size))
}
e$generateRecords(func=rg)
expect_equal(nrow(e$records), 5)
expect_true(all(e$records$marginal == 0))
expect_true(all(e$records$lower == 0))
expect_true(all(e$records$upper == 0))
expect_true(all(e$records$scale == 1))
e$generateRecords(func=list(scale=rg))
expect_equal(nrow(e$records), 5)
expect_true(all(e$records$marginal == 0))
expect_true(all(e$records$lower == 0))
expect_true(all(e$records$upper == 0))
expect_true(all(e$records$level == 0))
e$generateRecords(func=list(scale=rg, marginal=rg))
expect_equal(nrow(e$records), 5)
expect_true(all(e$records$lower == 0))
expect_true(all(e$records$upper == 0))
expect_true(all(e$records$level == 0))
expect_equal(colnames(e$records), c("i", "level", "marginal", "lower", "upper", "scale"))
#test the same for variables
m = Container$new()
i = Set$new(m, "i", records=paste0("i",1:5))
v = Variable$new(m, "v", "binary", domain=i)
v$generateRecords()
expect_equal(nrow(v$records), 5)
expect_true(all(v$records$marginal == 0))
expect_true(all(v$records$lower == 0))
expect_true(all(v$records$upper == 1))
expect_true(all(v$records$scale == 1))
rg = function(size) {
return(runif(n=size))
}
v$generateRecords(func=rg)
expect_equal(nrow(v$records), 5)
expect_true(all(v$records$marginal == 0))
expect_true(all(v$records$lower == 0))
expect_true(all(v$records$upper == 1))
expect_true(all(v$records$scale == 1))
v$generateRecords(func=list(scale=rg))
expect_equal(nrow(v$records), 5)
expect_true(all(v$records$marginal == 0))
expect_true(all(v$records$lower == 0))
expect_true(all(v$records$upper == 1))
expect_true(all(v$records$level == 0))
v$generateRecords(func=list(scale=rg, marginal=rg))
expect_equal(nrow(v$records), 5)
expect_true(all(v$records$lower == 0))
expect_true(all(v$records$upper == 1))
expect_true(all(v$records$level == 0))
expect_equal(colnames(v$records), c("i", "level", "marginal", "lower", "upper", "scale"))
# try scalar variables and equations
m = Container$new()
e0 = Equation$new(m, "e0", "eq")
v0 = Variable$new(m, "v0", "binary")
e0$generateRecords()
expect_equal(colnames(e0$records), c("level", "marginal", "lower", "upper", "scale"))
expect_true(all(e0$records$marginal == 0))
expect_true(all(e0$records$lower == 0))
expect_true(all(e0$records$upper == 0))
expect_true(all(e0$records$scale == 1))
v0$generateRecords()
expect_equal(colnames(v0$records), c("level", "marginal", "lower", "upper", "scale"))
expect_true(all(v0$records$marginal == 0))
expect_true(all(v0$records$lower == 0))
expect_true(all(v0$records$upper == 1))
expect_true(all(v0$records$scale == 1))
}
)
# test generateRecords for multidimensional
test_that("test_num_110", {
m = Container$new()
i = Set$new(m, "i", records=paste0("i", 1:50))
j = Set$new(m, "j", records=paste0("j", 1:50))
k = Set$new(m, "k", records=paste0("k", 1:50))
l = Set$new(m, "l", records=paste0("l", 1:50))
# create and define the symbol `a` with `regular` domains
a = Set$new(m, "a", c(i, j, k, l))
# generate the records
a$generateRecords(density = 0.05)
expect_equal(nrow(a$records), (50**4)/20)
}
)
# write empty gdx
test_that("test_num_111", {
skip_if_no_gams()
m = Container$new()
expect_true(is.null(m$write("empty.gdx")))
expect_true(is.null(m$write("empty.gdx", mode="string")))
# test the super call write
writeList = m$asList()
writeGDX(writeList, "empty.gdx")
# write empty gdx with uelPriority
m$write("gt.gdx", uelPriority = c("i1","i2","i3"))
system2(command="gdxdump", args=
"gt.gdx uelTable=foo",
stdout = "foo.gms")
system2(command="gams", args=
"foo.gms gdx=foo.gdx lo=0",
stdout = FALSE)
m = Container$new("foo.gdx")
expect_equal(m$getUELs(), c("i1","i2","i3"))
writeGDX(writeList, "gt.gdx", uelPriority = c("i1","i2","i3"))
system2(command="gdxdump", args=
"gt.gdx uelTable=foo",
stdout = "foo.gms")
system2(command="gams", args=
"foo.gms gdx=foo.gdx lo=0",
stdout = FALSE)
m = Container$new("foo.gdx")
expect_equal(m$getUELs(), c("i1","i2","i3"))
}
)
# test copy
test_that("test_num_112", {
m = Container$new()
i = Set$new(m, "i", records=paste0("i", 1:50))
p = Parameter$new(m, "p")
v = Variable$new(m, "v")
e = Equation$new(m, "e", type="eq")
m2 = Container$new()
i$copy(m2)
p$copy(m2)
v$copy(m2)
e$copy(m2)
m3 = Container$new()
i = Set$new(m3, "i")
p = Parameter$new(m3, "p")
v = Variable$new(m3, "v")
e = Equation$new(m3, "e", type="eq")
expect_error(i$copy(m2))
expect_true(is.null(i$copy(m2, overwrite=TRUE )))
expect_error(p$copy(m2))
expect_true(is.null(p$copy(m2, overwrite=TRUE )))
expect_error(v$copy(m2))
expect_true(is.null(v$copy(m2, overwrite=TRUE )))
expect_error(e$copy(m2))
expect_true(is.null(e$copy(m2, overwrite=TRUE )))
m = Container$new()
i = Set$new(m, "i")
m2 = Container$new()
i1 = Parameter$new(m2, "i")
p = Parameter$new(m2, "p")
expect_error(i$copy(m2))
expect_error(i$copy(i))
expect_error(p$copy(m, overwrite="true"))
m = Container$new()
i = Set$new(m, "i")
p = Parameter$new(m, "p", domain=i)
m2 = Container$new()
p$copy(m2)
expect_equal(m2["p"]$domain[[1]], "i")
expect_equal(m2["p"]$domainType, "relaxed")
i2 = Set$new(m2, "i", domain=c("*","*"))
i2$copy(m, overwrite=TRUE)
expect_equal(p$domain[[1]]$dimension, 2)
# todo
expect_equal(p$isValid(force=TRUE), FALSE)
m = Container$new()
i = Set$new(m, "i", records=c("i1","i2"))
m2 = Container$new()
i2 = Set$new(m2, "i", records=c("newi", "newi_1"))
i2$copy(m, overwrite=TRUE)
expect_equal(as.character(i$records[[1]]), c("newi", "newi_1"))
}
)
# test copy for alias and universe alias
test_that("test_num_113", {
m = Container$new()
i = Set$new(m, "i")
ii = Alias$new(m, "ii", i)
m2 = Container$new()
# ii$copy(m2)
# expect_equal(m2$listSymbols(), c("i","ii"))
u = UniverseAlias$new(m, "u")
u$copy(m2)
# expect_equal(m2$listSymbols(), c("i","ii","u"))
expect_equal(m2$listSymbols(), c("u"))
}
)
# test copy container method
test_that("test_num_114", {
m = Container$new(testthat::test_path("testdata", "trnsport.gdx"))
m2 = Container$new()
m$copy(m2)
expect_equal(m2$listSymbols(), m$listSymbols())
m2 = Container$new()
m$copy(m2, symbols=c("f","d"))
expect_equal(m2$listSymbols(), c("f","d"))
expect_error(m$copy(m2, "d"))
m$copy(m2, "d", overwrite=TRUE)
expect_equal(m2$listSymbols(), c("f","d"))
}
)
# test copy Container method
test_that("test_num_115", {
m = Container$new(testthat::test_path("testdata", "trnsport.gdx"))
m2 = Container$new()
m$copy(m2)
expect_equal(m2$listSymbols(), m$listSymbols())
m2 = Container$new()
m$copy(m2, symbols=c("f","d"))
expect_equal(m2$listSymbols(), c("f","d"))
expect_error(m$copy(m2, "d"))
m$copy(m2, "d", overwrite=TRUE)
expect_equal(m2$listSymbols(), c("f","d"))
}
)
# test copy for alias and universe alias
test_that("test_num_116", {
m = Container$new(testthat::test_path("testdata", "test95.gdx"))
m2 = Container$new()
m["h"]$copy(m2)
# expect_equal(m2$listSymbols(), c("i","ii","u"))
expect_equal(m2$listSymbols(), c("h"))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "test95.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
}
)
# test reading symbols with unused uels from gdx
test_that("test_num_117", {
m = Container$new()
i = Set$new(m, "i", records=paste0("i", 1:5))
isub = Set$new(m, "isub", domain=i, records=c("i1","i2"))
isub$setUELs(paste0("i",1:5))
m$write("gt.gdx")
m2 = Container$new(testthat::test_path("gt.gdx"))
expect_equal(m["isub"]$getUELs(), paste0("i",1:5))
m$write("gt.gdx", mode="string")
m2 = Container$new(testthat::test_path("gt.gdx"))
expect_equal(m["isub"]$getUELs(), paste0("i",1:5))
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
m2 = Container$new(testthat::test_path("gt.gdx"))
expect_equal(m["isub"]$getUELs(), paste0("i",1:5))
}
)
# test isScalar for symbols
test_that("test_num_118", {
m = Container$new()
p = Parameter$new(m, "p")
expect_true(p$isScalar)
v = Variable$new(m, "v", type="free")
expect_true(v$isScalar)
e = Equation$new(m, "e", type="eq")
expect_true(e$isScalar)
m$write("gt.gdx")
m2 = Container$new()
m2$read(testthat::test_path("gt.gdx"))
expect_true(m2["p"]$isScalar)
expect_true(m2["v"]$isScalar)
expect_true(m2["e"]$isScalar)
m$write("gt.gdx", mode="string")
m2 = Container$new()
m2$read(testthat::test_path("gt.gdx"))
expect_true(m2["p"]$isScalar)
expect_true(m2["v"]$isScalar)
expect_true(m2["e"]$isScalar)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
m2 = Container$new()
m2$read(testthat::test_path("gt.gdx"))
expect_true(m2["p"]$isScalar)
expect_true(m2["v"]$isScalar)
expect_true(m2["e"]$isScalar)
}
)
# test Scalars with more records isvalid
test_that("test_num_119", {
m = Container$new()
p = Parameter$new(m, "p")
p$setRecords(data.frame(value=c(1,2)))
expect_false(p$isValid())
v = Variable$new(m, "v", type="free")
v$setRecords(data.frame(level=c(1,2)))
expect_false(v$isValid())
e = Equation$new(m, "e", type="eq")
e$setRecords(data.frame(level=c(1,2)))
expect_false(e$isValid())
}
)
# test description of length > 255
test_that("test_num_119", {
m = Container$new()
i = Set$new(m, "i")
a = paste0(rep("m",255), collapse = "")
i$description = a
a = paste0(rep("m",256), collapse = "")
expect_error({i$description = a})
}
)
# reorderUELs with null argument
test_that("test_num_120", {
m = Container$new()
i = Set$new(m, "i", records = paste0("i", c(1,2,4,3)))
i$setUELs(paste0("i", 1:5))
expect_equal(i$getUELs(), paste0("i", 1:5))
i$reorderUELs()
expect_equal(i$getUELs(), paste0("i", c(1,2,4,3, 5)))
a = Parameter$new(m, "p", domain=c(i, i), records=data.frame(i=c("i1","i5","i3"), i=c("i2","i4","i1"), value=c(1,3,4)))
expect_equal(a$getUELs(1), c("i1","i5","i3"))
expect_equal(a$getUELs(2), c("i2","i4","i1"))
a$setUELs(uels=paste0("i", 1:5), dimension=1)
a$setUELs(uels=paste0("i", 1:5), dimension=2)
expect_equal(a$getUELs(1), paste0("i", 1:5))
expect_equal(a$getUELs(2), paste0("i", 1:5))
a$reorderUELs(dimension=1)
expect_equal(a$getUELs(1), c("i1","i5","i3", "i2","i4"))
a$reorderUELs(dimension=2)
expect_equal(a$getUELs(2), c("i2","i4","i1", "i3","i5"))
}
)
# todense uel checks
test_that("test_num_121", {
m = Container$new()
i = Set$new(m, "i", records = paste0("i", c(1,2,4,3)))
a = Parameter$new(m, "a", domain=i, records=data.frame(i = c("i1","i3"), value=c(1,3)))
expect_equal(a$toDense(), array(c(1, 0, 0, 3)))
i$setUELs(paste0("i", 1:5))
i$reorderUELs(paste0("i", c(1,2,4,3, 5)))
# unused uels at the end are okay
expect_equal(a$toDense(), array(c(1, 0, 0, 3)))
i$reorderUELs(paste0("i", c(1,2,5, 4,3)))
expect_error(a$toDense())
# now the order of UELs is different from that of the records
i$setUELs(paste0("i", 1:4))
expect_error(a$toDense())
}
)
# case insensitive check
test_that("test_num_122", {
m = Container$new()
m$read(testthat::test_path("testdata","trnsport.gdx"), "x")
expect_true(!is.null(m["x"]))
expect_true(!is.null(m["X"]))
expect_true(is.null(m["d"]))
}
)
# describe aliases
test_that("test_num_123", {
m = Container$new()
expect_error(m$read(testthat::test_path("testdata","trnsport_with_alias.gdx"), "ip"))
m$read(testthat::test_path("testdata","trnsport_with_alias.gdx"))
m$describeAliases()
}
)
# domain linking test on GDX read
test_that("test_num_124", {
m = Container$new()
m$read(testthat::test_path("testdata","trnsport.gdx"))
expect_equal(m["d"]$domain, c(m["i"], m["j"]))
# subset of symbols in a different order
m1 = Container$new()
m1$read(testthat::test_path("testdata","trnsport.gdx"), c("d","i","j"))
expect_equal(m1["d"]$domain, c(m1["i"], m1["j"]))
# check the same for container read
m1 = Container$new()
m1$read(m, c("d","i","j"))
expect_equal(m1["d"]$domain, c(m1["i"], m1["j"]))
# subset of symbols one string one regular
m1 = Container$new()
m1$read(testthat::test_path("testdata","trnsport.gdx"), c("d","i"))
expect_equal(m1["d"]$domain, c(m1["i"], "j"))
# check the same for container read
m1 = Container$new()
m1$read(m, c("d","i"))
expect_equal(m1["d"]$domain, c(m1["i"], "j"))
# ensure that symbols are not linked using names
m = Container$new()
j = Set$new(m, "j", records=paste0("j",1:10))
i = Set$new(m, "i", records=paste0("i",1:10))
p = Parameter$new(m, "p", domain=c("j"), records = data.frame(j=paste0("i",1:10), 1:10))
m$write("gt.gdx")
writeList = m$asList()
m = Container$new("gt.gdx")
expect_equal(m["p"]$domain, "j")
expect_false(m["p"]$hasDomainViolations())
# check the same for container read
m2 = Container$new()
m2$read(m)
expect_equal(m2["p"]$domain, "j")
expect_false(m2["p"]$hasDomainViolations())
m$write("gt.gdx", mode="string")
m = Container$new("gt.gdx")
expect_equal(m["p"]$domain, "j")
expect_false(m["p"]$hasDomainViolations())
# check the same for container read
m2 = Container$new()
m2$read(m)
expect_equal(m2["p"]$domain, "j")
expect_false(m2["p"]$hasDomainViolations())
writeGDX(writeList, "gt.gdx")
m = Container$new("gt.gdx")
expect_equal(m["p"]$domain, "j")
expect_false(m["p"]$hasDomainViolations())
# check the same for container read
m2 = Container$new()
m2$read(m)
expect_equal(m2["p"]$domain, "j")
expect_false(m2["p"]$hasDomainViolations())
}
)
# domain linking test on GDX read when domain symbol exists
# in the container but is not read from GDX
test_that("test_num_125", {
m = Container$new()
i = Set$new(m, "i")
m$read(testthat::test_path("testdata","trnsport.gdx"), "d")
expect_equal(m["d"]$domain, c("i", "j"))
}
)
# extensive partial column tests
test_that("test_num_126", {
# data frames with only domain - equation
for (t in c("eq","geq","leq","nonbinding", "cone", "external", "boolean")) {
m = Container$new()
e = Equation$new(m, "e", type=t, domain="*", records = data.frame(i=c("i1","i2","i3")))
expect_equal(m$listSymbols(), c("e"))
expect_equal(colnames(m["e"]$records), "i")
expect_equal(length(m["e"]$records), 1)
expect_true(m["e"]$isValid())
m$write("partial_equation.gdx")
m1 = Container$new("partial_equation.gdx")
expect_equal(m1$listSymbols(), "e")
expect_equal(colnames(m1["e"]$records), c("uni", "level", "marginal", "lower", "upper", "scale"))
expect_equal(length(m1["e"]$records), 6)
for (i in c("level", "marginal", "lower", "upper", "scale")) {
expect_equal(m1["e"]$records[,i], replicate(m["e"]$numberRecords, m["e"]$defaultValues[[i]]))
}
m$write("partial_equation.gdx", mode="string")
m1 = Container$new("partial_equation.gdx")
expect_equal(m1$listSymbols(), "e")
expect_equal(colnames(m1["e"]$records), c("uni", "level", "marginal", "lower", "upper", "scale"))
expect_equal(length(m1["e"]$records), 6)
for (i in c("level", "marginal", "lower", "upper", "scale")) {
expect_equal(m1["e"]$records[,i], replicate(m["e"]$numberRecords, m["e"]$defaultValues[[i]]))
}
# test the super call write
writeList = m$asList()
writeGDX(writeList, "partial_equation.gdx")
m1 = Container$new("partial_equation.gdx")
expect_equal(m1$listSymbols(), "e")
expect_equal(colnames(m1["e"]$records), c("uni", "level", "marginal", "lower", "upper", "scale"))
expect_equal(length(m1["e"]$records), 6)
for (i in c("level", "marginal", "lower", "upper", "scale")) {
expect_equal(m1["e"]$records[,i], replicate(m["e"]$numberRecords, m["e"]$defaultValues[[i]]))
}
}
# data frames with only domain - variable
for (t in c("binary", "integer", "positive", "negative", "free", "sos1", "sos2", "semicont", "semiint")) {
m = Container$new()
v = Variable$new(m, "v", type=t, domain="*", records = data.frame(i=c("i1","i2","i3")))
expect_equal(m$listSymbols(), c("v"))
expect_equal(colnames(m["v"]$records), "i")
expect_equal(length(m["v"]$records), 1)
expect_true(m["v"]$isValid())
m$write("partial_variable.gdx")
m1 = Container$new("partial_variable.gdx")
expect_equal(m1$listSymbols(), "v")
expect_equal(colnames(m1["v"]$records), c("uni", "level", "marginal", "lower", "upper", "scale"))
expect_equal(length(m1["v"]$records), 6)
for (i in c("level", "marginal", "lower", "upper", "scale")) {
expect_equal(m1["v"]$records[,i], replicate(m["v"]$numberRecords, m["v"]$defaultValues[[i]]))
}
m$write("partial_variable.gdx", mode="string")
m1 = Container$new("partial_variable.gdx")
expect_equal(m1$listSymbols(), "v")
expect_equal(colnames(m1["v"]$records), c("uni", "level", "marginal", "lower", "upper", "scale"))
expect_equal(length(m1["v"]$records), 6)
for (i in c("level", "marginal", "lower", "upper", "scale")) {
expect_equal(m1["v"]$records[,i], replicate(m["v"]$numberRecords, m["v"]$defaultValues[[i]]))
}
# test the super call write
writeList = m$asList()
writeGDX(writeList, "partial_variable.gdx")
m1 = Container$new("partial_variable.gdx")
expect_equal(m1$listSymbols(), "v")
expect_equal(colnames(m1["v"]$records), c("uni", "level", "marginal", "lower", "upper", "scale"))
expect_equal(length(m1["v"]$records), 6)
for (i in c("level", "marginal", "lower", "upper", "scale")) {
expect_equal(m1["v"]$records[,i], replicate(m["v"]$numberRecords, m["v"]$defaultValues[[i]]))
}
}
# data frames with only domain - parameter
m = Container$new()
p = Parameter$new(m, "p", domain="*", records = data.frame(i=c("i1","i2","i3")))
expect_equal(m$listSymbols(), c("p"))
expect_equal(colnames(m["p"]$records), "i")
expect_equal(length(m["p"]$records), 1)
expect_true(m["p"]$isValid())
m$write("partial_parameter.gdx")
m1 = Container$new("partial_parameter.gdx")
expect_equal(m1$listSymbols(), "p")
expect_equal(colnames(m1["p"]$records), c("uni", "value"))
expect_equal(length(m1["p"]$records), 2)
expect_equal(m1["p"]$records[,"value"], replicate(m["p"]$numberRecords, 0))
m$write("partial_parameter.gdx", mode="string")
m1 = Container$new("partial_parameter.gdx")
expect_equal(m1$listSymbols(), "p")
expect_equal(colnames(m1["p"]$records), c("uni", "value"))
expect_equal(length(m1["p"]$records), 2)
expect_equal(m1["p"]$records[,"value"], replicate(m["p"]$numberRecords, 0))
# test the super call write
writeList = m$asList()
writeGDX(writeList, "partial_parameter.gdx")
m1 = Container$new("partial_parameter.gdx")
expect_equal(m1$listSymbols(), "p")
expect_equal(colnames(m1["p"]$records), c("uni", "value"))
expect_equal(length(m1["p"]$records), 2)
expect_equal(m1["p"]$records[,"value"], replicate(m["p"]$numberRecords, 0))
# data frames with only domain - set
m = Container$new()
s = Set$new(m, "s", records = data.frame(i=c("i1","i2","i3")))
expect_equal(m$listSymbols(), c("s"))
expect_equal(colnames(m["s"]$records), "i")
expect_equal(length(m["s"]$records), 1)
expect_true(m["s"]$isValid())
m$write("partial_set.gdx")
m1 = Container$new("partial_set.gdx")
expect_equal(m1$listSymbols(), "s")
expect_equal(colnames(m1["s"]$records), c("uni", "element_text"))
expect_equal(length(m1["s"]$records), 2)
m$write("partial_set.gdx", mode="string")
m1 = Container$new("partial_set.gdx")
expect_equal(m1$listSymbols(), "s")
expect_equal(colnames(m1["s"]$records), c("uni", "element_text"))
expect_equal(length(m1["s"]$records), 2)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "partial_set.gdx")
m1 = Container$new("partial_set.gdx")
expect_equal(m1$listSymbols(), "s")
expect_equal(colnames(m1["s"]$records), c("uni", "element_text"))
expect_equal(length(m1["s"]$records), 2)
# data frames with domain + missing attribute columns - equation
for (t in c("eq","geq","leq","nonbinding", "cone", "external", "boolean")) {
m = Container$new()
e = Equation$new(m, "e", type=t, domain="*", records = data.frame(i=c("i1","i2","i3"), marginal=c(10, 10, 10)))
expect_equal(m$listSymbols(), c("e"))
expect_equal(colnames(m["e"]$records), c("i", "marginal"))
expect_equal(length(m["e"]$records), 2)
expect_true(m["e"]$isValid())
m$write("partial_equation.gdx")
m1 = Container$new("partial_equation.gdx")
expect_equal(m1$listSymbols(), "e")
expect_equal(colnames(m1["e"]$records), c("uni", "level", "marginal", "lower", "upper", "scale"))
expect_equal(length(m1["e"]$records), 6)
for (i in c("level", "lower", "upper", "scale")) {
expect_equal(m1["e"]$records[,i], replicate(m["e"]$numberRecords, m["e"]$defaultValues[[i]]))
}
expect_equal(m1["e"]$records[,"marginal"], replicate(m["e"]$numberRecords, 10))
m$write("partial_equation.gdx", mode="string")
m1 = Container$new("partial_equation.gdx")
expect_equal(m1$listSymbols(), "e")
expect_equal(colnames(m1["e"]$records), c("uni", "level", "marginal", "lower", "upper", "scale"))
expect_equal(length(m1["e"]$records), 6)
for (i in c("level", "lower", "upper", "scale")) {
expect_equal(m1["e"]$records[,i], replicate(m["e"]$numberRecords, m["e"]$defaultValues[[i]]))
}
expect_equal(m1["e"]$records[,"marginal"], replicate(m["e"]$numberRecords, 10))
# test the super call write
writeList = m$asList()
writeGDX(writeList, "partial_equation.gdx")
m1 = Container$new("partial_equation.gdx")
expect_equal(m1$listSymbols(), "e")
expect_equal(colnames(m1["e"]$records), c("uni", "level", "marginal", "lower", "upper", "scale"))
expect_equal(length(m1["e"]$records), 6)
for (i in c("level", "lower", "upper", "scale")) {
expect_equal(m1["e"]$records[,i], replicate(m["e"]$numberRecords, m["e"]$defaultValues[[i]]))
}
expect_equal(m1["e"]$records[,"marginal"], replicate(m["e"]$numberRecords, 10))
}
# data frames with domain + missing attribute columns - variable
for (t in c("binary", "integer", "positive", "negative", "free", "sos1", "sos2", "semicont", "semiint")) {
m = Container$new()
v = Variable$new(m, "v", type=t, domain="*", records = data.frame(i=c("i1","i2","i3"), marginal=c(10, 10, 10)))
expect_equal(m$listSymbols(), c("v"))
expect_equal(colnames(m["v"]$records), c("i", "marginal"))
expect_equal(length(m["v"]$records), 2)
expect_true(m["v"]$isValid())
m$write("partial_variable.gdx")
m1 = Container$new("partial_variable.gdx")
expect_equal(m1$listSymbols(), "v")
expect_equal(colnames(m1["v"]$records), c("uni", "level", "marginal", "lower", "upper", "scale"))
expect_equal(length(m1["v"]$records), 6)
for (i in c("level", "lower", "upper", "scale")) {
expect_equal(m1["v"]$records[,i], replicate(m["v"]$numberRecords, m["v"]$defaultValues[[i]]))
}
expect_equal(m1["v"]$records[,"marginal"], replicate(m["v"]$numberRecords, 10))
m$write("partial_variable.gdx", mode="string")
m1 = Container$new("partial_variable.gdx")
expect_equal(m1$listSymbols(), "v")
expect_equal(colnames(m1["v"]$records), c("uni", "level", "marginal", "lower", "upper", "scale"))
expect_equal(length(m1["v"]$records), 6)
for (i in c("level", "lower", "upper", "scale")) {
expect_equal(m1["v"]$records[,i], replicate(m["v"]$numberRecords, m["v"]$defaultValues[[i]]))
}
expect_equal(m1["v"]$records[,"marginal"], replicate(m["v"]$numberRecords, 10))
# test the super call write
writeList = m$asList()
writeGDX(writeList, "partial_variable.gdx")
m1 = Container$new("partial_variable.gdx")
expect_equal(m1$listSymbols(), "v")
expect_equal(colnames(m1["v"]$records), c("uni", "level", "marginal", "lower", "upper", "scale"))
expect_equal(length(m1["v"]$records), 6)
for (i in c("level", "lower", "upper", "scale")) {
expect_equal(m1["v"]$records[,i], replicate(m["v"]$numberRecords, m["v"]$defaultValues[[i]]))
}
expect_equal(m1["v"]$records[,"marginal"], replicate(m["v"]$numberRecords, 10))
}
}
)
# extensive partial column tests for scalars
test_that("test_num_127", {
#parameter
m = Container$new()
p = Parameter$new(m, "p", records=data.frame())
m$write("partial_scalar.gdx")
m1 = Container$new("partial_scalar.gdx")
expect_equal(m1["p"]$records$value, 0)
m$write("partial_scalar.gdx", mode="string")
m1 = Container$new("partial_scalar.gdx")
expect_equal(m1["p"]$records$value, 0)
# test the super call write
writeList = m$asList()
writeGDX(writeList, "partial_scalar.gdx")
m1 = Container$new("partial_scalar.gdx")
expect_equal(m1["p"]$records$value, 0)
#variable
m = Container$new()
v = Variable$new(m, "v", records=data.frame())
m$write("partial_scalar_variable.gdx")
m1 = Container$new("partial_scalar_variable.gdx")
for (i in c("level", "marginal", "lower", "upper", "scale")) {
expect_equal(m1["v"]$records[[i]], m["v"]$defaultValues[[i]])
}
m$write("partial_scalar_variable.gdx", mode="string")
m1 = Container$new("partial_scalar_variable.gdx")
for (i in c("level", "marginal", "lower", "upper", "scale")) {
expect_equal(m1["v"]$records[[i]], m["v"]$defaultValues[[i]])
}
# test the super call write
writeList = m$asList()
writeGDX(writeList, "partial_scalar_variable.gdx")
m1 = Container$new("partial_scalar_variable.gdx")
for (i in c("level", "marginal", "lower", "upper", "scale")) {
expect_equal(m1["v"]$records[[i]], m["v"]$defaultValues[[i]])
}
#equation
m = Container$new()
e = Equation$new(m, "e", type="eq", records=data.frame())
m$write("partial_scalar_equation.gdx")
m1 = Container$new("partial_scalar_equation.gdx")
for (i in c("level", "marginal", "lower", "upper", "scale")) {
expect_equal(m1["e"]$records[[i]], m["e"]$defaultValues[[i]])
}
m$write("partial_scalar_equation.gdx", mode="string")
m1 = Container$new("partial_scalar_equation.gdx")
for (i in c("level", "marginal", "lower", "upper", "scale")) {
expect_equal(m1["e"]$records[[i]], m["e"]$defaultValues[[i]])
}
# test the super call write
writeList = m$asList()
writeGDX(writeList, "partial_scalar_equation.gdx")
m1 = Container$new("partial_scalar_equation.gdx")
for (i in c("level", "marginal", "lower", "upper", "scale")) {
expect_equal(m1["e"]$records[[i]], m["e"]$defaultValues[[i]])
}
#variable partial column
m = Container$new()
v = Variable$new(m, "v", records=data.frame(marginal=10))
m$write("partial_scalar_variable.gdx")
m1 = Container$new("partial_scalar_variable.gdx")
for (i in c("level", "lower", "upper", "scale")) {
expect_equal(m1["v"]$records[[i]], m["v"]$defaultValues[[i]])
}
expect_equal(m1["v"]$records[["marginal"]], 10)
writeList = m$asList()
writeGDX(writeList, "partial_scalar_variable.gdx")
for (i in c("level", "lower", "upper", "scale")) {
expect_equal(m1["v"]$records[[i]], m["v"]$defaultValues[[i]])
}
expect_equal(m1["v"]$records[["marginal"]], 10)
#equation
m = Container$new()
e = Equation$new(m, "e", type="eq", records=data.frame(marginal=10))
m$write("partial_scalar_equation.gdx")
m1 = Container$new("partial_scalar_equation.gdx")
for (i in c("level", "lower", "upper", "scale")) {
expect_equal(m1["e"]$records[[i]], m["e"]$defaultValues[[i]])
}
expect_equal(m1["e"]$records[["marginal"]], 10)
m$write("partial_scalar_equation.gdx", mode="string")
m1 = Container$new("partial_scalar_equation.gdx")
for (i in c("level", "lower", "upper", "scale")) {
expect_equal(m1["e"]$records[[i]], m["e"]$defaultValues[[i]])
}
expect_equal(m1["e"]$records[["marginal"]], 10)
}
)
# test count* and isvalid methods with partial columns
test_that("test_num_128", {
# count* methods
m = Container$new()
i = Set$new(m, "i", records=paste0("i", 1:10))
p = Parameter$new(m, "p", domain = i, records = data.frame(i=paste0("i", 2:6)))
expect_true(p$isValid())
flist = c(p$countNA, p$countEps, p$countNegInf, p$countPosInf, p$countUndef)
for (f in flist) {
expect_equal(f(), 0)
}
v = Variable$new(m, "v", domain = i, records = data.frame(i=paste0("i", 2:6)))
expect_true(v$isValid())
flist = c(v$countNA, v$countEps, v$countNegInf, v$countPosInf, v$countUndef)
for (f in flist) {
expect_equal(f(columns="level"), 0)
}
flist = c(v$countNA, v$countEps, v$countNegInf, v$countPosInf, v$countUndef)
for (f in flist) {
expect_equal(f(columns=c("level", "scale")), 0)
}
expect_equal(v$countPosInf(columns="upper"), 5)
expect_equal(v$countNegInf(columns="lower"), 5)
e = Equation$new(m, "e", type="eq", domain = i, records = data.frame(i=paste0("i", 2:6)))
expect_true(e$isValid())
flist = c(e$countNA, e$countEps, e$countNegInf, e$countPosInf, e$countUndef)
for (f in flist) {
expect_equal(f(columns="level"), 0)
}
expect_equal(e$countPosInf(columns="upper"), 0)
expect_equal(e$countNegInf(columns="lower"), 0)
#scalars count* methods
m = Container$new()
p = Parameter$new(m, "p", records=data.frame())
expect_true(p$isValid())
flist = c(p$countNA, p$countEps, p$countNegInf, p$countPosInf, p$countUndef)
for (f in flist) {
expect_equal(f(), 0)
}
v = Variable$new(m, "v", records = data.frame())
expect_true(v$isValid())
flist = c(v$countNA, v$countEps, v$countNegInf, v$countPosInf, v$countUndef)
for (f in flist) {
expect_equal(f(columns="level"), 0)
}
flist = c(v$countNA, v$countEps, v$countNegInf, v$countPosInf, v$countUndef)
for (f in flist) {
expect_equal(f(columns=c("level", "scale")), 0)
}
expect_equal(v$countPosInf(columns="upper"), 1)
expect_equal(v$countNegInf(columns="lower"), 1)
e = Equation$new(m, "e", type="eq", records = data.frame())
expect_true(e$isValid())
flist = c(e$countNA, e$countEps, e$countNegInf, e$countPosInf, e$countUndef)
for (f in flist) {
expect_equal(f(columns="level"), 0)
}
expect_equal(e$countPosInf(columns="upper"), 0)
expect_equal(e$countNegInf(columns="lower"), 0)
}
)
# test get* and isvalid methods with partial columns
test_that("test_num_129", {
# get* methods
m = Container$new()
i = Set$new(m, "i", records=paste0("i", 1:10))
p = Parameter$new(m, "p", domain = i, records = data.frame(i=paste0("i", 2:6)))
expect_true(p$isValid())
flist = c(p$getMaxValue, p$getMinValue, p$getMaxAbsValue, p$getMeanValue)
for (f in flist) {
expect_equal(f(), 0)
}
v = Variable$new(m, "v", domain = i, records = data.frame(i=paste0("i", 2:6)))
expect_true(v$isValid())
flist = c(v$getMaxValue, v$getMinValue, v$getMaxAbsValue, v$getMeanValue)
for (f in flist) {
expect_equal(f(columns="level"), 0)
}
flist = c(v$getMaxValue, v$getMinValue, v$getMaxAbsValue, v$getMeanValue)
for (f in flist) {
expect_equal(f(columns=c("level", "marginal")), 0)
}
expect_equal(v$getMaxValue(columns="upper"), Inf)
expect_equal(v$getMaxValue(columns="lower"), -Inf)
e = Equation$new(m, "e", type="eq", domain = i, records = data.frame(i=paste0("i", 2:6)))
expect_true(e$isValid())
flist = c(e$getMaxValue, e$getMinValue, e$getMaxAbsValue, e$getMeanValue)
for (f in flist) {
expect_equal(f(columns="level"), 0)
}
expect_equal(e$getMaxValue(columns="upper"), 0)
expect_equal(e$getMinValue(columns="lower"), 0)
#scalars get* methods
m = Container$new()
p = Parameter$new(m, "p", records=data.frame())
expect_true(p$isValid())
flist = c(p$getMaxValue, p$getMinValue, p$getMaxAbsValue, p$getMeanValue)
for (f in flist) {
expect_equal(f(), 0)
}
v = Variable$new(m, "v", records = data.frame())
expect_true(v$isValid())
flist = c(v$getMaxValue, v$getMinValue, v$getMaxAbsValue, v$getMeanValue)
for (f in flist) {
expect_equal(f(columns="level"), 0)
}
flist = c(v$getMaxValue, v$getMinValue, v$getMaxAbsValue, v$getMeanValue)
for (f in flist) {
expect_equal(f(columns=c("level", "marginal")), 0)
}
expect_equal(v$getMaxValue(columns="upper"), Inf)
expect_equal(v$getMaxValue(columns="lower"), -Inf)
e = Equation$new(m, "e", type="eq", records = data.frame())
expect_true(e$isValid())
flist = c(e$getMaxValue, e$getMinValue, e$getMaxAbsValue, e$getMeanValue)
for (f in flist) {
expect_equal(f(columns="level"), 0)
}
expect_equal(e$getMaxValue(columns="upper"), 0)
expect_equal(e$getMinValue(columns="lower"), 0)
}
)
# test where* and isvalid methods with partial columns
test_that("test_num_130", {
# where* methods
m = Container$new()
i = Set$new(m, "i", records=paste0("i", 1:10))
p = Parameter$new(m, "p", domain = i, records = data.frame(i=paste0("i", 2:6)))
expect_equal(p$getSparsity(), 0.5)
flist = c(p$whereMax, p$whereMaxAbs, p$whereMin)
for (f in flist) {
expect_equal(f(), 1)
}
v = Variable$new(m, "v", domain = i, records = data.frame(i=paste0("i", 2:6)))
expect_equal(v$getSparsity(), 0.5)
flist = c(v$whereMax, v$whereMaxAbs, v$whereMin)
for (f in flist) {
expect_equal(f(column="level"), 1)
}
expect_equal(v$whereMax(column="upper"), 1)
expect_equal(v$whereMaxAbs(column="lower"), 1)
e = Equation$new(m, "e", type="eq", domain = i, records = data.frame(i=paste0("i", 2:6)))
expect_equal(e$getSparsity(), 0.5)
flist = c(e$whereMax, e$whereMaxAbs, e$whereMin)
for (f in flist) {
expect_equal(f(column="level"), 1)
}
expect_equal(e$whereMax(column="upper"), 1)
expect_equal(e$whereMin(column="lower"), 1)
#scalars where* methods
m = Container$new()
p = Parameter$new(m, "p", records=data.frame())
expect_equal(p$getSparsity(), NA)
flist = c(p$whereMax, p$whereMaxAbs, p$whereMin)
for (f in flist) {
expect_equal(f(), 1)
}
v = Variable$new(m, "v", records = data.frame())
expect_equal(v$getSparsity(), NA)
flist = c(v$whereMax, v$whereMaxAbs, v$whereMin)
for (f in flist) {
expect_equal(f(column="level"), 1)
}
expect_equal(v$whereMax(column="upper"), 1)
expect_equal(v$whereMin(column="lower"), 1)
e = Equation$new(m, "e", type="eq", records = data.frame())
expect_equal(e$getSparsity(), NA)
flist = c(e$whereMax, e$whereMaxAbs, e$whereMin)
for (f in flist) {
expect_equal(f(column="level"), 1)
}
expect_equal(e$whereMaxAbs(column="upper"), 1)
expect_equal(e$whereMin(column="lower"), 1)
# toDense
}
)
# test toDense* and isvalid methods with partial columns
test_that("test_num_131", {
m = Container$new()
i = Set$new(m, "i", records=paste0("i", 1:10))
p = Parameter$new(m, "p", domain = i, records = data.frame(i=paste0("i", 2:6)))
expect_equal(p$toDense(), as.array(replicate(10, 0)))
v = Variable$new(m, "v", domain = i, records = data.frame(i=paste0("i", 2:6)))
expect_equal(v$toDense(), as.array(replicate(10, 0)))
expect_equal(v$toDense(column="upper"), as.array(c(0, replicate(5, Inf), 0, 0, 0, 0)))
expect_equal(v$toDense(column="lower"), as.array(c(0, replicate(5, -Inf), 0, 0, 0, 0)))
e = Equation$new(m, "e", type="eq", domain = i, records = data.frame(i=paste0("i", 2:6)))
expect_equal(e$toDense(), as.array(replicate(10, 0)))
expect_equal(e$toDense(column="upper"), as.array(replicate(10, 0)))
expect_equal(e$toDense(column="lower"), as.array(replicate(10, 0)))
}
)
# equals
# test equals method with partial columns
test_that("test_num_132", {
m = Container$new()
i = Set$new(m, "i", records=paste0("i", 1:10))
p = Parameter$new(m, "p", domain = i, records = data.frame(i=paste0("i", 2:6)))
m2 = Container$new()
i2 = Set$new(m2, "i", records=data.frame(uni=paste0("i", 1:10), element_text=""))
p2 = Parameter$new(m2, "p", domain=i2, records=data.frame(i=paste0("i", 2:6), replicate(5, 0)))
expect_true(p$equals(p2))
expect_true(p2$equals(p))
v = Variable$new(m, "v", domain = i, records = data.frame(i=paste0("i", 2:6)))
v2 = Variable$new(m2, "v", domain = i2, records = data.frame(i=paste0("i", 2:6), level=0))
expect_true(v$equals(v2))
expect_true(v2$equals(v))
e = Equation$new(m, "e", type="eq", domain = i, records = data.frame(i=paste0("i", 2:6)))
e2 = Equation$new(m2, "e", type="eq", domain = i2, records = data.frame(i=paste0("i", 2:6), level=0))
expect_true(e$equals(e2))
expect_true(e2$equals(e))
}
)
# dataframe with no rows still have column names and factors
test_that("test_num_133", {
m = Container$new()
i = Set$new(m, "i", records=paste0("i", 1:3))
p = Parameter$new(m, "p", domain=i, records=c(0, 0, 0))
expect_true(is.factor(p$records[,1]))
expect_equal(colnames(p$records), "i")
expect_equal(levels(p$records[, 1]), c("i1","i2","i3"))
v = Variable$new(m, "v", domain=i, records=c(0, 0, 0))
expect_true(is.factor(v$records[,1]))
expect_equal(colnames(v$records), "i")
expect_equal(levels(v$records[, 1]), c("i1","i2","i3"))
e = Equation$new(m, "e", type="eq", domain=i, records=c(0, 0, 0))
expect_true(is.factor(e$records[,1]))
expect_equal(colnames(e$records), "i")
expect_equal(levels(e$records[, 1]), c("i1","i2","i3"))
}
)
# dataframe with no rows still have column names and factors
test_that("test_num_134", {
skip_if_no_gams()
m = Container$new()
i = Set$new(m, "i", records=paste0("i", 1:3))
p = Parameter$new(m, "p", domain=i, records=c(0, 0, 0))
expect_true(is.factor(p$records[,1]))
expect_equal(colnames(p$records), "i")
expect_equal(levels(p$records[, 1]), c("i1","i2","i3"))
writeList = m$asList()
m$write("gt.gdx", symbols="p")
system2(command="gdxdump", args=
"gt.gdx uelTable=foo",
stdout = "foo.gms")
system2(command="gams", args=
"foo.gms gdx=foo.gdx lo=0",
stdout = FALSE)
m = Container$new("foo.gdx")
expect_equal(m$getUELs(), c("i1","i2","i3"))
writeGDX(writeList, "gt.gdx")
system2(command="gdxdump", args=
"gt.gdx uelTable=foo",
stdout = "foo.gms")
system2(command="gams", args=
"foo.gms gdx=foo.gdx lo=0",
stdout = FALSE)
m = Container$new("foo.gdx")
expect_equal(m$getUELs(), c("i1","i2","i3"))
m = Container$new()
i = Set$new(m, "i", records=paste0("i", 1:3))
p = Parameter$new(m, "p", domain=i, records=c(0, 0, 0))
expect_true(is.factor(p$records[,1]))
expect_equal(colnames(p$records), "i")
expect_equal(levels(p$records[, 1]), c("i1","i2","i3"))
writeList = m$asList()
m$write("gt.gdx", symbols="p", mode="string")
system2(command="gdxdump", args=
"gt.gdx uelTable=foo",
stdout = "foo.gms")
system2(command="gams", args=
"foo.gms gdx=foo.gdx lo=0",
stdout = FALSE)
m = Container$new("foo.gdx")
expect_equal(m$getUELs(), c("i1","i2","i3"))
writeGDX(writeList, "gt.gdx")
system2(command="gdxdump", args=
"gt.gdx uelTable=foo",
stdout = "foo.gms")
system2(command="gams", args=
"foo.gms gdx=foo.gdx lo=0",
stdout = FALSE)
m = Container$new("foo.gdx")
expect_equal(m$getUELs(), c("i1","i2","i3"))
}
)
# mapped write
test_that("test_num_135", {
m = Container$new(testthat::test_path("testdata", "trnsport.gdx"))
expect_error(m$write("gt.gdx", mode = 1))
m$write("gt.gdx", mode = "string")
ms = Container$new("gt.gdx")
m$write("gt.gdx", mode = "mapped")
mm = Container$new("gt.gdx")
expect_true(ms$equals(mm))
m = Container$new()
m$read(testthat::test_path("testdata", "trnsport.gdx"), records=FALSE)
m$write("gt.gdx", mode="mapped")
m$write("gt.gdx", mode="string")
writeList = m$asList()
writeGDX(writeList, "gt.gdx")
})
# symbol shouldn't be added to the container if the constructor call fails
test_that("test_num_136", {
m = Container$new()
expect_error(Set$new(m, "i", domain = j, records=paste0("i", 1:3)))
expect_equal(length(m$listSymbols()), 0)
}
)
# get* methods
test_that("test_num_137", {
m = Container$new(testthat::test_path("testdata", "trnsport_with_alias.gdx"))
expect_equal(m$getSymbols(m$listSets()), m$getSets())
expect_equal(m$getSymbols(m$listAliases()), m$getAliases())
expect_equal(m$getSymbols(m$listParameters()), m$getParameters())
expect_equal(m$getSymbols(m$listVariables()), m$getVariables())
expect_equal(m$getSymbols(m$listEquations()), m$getEquations())
}
)
# get* methods
test_that("test_num_138", {
m = Container$new()
a = Parameter$new(m, "a", c("*","*"), records=data.frame(i=c("i1","i2"), j=c("j1","j2"), val=1:2))
a$setUELs(c("new","i1","i2"), 1)
expect_equal(a$getUELs(1), c("new","i1","i2"))
expect_error(a$toDense())
a$reorderUELs()
expect_equal(a$getUELs(1), c("i1","i2","new"))
}
)
# read test
test_that("test_num_139", {
m = Container$new(testthat::test_path("testdata", "trnsport.gdx"))
expect_equal(m["i"]$getUELs(), c("seattle","san-diego"))
expect_equal(m["j"]$getUELs(), c("new-york", "chicago", "topeka"))
expect_equal(m["d"]$toDense(), matrix(data = c(2.5, 1.7, 1.8, 2.5, 1.8, 1.4), nrow=2, ncol=3, byrow=TRUE))
}
)
# getUELs for NULL records
test_that("test_num_139", {
m = Container$new()
i = Set$new(m, "i")
j = Set$new(m, "j")
d = Parameter$new(m, "p", domain=c(i, j),
records=data.frame(i=c("i1","i2","i3"),
j=c("j1","j2","j3"), val=1:3))
dv = d$getDomainViolations()
expect_equal(length(dv), 2)
}
)
# getUELs order
test_that("test_num_140", {
m = Container$new(testthat::test_path("testdata", "universe_order.gdx"))
expect_equal(m["p"]$getUELs(), c("i2","i5","i9","i1","i3"))
expect_equal(m["p"]$getUELs(1), c("i2","i5","i9"))
expect_equal(m["p"]$getUELs(2), c("i1", "i2", "i3"))
# test supercall read
rl = readGDX(testthat::test_path("testdata", "universe_order.gdx"))
m2 = Container$new()
m2$readList(rl)
expect_equal(m$equals(m2), TRUE)
}
)
# acronyms
test_that("test_num_141", {
f = function() {
return(Container$new(testthat::test_path("testdata", "acronym_test.gdx")))
}
expect_warning(m <- f())
expect_equal(m["shutdown"]$records[["value"]], replicate(5, as.numeric(NA)))
expect_equal(m["v"]$records[["level"]], c(1, NA, NA, NA, 2))
expect_equal(m["e"]$records[["marginal"]], c(1, NA, NA, NA, 2))
}
)
Try the gamstransfer 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.