Nothing
tests/testthat/test-12-report_mig_char.R
In stacomiR: Fish Migration Monitoring
context("report_mig_char")
test_that("test creating an instance of report_mig_char and connect method (logrami required)",
{
skip_on_cran()
stacomi(database_expected = TRUE, sch ="logrami")
env_set_test_stacomi() # here parqual is not in the list
r_mig_char <- new("report_mig_char")
# so this is equivalent to parqual=NULL
r_mig_char <- choice_c(
r_mig_char,
dc = c(107, 108, 101),
taxa = c("Salmo salar"),
stage = c('5', '11', 'BEC', 'BER', 'IND'),
parquan = c('A124', 'C001'),
parqual = NULL,
horodatedebut = "2009-01-01",
horodatefin = "2012-12-31",
silent = TRUE
)
# r_mig_char<-charge(r_mig_char) not necessary there
r_mig_char <- connect(r_mig_char)
expect_true(is.null(r_mig_char@data$parqual), label = "there should be no data in parqual when not qualitative parm are selected")
expect_true(
nrow(r_mig_char@data$parquan) > 0,
"There should be data in the parquan slot when quantitative parm are selected"
)
rm(list = ls(envir = envir_stacomi), envir = envir_stacomi)
})
test_that("test setasqualitative method", {
skip_on_cran()
stacomi(database_expected = TRUE, sch = "logrami")
env_set_test_stacomi()
r_mig_char <- new("report_mig_char")
# here parqual is not in the list
# so this is equivalent to parqual=NULL
r_mig_char <- choice_c(
r_mig_char,
dc = c(107, 108, 101),
taxa = c("Salmo salar"),
stage = c('5', '11', 'BEC', 'BER', 'IND'),
parquan = c('A124', 'C001'),
parqual = NULL,
horodatedebut = "2009-01-01",
horodatefin = "2012-12-31",
silent = TRUE
)
# r_mig_char<-charge(r_mig_char) not necessary there
r_mig_char <- connect(r_mig_char, silent = TRUE)
# load the dataset generated by previous lines
r_mig_char <- setasqualitative(
r_mig_char,
par = 'A124',
silent = TRUE,
breaks = c(0, 1.5, 2.5, 10),
labels = c("age 1", "age 2", "age 3")
)
expect_true(r_mig_char@parqual@par_selected == "A124_discrete", label = "Test passing quant parm A124 to qualitative failed")
expect_true(nrow(r_mig_char@parqual@valqual) == 3, label = "Test adding rows to valqual failed")
expect_true(!is.null(r_mig_char@data[["parqual"]]), label = "Test new rows have been added")
expect_true("A124_discrete" %in% r_mig_char@data$parqual$car_par_code)
expect_true("A124_discrete" %in% r_mig_char@data[["parqual"]]$car_par_code)
nrbefore1 <- nrow(r_mig_char@data[["parqual"]])
nrbefore2 <- nrow(r_mig_char@parqual@valqual)
nrbefore3 <- nrow(r_mig_char@parqual@data)
# running again will not add lines
r_mig_char <- setasqualitative(
r_mig_char,
par = 'A124',
silent = TRUE,
breaks = c(0, 1.5, 10),
labels = c("age 1", "age 2 and 3")
)
nrafter1 <- nrow(r_mig_char@data[["parqual"]])
nrafter2 <- nrow(r_mig_char@parqual@valqual)
nrafter3 <- nrow(r_mig_char@parqual@data)
expect_true(nrafter1==nrbefore1, "The same number of row shoud have been produced in r_mig_char@data[['parqual']] when running two options of setasqualitative")
expect_true(length(levels(r_mig_char@data[["parqual"]]$car_val_identifiant))==2, "Only two ages are expected")
expect_true(nrafter2<nrbefore2, "The number of possible parm has not been updated by setasqualitative")
expect_true(nrafter3==nrbefore3, "The same number of row shoud have been produced in r_mig_char@parqual@data when running two options of setasqualitative")
rm(list = ls(envir = envir_stacomi), envir = envir_stacomi)
})
test_that("test calcule method", {
skip_on_cran()
stacomi(database_expected = TRUE, sch ="logrami")
env_set_test_stacomi()
r_mig_char <- new("report_mig_char")
r_mig_char <- choice_c(
r_mig_char,
dc = c(107, 108, 101),
taxa = c("Salmo salar"),
stage = c('5', '11', 'BEC', 'BER', 'IND'),
parquan = c('A124', 'C001'),
parqual = NULL,
horodatedebut = "2012-01-01",
horodatefin = "2012-12-31",
silent = TRUE
)
r_mig_char <- connect(r_mig_char)
r_mig_char <- calcule(r_mig_char, silent = TRUE)
expect_true(nrow(r_mig_char@calcdata) > 0, label = "Test that calcule method worked")
expect_true(all(is.na(
r_mig_char@calcdata$car_par_code_qual
)), label = "Test that calcule method does not return any qualitative result in absence of qualitative parm")
# now with a qualitative parm
r_mig_char <- setasqualitative(
r_mig_char,
par = 'A124',
silent = TRUE,
breaks = c(0, 1.5, 2.5, 10),
labels = c("age 1", "age 2", "age 3")
)
r_mig_char <- calcule(r_mig_char, silent = TRUE)
expect_true(any(!is.na(
r_mig_char@calcdata$car_par_code_qual
)) &
any(!is.na(
r_mig_char@calcdata$car_par_code_quan
)), label = "The merge function works and returns both qualitative and quantitative parameters")
rm(list = ls(envir = envir_stacomi), envir = envir_stacomi)
})
test_that("test charge method", {
skip_on_cran()
stacomi(database_expected = TRUE, sch ="logrami")
env_set_test_stacomi()
r_mig_char <- new("report_mig_char")
r_mig_char <- choice_c(
r_mig_char,
dc = c(107, 108, 101),
taxa = c("Salmo salar"),
stage = c('5', '11', 'BEC', 'BER', 'IND'),
parquan = c('A124', 'C001'),
parqual = NULL,
horodatedebut = "2012-01-01",
horodatefin = "2012-12-31",
echantillon= "with",
silent = TRUE
)
expect_error(r_mig_char <- charge(r_mig_char), NA)
rm(list = ls(envir = envir_stacomi), envir = envir_stacomi)
})
test_that("test plot and xtable and summary method", {
skip_on_cran()
stacomi(database_expected = TRUE, sch ="logrami")
env_set_test_stacomi()
r_mig_char <- new("report_mig_char")
r_mig_char <- choice_c(
r_mig_char,
dc = c(107, 108, 101),
taxa = c("Salmo salar"),
stage = c('5', '11', 'BEC', 'BER', 'IND'),
parquan = c('A124', 'C001'),
parqual = NULL,
horodatedebut = "2012-01-01",
horodatefin = "2012-12-31",
silent = TRUE
)
r_mig_char <- connect(r_mig_char)
expect_error(suppressWarnings(plot(r_mig_char, plot.type = "quant", silent = TRUE)))
r_mig_char <- calcule(r_mig_char, silent = TRUE)
expect_error(suppressWarnings(plot(r_mig_char, plot.type = "quant", silent = TRUE)), NA)
# now with a qualitative parm
r_mig_char <- setasqualitative(
r_mig_char,
par = 'A124',
silent = TRUE,
breaks = c(0, 1.5, 2.5, 10),
label = c("age 1", "age 2", "age 3")
)
r_mig_char <- suppressMessages(calcule(r_mig_char, silent = TRUE))
expect_error(suppressWarnings(plot(r_mig_char, plot.type = "quant", silent = TRUE)), NA)
expect_error(suppressWarnings(plot(r_mig_char, plot.type = "crossed", silent = TRUE)), NA)
# when wrong limits are passed should fail
r_mig_char <- new("report_mig_char")
r_mig_char <- choice_c(
r_mig_char,
dc = c(107, 108, 101),
taxa = c("Salmo salar"),
stage = c('5', '11', 'BEC', 'BER', 'IND'),
parquan = c('C001'),
parqual = NULL,
horodatedebut = "2012-01-01",
horodatefin = "2012-12-31",
silent = TRUE
)
r_mig_char <- connect(r_mig_char)
r_mig_char <- calcule(r_mig_char)
expect_error(r_mig_char <- setasqualitative(
r_mig_char,
par = 'C001',
silent = TRUE,
breaks = c(0, 1.5, 2.5, 10),
label = c("missing", "missing", "missing")
))
expect_warning(r_mig_char <- setasqualitative(
r_mig_char,
par = 'C001',
silent = TRUE,
breaks = c(0, 1.5, 2.5, 600),
label = c("missing", "missing", "few")
))
r_mig_char <- calcule(r_mig_char, silent = TRUE)
# yes should only plot 3 points
expect_error(suppressWarnings(plot(r_mig_char, plot.type = "crossed", silent = TRUE)), NA)
su <- summary(r_mig_char)
expect_equal(class(su),"data.frame")
xt <- xtable(r_mig_char)
expect_equal(class(xt)[1],"xtable")
# test with several years
r_mig_char <- choice_c(
r_mig_char,
dc = c(107, 108, 101),
taxa = c("Salmo salar"),
stage = c('5', '11', 'BEC', 'BER', 'IND'),
parquan = c('A124', 'C001'),
parqual = NULL,
horodatedebut = "2012-01-01",
horodatefin = "2013-12-31",
silent = TRUE
)
r_mig_char <- connect(r_mig_char)
r_mig_char <- setasqualitative(
r_mig_char,
par = 'A124',
silent = TRUE,
breaks = c(0, 1.5, 2.5, 10),
labels = c("age 1", "age 2", "age 3")
)
r_mig_char <- calcule(r_mig_char, silent = TRUE)
su <- summary(r_mig_char)
expect_equal(class(su),"data.frame")
xt <- xtable(r_mig_char)
expect_equal(class(xt)[1],"xtable")
rm(list = ls(envir = envir_stacomi), envir = envir_stacomi)
})
Try the stacomiR package in your browser
Any scripts or data that you put into this service are public.
stacomiR documentation built on Sept. 9, 2022, 3:10 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
context("report_mig_char")
test_that("test creating an instance of report_mig_char and connect method (logrami required)",
{
skip_on_cran()
stacomi(database_expected = TRUE, sch ="logrami")
env_set_test_stacomi() # here parqual is not in the list
r_mig_char <- new("report_mig_char")
# so this is equivalent to parqual=NULL
r_mig_char <- choice_c(
r_mig_char,
dc = c(107, 108, 101),
taxa = c("Salmo salar"),
stage = c('5', '11', 'BEC', 'BER', 'IND'),
parquan = c('A124', 'C001'),
parqual = NULL,
horodatedebut = "2009-01-01",
horodatefin = "2012-12-31",
silent = TRUE
)
# r_mig_char<-charge(r_mig_char) not necessary there
r_mig_char <- connect(r_mig_char)
expect_true(is.null(r_mig_char@data$parqual), label = "there should be no data in parqual when not qualitative parm are selected")
expect_true(
nrow(r_mig_char@data$parquan) > 0,
"There should be data in the parquan slot when quantitative parm are selected"
)
rm(list = ls(envir = envir_stacomi), envir = envir_stacomi)
})
test_that("test setasqualitative method", {
skip_on_cran()
stacomi(database_expected = TRUE, sch = "logrami")
env_set_test_stacomi()
r_mig_char <- new("report_mig_char")
# here parqual is not in the list
# so this is equivalent to parqual=NULL
r_mig_char <- choice_c(
r_mig_char,
dc = c(107, 108, 101),
taxa = c("Salmo salar"),
stage = c('5', '11', 'BEC', 'BER', 'IND'),
parquan = c('A124', 'C001'),
parqual = NULL,
horodatedebut = "2009-01-01",
horodatefin = "2012-12-31",
silent = TRUE
)
# r_mig_char<-charge(r_mig_char) not necessary there
r_mig_char <- connect(r_mig_char, silent = TRUE)
# load the dataset generated by previous lines
r_mig_char <- setasqualitative(
r_mig_char,
par = 'A124',
silent = TRUE,
breaks = c(0, 1.5, 2.5, 10),
labels = c("age 1", "age 2", "age 3")
)
expect_true(r_mig_char@parqual@par_selected == "A124_discrete", label = "Test passing quant parm A124 to qualitative failed")
expect_true(nrow(r_mig_char@parqual@valqual) == 3, label = "Test adding rows to valqual failed")
expect_true(!is.null(r_mig_char@data[["parqual"]]), label = "Test new rows have been added")
expect_true("A124_discrete" %in% r_mig_char@data$parqual$car_par_code)
expect_true("A124_discrete" %in% r_mig_char@data[["parqual"]]$car_par_code)
nrbefore1 <- nrow(r_mig_char@data[["parqual"]])
nrbefore2 <- nrow(r_mig_char@parqual@valqual)
nrbefore3 <- nrow(r_mig_char@parqual@data)
# running again will not add lines
r_mig_char <- setasqualitative(
r_mig_char,
par = 'A124',
silent = TRUE,
breaks = c(0, 1.5, 10),
labels = c("age 1", "age 2 and 3")
)
nrafter1 <- nrow(r_mig_char@data[["parqual"]])
nrafter2 <- nrow(r_mig_char@parqual@valqual)
nrafter3 <- nrow(r_mig_char@parqual@data)
expect_true(nrafter1==nrbefore1, "The same number of row shoud have been produced in r_mig_char@data[['parqual']] when running two options of setasqualitative")
expect_true(length(levels(r_mig_char@data[["parqual"]]$car_val_identifiant))==2, "Only two ages are expected")
expect_true(nrafter2<nrbefore2, "The number of possible parm has not been updated by setasqualitative")
expect_true(nrafter3==nrbefore3, "The same number of row shoud have been produced in r_mig_char@parqual@data when running two options of setasqualitative")
rm(list = ls(envir = envir_stacomi), envir = envir_stacomi)
})
test_that("test calcule method", {
skip_on_cran()
stacomi(database_expected = TRUE, sch ="logrami")
env_set_test_stacomi()
r_mig_char <- new("report_mig_char")
r_mig_char <- choice_c(
r_mig_char,
dc = c(107, 108, 101),
taxa = c("Salmo salar"),
stage = c('5', '11', 'BEC', 'BER', 'IND'),
parquan = c('A124', 'C001'),
parqual = NULL,
horodatedebut = "2012-01-01",
horodatefin = "2012-12-31",
silent = TRUE
)
r_mig_char <- connect(r_mig_char)
r_mig_char <- calcule(r_mig_char, silent = TRUE)
expect_true(nrow(r_mig_char@calcdata) > 0, label = "Test that calcule method worked")
expect_true(all(is.na(
r_mig_char@calcdata$car_par_code_qual
)), label = "Test that calcule method does not return any qualitative result in absence of qualitative parm")
# now with a qualitative parm
r_mig_char <- setasqualitative(
r_mig_char,
par = 'A124',
silent = TRUE,
breaks = c(0, 1.5, 2.5, 10),
labels = c("age 1", "age 2", "age 3")
)
r_mig_char <- calcule(r_mig_char, silent = TRUE)
expect_true(any(!is.na(
r_mig_char@calcdata$car_par_code_qual
)) &
any(!is.na(
r_mig_char@calcdata$car_par_code_quan
)), label = "The merge function works and returns both qualitative and quantitative parameters")
rm(list = ls(envir = envir_stacomi), envir = envir_stacomi)
})
test_that("test charge method", {
skip_on_cran()
stacomi(database_expected = TRUE, sch ="logrami")
env_set_test_stacomi()
r_mig_char <- new("report_mig_char")
r_mig_char <- choice_c(
r_mig_char,
dc = c(107, 108, 101),
taxa = c("Salmo salar"),
stage = c('5', '11', 'BEC', 'BER', 'IND'),
parquan = c('A124', 'C001'),
parqual = NULL,
horodatedebut = "2012-01-01",
horodatefin = "2012-12-31",
echantillon= "with",
silent = TRUE
)
expect_error(r_mig_char <- charge(r_mig_char), NA)
rm(list = ls(envir = envir_stacomi), envir = envir_stacomi)
})
test_that("test plot and xtable and summary method", {
skip_on_cran()
stacomi(database_expected = TRUE, sch ="logrami")
env_set_test_stacomi()
r_mig_char <- new("report_mig_char")
r_mig_char <- choice_c(
r_mig_char,
dc = c(107, 108, 101),
taxa = c("Salmo salar"),
stage = c('5', '11', 'BEC', 'BER', 'IND'),
parquan = c('A124', 'C001'),
parqual = NULL,
horodatedebut = "2012-01-01",
horodatefin = "2012-12-31",
silent = TRUE
)
r_mig_char <- connect(r_mig_char)
expect_error(suppressWarnings(plot(r_mig_char, plot.type = "quant", silent = TRUE)))
r_mig_char <- calcule(r_mig_char, silent = TRUE)
expect_error(suppressWarnings(plot(r_mig_char, plot.type = "quant", silent = TRUE)), NA)
# now with a qualitative parm
r_mig_char <- setasqualitative(
r_mig_char,
par = 'A124',
silent = TRUE,
breaks = c(0, 1.5, 2.5, 10),
label = c("age 1", "age 2", "age 3")
)
r_mig_char <- suppressMessages(calcule(r_mig_char, silent = TRUE))
expect_error(suppressWarnings(plot(r_mig_char, plot.type = "quant", silent = TRUE)), NA)
expect_error(suppressWarnings(plot(r_mig_char, plot.type = "crossed", silent = TRUE)), NA)
# when wrong limits are passed should fail
r_mig_char <- new("report_mig_char")
r_mig_char <- choice_c(
r_mig_char,
dc = c(107, 108, 101),
taxa = c("Salmo salar"),
stage = c('5', '11', 'BEC', 'BER', 'IND'),
parquan = c('C001'),
parqual = NULL,
horodatedebut = "2012-01-01",
horodatefin = "2012-12-31",
silent = TRUE
)
r_mig_char <- connect(r_mig_char)
r_mig_char <- calcule(r_mig_char)
expect_error(r_mig_char <- setasqualitative(
r_mig_char,
par = 'C001',
silent = TRUE,
breaks = c(0, 1.5, 2.5, 10),
label = c("missing", "missing", "missing")
))
expect_warning(r_mig_char <- setasqualitative(
r_mig_char,
par = 'C001',
silent = TRUE,
breaks = c(0, 1.5, 2.5, 600),
label = c("missing", "missing", "few")
))
r_mig_char <- calcule(r_mig_char, silent = TRUE)
# yes should only plot 3 points
expect_error(suppressWarnings(plot(r_mig_char, plot.type = "crossed", silent = TRUE)), NA)
su <- summary(r_mig_char)
expect_equal(class(su),"data.frame")
xt <- xtable(r_mig_char)
expect_equal(class(xt)[1],"xtable")
# test with several years
r_mig_char <- choice_c(
r_mig_char,
dc = c(107, 108, 101),
taxa = c("Salmo salar"),
stage = c('5', '11', 'BEC', 'BER', 'IND'),
parquan = c('A124', 'C001'),
parqual = NULL,
horodatedebut = "2012-01-01",
horodatefin = "2013-12-31",
silent = TRUE
)
r_mig_char <- connect(r_mig_char)
r_mig_char <- setasqualitative(
r_mig_char,
par = 'A124',
silent = TRUE,
breaks = c(0, 1.5, 2.5, 10),
labels = c("age 1", "age 2", "age 3")
)
r_mig_char <- calcule(r_mig_char, silent = TRUE)
su <- summary(r_mig_char)
expect_equal(class(su),"data.frame")
xt <- xtable(r_mig_char)
expect_equal(class(xt)[1],"xtable")
rm(list = ls(envir = envir_stacomi), envir = envir_stacomi)
})
Try the stacomiR 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.