tests/testthat/test-impl-idd.R

In hongyuanjia/eplusr: A Toolkit for Using Whole Building Simulation Program 'EnergyPlus'

test_that("Idd implementation", {
    expect_silent(idd_parsed <- parse_idd_file(idftext("idd", "9.9.9")))

    # GROUP {{{
    expect_equal(get_idd_group_index(idd_parsed), 1L:2L)
    expect_equal(get_idd_group_index(idd_parsed, "TestGroup2"), 2L)
    expect_error(get_idd_group_index(idd_parsed, "Wrong"), class = "eplusr_error_invalid_group_name")
    expect_equal(get_idd_group_name(idd_parsed), c("TestGroup1", "TestGroup2"))
    expect_equal(get_idd_group_name(idd_parsed, 2L), "TestGroup2")
    expect_error(get_idd_group_name(idd_parsed, 3), class = "eplusr_error_invalid_group_index")
    # }}}

    # CLASS {{{
    expect_equal(
        ignore_attr = TRUE,
        get_idd_class(idd_parsed),
        idd_parsed$class[, .SD, .SDcols = c("class_id", "class_name", "group_id")]
    )
    expect_equal(
        ignore_attr = TRUE,
        d <- get_idd_class(idd_parsed, property = c("group_name", "group_id"))[],
        data.table(
            class_id = 1:2, class_name = c("TestSimple", "TestSlash"),
            group_id = 1:2, group_name = c("TestGroup1", "TestGroup2")
        )
    )
    expect_equal(
        ignore_attr = TRUE,
        get_idd_class(idd_parsed, property = "group_name"),
        set(idd_parsed$class[, .SD, .SDcols = c("class_id", "class_name", "group_id")],
            NULL, "group_name", c("TestGroup1", "TestGroup2")
        )
    )
    expect_error(get_idd_class(idd_parsed, ""), class = "eplusr_error_invalid_class_name")
    expect_error(get_idd_class(idd_parsed, 10L), class = "eplusr_error_invalid_class_index")

    expect_equal(
        get_idd_class(idd_parsed, c(2L, 1L)),
        data.table(rleid = 1:2, class_id = c(2L, 1L),
            class_name = c("TestSlash", "TestSimple"), group_id = c(2L, 1L))
    )
    expect_equal(
        get_idd_class(idd_parsed, c(2L, 1L), "group_name"),
        data.table(rleid = 1:2, class_id = c(2L, 1L),
            class_name = c("TestSlash", "TestSimple"), group_id = c(2L, 1L),
            group_name = c("TestGroup2", "TestGroup1")
        )
    )
    expect_equal(
        get_idd_class(idd_parsed, c("TestSlash", "TestSimple")),
        data.table(rleid = 1:2, class_id = c(2L, 1L),
            class_name = c("TestSlash", "TestSimple"), group_id = c(2L, 1L))
    )
    expect_equal(
        get_idd_class(idd_parsed, c("TestSlash", "TestSimple"), "min_fields"),
        data.table(rleid = 1:2, class_id = c(2L, 1L),
            class_name = c("TestSlash", "TestSimple"), group_id = c(2L, 1L),
            min_fields = c(3L, 0L)
        )
    )
    expect_equal(
        ignore_attr = TRUE,
       
        get_idd_class(idd_parsed, NULL, "min_fields"),
        data.table(class_id = c(1L, 2L),
            class_name = c("TestSimple", "TestSlash"), group_id = c(1L, 2L),
            min_fields = c(0L, 3L)
        )
    )

    expect_equal(
            ignore_attr = TRUE,
            get_idd_class_field_num(copy(idd_parsed$class)),
        set(copy(idd_parsed$class), NULL, c("input_num", "acceptable_num"), list(0L, c(0L, 3L)))
    )
    expect_equal(
            ignore_attr = TRUE,
            names(get_idd_class_field_num(idd_parsed$class[0L])),
        names(set(idd_parsed$class[0L], NULL, c("input_num", "acceptable_num"), integer(0))[])
    )

    expect_equal(get_class_component_name("Material"), "Material")
    expect_equal(get_class_component_name("Material:NoMass"), "Material")
    expect_equal(get_class_component_name("BuildingSurface:Detailed"), "BuildingSurface")
    # }}}

    # EXTENSIBLE GROUP {{{
    # ADD {{{
    expect_equal(
        {
            cls <- get_idd_class(idd_parsed, "TestSimple", property = c("min_fields", "num_fields", "num_extensible", "last_required", "num_extensible_group"))
            add_idd_extensible_group(idd_parsed, cls, 1)$field
        },
        idd_parsed$field
    )
    expect_equal(add_idd_extensible_group(idd_parsed, "TestSimple", 1)$field, idd_parsed$field)
    expect_error(add_idd_extensible_group(idd_parsed, "TestSimple", 1, strict = TRUE), "Non-extensible class", class = "eplusr_error_non_extensible_class")
    expect_equal(nrow(idd_added <- add_idd_extensible_group(idd_parsed, "TestSlash", 2)$field), 13L)
    expect_equal(nrow((idd_added <- add_idd_extensible_group(idd_parsed, "TestSlash", 1))$field), 9L)
    expect_equal(idd_added$class$num_fields[2L], 8L)
    expect_equal(idd_added$class$num_extensible_group[2L], 2L)
    expect_equal(idd_added$field$field_id[6:9], 6L:9L)
    expect_equal(idd_added$field$class_id[6:9], rep(2L, 4L))
    expect_equal(idd_added$field$field_index[6:9], 5L:8L)
    expect_equal(idd_added$field$field_name[6:9],
        c("Test Character Field 3", "Test Numeric Field 3",
          "Test Numeric Field 4", "Test Character Field 4")
    )
    expect_equal(idd_added$field$field_name_us[6:9],
        c("test_character_field_3", "test_numeric_field_3",
          "test_numeric_field_4", "test_character_field_4")
    )
    cols <- c("field_index", "field_id", "field_anid", "required_field",
        "field_name", "field_name_us", "extensible_group"
    )
    expect_equal(idd_added$field[6:9, -..cols], idd_added$field[2:5, -..cols])
    expect_equal(idd_added$field$field_id[6:9], 6L:9L)
    expect_equal(idd_added$field$field_anid[6:9], c("A3", "N3", "N4", "A4"))
    expect_equal(idd_added$field$required_field[6:9], rep(FALSE, 4L))
    expect_equal(idd_added$field$extensible_group[6:9], rep(2L, 4L))

    # references of extensible fields should be automatically generated
    expect_silent(idd_added <- add_idd_extensible_group(idd_parsed, "TestSlash", 1))
    expect_equal(idd_added$reference,
        data.table(class_id = 2L, field_id = c(2L, 6L), src_class_id = 1L, src_field_id = 1L, src_enum = 2L)
    )
    # }}}
    # DEL {{{
    expect_error(del_idd_extensible_group(idd_parsed, "TestSimple", 1, strict = TRUE), "Non-extensible class", class = "eplusr_error_non_extensible_class")
    expect_equal(
    ignore_attr = TRUE,
    (idd_del <- del_idd_extensible_group(idd_added, "TestSlash", 1))$field, idd_parsed$field)
    expect_equal(idd_del$class$num_fields[2L], 4L)
    expect_equal(idd_del$class$num_extensible_group[2L], 1L)
    expect_error(del_idd_extensible_group(idd_del, "TestSlash", 4), "0 left with 1 required", class = "eplusr_error")
    # }}}
    # }}}

    # FIELD {{{
    ## USING CLASS {{{
    expect_error(get_idd_field(idd_parsed, 10), class = "eplusr_error_invalid_class_index")
    expect_error(get_idd_field(idd_parsed, ""), class = "eplusr_error_invalid_class_name")
    expect_equal(get_idd_field(idd_parsed, c("TestSimple", "TestSlash")),
        data.table(field_id = 1:4, class_id = c(1L, rep(2L, 3)),
            field_index = c(1L, 1:3),
            field_name = c("Test Field", "Test Character Field 1",
                paste("Test Numeric Field", 1:2)),
            rleid = c(1L, rep(2L, 3)), class_name = c("TestSimple", rep("TestSlash", 3))
        )
    )
    expect_equal(
            ignore_attr = TRUE,
            get_idd_field(idd_parsed, c("TestSimple", "TestSlash"), all = TRUE),
        data.table(field_id = 1:5, class_id = c(1L, rep(2L, 4)),
            field_index = c(1L, 1:4),
            field_name = c("Test Field", "Test Character Field 1",
                paste("Test Numeric Field", 1:2), "Test Character Field 2"),
            rleid = c(1L, rep(2L, 4)), class_name = c("TestSimple", rep("TestSlash", 4))
        )
    )
    expect_equal(
            ignore_attr = TRUE,
            get_idd_field(idd_parsed, c("TestSimple", "TestSlash"), property = "type_enum"),
        data.table(field_id = 1:4, class_id = c(1L, rep(2L, 3)),
            field_index = c(1L, 1:3),
            field_name = c("Test Field", "Test Character Field 1",
                paste("Test Numeric Field", 1:2)),
            type_enum = c(4L, 5L, 2L, 2L), rleid = c(1L, rep(2L, 3)),
            class_name = c("TestSimple", rep("TestSlash", 3))
        )
    )
    # }}}
    ## USING FIELD INDEX {{{
    expect_error(get_idd_field(idd_parsed, c("TestSimple", "TestSlash"), c(2, 2)), class = "eplusr_error_invalid_field_index")
    expect_error(get_idd_field(idd_parsed, c("TestSimple", "TestSlash"), c(2, 2, 3)), "Must have same length")
    expect_error(get_idd_field(idd_parsed, c("TestSimple", "TestSlash"), c(1, 10), no_ext = TRUE), class = "eplusr_error_invalid_field_index")
    expect_equal(get_idd_field(idd_parsed, c("TestSimple", "TestSlash", "TestSlash"), c(1, 3, 99)),
        data.table(field_id = c(1L, 4L, 100L), class_id = c(1L, 2L, 2L),
            field_index = c(1L, 3L, 99L),
            field_name = c("Test Field", "Test Numeric Field 2", "Test Numeric Field 50"),
            rleid = c(1L, 2L, 3L), class_name = c("TestSimple", "TestSlash", "TestSlash"),
            field_in = c(1L, 3L, 99L)
        )
    )
    expect_silent({fld <- get_idd_field(idd_parsed, c("TestSlash", "TestSlash"), c(3, 19), all = TRUE)})
    expect_equal(fld,
        data.table(field_id = c(2:5, 2:21), class_id = rep(2L, 24), field_index = c(1:4, 1:20),
            field_name = paste0(
                rep(c("Test Character Field ", "Test Numeric Field ", "Test Numeric Field ", "Test Character Field "), times = 6),
                c(rep(1:2, each = 2), rep(1:10, each = 2))
            ),
            rleid = c(rep(1L, 4), rep(2L, 20)), class_name = rep("TestSlash", 24),
            field_in = c(rep(NA_real_, 2), 3L, rep(NA_real_, 19), 19L, NA_real_)
        )
    )
    expect_silent({fld <- get_idd_field(idd_parsed, c("TestSlash", "TestSlash"), c(3, 19), complete = TRUE)})
    expect_equal(fld,
        data.table(field_id = c(2:5, 2:21), class_id = rep(2L, 24), field_index = c(1:4, 1:20),
            field_name = paste0(
                rep(c("Test Character Field ", "Test Numeric Field ", "Test Numeric Field ", "Test Character Field "), times = 6),
                c(rep(1:2, each = 2), rep(1:10, each = 2))
            ),
            rleid = c(rep(1L, 4), rep(2L, 20)), class_name = rep("TestSlash", 24),
            field_in = c(rep(NA_real_, 2), 3L, rep(NA_real_, 19), 19L, NA_real_)
        )
    )
    # }}}
    ## USING FIELD NAME {{{
    expect_equal(get_idd_field(idd_parsed, c(1L, 2L), c("test_field", "test_numeric_field_2")),
        data.table(field_id = c(1L, 4L), class_id = c(1L, 2L), field_index = c(1L, 3L),
            field_name = c("Test Field", "Test Numeric Field 2"),
            rleid = c(1L, 2L), class_name = c("TestSimple", "TestSlash"),
            field_in = c("test_field", "test_numeric_field_2")
        )
    )
    expect_equal(get_idd_field(idd_parsed, c(1L, 2L), c("test_field", "test_numeric_field_2"), complete = TRUE),
        data.table(field_id = 1:5, class_id = c(1L, rep(2L, 4)), field_index = c(1L, 1:4),
            field_name = c("Test Field", "Test Character Field 1", "Test Numeric Field 1",
                "Test Numeric Field 2", "Test Character Field 2"
            ),
            rleid = c(1L, rep(2L, 4)), class_name = c("TestSimple", rep("TestSlash", 4)),
            field_in = c("test_field", rep(NA_character_, 2),
                "test_numeric_field_2", NA_character_
            )
        )
    )
    expect_error(get_idd_field(idd_parsed, "TestSimple", ""), class = "eplusr_error_invalid_field_name")
    expect_error(get_idd_field(idd_parsed, "TestSlash", ""), class = "eplusr_error_invalid_field_name")
    expect_error(get_idd_field(idd_parsed, "TestSlash", "", no_ext = TRUE), class = "eplusr_error_invalid_field_name")
    expect_equal(get_idd_field(idd_parsed, 1L, "Test Field", underscore = FALSE),
        data.table(field_id = 1L, class_id = 1L, field_index = 1L,
            field_name = "Test Field", rleid = 1L, class_name = "TestSimple",
            field_in = "Test Field"
        )
    )
    expect_equal(get_idd_field(idd_parsed, c(1L, 2L), c("test_field", "test_numeric_field_3")),
        data.table(field_id = c(1L, 7L), class_id = c(1L, 2L), field_index = c(1L, 6L),
            field_name = c("Test Field", "Test Numeric Field 3"),
            rleid = c(1L, 2L), class_name = c("TestSimple", "TestSlash"),
            field_in = c("test_field", "test_numeric_field_3")
        )
    )
    expect_equal(get_idd_field(idd_parsed, c(1L, 2L), c("test_field", "test_numeric_field_3"), all = TRUE),
        data.table(field_id = 1:9, class_id = c(1L, rep(2L, 8)), field_index = c(1L, 1:8),
            field_name = c("Test Field",
                paste0(
                    rep(c("Test Character Field ", "Test Numeric Field ", "Test Numeric Field ", "Test Character Field "), 2),
                    rep(1:4, each = 2)
                )),
            rleid = c(1L, rep(2L, 8)), class_name = c("TestSimple", rep("TestSlash", 8)),
            field_in = c("test_field", rep(NA_character_, 5),
                "test_numeric_field_3", rep(NA_character_, 2)
            )
        )
    )
    expect_equal(get_idd_field(idd_parsed, c(1L, 2L), c("test_field", "test_numeric_field_3"), complete = TRUE),
        data.table(field_id = 1:9, class_id = c(1L, rep(2L, 8)), field_index = c(1L, 1:8),
            field_name = c("Test Field",
                paste0(
                    rep(c("Test Character Field ", "Test Numeric Field ", "Test Numeric Field ", "Test Character Field "), 2),
                    rep(1:4, each = 2)
                )),
            rleid = c(1L, rep(2L, 8)), class_name = c("TestSimple", rep("TestSlash", 8)),
            field_in = c("test_field", rep(NA_character_, 5),
                "test_numeric_field_3", rep(NA_character_, 2)
            )
        )
    )
    expect_equal(nrow(get_idd_field(idd_parsed, 2L, "test_numeric_field_3", all = TRUE)), 8L)

    expect_equal(get_idd_field(idd_parsed, 2, "test_numeric_field_2", all = TRUE)$field_index, 1:4)
    # }}}
    # }}}

    # RELATION {{{
    expect_equal(
            ignore_attr = TRUE,
           
        get_idd_relation(idd_parsed, name = TRUE),
        data.table(
            class_id = 2L, class_name = "TestSlash",
            field_id = 2L, field_index = 1L, field_name = "Test Character Field 1",
            src_class_id = 1L, src_class_name = "TestSimple",
            sec_field_id = 1L, src_field_index = 1L, src_field_name = "Test Field",
            src_enum = 2L, dep = 0L
        )
    )
    expect_equal(
            ignore_attr = TRUE,
           
        get_idd_relation(idd_parsed, name = TRUE, direction = "ref_by"),
        data.table(
            class_id = 2L, class_name = "TestSlash",
            field_id = 2L, field_index = 1L, field_name = "Test Character Field 1",
            src_class_id = 1L, src_class_name = "TestSimple",
            src_field_id = 1L, src_field_index = 1L, src_field_name = "Test Field",
            src_enum = 2L, dep = 0L
        )
    )

    idd <- use_idd(LATEST_EPLUS_VER, "auto")
    idd_env <- get_priv_env(idd)$idd_env()
    fld <- get_idd_field(idd_env, "Construction")
    expect_equal(nrow(get_idd_relation(idd_env, field_id = fld$field_id, direction = "ref_to", keep_all = TRUE, depth = 0L)), 15L)

    fld <- get_idd_field(idd_env, "Material")
    expect_equal(nrow(get_idd_relation(idd_env, field_id = fld$field_id, direction = "ref_to", depth = NULL)), 0L)
    expect_equal(nrow(get_idd_relation(idd_env, class_id = fld$class_id, direction = "ref_to", depth = NULL)), 0L)
    expect_error(get_idd_relation(idd_env, class_id = fld$class_id, field_id = fld$field_id), class = "eplusr_error_idd_relation")

    fld <- get_idd_field(idd_env, "Construction")
    expect_equal(nrow(get_idd_relation(idd_env, field_id = fld$field_id, direction = "ref_by", keep_all = TRUE, depth = 2L)), 32871L)

    fld <- get_idd_field(idd_env, "Construction", 2L)
    expect_equal(nrow(get_idd_relation(idd_env, field_id = fld$field_id, direction = "ref_to", depth = 0L)), 14L)

    fld <- get_idd_field(idd_env, "Construction", 1L)
    expect_equal(nrow(get_idd_relation(idd_env, field_id = fld$field_id, direction = "ref_by", depth = 3L, class = "PlantEquipmentOperationSchemes")), 282L)

    fld <- get_idd_field(idd_env, "Branch", 3:4)
    expect_equal(nrow(get_idd_relation(idd_env, field_id = fld$field_id, direction = "ref_to", depth = 0L)), 131L)

    fld <- get_idd_field(idd_env, "Pump:ConstantSpeed")
    expect_equal(nrow(get_idd_relation(idd_env, field_id = fld$field_id, direction = "ref_by",
            group = "Node-Branch Management", depth = 2L)), 11L)
    fld <- get_idd_field(idd_env, "Branch", 1:4, property = "type_enum")
    expect_equal(nrow(get_idd_relation(idd_env, field_id = fld$field_id, direction = "ref_to",
            class_ref = "none", group = "Node-Branch Management", depth = 0L)), 7L)
    expect_equal(nrow(get_idd_relation(idd_env, field_id = fld$field_id, direction = "ref_to",
            class_ref = "all", group = "Node-Branch Management", depth = 0L)), 14L)

    expect_equal(nrow(get_idd_relation(idd_env, field_id = fld$field_id, class = "Version")), 0L)
    # }}}

    # PROPERTY COLUMNS {{{
    dt_in <- idd_env$class[1:5, .(class_name)]
    expect_equal(add_class_id(idd_env, dt_in), set(dt_in, NULL, "class_id", list(1:5)))

    dt_in <- idd_env$class[1:3, .(class_id)]
    expect_equal(add_class_name(idd_env, dt_in),
        set(dt_in, NULL, "class_name", list(c("Version", "SimulationControl", "Building"))))

    dt_in <- idd_env$class[1:3, .(class_id)]
    expect_equal(add_class_property(idd_env, dt_in, c("group_name", "num_fields")),
        set(dt_in, NULL, c("num_fields", "group_name"), list(c(1L, 7:8), "Simulation Parameters")))
    dt_in <- idd_env$class[1:3, .(class_id, group_id)]
    expect_equal(add_class_property(idd_env, dt_in, c("group_name", "num_fields")),
        set(dt_in, NULL, c("num_fields", "group_name"), list(c(1L, 7:8), "Simulation Parameters")))

    dt_in <- idd_env$field[1:3, .(field_id)]
    expect_equal(add_field_property(idd_env, dt_in, "type_enum"),
        set(dt_in, NULL, "type_enum", list(c(4L, 3L, 3L))))
    # }}}

    # UNIT CONVERSION {{{
    fld <- get_idd_field(idd_env, "WindowMaterial:Glazing:RefractionExtinctionMethod", 9, property = c("units", "ip_units"))
    expect_equal(field_default_to_unit(idd_env, fld, "si", "ip")$default_num,
        drop_units(set_units(set_units(0.9, "W/m/K"), "Btu*in/h/ft^2/degF"))
    )

    # can keep input value_id
    fld <- get_idd_field(idd_env, "Material", 1:6)
    set(fld, NULL, "value_id", 1:6)
    expect_equal(field_default_to_unit(idd_env, fld, "si", "ip")$value_id, 1:6)
    # }}}

    # TABLE {{{
    expect_equal(get_idd_table(idd_parsed, 1),
        data.table(class = "TestSimple", index = 1L, field = "Test Field")
    )
    # }}}

    # STRING {{{
    expect_equal(get_idd_string(idd_parsed, 2, leading = 0L, sep_at = 0L),
        c("TestSlash,",
          ",!- Test Character Field 1",
          ",!- Test Numeric Field 1 {m}",
          ";!- Test Numeric Field 2"
        )

    )
    # }}}
})

# vim: set fdm=marker: