tests/test-gadgetstock.R

library(Rgadget)
library(unittest, quietly = TRUE)
library(magrittr)

ver_string <- paste("; Generated by Rgadget", utils::packageVersion("Rgadget"))

# Read all files in a directory
dir_list <- function (dir) {
    files <- sort(list.files(dir, full.names = FALSE, recursive = TRUE), method = 'radix')
    structure(
        lapply(files, function (f) readLines(file.path(dir, f), n = -1)),
        names = files
    )
}

# Is vector (snippet) part of (full)?
part_of <- function(full, snippet) {
    # If positions of each part of snippet make an ordered list from start
    if (!is.na(match(snippet[[1]], full)) && identical(
            match(snippet, full),
            seq.int(match(snippet[[1]], full), along.with=snippet))) {
        return(TRUE)
    }
    # Fall back to ut_cmp_identical, which will show some difference
    ut_cmp_identical(full, snippet)
}

# Write string into temporary directory and read it back again as a gadget file
read.gadget.string <- function(..., file_type = "generic") {
    dir <- tempfile()
    dir.create(dir)
    writeLines(c(...), con = file.path(dir, "wibble"))
    read.gadget.file(dir, "wibble", file_type = file_type)
}

ok_group("Can create new stocks with some default content", {
    path <- tempfile()

    # MFDB data should look roughly like this
    data <- structure(
        data.frame(
            year = 1998,
            step = 1,
            area = rep(c('A', 'B'), each = 4, times = 1),
            age = rep(c('1', '9'), each = 1, times = 4),
            length = rep(c('len100', 'len200'), each = 1, times = 4),
            number = 10:17,
            mean = 20:27,
            stringsAsFactors = TRUE),
        area = list(A = 1:3, B = 4:6),
        length = list(
            len100 = structure(call("seq", 100, 200 - 1), min = 100, max = 200),
            len200 = structure(call("seq", 200, 300 - 1), min = 200, max = 300)))

    gadgetstock('codimm', path, missingOkay = TRUE) %>%  # Create a skeleton if missing
        gadget_update('stock', minage = 2, maxage = 4) %>%
        gadget_update('doeseat', maxconsumption = 100, halffeedingvalue = 70) %>%
        gadget_update('doesrenew', number = data) %>%
        write.gadget.file(path)
    ok(ut_cmp_identical(dir_list(path), list(
        "Modelfiles/codimm.rec.number" = c(
            ver_string,
            "; -- data --",
            "; year\tstep\tarea\tage\tlength\tnumber\tweight",
            "1998\t1\tA\t1\t100\t10\t20",
            "1998\t1\tA\t9\t200\t11\t21",
            "1998\t1\tA\t1\t100\t12\t22",
            "1998\t1\tA\t9\t200\t13\t23",
            "1998\t1\tB\t1\t100\t14\t24",
            "1998\t1\tB\t9\t200\t15\t25",
            "1998\t1\tB\t1\t100\t16\t26",
            "1998\t1\tB\t9\t200\t17\t27",
        NULL),
        codimm = c(
            ver_string,
            "stockname\tcodimm",
            "livesonareas\t",
            "minage\t2",
            "maxage\t4",
            "minlength\t",
            "maxlength\t",
            "dl\t",
            "refweightfile\t",
            "growthandeatlengths\t",
            "doesgrow\t1", "growthfunction\tlengthvbsimple", "growthparameters\t#codimm.Linf\t(* 0.001 #codimm.k)\t#codimm.walpha\t#codimm.wbeta", "beta\t(* 10 #codimm.bbin)", "maxlengthgroupgrowth\t15",
            "naturalmortality\t#codimm.M\t#codimm.M\t#codimm.M",
            "iseaten\t0",
            "doeseat\t1", "maxconsumption\t100", "halffeedingvalue\t70",
            "initialconditions",
            "doesmigrate\t0", "doesmature\t0", "doesmove\t0",
            "doesrenew\t1", "minlength\t100", "maxlength\t300", "dl\t100", "numberfile\tModelfiles/codimm.rec.number",
            "doesspawn\t0", "doesstray\t0",
        NULL),
        main = c(
            ver_string,
            "timefile\t",
            "areafile\t",
            "printfiles\t; Required comment",
            "[stock]",
            "stockfiles\tcodimm",
            "[tagging]",
            "[otherfood]",
            "[fleet]",
            "[likelihood]",
        NULL)
    )), "Wrote out stock file")

    gadgetstock('codimm', path, missingOkay = FALSE) %>%
        gadget_update('stock', maxage = 6, minlength = 10, maxlength = 20) %>%
        gadget_update('renewal', 0) %>% # Doesn't renew anymore, we use component name alias
        write.gadget.file(path)
    ok(ut_cmp_identical(dir_list(path), list(
        "Modelfiles/codimm.rec.number" = c(  # NB: We don't tidy up old files (yet)
            ver_string,
            "; -- data --",
            "; year\tstep\tarea\tage\tlength\tnumber\tweight",
            "1998\t1\tA\t1\t100\t10\t20",
            "1998\t1\tA\t9\t200\t11\t21",
            "1998\t1\tA\t1\t100\t12\t22",
            "1998\t1\tA\t9\t200\t13\t23",
            "1998\t1\tB\t1\t100\t14\t24",
            "1998\t1\tB\t9\t200\t15\t25",
            "1998\t1\tB\t1\t100\t16\t26",
            "1998\t1\tB\t9\t200\t17\t27",
        NULL),
        codimm = c(
            ver_string,
            "stockname\tcodimm",
            "livesonareas\t",
            "minage\t2",
            "maxage\t6",
            "minlength\t10",
            "maxlength\t20",
            "dl\t",
            "refweightfile\t",
            "growthandeatlengths\t",
            "doesgrow\t1", "growthfunction\tlengthvbsimple", "growthparameters\t#codimm.Linf\t(* 0.001 #codimm.k)\t#codimm.walpha\t#codimm.wbeta", "beta\t(* 10 #codimm.bbin)", "maxlengthgroupgrowth\t15",
            "naturalmortality\t#codimm.M\t#codimm.M\t#codimm.M\t#codimm.M\t#codimm.M", # NB: Now with extra defaults
            "iseaten\t0",
            "doeseat\t1", "maxconsumption\t100", "halffeedingvalue\t70",
            "initialconditions",
            "doesmigrate\t0", "doesmature\t0", "doesmove\t0",
            "doesrenew\t0", "doesspawn\t0", "doesstray\t0",
        NULL),
        main = c(
            ver_string,
            "timefile\t",
            "areafile\t",
            "printfiles\t; Required comment",
            "[stock]",
            "stockfiles\tcodimm",
            "[tagging]",
            "[otherfood]",
            "[fleet]",
            "[likelihood]",
        NULL)
    )), "Updated existing stock file")

    gadgetstock('codmat', path, missingOkay = TRUE) %>%
        write.gadget.file(path)
    ok(ut_cmp_identical(dir_list(path), list(
        "Modelfiles/codimm.rec.number" = c(
            ver_string,
            "; -- data --",
            "; year\tstep\tarea\tage\tlength\tnumber\tweight",
            "1998\t1\tA\t1\t100\t10\t20",
            "1998\t1\tA\t9\t200\t11\t21",
            "1998\t1\tA\t1\t100\t12\t22",
            "1998\t1\tA\t9\t200\t13\t23",
            "1998\t1\tB\t1\t100\t14\t24",
            "1998\t1\tB\t9\t200\t15\t25",
            "1998\t1\tB\t1\t100\t16\t26",
            "1998\t1\tB\t9\t200\t17\t27",
        NULL),
        codimm = c(
            ver_string,
            "stockname\tcodimm",
            "livesonareas\t",
            "minage\t2",
            "maxage\t6",
            "minlength\t10",
            "maxlength\t20",
            "dl\t",
            "refweightfile\t",
            "growthandeatlengths\t",
            "doesgrow\t1", "growthfunction\tlengthvbsimple", "growthparameters\t#codimm.Linf\t(* 0.001 #codimm.k)\t#codimm.walpha\t#codimm.wbeta", "beta\t(* 10 #codimm.bbin)", "maxlengthgroupgrowth\t15",
            "naturalmortality\t#codimm.M\t#codimm.M\t#codimm.M\t#codimm.M\t#codimm.M",
            "iseaten\t0",
            "doeseat\t1", "maxconsumption\t100", "halffeedingvalue\t70",
            "initialconditions",
            "doesmigrate\t0", "doesmature\t0", "doesmove\t0",
            "doesrenew\t0", "doesspawn\t0", "doesstray\t0",
        NULL),
        codmat = c(
            ver_string,
           "stockname\tcodmat",
            "livesonareas\t",
            "minage\t",
            "maxage\t",
            "minlength\t",
            "maxlength\t",
            "dl\t",
            "refweightfile\t",
            "growthandeatlengths\t",
            "doesgrow\t1", "growthfunction\tlengthvbsimple", "growthparameters\t#codmat.Linf\t(* 0.001 #codmat.k)\t#codmat.walpha\t#codmat.wbeta", "beta\t(* 10 #codmat.bbin)", "maxlengthgroupgrowth\t15",
            "naturalmortality\t",
            "iseaten\t0", "doeseat\t0",
            "initialconditions",
            "doesmigrate\t0", "doesmature\t0", "doesmove\t0",
            "doesrenew\t0", "doesspawn\t0", "doesstray\t0",
        NULL),
        main = c(
            ver_string,
            "timefile\t",
            "areafile\t",
            "printfiles\t; Required comment",
            "[stock]",
            "stockfiles\tcodmat\tcodimm",
            "[tagging]",
            "[otherfood]",
            "[fleet]",
            "[likelihood]",
        NULL)
    )), "Added new stock file, left old one alone")

    gadgetstock('codmat', path, missingOkay = TRUE) %>%
        gadget_update('doesmigrate', 
            yearstepfile = gadgetfile('data/yearstepfile', components = list(
                data.frame(year = 1998, step = 1:4, matrix = 'codmat-migration'))),
            definematrices = gadgetfile('data/migratematrix', components = list(
                migrationmatrix = list(name = 'codmat-migration'),
                data.frame(1:4, 1:4, 1:4, 1:4)))) %>%
        write.gadget.file(path)
    ok(ut_cmp_identical(dir_list(path), list(
        "Modelfiles/codimm.rec.number" = c(
            ver_string,
            "; -- data --",
            "; year\tstep\tarea\tage\tlength\tnumber\tweight",
            "1998\t1\tA\t1\t100\t10\t20",
            "1998\t1\tA\t9\t200\t11\t21",
            "1998\t1\tA\t1\t100\t12\t22",
            "1998\t1\tA\t9\t200\t13\t23",
            "1998\t1\tB\t1\t100\t14\t24",
            "1998\t1\tB\t9\t200\t15\t25",
            "1998\t1\tB\t1\t100\t16\t26",
            "1998\t1\tB\t9\t200\t17\t27",
        NULL),
        codimm = c(
            ver_string,
            "stockname\tcodimm",
            "livesonareas\t",
            "minage\t2",
            "maxage\t6",
            "minlength\t10",
            "maxlength\t20",
            "dl\t",
            "refweightfile\t",
            "growthandeatlengths\t",
            "doesgrow\t1", "growthfunction\tlengthvbsimple", "growthparameters\t#codimm.Linf\t(* 0.001 #codimm.k)\t#codimm.walpha\t#codimm.wbeta", "beta\t(* 10 #codimm.bbin)", "maxlengthgroupgrowth\t15",
            "naturalmortality\t#codimm.M\t#codimm.M\t#codimm.M\t#codimm.M\t#codimm.M",
            "iseaten\t0",
            "doeseat\t1", "maxconsumption\t100", "halffeedingvalue\t70",
            "initialconditions",
            "doesmigrate\t0", "doesmature\t0", "doesmove\t0",
            "doesrenew\t0", "doesspawn\t0", "doesstray\t0",
        NULL),
        codmat = c(
            ver_string,
            "stockname\tcodmat",
            "livesonareas\t",
            "minage\t",
            "maxage\t",
            "minlength\t",
            "maxlength\t",
            "dl\t",
            "refweightfile\t",
            "growthandeatlengths\t",
            "doesgrow\t1", "growthfunction\tlengthvbsimple", "growthparameters\t#codmat.Linf\t(* 0.001 #codmat.k)\t#codmat.walpha\t#codmat.wbeta", "beta\t(* 10 #codmat.bbin)", "maxlengthgroupgrowth\t15",
            "naturalmortality\t",
            "iseaten\t0",
            "doeseat\t0",
            "initialconditions",
            "doesmigrate\t1", "yearstepfile\tdata/yearstepfile", "definematrices\tdata/migratematrix",
            "doesmature\t0", "doesmove\t0",
            "doesrenew\t0", "doesspawn\t0", "doesstray\t0",
        NULL),
        "data/migratematrix" = c(
            ver_string,
            "[migrationmatrix]",
            "name\tcodmat-migration",
            "; -- data --",
            "; X1.4\tX1.4.1\tX1.4.2\tX1.4.3",
            "1\t1\t1\t1",
            "2\t2\t2\t2",
            "3\t3\t3\t3",
            "4\t4\t4\t4",
        NULL),
        "data/yearstepfile" = c(
            ver_string,
            "; -- data --",
            "; year\tstep\tmatrix",
            "1998\t1\tcodmat-migration",
            "1998\t2\tcodmat-migration",
            "1998\t3\tcodmat-migration",
            "1998\t4\tcodmat-migration",
        NULL),
        main = c(
            ver_string,
            "timefile\t",
            "areafile\t",
            "printfiles\t; Required comment",
            "[stock]",
            "stockfiles\tcodmat\tcodimm",
            "[tagging]",
            "[otherfood]",
            "[fleet]",
            "[likelihood]",
        NULL)
    )), "Added new stock file, left old one alone")
})

ok_group("Can detect some GADGET errors", {
    path <- tempfile()

    s <- gadgetstock('codimm', path, missingOkay = TRUE)
    ok(ut_cmp_error(
        gadget_update(s, 'idontexist', minage = 2, maxage = 4),
        "idontexist.*stock.*doesmigrate"), "Noticed bad stock name, suggested proper ones")

})

ok_group("Can populate naturalmortality", {
    path <- tempfile()

    gadgetstock('codimm', path, missingOkay = TRUE) %>%  # Create a skeleton if missing
        gadget_update('stock', minage = 2, maxage = 10) %>%
        gadget_update('naturalmortality', c(0.5, 0.8)) %>%
        write.gadget.file(path)
    ok(ut_cmp_identical(dir_list(path), list(
        codimm = c(
            ver_string,
            "stockname\tcodimm",
            "livesonareas\t",
            "minage\t2",
            "maxage\t10",
            "minlength\t",
            "maxlength\t",
            "dl\t",
            "refweightfile\t",
            "growthandeatlengths\t",
            "doesgrow\t1", "growthfunction\tlengthvbsimple", "growthparameters\t#codimm.Linf\t(* 0.001 #codimm.k)\t#codimm.walpha\t#codimm.wbeta", "beta\t(* 10 #codimm.bbin)", "maxlengthgroupgrowth\t15",
            "naturalmortality\t0.5\t0.8\t#codimm.M\t#codimm.M\t#codimm.M\t#codimm.M\t#codimm.M\t#codimm.M\t#codimm.M",
            "iseaten\t0",
            "doeseat\t0",
            "initialconditions",
            "doesmigrate\t0", "doesmature\t0", "doesmove\t0",
            "doesrenew\t0",
            "doesspawn\t0", "doesstray\t0",
        NULL),
        main = c(
            ver_string,
            "timefile\t",
            "areafile\t",
            "printfiles\t; Required comment",
            "[stock]",
            "stockfiles\tcodimm",
            "[tagging]",
            "[otherfood]",
            "[fleet]",
            "[likelihood]",
        NULL)
    )), "naturalmortality as long as age-groups, values given at start")

})

ok_group("Doesgrow defaults", {
    path <- tempfile()

    gadgetstock('codimm', path, missingOkay = TRUE) %>%  # Create a skeleton if missing
        gadget_update('stock', minage = 2, maxage = 10) %>%
        gadget_update('doesgrow', 1) %>%
        write.gadget.file(path)
    ok(ut_cmp_identical(dir_list(path)$codimm, c(
        ver_string,
        "stockname\tcodimm",
        "livesonareas\t",
        "minage\t2",
        "maxage\t10",
        "minlength\t",
        "maxlength\t",
        "dl\t",
        "refweightfile\t",
        "growthandeatlengths\t",
        "doesgrow\t1",
        "growthfunction\tlengthvbsimple",
        "growthparameters\t#codimm.Linf\t(* 0.001 #codimm.k)\t#codimm.walpha\t#codimm.wbeta",
        "beta\t(* 10 #codimm.bbin)",
        "maxlengthgroupgrowth\t15",
        "naturalmortality\t#codimm.M\t#codimm.M\t#codimm.M\t#codimm.M\t#codimm.M\t#codimm.M\t#codimm.M\t#codimm.M\t#codimm.M",
        "iseaten\t0",
        "doeseat\t0",
        "initialconditions",
        "doesmigrate\t0", "doesmature\t0", "doesmove\t0",
        "doesrenew\t0",
        "doesspawn\t0", "doesstray\t0",
        NULL)
    ), "Default values for doesgrow filled in")

})

ok_group("Refweight from a data.frame", {
    path <- tempfile()

    gadgetstock('codimm', path, missingOkay = TRUE) %>%  # Create a skeleton if missing
        gadget_update('refweight', data = data.frame(length = c(2,4,6,8,10), weight = 11:15)) %>%
        write.gadget.file(path)
    ok(ut_cmp_identical(dir_list(path), list(
        "Modelfiles/codimm.refwgt" = c(
            ver_string,
            "; -- data --",
            "; length\tweight",
            "2\t11", "4\t12", "6\t13", "8\t14", "10\t15",
        NULL),
        codimm = c(
            ver_string,
            "stockname\tcodimm",
            "livesonareas\t",
            "minage\t",
            "maxage\t",
            "minlength\t2",
            "maxlength\t10",
            "dl\t2",
            "refweightfile\tModelfiles/codimm.refwgt",
            "growthandeatlengths\t",
            "doesgrow\t1", "growthfunction\tlengthvbsimple", "growthparameters\t#codimm.Linf\t(* 0.001 #codimm.k)\t#codimm.walpha\t#codimm.wbeta", "beta\t(* 10 #codimm.bbin)", "maxlengthgroupgrowth\t15",
            "naturalmortality\t",
            "iseaten\t0",
            "doeseat\t0",
            "initialconditions",
            "doesmigrate\t0", "doesmature\t0", "doesmove\t0",
            "doesrenew\t0",
            "doesspawn\t0", "doesstray\t0",
        NULL),
        main = c(
            ver_string,
            "timefile\t",
            "areafile\t",
            "printfiles\t; Required comment",
            "[stock]",
            "stockfiles\tcodimm",
            "[tagging]",
            "[otherfood]",
            "[fleet]",
            "[likelihood]",
        NULL)
    )), "refweight tables both create table and update min/max/dl")

    gadgetstock('codimm', path, missingOkay = TRUE) %>%  # Create a skeleton if missing
        gadget_update('refweight', length = seq(10,28,3), alpha = 4, beta = 2) %>%
        write.gadget.file(path)
    ok(ut_cmp_identical(dir_list(path), list(
        "Modelfiles/codimm.refwgt" = c(
            ver_string,
            "; -- data --",
            "; length\tweight",
            "10\t400", "13\t676", "16\t1024", "19\t1444", "22\t1936", "25\t2500", "28\t3136",
        NULL),
        codimm = c(
            ver_string,
            "stockname\tcodimm",
            "livesonareas\t",
            "minage\t",
            "maxage\t",
            "minlength\t10",
            "maxlength\t28",
            "dl\t3",
            "refweightfile\tModelfiles/codimm.refwgt",
            "growthandeatlengths\t",
            "doesgrow\t1", "growthfunction\tlengthvbsimple", "growthparameters\t#codimm.Linf\t(* 0.001 #codimm.k)\t#codimm.walpha\t#codimm.wbeta", "beta\t(* 10 #codimm.bbin)", "maxlengthgroupgrowth\t15",
            "naturalmortality\t",
            "iseaten\t0",
            "doeseat\t0",
            "initialconditions",
            "doesmigrate\t0", "doesmature\t0", "doesmove\t0",
            "doesrenew\t0",
            "doesspawn\t0", "doesstray\t0",
        NULL),
        main = c(
            ver_string,
            "timefile\t",
            "areafile\t",
            "printfiles\t; Required comment",
            "[stock]",
            "stockfiles\tcodimm",
            "[tagging]",
            "[otherfood]",
            "[fleet]",
            "[likelihood]",
        NULL)
    )), "refweight tables can be derived from alpha/beta")
})

ok_group("Refweight from an MFDB data.frame", {
    path <- tempfile()

    # MFDB data should look roughly like this
    data <- structure(
        data.frame(
            area = rep(c('A', 'B'), each = 4, times = 1),
            length = rep(c('len100', 'len200'), each = 1, times = 4),
            number = 10:17,
            mean = 20:27,
            stringsAsFactors = TRUE),
        area = list(A = 1:3, B = 4:6),
        length = list(
            len100 = structure(call("seq", 100, 200 - 1), min = 100, max = 200),
            len200 = structure(call("seq", 200, 300 - 1), min = 200, max = 300)))

    gadgetstock('codimm', path, missingOkay = TRUE) %>%  # Create a skeleton if missing
        gadget_update('refweight', data = data) %>%
        write.gadget.file(path)
    ok(ut_cmp_identical(dir_list(path), list(
        "Modelfiles/codimm.refwgt" = c(
            ver_string,
            "; -- data --",
            "; length\tweight",
            "100\t20", "100\t22", "100\t24", "100\t26", "200\t21", "200\t23", "200\t25", "200\t27",
        NULL),
        codimm = c(
            ver_string,
            "stockname\tcodimm",
            "livesonareas\t",
            "minage\t",
            "maxage\t",
            "minlength\t100",
            "maxlength\t300",
            "dl\t100",
            "refweightfile\tModelfiles/codimm.refwgt",
            "growthandeatlengths\t",
            "doesgrow\t1", "growthfunction\tlengthvbsimple", "growthparameters\t#codimm.Linf\t(* 0.001 #codimm.k)\t#codimm.walpha\t#codimm.wbeta", "beta\t(* 10 #codimm.bbin)", "maxlengthgroupgrowth\t15",
            "naturalmortality\t",
            "iseaten\t0",
            "doeseat\t0",
            "initialconditions",
            "doesmigrate\t0", "doesmature\t0", "doesmove\t0",
            "doesrenew\t0",
            "doesspawn\t0", "doesstray\t0",
        NULL),
        main = c(
            ver_string,
            "timefile\t",
            "areafile\t",
            "printfiles\t; Required comment",
            "[stock]",
            "stockfiles\tcodimm",
            "[tagging]",
            "[otherfood]",
            "[fleet]",
            "[likelihood]",
        NULL)
    )), "refweight tables both create table and update min/max/dl, using attributes")

    gadgetstock('codimm', path, missingOkay = TRUE) %>%  # Create a skeleton if missing
        gadget_update('refweight', length = seq(10,28,3), alpha = 4, beta = 2) %>%
        write.gadget.file(path)
    ok(ut_cmp_identical(dir_list(path), list(
        "Modelfiles/codimm.refwgt" = c(
            ver_string,
            "; -- data --",
            "; length\tweight",
            "10\t400", "13\t676", "16\t1024", "19\t1444", "22\t1936", "25\t2500", "28\t3136",
        NULL),
        codimm = c(
            ver_string,
            "stockname\tcodimm",
            "livesonareas\t",
            "minage\t",
            "maxage\t",
            "minlength\t10",
            "maxlength\t28",
            "dl\t3",
            "refweightfile\tModelfiles/codimm.refwgt",
            "growthandeatlengths\t",
            "doesgrow\t1", "growthfunction\tlengthvbsimple", "growthparameters\t#codimm.Linf\t(* 0.001 #codimm.k)\t#codimm.walpha\t#codimm.wbeta", "beta\t(* 10 #codimm.bbin)", "maxlengthgroupgrowth\t15",
            "naturalmortality\t",
            "iseaten\t0",
            "doeseat\t0",
            "initialconditions",
            "doesmigrate\t0", "doesmature\t0", "doesmove\t0",
            "doesrenew\t0",
            "doesspawn\t0", "doesstray\t0",
        NULL),
        main = c(
            ver_string,
            "timefile\t",
            "areafile\t",
            "printfiles\t; Required comment",
            "[stock]",
            "stockfiles\tcodimm",
            "[tagging]",
            "[otherfood]",
            "[fleet]",
            "[likelihood]",
        NULL)
    )), "refweight tables can be derived from alpha/beta")
})

ok_group("initialconditions from MFDB data.frame", {
    path <- tempfile()

    # MFDB data should look roughly like this
    data <- structure(
        data.frame(
            area = rep(c('A', 'B'), each = 4, times = 1),
            age = rep(c('age5', 'age10'), each = 2, times = 2),
            length = rep(c('len100', 'len200'), each = 1, times = 4),
            number = 10:17,
            weight = 20:27,
            stringsAsFactors = TRUE),
        area = list(A = 1:3, B = 4:6),
        age = list(age5 = c(5:9), age10 = c(10:15)),
        length = list(
            len100 = structure(call("seq", 100, 200 - 1), min = 100, max = 200),
            len200 = structure(call("seq", 200, 300 - 1), min = 200, max = 300)))

    gadgetstock('codimm', path, missingOkay = TRUE) %>%
        gadget_update('initialconditions', number = data) %>%
        write.gadget.file(path)
    ok(ut_cmp_identical(dir_list(path), list(
        "Modelfiles/codimm.init.number" = c(
            ver_string,
            "; -- data --",
            "; age\tarea\tlength\tnumber\tweight",
            "age5\tA\t100\t10\t20",
            "age5\tA\t200\t11\t21",
            "age10\tA\t100\t12\t22",
            "age10\tA\t200\t13\t23",
            "age5\tB\t100\t14\t24",
            "age5\tB\t200\t15\t25",
            "age10\tB\t100\t16\t26",
            "age10\tB\t200\t17\t27",
            NULL),
        "codimm" = c(
            ver_string,
            "stockname\tcodimm",
            "livesonareas\t",
            "minage\t",
            "maxage\t",
            "minlength\t",
            "maxlength\t",
            "dl\t",
            "refweightfile\t",
            "growthandeatlengths\t",
            "doesgrow\t1",
            "growthfunction\tlengthvbsimple",
            "growthparameters\t#codimm.Linf\t(* 0.001 #codimm.k)\t#codimm.walpha\t#codimm.wbeta",
            "beta\t(* 10 #codimm.bbin)",
            "maxlengthgroupgrowth\t15",
            "naturalmortality\t",
            "iseaten\t0",
            "doeseat\t0",
            "initialconditions",
            "minage\t5",
            "maxage\t15",
            "minlength\t100",
            "maxlength\t300",
            "dl\t100",
            "numberfile\tModelfiles/codimm.init.number",
            "doesmigrate\t0",
            "doesmature\t0",
            "doesmove\t0",
            "doesrenew\t0",
            "doesspawn\t0",
            "doesstray\t0",
            NULL),
        "main" = c(
            ver_string,
            "timefile\t",
            "areafile\t",
            "printfiles\t; Required comment",
            "[stock]",
            "stockfiles\tcodimm",
            "[tagging]",
            "[otherfood]",
            "[fleet]",
            "[likelihood]",
            NULL)
    )), "Generate initialconditions from MFDB data")
})

ok_group("Generate maturation files", {
    path <- tempfile()

    gadgetstock('codimm', path, missingOkay = TRUE) %>%  # Create a skeleton if missing
        gadget_update(
            'maturation',
            maturityfunction = 'constant',
            maturestocksandratios = c('codimm', 0.9, 'codmat', 0.1),
            coefficients = c(0.24, 0.25, 0.15, 0.25)) %>%
        write.gadget.file(path)
    ok(ut_cmp_identical(dir_list(path)$codimm, c(
        ver_string,
        "stockname\tcodimm",
        "livesonareas\t",
        "minage\t",
        "maxage\t",
        "minlength\t",
        "maxlength\t",
        "dl\t",
        "refweightfile\t",
        "growthandeatlengths\t",
        "doesgrow\t1",
        "growthfunction\tlengthvbsimple",
        "growthparameters\t#codimm.Linf\t(* 0.001 #codimm.k)\t#codimm.walpha\t#codimm.wbeta",
        "beta\t(* 10 #codimm.bbin)",
        "maxlengthgroupgrowth\t15",
        "naturalmortality\t",
        "iseaten\t0",
        "doeseat\t0",
        "initialconditions",
        "doesmigrate\t0",
        "doesmature\t1", "maturityfunction\tconstant", "maturityfile\tModelfiles/codimm.maturity",
        "doesmove\t0",
        "doesrenew\t0",
        "doesspawn\t0", "doesstray\t0",
        NULL)
    ), "Filled in doesmature")
    ok(ut_cmp_identical(dir_list(path)[['Modelfiles/codimm.maturity']], c(
        ver_string,
        "maturestocksandratios\tcodimm\t0.9\tcodmat\t0.1",
        "coefficients\t0.24\t0.25\t0.15\t0.25",
        NULL)
    ), "Rest of parameters went into maturity file")

})

ok_group("Numeric recruitment from MFDB data.frame", {
    path <- tempfile()

    # MFDB data should look roughly like this
    data <- structure(
        data.frame(
            year = 1998,
            step = 'all',
            area = rep(c('A', 'B'), each = 4, times = 1),
            age = rep(c('age5', 'age10'), each = 2, times = 2),
            length = rep(c('len100', 'len200'), each = 1, times = 4),
            number = 10:17,
            mean = 20:27,
            stringsAsFactors = TRUE),
        year = list("1998" = 1998),
        step = list(all = 1:4),
        area = list(A = 1:3, B = 4:6),
        age = list(age5 = c(5:9), age10 = c(10:15)),
        length = list(
            len100 = structure(call("seq", 100, 200 - 1), min = 100, max = 200),
            len200 = structure(call("seq", 200, 300 - 1), min = 200, max = 300)))

    gadgetstock('codimm', path, missingOkay = TRUE) %>%
        gadget_update('doesrenew', number = data) %>%
        write.gadget.file(path)
    ok(ut_cmp_identical(dir_list(path), list(
        "Modelfiles/codimm.rec.number" = c(
            ver_string,
            "; -- data --",
            "; year\tstep\tarea\tage\tlength\tnumber\tweight",
            "1998\tall\tA\tage5\t100\t10\t20",
            "1998\tall\tA\tage5\t200\t11\t21",
            "1998\tall\tA\tage10\t100\t12\t22",
            "1998\tall\tA\tage10\t200\t13\t23",
            "1998\tall\tB\tage5\t100\t14\t24",
            "1998\tall\tB\tage5\t200\t15\t25",
            "1998\tall\tB\tage10\t100\t16\t26",
            "1998\tall\tB\tage10\t200\t17\t27",
            NULL),
        "codimm" = c(
            ver_string,
            "stockname\tcodimm",
            "livesonareas\t",
            "minage\t",
            "maxage\t",
            "minlength\t",
            "maxlength\t",
            "dl\t",
            "refweightfile\t",
            "growthandeatlengths\t",
            "doesgrow\t1",
            "growthfunction\tlengthvbsimple",
            "growthparameters\t#codimm.Linf\t(* 0.001 #codimm.k)\t#codimm.walpha\t#codimm.wbeta",
            "beta\t(* 10 #codimm.bbin)",
            "maxlengthgroupgrowth\t15",
            "naturalmortality\t",
            "iseaten\t0",
            "doeseat\t0",
            "initialconditions",
            "doesmigrate\t0",
            "doesmature\t0",
            "doesmove\t0",
            "doesrenew\t1", "minlength\t100", "maxlength\t300", "dl\t100", "numberfile\tModelfiles/codimm.rec.number",
            "doesspawn\t0",
            "doesstray\t0",
            NULL),
        "main" = c(
            ver_string,
            "timefile\t",
            "areafile\t",
            "printfiles\t; Required comment",
            "[stock]",
            "stockfiles\tcodimm",
            "[tagging]",
            "[otherfood]",
            "[fleet]",
            "[likelihood]",
            NULL)
    )), "Generate recruitment from MFDB data")
})

ok_group("Multiple suitability functions", {
    path <- tempfile()

    gadgetstock('simple_stock', path, missingOkay = TRUE) %>%
        gadget_update('doeseat',
                  suitability = list(
                      prey = list(type='function',suit_func = 'constant', alpha = 1),
                      otherfood = list(type='function',suit_func = 'constant', alpha = 1e5)),
                  preference = list(prey = 0.75,otherfood = 0.25),
                  maxconsumption = list(m0=1,m1=0,m2=0,m3=0,m4=0),
                  halffeedingvalue = 0.5) %>%
        write.gadget.file(path)
    ok(part_of(dir_list(path)$simple_stock, c(
        "suitability",
        "prey\tfunction\tconstant\t1",
        "otherfood\tfunction\tconstant\t1e+05",
        "preference\t0.75\t0.25",
        "maxconsumption\t1\t0\t0\t0\t0",
        "halffeedingvalue\t0.5")), "suitibility functions each in a sub-section")
})
Hafro/rgadget documentation built on July 21, 2022, 8:38 a.m.