Skip to content

Commit

Permalink
updated tests syntax
Browse files Browse the repository at this point in the history
  • Loading branch information
pvictor committed Nov 9, 2020
1 parent b11b1c4 commit 3ae8188
Show file tree
Hide file tree
Showing 12 changed files with 221 additions and 239 deletions.
77 changes: 37 additions & 40 deletions tests/testthat/test-catColorPal.R
Original file line number Diff line number Diff line change
@@ -1,43 +1,40 @@
context("catColorPal")

describe("catColorPal", {

it("returns a vector of colors with attributes levels and pal", {
x <- as.factor(c("a", "b", "c", "a"))
res <- catColorPal(x)
expect_true(all(res == DEFAULT_CAT_COLORS[c(1,2,3,1)]))
expect_equal(attr(res, "levels"), levels(x))
expect_equal(attr(res, "pal"), structure(DEFAULT_CAT_COLORS[1:3], names = levels(x)))
})

it ("accepts character vectors", {
x <- c("a", "b", "c", "a")
res <- catColorPal(x)
expect_true(all(res == DEFAULT_CAT_COLORS[c(1,2,3,1)]))
expect_equal(attr(res, "levels"), unique(x))
expect_equal(attr(res, "pal"), structure(DEFAULT_CAT_COLORS[1:3], names = unique(x)))
})

it("accepts custom colors", {
x <- as.factor(c("a", "b", "c", "a"))
pal <- c("red", "green", "blue")
res <- catColorPal(x, colors = pal)
expect_true(all(res == pal[c(1,2,3,1)]))
expect_equal(attr(res, "levels"), levels(x))
expect_equal(attr(res, "pal"), structure(pal, names = levels(x)))
})

it("handles missing values", {
x <- as.factor(c("a", "b", "c", "a", NA))
res <- catColorPal(x)
expect_true(all(res == c(DEFAULT_CAT_COLORS[c(1,2,3,1)], "#EEEEEE")))
})

it("can reset levels", {
x <- as.factor(c("a", "b", "a", "c"))
res <- catColorPal(x, levels = c("a", "b", "d"))
expect_true(all(res == c(DEFAULT_CAT_COLORS[c(1,2,1)], "#EEEEEE")))
expect_equal(attr(res, "levels"), c("a", "b", "d"))
expect_equal(attr(res, "pal"), structure(DEFAULT_CAT_COLORS[1:3], names = c("a", "b", "d")))
})
test_that("returns a vector of colors with attributes levels and pal", {
x <- as.factor(c("a", "b", "c", "a"))
res <- catColorPal(x)
expect_true(all(res == DEFAULT_CAT_COLORS[c(1,2,3,1)]))
expect_equal(attr(res, "levels"), levels(x))
expect_equal(attr(res, "pal"), structure(DEFAULT_CAT_COLORS[1:3], names = levels(x)))
})

test_that("accepts character vectors", {
x <- c("a", "b", "c", "a")
res <- catColorPal(x)
expect_true(all(res == DEFAULT_CAT_COLORS[c(1,2,3,1)]))
expect_equal(attr(res, "levels"), unique(x))
expect_equal(attr(res, "pal"), structure(DEFAULT_CAT_COLORS[1:3], names = unique(x)))
})

test_that("accepts custom colors", {
x <- as.factor(c("a", "b", "c", "a"))
pal <- c("red", "green", "blue")
res <- catColorPal(x, colors = pal)
expect_true(all(res == pal[c(1,2,3,1)]))
expect_equal(attr(res, "levels"), levels(x))
expect_equal(attr(res, "pal"), structure(pal, names = levels(x)))
})

test_that("handles missing values", {
x <- as.factor(c("a", "b", "c", "a", NA))
res <- catColorPal(x)
expect_true(all(res == c(DEFAULT_CAT_COLORS[c(1,2,3,1)], "#EEEEEE")))
})

test_that("can reset levels", {
x <- as.factor(c("a", "b", "a", "c"))
res <- catColorPal(x, levels = c("a", "b", "d"))
expect_true(all(res == c(DEFAULT_CAT_COLORS[c(1,2,1)], "#EEEEEE")))
expect_equal(attr(res, "levels"), c("a", "b", "d"))
expect_equal(attr(res, "pal"), structure(DEFAULT_CAT_COLORS[1:3], names = c("a", "b", "d")))
})
130 changes: 64 additions & 66 deletions tests/testthat/test-continuousColorPal.R
Original file line number Diff line number Diff line change
@@ -1,69 +1,67 @@
context("Continuous Color Scale")

describe("continuousColorPal()", {
# Default colors
posCol <- "#0000FF"
zeroCol <- "#FFFFFF"
negCol <- "#FF0000"
# Custom colors
custZeroCol <- "#FF0000"
custPosCol <- "#00FF00"

it ("returns a vector of colors with break points and color palette", {
cols <- continuousColorPal(1:100)
expect_is(cols, "character")
expect_true(all(grepl("^#[0-9A-F]{6}", cols)))
expect_false(is.null(attr(cols, "breaks")))
expect_false(is.null(attr(cols, "pal")))
})

it ("works with positive values", {
cols <- continuousColorPal(1:100)
expect_equal(cols[1], zeroCol)
expect_equal(cols[100], posCol)
})

it ("works with negative values", {
cols <- continuousColorPal(-1:-100)
expect_equal(cols[1], zeroCol)
expect_equal(cols[100], negCol)
})

it ("works with positive and negative values", {
cols <- continuousColorPal(-100:100)
expect_equal(cols[1], negCol)
expect_equal(cols[101], zeroCol)
expect_equal(cols[201], posCol)
})

it ("modifies the number of break points", {
cols1 <- continuousColorPal(1:100, 3)
cols2 <- continuousColorPal(1:100, 10)
expect_gt(length(unique(cols2)), length(unique(cols1)))
})

it ("accepts custom domains", {
cols <- continuousColorPal(1:100, domain = c(0, 1000))
expect_equal(max(attr(cols, "breaks")), 1000)
expect_false(cols[100] == posCol)
})

it ("accepts custom break points", {
cols <- continuousColorPal(1:100, breaks = c(0, 80, 100))
expect_true(all(cols[1:80] == zeroCol))
expect_true(all(cols[81:100] == posCol))
})

it ("accepts custom colors if custom break points", {
cols <- continuousColorPal(1:100, breaks = c(0, 80, 100),
colors = c(custZeroCol, custPosCol))
expect_true(all(cols[1:80] == custZeroCol))
expect_true(all(cols[81:100] == custPosCol))
})

it ("ignores custom colors if automatic break points", {
cols <- continuousColorPal(1:100, colors = c(custZeroCol, custPosCol))
expect_true(all(cols[1] == zeroCol))
expect_true(all(cols[100] == posCol))
})
# Default colors
posCol <- "#0000FF"
zeroCol <- "#FFFFFF"
negCol <- "#FF0000"
# Custom colors
custZeroCol <- "#FF0000"
custPosCol <- "#00FF00"

test_that("returns a vector of colors with break points and color palette", {
cols <- continuousColorPal(1:100)
expect_is(cols, "character")
expect_true(all(grepl("^#[0-9A-F]{6}", cols)))
expect_false(is.null(attr(cols, "breaks")))
expect_false(is.null(attr(cols, "pal")))
})

test_that("works with positive values", {
cols <- continuousColorPal(1:100)
expect_equal(cols[1], zeroCol)
expect_equal(cols[100], posCol)
})

test_that("works with negative values", {
cols <- continuousColorPal(-1:-100)
expect_equal(cols[1], zeroCol)
expect_equal(cols[100], negCol)
})

test_that("works with positive and negative values", {
cols <- continuousColorPal(-100:100)
expect_equal(cols[1], negCol)
expect_equal(cols[101], zeroCol)
expect_equal(cols[201], posCol)
})

test_that("modifies the number of break points", {
cols1 <- continuousColorPal(1:100, 3)
cols2 <- continuousColorPal(1:100, 10)
expect_gt(length(unique(cols2)), length(unique(cols1)))
})

test_that("accepts custom domains", {
cols <- continuousColorPal(1:100, domain = c(0, 1000))
expect_equal(max(attr(cols, "breaks")), 1000)
expect_false(cols[100] == posCol)
})

test_that("accepts custom break points", {
cols <- continuousColorPal(1:100, breaks = c(0, 80, 100))
expect_true(all(cols[1:80] == zeroCol))
expect_true(all(cols[81:100] == posCol))
})

test_that("accepts custom colors if custom break points", {
cols <- continuousColorPal(1:100, breaks = c(0, 80, 100),
colors = c(custZeroCol, custPosCol))
expect_true(all(cols[1:80] == custZeroCol))
expect_true(all(cols[81:100] == custPosCol))
})

test_that("ignores custom colors if automatic break points", {
cols <- continuousColorPal(1:100, colors = c(custZeroCol, custPosCol))
expect_true(all(cols[1] == zeroCol))
expect_true(all(cols[100] == posCol))
})
37 changes: 17 additions & 20 deletions tests/testthat/test-exchangesStack.R
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
context("exchangesStack")

describe("no interactive", {
test_that("no interactive", {

mydata <- readAntares(links = "all", timeStep = "daily", showProgress = FALSE)
# default parameters
Expand All @@ -13,7 +13,7 @@ describe("no interactive", {
# - tester les retours d'erreurs
})

describe("exchangesStack, no interactive", {
test_that("exchangesStack, no interactive", {
dta <- readAntares(areas = "all", links = "all", showProgress = FALSE)
testClass <- function(obj){
class(obj)[1] == "combineWidgets"
Expand All @@ -24,21 +24,18 @@ describe("exchangesStack, no interactive", {
ylab = list(x = dta, interactive = FALSE, areas = "all", main = "Title", ylab = "Subt")
)
lapply(listArgs, function(X){
test_that (names(listArgs), {
re1 <- do.call(exchangesStack, X)
expect_true(testClass(re1))
})
re1 <- do.call(exchangesStack, X)
expect_true(testClass(re1))
})

})

describe("exchangesStack, no interactive return error", {
test_that("exchangesStack, no interactive return error", {
dta <- readAntares(areas = "all", links = "all", showProgress = FALSE)
expect_error(exchangesStack(dta, interactive = FALSE, compare = "areas"))

})

describe("exchangesStack, no interactive, x and refStudy are antaresDataTable", {
test_that("exchangesStack, no interactive, x and refStudy are antaresDataTable", {
myData1 <- readAntares(links = "all", showProgress = FALSE)
myData2 <- readAntares(links = "all", showProgress = FALSE)
myArea <- "a"
Expand Down Expand Up @@ -66,7 +63,7 @@ describe("exchangesStack, no interactive, x and refStudy are antaresDataTable",
expect_equal(dataExS21V1$nega_offshore[indexHour], 2500)
})

describe("exchangesStack, no interactive, x and refStudy are antaresDataList", {
test_that("exchangesStack, no interactive, x and refStudy are antaresDataList", {
myData1 <- readAntares(areas = "all", links = "all", showProgress = FALSE)
myData2 <- readAntares(areas = "all", links = "all", showProgress = FALSE)
myArea <- "a"
Expand Down Expand Up @@ -120,7 +117,7 @@ describe("exchangesStack, no interactive, x and refStudy are antaresDataList", {
expect_equal(dataExS21V3$ROW[indexHour], 500)
})

describe("exchangesStack, no interactive, x is a list of antaresDataTable and refStudy an antaresDataTable", {
test_that("exchangesStack, no interactive, x is a list of antaresDataTable and refStudy an antaresDataTable", {
myData1 <- readAntares(links = "all", showProgress = FALSE)
myData2 <- readAntares(links = "all", showProgress = FALSE)
myData3 <- readAntares(links = "all", showProgress = FALSE)
Expand Down Expand Up @@ -154,7 +151,7 @@ describe("exchangesStack, no interactive, x is a list of antaresDataTable and re
expect_equal(dataExS21V1$a_offshore[indexHour], 2500)
})

describe("exchangesStack, no interactive, x is a list of antaresDataList and refStudy an antaresDataList", {
test_that("exchangesStack, no interactive, x is a list of antaresDataList and refStudy an antaresDataList", {
myData1 <- readAntares(areas = "all", links = "all", showProgress = FALSE)
myData2 <- readAntares(areas = "all", links = "all", showProgress = FALSE)
myData3 <- readAntares(areas = "all", links = "all", showProgress = FALSE)
Expand Down Expand Up @@ -224,7 +221,7 @@ describe("exchangesStack, no interactive, x is a list of antaresDataList and ref
expect_equal(dataExListV3g2$negROW[indexHour], 1000)
})

describe("exchangesStack, interactive, x and refStudy are antaresDataTable", {
test_that("exchangesStack, interactive, x and refStudy are antaresDataTable", {
skip_if_not(.runExchangesStackTest)
myData1 <- readAntares(links = "all", showProgress = FALSE)
myData2 <- readAntares(links = "all", showProgress = FALSE)
Expand Down Expand Up @@ -275,7 +272,7 @@ describe("exchangesStack, interactive, x and refStudy are antaresDataTable", {
expect_equal(dataExS21V1$nega_offshore[indexHour], 2500)
})

describe("exchangesStack, interactive, x and refStudy are antaresDataList", {
test_that("exchangesStack, interactive, x and refStudy are antaresDataList", {
skip_if_not(.runExchangesStackTest)
myData1 <- readAntares(areas = "all", links = "all", showProgress = FALSE)
myData2 <- readAntares(areas = "all", links = "all", showProgress = FALSE)
Expand Down Expand Up @@ -366,7 +363,7 @@ describe("exchangesStack, interactive, x and refStudy are antaresDataList", {
expect_equal(dataExS21V3$ROW[indexHour], 500)
})

describe("exchangesStack, interactive, x is a list of antaresDataTable and refStudy an antaresDataTable", {
test_that("exchangesStack, interactive, x is a list of antaresDataTable and refStudy an antaresDataTable", {
skip_if_not(.runExchangesStackTest)
myData1 <- readAntares(links = "all", showProgress = FALSE)
myData2 <- readAntares(links = "all", showProgress = FALSE)
Expand Down Expand Up @@ -420,7 +417,7 @@ describe("exchangesStack, interactive, x is a list of antaresDataTable and refSt
expect_equal(dataExS21V1$a_offshore[indexHour], 2500)
})

describe("exchangesStack, interactive, x is a list of antaresDataList and refStudy an antaresDataList", {
test_that("exchangesStack, interactive, x is a list of antaresDataList and refStudy an antaresDataList", {
skip_if_not(.runExchangesStackTest)
myData1 <- readAntares(areas = "all", links = "all", showProgress = FALSE)
myData2 <- readAntares(areas = "all", links = "all", showProgress = FALSE)
Expand Down Expand Up @@ -527,7 +524,7 @@ describe("exchangesStack, interactive, x is a list of antaresDataList and refStu
expect_equal(dataExListV3g2$negROW[indexHour], 1000)
})

describe("exchangesStack, no interactive, x and refStudy are optsH5 ", {
test_that("exchangesStack, no interactive, x and refStudy are optsH5 ", {
if (.requireRhdf5_Antares(stopP = FALSE)){
skip_if_not(.runExchangesStackTest)
suppressMessages(writeAntaresH5(pathtemp, opts = opts, overwrite = TRUE))
Expand Down Expand Up @@ -580,7 +577,7 @@ describe("exchangesStack, no interactive, x and refStudy are optsH5 ", {
}
})

describe("exchangesStack, no interactive, x is a list of optH5 and refStudy are optsH5 ", {
test_that("exchangesStack, no interactive, x is a list of optH5 and refStudy are optsH5 ", {
if (.requireRhdf5_Antares(stopP = FALSE)){
skip_if_not(.runExchangesStackTest)
suppressMessages(writeAntaresH5(pathtemp, opts = opts, overwrite = TRUE))
Expand Down Expand Up @@ -653,7 +650,7 @@ describe("exchangesStack, no interactive, x is a list of optH5 and refStudy are
}
})

describe("exchangesStack, interactive, x and refStudy are optsH5 ", {
test_that("exchangesStack, interactive, x and refStudy are optsH5 ", {
if (.requireRhdf5_Antares(stopP = FALSE)){
skip_if_not(.runExchangesStackTest)
suppressMessages(writeAntaresH5(pathtemp, opts = opts, overwrite = TRUE))
Expand Down Expand Up @@ -788,7 +785,7 @@ describe("exchangesStack, interactive, x and refStudy are optsH5 ", {
}
})

describe("exchangesStack, interactive, x is a list of optsH5 and refStudy optsH5 , ", {
test_that("exchangesStack, interactive, x is a list of optsH5 and refStudy optsH5 , ", {
if (.requireRhdf5_Antares(stopP = FALSE)){
skip_if_not(.runExchangesStackTest)
suppressMessages(writeAntaresH5(pathtemp, opts = opts, overwrite = TRUE))
Expand Down
Loading

0 comments on commit 3ae8188

Please sign in to comment.