R/impl-geom.R

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

get_first_vertex_field_index <- function(ver) {
    c(
        "Zone" = 3L,

        # NOTE: handle 'Space' class added in EnergyPlus v9.6
        "BuildingSurface:Detailed"     = if (ver < "9.6") 11L else 12L,
        "Wall:Detailed"                = if (ver < "9.6") 10L else 11L,
        "RoofCeiling:Detailed"         = if (ver < "9.6") 10L else 11L,
        "Floor:Detailed"               = if (ver < "9.6") 10L else 11L,

        # NOTE: 7th 'Shading Control Name' field has been removed in EnergyPlus v9.0
        "FenestrationSurface:Detailed" = if (ver < "9.0") 11L else 10L,

        "Shading:Site:Detailed"        = 4L,
        "Shading:Building:Detailed"    = 4L,
        "Shading:Zone:Detailed"        = 5L
    )
}

# get_geom_class {{{
get_geom_class <- function(idf, object = NULL) {
    # geometry and daylighting points
    cls <- idf$class_name(by_group = TRUE)[c("Thermal Zones and Surfaces", "Daylighting")]
    cls <- data.table(class = unlist(cls))
    # category by class names
    set(cls, NULL, c("type", "subtype", "misc"),
        as.data.table(stri_split_fixed(cls$class, ":", n = 3L, simplify = TRUE))
    )

    cls[type %chin% c("BuildingSurface", "Wall", "RoofCeiling", "Floor", "Wall", "Roof", "Ceiling"), category := "Surface"]
    cls[type %chin% c("FenestrationSurface", "Window", "Door", "GlazedDoor"), category := "SubSurface"]
    cls[type == "RoofCeiling", subtype := "Roof"]
    cls[type == "Shading", category := "Shading"]
    cls[type == "Daylighting", category := "Daylighting"]
    cls <- setcolorder(cls[!J(NA_character_), on = "category"], "category")

    if (is.null(object)) return(cls)

    obj <- get_idf_object(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(),
        object = object, ignore_case = TRUE)[, list(class = class_name,
            id = object_id, name = object_name)]

    cls[obj, on = "class", nomatch = NULL]
}
# }}}

# get_global_geom_rules {{{
get_global_geom_rules <- function(idf) {
    if (!idf$is_valid_class("GlobalGeometryRules")) {
        warn("No 'GlobalGeometryRules' object found in current IDF. Assuming all defaults.",
            "geom_no_global_geom_rules"
        )
        rules <- list(
            starting_vertex_position = "upperleftcorner",
            vertex_entry_direction = "counterclockwise",
            coordinate_system = "relative",
            daylighting_reference_point_coordinate_system = "relative",
            rectangular_surface_coordinate_system = "relative"
        )
    } else {
        rules <- get_idf_value(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(),
            "GlobalGeometryRules", all = TRUE, property = "choice"
        )
        # assign default value for missing fields
        if (any(i <- rules$value_id < 0L)) {
            rules <- assign_idf_value_default(
                get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(),
                rules[value_id < 0L, defaulted := TRUE]
            )
            set(rules, NULL, "defaulted", NULL)
        }

        choices <- rules$choice
        rules <- setattr(as.list(rules$value_chr), "names", rules$field_name)

        for (i in seq_along(rules)) {
            if (is.na(rules[[i]])) {
                warn(sprintf("Empty '%s' found in 'GlobalGeometryRules'. Assuming '%s'.",
                    names(rules[i]), choices[[i]][[1L]]
                ), "geom_invalid_ggr")
                rules[[i]] <- stri_trans_tolower(choices[[i]][[1L]])
            } else {
                if (stri_trans_tolower(rules[[i]]) == "absolute") rules[[i]] <- "world"

                if (!stri_trans_tolower(rules[[i]]) %chin% stri_trans_tolower(choices[[i]])) {
                    warn(sprintf("Invalid '%s' found ('%s') in 'GlobalGeometryRules'. Assuming '%s'.",
                        names(rules[i]), rules[[i]], choices[[i]][[1L]]
                    ), "geom_invalid_ggr")
                    rules[[i]] <- stri_trans_tolower(choices[[i]][[1L]])
                } else {
                    rules[[i]] <- stri_trans_tolower(rules[[i]])
                }
            }
        }

        setattr(rules, "names", lower_name(names(rules)))
    }

    rules
}
# }}}

# get_building_transformation {{{
get_building_transformation <- function(idf) {
    if (!idf$is_valid_class("Building")) {
        warn("Could not find 'Building' object, assuming 0 rotation", "geom_no_building")

        list(id = NA_integer_, name = NA_character_, north_axis = 0.0)
    } else {
        # NOTE: Always check 'Building' class when adding compatibility for new
        # EnergyPlus versions
        bldg <- get_idf_value(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(),
            "Building", field = 2L, complete = TRUE)
        id <- bldg$object_id[[1L]]
        name <- bldg$object_name[[1L]]
        north_axis <- bldg$value_num[[2L]]

        if (is.na(north_axis)) {
            warn("North Axis unknown. Using 0.", "geom_unknown_north_axis")
            north_axis <- 0.0
        }

        list(id = id, name = name, north_axis = north_axis)
    }
}
# }}}

# get_zone_transformation {{{
get_zone_transformation <- function(idf) {
    if (!idf$is_valid_class("Zone")) {
        zone <- data.table(id = integer(), name = character(), x = double(), y = double(), z = double())
    } else {
        zone <- idf$to_table(class = "Zone", wide = TRUE, all = TRUE, string_value = FALSE)[
            , .SD, .SDcols = c("id", "name", paste(c("X", "Y", "Z"), "Origin"), "Direction of Relative North")]
        setnames(zone, c("id", "name", "x", "y", "z", "dir_relative_north"))
        if (nrow(mis_origin <- na.omit(zone, by = c("x", "y", "z"), invert = TRUE))) {
            warn(paste0("Zone below has unknown origin. (0, 0, 0) will be used:\n",
                collapse(mis_origin$name)
            ), "geom_no_zone_origin")
            zone[J(NA_real_), on = "x", x := 0.0]
            zone[J(NA_real_), on = "y", y := 0.0]
            zone[J(NA_real_), on = "z", z := 0.0]
        }

        if (anyNA(zone$dir_relative_north)) {
            warn(paste0("Zone below has unknown direction of relative North. 0 will be used:\n",
                collapse(zone[is.na(dir_relative_north), name])
            ), "geom_no_zone_north")

            zone[J(NA_real_), on = "dir_relative_north", dir_relative_north := 0.0]
        }
    }
    zone
}
# }}}

get_spaces <- function(idf) {
    if (!idf$is_valid_class("Space")) {
        space <- data.table(id = integer(), name = character(), type = character(), zone = character())
    } else {
        space <- get_idf_value(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(),
            class = "Space", field = c("Name", "Zone Name", "Space Type"))
        space <- standardize_idf_value(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(), space, keep = FALSE)
        space <- dcast.data.table(space, object_id + class_name ~ field_name, value.var = "value_chr")
        set(space, NULL, "class_name", NULL)
        setnames(space, lower_name(names(space)))
        setcolorder(space, c("object_id", "name", "space_type", "zone_name"))
        setnames(space, c("id", "name", "type", "zone"))
    }
    space
}

# extract_geom {{{
extract_geom <- function(idf, object = NULL) {
    geom_class <- get_geom_class(idf, object)

    # get current global geometry rules
    rules <- get_global_geom_rules(idf)

    # convert to counter clockwise vertex entry direction
    if (rules$vertex_entry_direction == "clockwise") {
        warn(paste("'Clockwise' vertex entry direction found in 'GlobalGeometryRules'.",
            "All vertices will be changed to 'Counterclockwise' direction."
        ))
        idf <- reverse_idf_detailed_vertices(idf, geom_class)
        rules$vertex_entry_direction <- "counterclockwise"
    }

    # extract surface data
    surface <- extract_geom_surface(idf, geom_class)

    # extract subsurface data
    subsurface <- extract_geom_subsurface(idf, geom_class, surface = surface)

    # extract shading data
    shading <- extract_geom_shading(idf, geom_class, subsurface = subsurface)

    # extract daylighting reference point data
    dayl_pnts <- extract_geom_daylighting_point(idf, geom_class)

    # merge all vertices
    vertices <- rbindlist(list(surface$vertices, subsurface$vertices, shading$vertices, dayl_pnts$vertices))
    if (nrow(vertices)) setindexv(vertices, "id")

    # building transformation
    building <- get_building_transformation(idf)

    # zone transformation
    zone <- get_zone_transformation(idf)

    # spaces
    space <- get_spaces(idf)

    list(rules = rules, building = building, zone = zone, space = space,
         surface = surface$meta, subsurface = subsurface$meta,
         shading = shading$meta, daylighting_point = dayl_pnts$meta,
         vertices = vertices
    )
}
# }}}

# extract_geom_surface {{{
extract_geom_surface <- function(idf, geom_class = NULL, object = NULL) {
    if (is.null(geom_class)) geom_class <- get_geom_class(idf, object)

    if (!nrow(geom_class)) return(list(meta = data.table(), vertices = data.table()))

    detailed <- extract_geom_surface_detailed(idf, geom_class)
    simple <- extract_geom_surface_simple(idf, geom_class)

    meta <- rbindlist(list(detailed$meta, simple$meta))
    vertices <- rbindlist(list(detailed$vertices, simple$vertices))
    if (nrow(meta)) {
        list(meta = setorderv(meta, "id"), vertices = setorderv(vertices, "id"))
    } else {
        list(meta = meta, vertices = vertices)
    }
}
# }}}

# extract_geom_surface_detailed {{{
extract_geom_surface_detailed <- function(idf, geom_class = NULL, object = NULL) {
    if (is.null(geom_class)) geom_class <- get_geom_class(idf, object)
    geom_class <- geom_class[J("Surface", "Detailed"), on = c("category", "subtype"), nomatch = NULL]

    if (!nrow(geom_class)) return(list(meta = data.table(), vertices = data.table()))

    # NOTE: handle 'Space' class added in EnergyPlus v9.6
    has_space <- idf$version() > "9.5"

    # fields needed
    fld <- get_idd_field(get_priv_env(idf)$idd_env(), "BuildingSurface:Detailed",
        # NOTE: Always check 'BuildingSurface:Detailed' class when adding
        # compatibility for new EnergyPlus versions
        c(1:8, if (has_space) 9L)
    )$field_name

    # extract data
    dt <- get_idf_value(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(),
        class = geom_class$class, object = geom_class$id, complete = TRUE,
        property = "extensible_group"
    )[field_name %chin% fld | extensible_group > 0L]

    # meta
    meta <- dt[J(0L), on = "extensible_group"]
    meta <- standardize_idf_value(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(), meta, keep = FALSE)
    meta <- dcast.data.table(meta, object_id + class_name ~ field_name, value.var = "value_chr")
    setnames(meta, lower_name(names(meta)))
    meta[geom_class[!J("Detailed"), on = "subtype"], on = c(class_name = "class"), surface_type := i.subtype]
    if (!has_space) set(meta, NULL, "space_name", NA_character_)
    setcolorder(meta, c("object_id", "name", "class_name", "surface_type",
        "construction_name", "space_name", "zone_name"))
    # a surface will be an adiabatic one if the outside boundary condition
    # object is itself
    meta[name == outside_boundary_condition_object, `:=`(outside_boundary_condition = "Adiabatic", outside_boundary_condition_object = NA_character_)]
    setnames(meta, c("object_id", "class_name"), c("id", "class"))

    # vertices
    vertices <- dt[!J(0L), on = "extensible_group"]
    vertices[, by = c("object_id", "extensible_group"),
        extensible_group_index := seq_len(.N)]
    vertices <- dcast.data.table(vertices, object_id + extensible_group ~ extensible_group_index,
        value.var = "value_num")
    setnames(vertices, c("id", "index", "x", "y", "z"))

    list(meta = meta, vertices = vertices)
}
# }}}

# extract_geom_surface_simple {{{
extract_geom_surface_simple <- function(idf, geom_class = NULL, object = NULL) {
    if (is.null(geom_class)) geom_class <- get_geom_class(idf, object)
    geom_class <- geom_class[category == "Surface" & subtype != "Detailed"]

    if (!nrow(geom_class)) return(list(meta = data.table(), vertices = data.table()))

    # extract data
    dt <- get_idf_value(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(),
        class = geom_class$class, object = geom_class$id, all = TRUE)

    dt <- standardize_idf_value(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(), dt, keep = FALSE)

    # add surface type
    dt[geom_class, on = c("class_name" = "class"), surface_type := i.type]

    # use "height" for all
    dt[surface_type != "Wall" & field_name == "Width", field_name := "Height"]

    # change to wide
    dt <- dcast.data.table(dt, object_id + class_name + surface_type ~ field_name, value.var = "value_chr")

    # rename
    setnames(dt, lower_name(names(dt)))

    # in case there is no '*.Interzone'
    if (!"outside_boundary_condition_object" %chin% names(dt)) {
        set(dt, NULL, "outside_boundary_condition_object", NA_character_)
    }

    # rename
    setnames(dt, paste0("starting_", c("x", "y", "z"), "_coordinate"), c("x0", "y0", "z0"))
    setnames(dt, c("azimuth_angle", "tilt_angle"), c("azimuth", "tilt"))

    # format numeric fields
    cols <- c("azimuth", "tilt", "length", "height", "x0", "y0", "z0")
    dt[, c(cols) := lapply(.SD, as.numeric), .SDcols = cols]

    # calculate vertices
    vertices <- get_vertices_from_specs(dt$azimuth, dt$tilt, dt$length, dt$height, dt$x0, dt$y0, dt$z0)
    vertices <- data.table(id = rep(dt$object_id, each = 4L), index = rep(1:4, nrow(dt)),
        x = round(as.numeric(t(matrix(unlist(vertices$x), ncol = 4L))), 4L),
        y = round(as.numeric(t(matrix(unlist(vertices$y), ncol = 4L))), 4L),
        z = round(as.numeric(t(matrix(unlist(vertices$z), ncol = 4L))), 4L)
    )

    # extract meta
    set(dt, NULL, c("azimuth", "tilt", "length", "height", "x0", "y0", "z0"), NULL)

    # complete column
    geom_class[J(c("Exterior", "")), on = "subtype", `:=`(
        outside_boundary_condition = "Outdoors",
        sun_exposure = "SunExposed", wind_exposure = "WindExposed"
    )]
    geom_class[J(c("Adiabatic", "Ground", "GroundContact")), on = "subtype", `:=`(
        outside_boundary_condition = gsub("Contact", "", subtype, fixed = TRUE),
        sun_exposure = "NoSun", wind_exposure = "NoWind"
    )]
    geom_class[J(c("Interzone")), on = "subtype", `:=`(
        outside_boundary_condition = "Surface",
        sun_exposure = "NoSun", wind_exposure = "NoWind"
    )]

    dt[geom_class, on = c("class_name" = "class"),
        `:=`(outside_boundary_condition = i.outside_boundary_condition,
             sun_exposure = i.sun_exposure, wind_exposure = i.wind_exposure
        )
    ]

    # NOTE: handle 'Space' class added in EnergyPlus v9.6
    has_space <- idf$version() > "9.5"
    if (!has_space) set(dt, NULL, "space_name", NA_character_)
    setnames(dt, c("object_id", "class_name"), c("id", "class"))
    setcolorder(dt, c("id", "name", "class", "surface_type",
        "construction_name", "space_name", "zone_name", "outside_boundary_condition"))
    list(meta = dt, vertices = vertices)
}
# }}}

# extract_geom_subsurface {{{
extract_geom_subsurface <- function(idf, geom_class = NULL, object = NULL, surface = NULL) {
    if (is.null(geom_class)) geom_class <- get_geom_class(idf, object)

    if (!nrow(geom_class)) return(list(meta = data.table(), vertices = data.table()))

    detailed <- extract_geom_subsurface_detailed(idf, geom_class)
    simple <- extract_geom_subsurface_simple(idf, geom_class, surface = surface)

    meta <- rbindlist(list(detailed$meta, simple$meta))
    vertices <- rbindlist(list(detailed$vertices, simple$vertices))
    if (nrow(meta)) {
        list(meta = setorderv(meta, "id"), vertices = setorderv(vertices, "id"))
    } else {
        list(meta = meta, vertices = vertices)
    }
}
# }}}

# extract_geom_subsurface_detailed {{{
extract_geom_subsurface_detailed <- function(idf, geom_class = NULL, object = NULL) {
    if (is.null(geom_class)) geom_class <- get_geom_class(idf, object)

    # currently only 'FenestrationSurface:Detailed' is the defailed geometry
    geom_class <- geom_class[J("SubSurface", "Detailed"), on = c("category", "subtype"), nomatch = NULL]

    if (!nrow(geom_class)) return(list(meta = data.table(), vertices = data.table()))

    # extract data
    dt <- get_idf_value(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(),
        class = geom_class$class, object = geom_class$id, all = TRUE
    )

    # meta
    # NOTE: Always check 'FenestrationSurface:Detailed' class when adding
    # compatibility for new EnergyPlus versions
    meta <- dt[J(1:5), on = "field_index"]
    meta <- standardize_idf_value(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(), meta, keep = FALSE)
    meta <- dcast.data.table(meta, object_id + class_name ~ field_name, value.var = "value_chr")
    setnames(meta, lower_name(names(meta)))
    setcolorder(meta, c("object_id", "name", "class_name", "surface_type", "construction_name"))
    setnames(meta, c("object_id", "class_name"), c("id", "class"))

    # vertices
    fldid_start <- get_first_vertex_field_index(idf$version())[["FenestrationSurface:Detailed"]]
    # NOTE: currently fenestrations only support triangle and rectangles
    vertices <- dt[J(fldid_start:(fldid_start + 11L)), on = "field_index"][, by = "object_id",
        list(index = rep(1:4, each = 3L), field = rep(c("x", "y", "z"), 4L), value_num)]
    vertices <- dcast.data.table(vertices, object_id + index ~ field, value.var = "value_num")
    setnames(vertices, "object_id", "id")

    list(meta = meta, vertices = vertices)
}
# }}}

# extract_geom_subsurface_simple {{{
extract_geom_subsurface_simple <- function(idf, geom_class = NULL, object = NULL, surface = NULL) {
    if (is.null(geom_class)) geom_class <- get_geom_class(idf, object)
    geom_class <- geom_class[category == "SubSurface" & subtype != "Detailed"]

    if (!nrow(geom_class)) return(list(meta = data.table(), vertices = data.table()))

    # extract data
    dt <- get_idf_value(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(),
        class = geom_class$class, object = geom_class$id, all = TRUE)

    dt <- standardize_idf_value(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(), dt, keep = FALSE)

    # remove uncessary fields
    dt <- dt[!J(c("Frame and Divider Name", "Multiplier", "Shading Control Name")), on = "field_name"]

    # change to wide
    dt <- dcast.data.table(dt, object_id + class_name ~ field_name, value.var = "value_chr")

    # rename
    setnames(dt, lower_name(names(dt)))

    # in case there is no '*.Interzone'
    if (!"outside_boundary_condition_object" %chin% names(dt)) {
        set(dt, NULL, "outside_boundary_condition_object", NA_character_)
    }

    # rename
    setnames(dt, paste0("starting_", c("x", "z"), "_coordinate"), c("x0", "z0"))

    # format numeric fields
    cols <- c("length", "height", "x0", "z0")
    dt[, c(cols) := lapply(.SD, as.numeric), .SDcols = cols]

    # vertices
    # remove ones that have incomplete data
    vertices <- dt[
        , by = "object_id", list(
        index = 1:4,
        x = c(x0, x0, x0 + length, x0 + length),
        y = c(z0 + height, z0, z0, z0 + height),
        z = 0.0
    )]
    setnames(vertices, "object_id", "id")

    # meta
    meta <- set(dt, NULL, cols, NULL)
    # add surface type
    meta[geom_class, on = c("class_name" = "class"), surface_type := i.type]
    # rename
    setnames(meta, c("object_id", "class_name"), c("id", "class"))
    setcolorder(meta, c("id", "name", "class", "surface_type",
        "construction_name", "building_surface_name", "outside_boundary_condition_object"))

    # get parent surface vertices
    nm_surface <- meta[J(unique(vertices$id)), on = "id", unique(building_surface_name)]
    if (is.null(surface)) {
        surface <- extract_geom_surface(idf, object = nm_surface)
    } else {
        surface$meta <- surface$meta[J(nm_surface), on = "name"]
        surface$vertices <- surface$vertices[surface$meta, on = "id"]
    }

    # get transformation from face coordinates to zone
    surface$trans <- align_face(surface$vertices)

    # add surface name for matching
    surface$trans[surface$meta, on = "id", building_surface_name := i.name]
    vertices[meta, on = "id", building_surface_name := i.building_surface_name]

    # transform
    vertices[surface$trans, on = "building_surface_name", "trans" := i.trans][
        , by = "id", c("x", "y", "z") := {
            if (is.null(trans[[1L]])) {
                list(NA_real_, NA_real_, NA_real_)
            } else {
                vert <- apply(matrix(c(x, y, z, rep(1.0, .N)), ncol = 4L), 1, function(x) trans[[1L]] %*% x)[1:3,]
                list(vert[1L,], vert[2L,], vert[3L,])
            }
        }
    ]
    set(vertices, NULL, c("building_surface_name", "trans"), NULL)

    list(meta = meta, vertices = vertices)
}
# }}}

# extract_geom_shading {{{
extract_geom_shading <- function(idf, geom_class = NULL, object = NULL, subsurface = NULL) {
    if (is.null(geom_class)) geom_class <- get_geom_class(idf, object)

    if (!nrow(geom_class)) return(list(meta = data.table(), vertices = data.table()))

    detailed <- extract_geom_shading_detailed(idf, geom_class)
    simple <- extract_geom_shading_simple(idf, geom_class, subsurface = subsurface)

    meta <- rbindlist(list(detailed$meta, simple$meta))
    vertices <- rbindlist(list(detailed$vertices, simple$vertices))
    if (nrow(meta)) {
        list(meta = setorderv(meta, "id"), vertices = setorderv(vertices, "id"))
    } else {
        list(meta = meta, vertices = vertices)
    }
}
# }}}

# extract_geom_shading_detailed {{{
extract_geom_shading_detailed <- function(idf, geom_class = NULL, object = NULL) {
    if (is.null(geom_class)) geom_class <- get_geom_class(idf, object)
    geom_class <- geom_class[J("Shading", "Detailed"), on = c("category", "misc"), nomatch = NULL]

    if (!nrow(geom_class)) return(list(meta = data.table(), vertices = data.table()))

    # extract data
    dt <- get_idf_value(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(),
        class = geom_class$class, object = geom_class$id,
        complete = TRUE, property = "extensible_group"
    )[field_name %chin% c("Name", "Base Surface Name") | extensible_group > 0L]

    # meta
    meta <- dt[J(0L), on = "extensible_group"]
    meta <- standardize_idf_value(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(), meta, keep = FALSE)
    meta <- dcast.data.table(meta, object_id + class_name ~ field_name, value.var = "value_chr")
    setnames(meta, lower_name(names(meta)))
    # in case there is no Shading:Zone:Detailed
    if (!"base_surface_name" %chin% names(meta)) {
        set(meta, NULL, "base_surface_name", NA_character_)
    }
    meta[geom_class, on = c(class_name = "class"), surface_type := paste0(i.subtype, "Shading")]
    setcolorder(meta, c("object_id", "name", "class_name", "surface_type", "base_surface_name"))
    setnames(meta, c("id", "name", "class", "surface_type", "base_surface_name"))

    # vertices
    vertices <- dt[!J(0L), on = "extensible_group"]
    vertices[, by = c("object_id", "extensible_group"),
        extensible_group_index := seq_len(.N)]
    vertices <- dcast.data.table(vertices, object_id + extensible_group ~ extensible_group_index,
        value.var = "value_num")
    setnames(vertices, c("id", "index", "x", "y", "z"))

    list(meta = meta, vertices = vertices)
}
# }}}

# extract_geom_shading_simple {{{
extract_geom_shading_simple <- function(idf, geom_class = NULL, object = NULL, subsurface = NULL) {
    if (is.null(geom_class)) geom_class <- get_geom_class(idf, object)
    geom_class <- geom_class[category == "Shading" & misc != "Detailed"]

    if (!nrow(geom_class)) return(list(meta = data.table(), vertices = data.table()))

    # extract data
    dt <- get_idf_value(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(),
        class = geom_class$class, object = geom_class$id, all = TRUE)

    dt <- standardize_idf_value(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(), dt, keep = FALSE)

    # add surface type
    dt[geom_class, on = c("class_name" = "class"), surface_type := paste0(i.subtype, "Shading")]

    # Site and Building shadings {{{
    meta_shade <- data.table()
    vertices_shade <- data.table()
    if (any(c("Site", "Building") %chin% geom_class$subtype)) {
        shade <- dt[surface_type %chin% c("SiteShading", "BuildingShading") & field_index != 1L]
        shade <- dcast.data.table(shade, object_id + object_name + class_name + surface_type ~ field_name, value.var = "value_num")
        setnames(shade, lower_name(names(shade)))
        setnames(shade, paste0("starting_", c("x", "y", "z"), "_coordinate"), c("x0", "y0", "z0"))
        setnames(shade, c("azimuth_angle", "tilt_angle"), c("azimuth", "tilt"))

        # calculate vertices
        vertices <- get_vertices_from_specs(shade$azimuth, shade$tilt, shade$length, shade$height, shade$x0, shade$y0, shade$z0)
        vertices_shade <- data.table(id = rep(shade$object_id, each = 4L), index = rep(1:4, nrow(shade)),
            x = as.numeric(t(matrix(unlist(vertices$x), ncol = 4L))),
            y = as.numeric(t(matrix(unlist(vertices$y), ncol = 4L))),
            z = as.numeric(t(matrix(unlist(vertices$z), ncol = 4L)))
        )

        # extract meta
        meta_shade <- set(shade, NULL, c("azimuth", "tilt", "length", "height", "x0", "y0", "z0"), NULL)
        setnames(meta_shade, c("id", "name", "class", "surface_type"))

        # make sure all meta tables have the same column
        set(meta_shade, NULL, "base_surface_name", NA_character_)
    }
    # }}}

    # Overhang {{{
    meta_overhang <- data.table()
    vertices_overhang <- data.table()
    if ("Overhang" %chin% geom_class$subtype) {
        overhang <- dt[J("OverhangShading"), on = "surface_type"]
        meta_overhang <- overhang[J(2L), on = "field_index"]
        set(meta_overhang, NULL, value = NULL,
            setdiff(names(meta_overhang),
                c("object_id", "object_name", "class_name", "surface_type", "value_chr"))
        )
        setnames(meta_overhang, c("class", "id", "name", "window_or_door_name", "surface_type"))
        setcolorder(meta_overhang, c("id", "name", "class", "surface_type"))
        set(meta_overhang, NULL, "surface_type", "ZoneShading")

        # calculate vertices
        vertices_overhang <- overhang[!J(1:2), on = "field_index"]
        vertices_overhang[J(7L), on = "field_index", field_name := "Depth"]
        vertices_overhang <- dcast.data.table(vertices_overhang, object_id + object_name + class_name + surface_type ~ field_name, value.var = "value_num")
        setnames(vertices_overhang, lower_name(names(vertices_overhang)))
        setnames(vertices_overhang, gsub("_(from|above){0,1}_window(_or){0,1}_door(_width){0,1}", "", names(vertices_overhang)))
        setnames(vertices_overhang, "object_id", "id")

        # get parent subsurface vertices
        if (any(!is.na(meta_overhang$window_or_door_name))) {
            nm_subsurf<- meta_overhang[!J(NA_character_), on = "window_or_door_name", unique(window_or_door_name)]
            if (is.null(subsurface)) {
                subsurf <- extract_geom_subsurface(idf, object = nm_subsurf)
            } else {
                subsurf <- subsurface
                subsurf$meta <- subsurf$meta[J(nm_subsurf), on = "name"]
                subsurf$vertices <- subsurf$vertices[subsurf$meta, on = "id"]
            }
            # get transformation from face coordinates to zone
            subsurf$trans <- align_face(subsurf$vertices)

            # figure out bounds of the subsurface in face coordinates
            bound_verts <- subsurf$vertices[subsurf$trans, on = "id", by = .EACHI,
                {
                    align_inv <- solve(i.trans[[1L]])
                    align_vert <- apply(matrix(c(x, y, z, rep(1.0, .N)), ncol = 4L), 1, function(x) align_inv %*% x)[1:3, ]
                    r_x <- range(align_vert[1, ])
                    r_y <- range(align_vert[2, ])
                    list(min_x = r_x[[1L]], max_x = r_x[[2L]], min_y = r_y[[1L]], max_y = r_y[[2L]])
                }
            ]
            bound_verts[subsurf$meta, on = "id", window_or_door_name := i.name]
            set(bound_verts, NULL, "id", NULL)

            # add subsurface name
            vertices_overhang[meta_overhang, on = "id", window_or_door_name := i.window_or_door_name]
            # add subsurface bounds
            vertices_overhang[bound_verts, on = "window_or_door_name",
                `:=`(min_x = i.min_x, max_x = i.max_x, min_y = i.min_y, max_y = i.max_y)]

            # get depth for overhang projection
            vertices_overhang[J("Shading:Overhang:Projection"), on = "class_name",
                depth := depth * (max_y - min_y)]

            # transform vertices
            subsurf$trans[subsurf$meta, on = "id", window_or_door_name := i.name]
            vertices_overhang[subsurf$trans, on = "window_or_door_name", "trans" := i.trans]

            vertices_overhang <- vertices_overhang[, by = "id", {
                if (is.null(trans[[1L]])) {
                    list(index = 1:4, x = NA_real_, y = NA_real_, z = NA_real_)
                } else {
                    x <- c(max_x + right_extension, max_x + right_extension, min_x - left_extension, min_x - left_extension)
                    y <- c(max_y + height + depth * cos(deg_to_rad(tilt_angle)), max_y + height, max_y + height, max_y + height + depth * cos(deg_to_rad(tilt_angle)))
                    z <- c(depth * sin(deg_to_rad(tilt_angle)), 0.0, 0.0, depth * sin(deg_to_rad(tilt_angle)))
                    vert <- apply(matrix(c(x, y, z, rep(1.0, 4L)), ncol = 4L), 1, function(x) trans[[1L]] %*% x)[1:3, ]
                    list(index = 1:4, x = vert[1L, ], y = vert[2L, ], z = vert[3L, ])
                }
            }]

            # add building surface name
            meta_overhang[subsurf$meta, on = c("window_or_door_name" = "name"), base_surface_name := i.building_surface_name]
            set(meta_overhang, NULL, "window_or_door_name", NULL)
        }
    }
    # }}}

    # Fin {{{
    meta_fin <- data.table()
    vertices_fin <- data.table()
    if ("Fin" %chin% geom_class$subtype) {
        fin <- dt[J("FinShading"), on = "surface_type"]
        meta_fin <- fin[J(2L), on = "field_index"]
        set(meta_fin, NULL, value = NULL,
            setdiff(names(meta_fin),
                c("object_id", "object_name", "class_name", "surface_type", "value_chr"))
        )
        setnames(meta_fin, c("class", "id", "name", "window_or_door_name", "surface_type"))
        setcolorder(meta_fin, c("id", "name", "class", "surface_type"))
        set(meta_fin, NULL, "surface_type", "ZoneShading")

        # calculate vertices
        vertices_fin <- fin[!J(1:2), on = "field_index"]
        vertices_fin[J("Shading:Fin:Projection"), on = "class_name", field_name := gsub("((Left|Right) Depth).*", "\\1", field_name)]
        vertices_fin <- dcast.data.table(vertices_fin, object_id + object_name + class_name + surface_type ~ field_name, value.var = "value_num")
        setnames(vertices_fin, lower_name(names(vertices_fin)))
        setnames(vertices_fin, gsub("_from.+", "", names(vertices_fin)))
        setnames(vertices_fin, gsub("(above|below).+", "\\1", names(vertices_fin)))
        setnames(vertices_fin, "object_id", "id")

        # get parent subsurface vertices
        if (any(!is.na(meta_fin$window_or_door_name))) {
            nm_subsurf <- meta_fin[!J(NA_character_), on = "window_or_door_name", unique(window_or_door_name)]
            if (is.null(subsurface)) {
                subsurf <- extract_geom_subsurface(idf, object = nm_subsurf)
            } else {
                subsurf <- subsurface
                subsurf$meta <- subsurf$meta[J(nm_subsurf), on = "name"]
                subsurf$vertices <- subsurf$vertices[subsurf$meta, on = "id"]
            }

            # get transformation from face coordinates to zone
            subsurf$trans <- align_face(subsurf$vertices)

            # figure out bounds of the subsurf in face coordinates
            bound_verts <- subsurf$vertices[subsurf$trans, on = "id", by = .EACHI,
                {
                    align_inv <- solve(i.trans[[1L]])
                    align_vert <- apply(matrix(c(x, y, z, rep(1.0, .N)), ncol = 4L), 1, function(x) align_inv %*% x)[1:3, ]

                    r_x <- range(align_vert[1, ])
                    r_y <- range(align_vert[2, ])
                    list(min_x = r_x[[1L]], max_x = r_x[[2L]], min_y = r_y[[1L]], max_y = r_y[[2L]])
                }
            ]
            bound_verts[subsurf$meta, on = "id", window_or_door_name := i.name]
            set(bound_verts, NULL, "id", NULL)

            # add subsurface name
            vertices_fin[meta_fin, on = "id", window_or_door_name := i.window_or_door_name]
            # add subsurface bounds
            vertices_fin[bound_verts, on = "window_or_door_name",
                `:=`(min_x = i.min_x, max_x = i.max_x, min_y = i.min_y, max_y = i.max_y)]

            # get depth for fin projection
            vertices_fin[J("Shading:Fin:Projection"), on = "class_name",
                `:=`(left_depth = left_depth * (max_y - min_y),
                     right_depth = right_depth * (max_y - min_y))
            ]

            # transform vertices
            subsurf$trans[subsurf$meta, on = "id", window_or_door_name := i.name]
            vertices_fin[subsurf$trans, on = "window_or_door_name", "trans" := i.trans]

            vertices_fin <- vertices_fin[, by = "id", {
                if (is.null(trans[[1L]])) {
                    # set id of right fins to negative to distinguish
                    list(new_id = c(rep(.BY$id, 4L), rep(-.BY$id, 4L)),
                         index = rep(1:4, 2),
                         x = NA_real_, y = NA_real_, z = NA_real_
                    )
                } else {
                    lx <- c(min_x - left_extension + left_depth * cos(deg_to_rad(left_tilt_angle)),
                            min_x - left_extension + left_depth * cos(deg_to_rad(left_tilt_angle)),
                            min_x - left_extension, min_x - left_extension)
                    ly <- c(max_y + left_distance_above, min_y - left_distance_below,
                            min_y - left_distance_below, max_y + left_distance_above)
                    lz <- c(left_depth * sin(deg_to_rad(left_tilt_angle)),
                            left_depth * sin(deg_to_rad(left_tilt_angle)),
                            0.0, 0.0)
                    lvert <- apply(matrix(c(lx, ly, lz, rep(1.0, 4L)), ncol = 4L), 1, function(x) trans[[1L]] %*% x)[1:3, ]

                    rx <- c(max_x + right_extension + right_depth * cos(deg_to_rad(right_tilt_angle)),
                            max_x + right_extension + right_depth * cos(deg_to_rad(right_tilt_angle)),
                            max_x + right_extension, max_x + right_extension)
                    ry <- c(max_y + right_distance_above, min_y - right_distance_below,
                            min_y - right_distance_below, max_y + right_distance_above)
                    rz <- c(right_depth * sin(deg_to_rad(right_tilt_angle)),
                            right_depth * sin(deg_to_rad(right_tilt_angle)),
                            0.0, 0.0)
                    rvert <- apply(matrix(c(rx, ry, rz, rep(1.0, 4L)), ncol = 4L), 1, function(x) trans[[1L]] %*% x)[1:3, ]

                    # set id of right fins to negative to distinguish
                    list(new_id = c(rep(.BY$id, 4L), rep(-.BY$id, 4L)), index = rep(1:4, 2),
                         x = c(lvert[1L, ], rvert[1L, ]),
                         y = c(lvert[2L, ], rvert[2L, ]),
                         z = c(lvert[3L, ], rvert[3L, ])
                    )
                }
            }]
            set(vertices_fin, NULL, "id", NULL)
            setnames(vertices_fin, "new_id", "id")

            # add building surface name
            meta_fin[subsurf$meta, on = c("window_or_door_name" = "name"), base_surface_name := i.building_surface_name]
            set(meta_fin, NULL, "window_or_door_name", NULL)

            meta_fin[, by = "id", index := .I]
            meta_fin <- rbindlist(list(
                copy(meta_fin)[, name := paste(name, "Left")],
                meta_fin[, `:=`(id = -id, name = paste(name, "Right"))]
            ))
            setorderv(meta_fin, "index")
            set(meta_fin, NULL, "index", NULL)
        }
    }
    # }}}

    meta <- rbindlist(list(meta_shade, meta_overhang, meta_fin))
    vertices <- rbindlist(list(vertices_shade, vertices_overhang, vertices_fin))

    list(meta = meta, vertices = vertices)
}
# }}}

# extract_geom_daylighting_point {{{
extract_geom_daylighting_point <- function(idf, geom_class = NULL, object = NULL) {
    if (is.null(geom_class)) geom_class <- get_geom_class(idf, object)

    # Previous v8.6, normal daylighting control ref pnts are saved in
    # 'Daylighting:Controls' and DE daylighting in
    # 'Daylighting:DELight:ReferencePoint'
    if (idf$version() > "8.5") {
        geom_class <- geom_class[J("Daylighting", "ReferencePoint"), on = c("category", "subtype"), nomatch = NULL]

        if (!nrow(geom_class)) return(list(meta = data.table(), vertices = data.table()))

        # extract data
        dt <- get_idf_value(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(),
            class = geom_class$class, object = geom_class$id, all = TRUE)

        # meta
        meta <- dt[J(2L), on = "field_index"]
        meta <- standardize_idf_value(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(), meta, keep = FALSE)
        set(meta, NULL, setdiff(names(meta), c("class_name", "object_id", "object_name", "value_chr")), NULL)
        # NOTE: In EnergyPlus v9.6, 2nd field 'Zone Name' has been changed to
        # 'Zone or Space Name'
        setnames(meta, c("class", "id", "name", "zone_name"))
        setcolorder(meta, c("id", "name"))

        # vertices
        vertices <- dt[!J(1:2), on = "field_index", by = "object_id",
            list(index = field_index - 2L, value_num)]
        vertices <- dcast.data.table(vertices, object_id ~ index, value.var = "value_num")
        setnames(vertices, c("id", "x", "y", "z"))
        set(vertices, NULL, "index", 1L)
        setcolorder(vertices, c("id", "index"))
    } else {
        meta <- data.table()
        vertices <- data.table()
        # points in 'Daylighting:Controls'
        if (nrow(ctrl <- geom_class[J("Daylighting", "Controls"), on = c("category", "subtype"), nomatch = NULL])) {
            # extract data
            dt <- get_idf_value(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(),
                class = ctrl$class, object = ctrl$object, field = c(1:8))

            # meta
            meta <- dt[J(1L), on = "field_index"]
            meta <- standardize_idf_value(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(), meta, keep = FALSE)
            set(meta, NULL, setdiff(names(meta), c("class_name", "object_id", "object_name", "value_chr")), NULL)
            setnames(meta, c("class", "id", "name", "zone_name"))
            setcolorder(meta, c("id", "name"))
            # generate ref point names in the same way as transition program
            meta <- meta[, by = "id", list(
                name = paste0(data.table::fifelse(is.na(zone_name), "", zone_name), c("_DaylRefPt1", "_DaylRefPt2")),
                class = rep(class, 2L),
                zone_name = rep(zone_name, 2L)
            )]

            # vertices
            vertices <- dt[!J(1:2), on = "field_index", by = "object_id",
                list(index = rep(1:2, each = 3L), field = rep(c("x", "y", "z"), 2L), value_num)]
            vertices <- dcast.data.table(vertices, object_id + index ~ field, value.var = "value_num")
            setnames(vertices, "object_id", "id")
        }

        # points in 'Daylighting:DELight:ReferencePoint'
        if (nrow(ctrl <- geom_class[J("DELight", "ReferencePoint"), on = c("subtype", "misc"), nomatch = NULL])) {
            # extract data
            dt <- get_idf_value(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(),
                class = ctrl$class, object = ctrl$object, field = 1:5)

            # meta
            meta2 <- dt[J(2L), on = "field_index"]
            meta2 <- standardize_idf_value(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(), meta2, keep = FALSE)
            set(meta2, NULL, setdiff(names(meta2), c("class_name", "object_id", "object_name", "value_chr")), NULL)
            setnames(meta2, c("class", "id", "name", "delight_name"))
            setcolorder(meta2, c("id", "name"))
            # get zone name
            if (!"Daylighting:DELight:Controls" %chin% geom_class$class) {
                setnames(meta2, "delight_name", "zone_name")
                set(meta2, NULL, "zone_name", NA_character_)
            } else {
                de <- get_idf_value(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(),
                    class = "Daylighting:DELight:Controls", field = 2L)
                meta2[de, on = c("delight_name" = "object_name"), zone_name := i.value_chr]
                set(meta2, NULL, "delight_name", NULL)
            }

            # vertices
            vertices2 <- dt[!J(1:2), on = "field_index", by = "object_id",
                list(index = field_index - 2L, value_num)]
            vertices2 <- dcast.data.table(vertices2, object_id ~ index, value.var = "value_num")
            setnames(vertices2, c("id", "x", "y", "z"))
            set(vertices2, NULL, "index", 1L)
            setcolorder(vertices2, c("id", "index"))

            meta <- rbindlist(list(meta, meta2))
            vertices <- rbindlist(list(vertices, vertices2))
        }
    }

    list(meta = meta, vertices = vertices)
}
# }}}

# convert_geom {{{
convert_geom <- function(idf, geoms = NULL, type = c("surface", "subsurface", "shading")) {
    assert_subset(type, c("surface", "subsurface", "shading"), empty.ok = FALSE)

    if (is.null(geoms)) geoms <- extract_geom(idf)

    surf <- list()
    if ("surface" %chin% type) {
        surf <- convert_geom_surface_simple(idf, list(meta = geoms$surface, vertices = geoms$vertices))
    }
    subsurf <- list()
    if ("subsurface" %chin% type) {
        subsurf <- convert_geom_subsurface_simple(idf, list(meta = geoms$subsurface, vertices = geoms$vertices))
    }
    shading <- list()
    if ("shading" %chin% type) {
        shading <- convert_geom_shading_simple(idf, list(meta = geoms$shading, vertices = geoms$vertices))
    }

    object <- rbindlist(list(surf$object, subsurf$object, shading$object))
    if (!nrow(object)) return(list(idf = idf, map = data.table()))

    value <- rbindlist(list(surf$value, subsurf$value, shading$value))
    map <- rbindlist(list(surf$map, subsurf$map, shading$map))

    object_set <- object[object_id > 0L]
    value_set <- value[object_id > 0L]

    object_add <- object[object_id < 0L]
    value_add <- value[object_id < 0L]

    set <- set_idf_object(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(), object_set, value_set, replace = TRUE)

    # log
    get_priv_env(idf)$log_add_order(c(set$changed, set$updated))
    get_priv_env(idf)$log_unsaved()
    get_priv_env(idf)$log_new_uuid()
    get_priv_env(idf)$update_idf_env(set)

    if (nrow(object_add)) {
        add <- add_idf_object(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(), object_add, value_add)

        # log
        get_priv_env(idf)$log_add_order(c(add$changed, add$updated))
        get_priv_env(idf)$log_unsaved()
        get_priv_env(idf)$log_new_uuid()
        get_priv_env(idf)$update_idf_env(add)
    }

    # update actual object id for newly add objects in the mapping
    id <- get_idf_object(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(),
        class = map[new_id < 0L, new_class], object = map[new_id < 0L, new_name]
    )$object_id
    map[new_id < 0L, new_id := id]

    list(idf = idf, map = map)
}
# }}}

# convert_geom_simple {{{
convert_geom_simple <- function(idf, geom, target_class, field_keep = NULL, first_vertex) {
    if (!nrow(geom$meta)) return(list(object = data.table(), value = data.table(), map = data.table()))

    # init object table {{{
    obj <- init_idf_object(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(),
        rep(target_class, nrow(geom$meta)), id = FALSE, name = FALSE
    )
    # restore original comments
    ori_obj <- get_idf_object(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(), object = geom$meta$id)
    set(obj, NULL, c("object_id", "object_name", "object_name_lower", "comment"),
        list(ori_obj$object_id, ori_obj$object_name, ori_obj$object_name_lower, ori_obj$comment))

    # store mapping
    ori_map <- fast_subset(ori_obj, c("object_id", "object_name", "class_name"))
    new_map <- fast_subset(obj, c("object_id", "object_name", "class_name"))
    map <- setnames(cbind(ori_map, new_map), c("ori_id", "ori_name", "ori_class", "new_id", "new_name", "new_class"))
    # }}}

    # init value table {{{
    # make sure enough fields
    num <- geom$vertices[, by = "id", .N]
    val <- init_idf_value(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(),
        rep(target_class, nrow(num)), first_vertex - 1L + num$N * 3L,
        id = FALSE, complete = TRUE
    )
    set(val, NULL, "field_in", NULL)

    # update object id and name
    val[obj, on = "rleid", `:=`(object_id = i.object_id, object_name = i.object_name)]

    # use the original value id for handling references
    if (!is.null(field_keep)) {
        ori_val <- get_idf_value(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(), object = num$id, all = TRUE)[
            J(field_keep), on = "field_name", nomatch = NULL]
        val[ori_val, on = c("object_id", "field_name"), `:=`(value_id = i.value_id, value_chr = i.value_chr)]
    }

    # assign new character values
    new_val <- melt.data.table(geom$meta, id.vars = c("id", "name", "class"),
        variable.name = "field_in", variable.factor = FALSE, value.name = "value_chr")
    set(val, NULL, "field_in", lower_name(val$field_name))
    val[new_val, on = c("object_id" = "id", "field_in"), value_chr := i.value_chr]
    set(val, NULL, "field_in", NULL)

    # assign new vertices
    vert <- melt.data.table(geom$vertices, id.vars = c("id", "index"))
    setorderv(vert, c("id", "index"))
    vert[, field_index := first_vertex - 1L + seq_len(.N), by = "id"]
    val[vert, on = c("object_id" = "id", "field_index"),
        `:=`(value_chr = as.character(i.value), value_num = i.value)]

    # set value id for all new fields to negative
    val[J(NA_integer_), on = "value_id", value_id := -seq_len(.N)]
    # }}}

    list(object = obj, value = val, map = map)
}
# }}}

# convert_geom_surface_simple {{{
convert_geom_surface_simple <- function(idf, geom = NULL) {
    if (is.null(geom)) {
        geom <- extract_geom_surface_simple(idf)
    } else {
        if (!any(is_simple <- !stri_endswith_fixed(geom$meta$class, "Detailed"))) {
            geom <- list(meta = data.table(), vertices = data.table())
        } else {
            geom$meta <- geom$meta[is_simple]
            geom$vertices <- geom$vertices[J(geom$meta$id[is_simple]), on = "id", nomatch = NULL]
        }
    }
    # NOTE: handle 'Space' class added in EnergyPlus v9.6
    convert_geom_simple(idf, geom, "BuildingSurface:Detailed",
        c("Name", "Construction Name", "Zone Name", "Outside Boundary Condition Object"),
        first_vertex = get_first_vertex_field_index(idf$version())[["BuildingSurface:Detailed"]]
    )
}
# }}}

# convert_geom_subsurface_simple {{{
convert_geom_subsurface_simple <- function(idf, geom = NULL) {
    if (is.null(geom)) {
        geom <- extract_geom_subsurface_simple(idf)
    } else {
        if (!any(is_simple <- geom$meta$class != "FenestrationSurface:Detailed")) {
            geom <- list(meta = data.table(), vertices = data.table())
        } else {
            geom$meta <- geom$meta[is_simple]
            geom$vertices <- geom$vertices[J(geom$meta$id[is_simple]), on = "id", nomatch = NULL]
        }
    }
    convert_geom_simple(idf, geom, "FenestrationSurface:Detailed",
        c("Name", "Construction Name", "Building Surface Name", "Frame and Divider Name", "Outside Boundary Condition Object"),
        first_vertex = get_first_vertex_field_index(idf$version())[["FenestrationSurface:Detailed"]]
    )
}
# }}}

# convert_geom_shading_simple {{{
convert_geom_shading_simple <- function(idf, geom = NULL) {
    if (is.null(geom)) {
        geom <- extract_geom_shading_simple(idf)
    } else {
        if (!any(is_simple <- !stri_endswith_fixed(geom$meta$class, "Detailed"))) {
            geom <- list(meta = data.table(), vertices = data.table())
        } else {
            geom$meta <- geom$meta[is_simple]
            geom$vertices <- geom$vertices[J(geom$meta$id[is_simple]), on = "id", nomatch = NULL]
        }
    }

    if (!nrow(geom$meta)) return(list(object = data.table(), value = data.table(), map = data.table()))

    meta <- split(geom$meta, by = "surface_type")

    site <- list()
    bldg <- list()
    zone <- list()

    if ("SiteShading" %chin% names(meta)) {
        site <- convert_geom_simple(idf,
            list(meta = meta$SiteShading, vertices = geom$vertices[J(meta$SiteShading$id), on = "id"]),
            "Shading:Site:Detailed", c("Name", "Transmittance Schedule Name"),
            first_vertex = get_first_vertex_field_index(idf$version())[["Shading:Site:Detailed"]]
        )
    }
    if ("BuildingShading" %chin% names(meta)) {
        bldg <- convert_geom_simple(idf,
            list(meta = meta$BuildingShading, vertices = geom$vertices[J(meta$BuildingShading$id), on = "id"]),
            "Shading:Building:Detailed", c("Name", "Transmittance Schedule Name"),
            first_vertex = get_first_vertex_field_index(idf$version())[["Shading:Building:Detailed"]]
        )
    }
    if ("ZoneShading" %chin% names(meta)) {
        overhang <- list()
        fin <- list()

        if (any(c("Shading:Overhang", "Shading:Overhang:Projection") %chin% meta$ZoneShading$class)) {
            overhang$meta <- meta$ZoneShading[J(c("Shading:Overhang", "Shading:Overhang:Projection")), on = "class", nomatch = NULL]
            overhang$vertices <- geom$vertices[J(overhang$meta$id), on = "id"]

            overhang <- convert_geom_simple(idf, overhang, "Shading:Zone:Detailed", "Name",
                first_vertex = get_first_vertex_field_index(idf$version())[["Shading:Zone:Detailed"]]
            )
        }

        # should handle fin shading separately
        if (any(c("Shading:Fin", "Shading:Fin:Projection") %chin% meta$ZoneShading$class)) {
            fin$meta <- meta$ZoneShading[J(c("Shading:Fin", "Shading:Fin:Projection")), on = "class", nomatch = NULL]
            fin$vertices <- geom$vertices[J(fin$meta$id), on = "id"]

            fin_left <- convert_geom_simple(idf,
                list(meta = fin$meta[id > 0L], vertices = fin$vertices[id > 0L]),
                "Shading:Zone:Detailed", "Name",
                first_vertex = get_first_vertex_field_index(idf$version())[["Shading:Zone:Detailed"]]
            )
            set(fin_left$object, NULL, c("object_name", "object_name_lower"),
                list(paste(fin_left$object$object_name, "Left"),
                    paste(fin_left$object$object_name_lower, "left")
                )
            )
            # in case adding a suffix 'Left' can introduce name conflict
            fin_left$object <- make_idf_object_name(
                get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(),
                fin_left$object, use_old = TRUE
            )
            # update name
            set(fin_left$object, NULL, c("object_name", "object_name_lower"), NULL)
            setnames(fin_left$object, c("new_object_name", "new_object_name_lower"), c("object_name", "object_name_lower"))
            fin_left$value[fin_left$object, on = "object_id", object_name := i.object_name]
            fin_left$value[J(1L), on = "field_index", value_chr := object_name]
            set(fin_left$map, NULL, "new_name", fin_left$object$object_name)

            fin_right <- convert_geom_simple(idf,
                list(meta = fin$meta[id < 0L][, id := -id], vertices = fin$vertices[id < 0L][, id := -id]),
                "Shading:Zone:Detailed", "Name",
                first_vertex = get_first_vertex_field_index(idf$version())[["Shading:Zone:Detailed"]]
            )
            set(fin_right$object, NULL, c("object_name", "object_name_lower"),
                list(paste(fin_right$object$object_name, "Right"),
                    paste(fin_right$object$object_name_lower, "right")
                )
            )
            # in case adding a suffix 'Right' can introduce name conflict
            fin_right$object <- make_idf_object_name(
                get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env(),
                fin_right$object, use_old = TRUE
            )
            # update name
            set(fin_right$object, NULL, c("object_name", "object_name_lower"), NULL)
            setnames(fin_right$object, c("new_object_name", "new_object_name_lower"), c("object_name", "object_name_lower"))
            fin_right$value[fin_right$object, on = "object_id", object_name := i.object_name]
            fin_right$value[J(1L), on = "field_index", value_chr := object_name]
            set(fin_right$map, NULL, "new_name", fin_right$object$object_name)

            set(fin_right$object, NULL, "object_id", -fin_right$object$object_id)
            set(fin_right$value, NULL, "object_id", -fin_right$value$object_id)
            set(fin_right$map, NULL, "new_id", -fin_right$map$new_id)

            fin$object <- rbindlist(list(fin_left$object, fin_right$object))
            fin$value <- rbindlist(list(fin_left$value, fin_right$value))
            fin$map <- rbindlist(list(fin_left$map, fin_right$map))
        }

        zone$object <- rbindlist(list(overhang$object, fin$object), use.names = TRUE)
        zone$value <- rbindlist(list(overhang$value, fin$value))
        zone$map <- rbindlist(list(overhang$map, fin$map))
    }

    list(object = rbindlist(list(site$object, bldg$object, zone$object), use.names = TRUE),
         value = rbindlist(list(site$value, bldg$value, zone$value)),
         map = rbindlist(list(site$map, bldg$map, zone$map))
    )
}
# }}}

# subset_geom {{{
subset_geom <- function(geoms, type = c("all", "floor", "wall", "roof", "window", "door", "shading", "daylighting"),
                         zone = NULL, surface = NULL, space = NULL) {
    assert_subset(type, c("all", "floor", "wall", "roof", "window", "door", "shading", "daylighting"))
    zone <- assert_valid_type(unique(zone), "Zone ID|Name", null.ok = TRUE)
    surface <- assert_valid_type(unique(surface), "Surface ID|Name", null.ok = TRUE)
    space <- assert_valid_type(unique(space), "Space ID|Name", null.ok = TRUE)

    # subset geoms by components {{{
    if (!length(type)) {
        geoms$surface <- geoms$surface[0L]
        geoms$subsurface <- geoms$surface[0L]
        geoms$shading <- geoms$surface[0L]
        geoms$daylighting_point <- geoms$surface[0L]
        geoms$vertices <- geoms$vertices[0L]
        if (has_names(geoms, "vertices2")) geoms$vertices2 <- geoms$vertices2[0L]
        return(geoms)
    }

    ALL_COMP <- c("floor", "wall", "roof", "window", "door", "shading", "daylighting")
    if ("all" %chin% type) type <- ALL_COMP
    dshow <- setdiff(ALL_COMP, type)
    if (length(dshow)) {
        dshow_surf <- c("Floor", "Wall", "Roof")[c("floor", "wall", "roof") %chin% dshow]
        dshow_subsurf <- c("Window", "Door")[c("window", "door") %chin% dshow]
        if (nrow(geoms$surface)) {
            if ("Roof" %chin% dshow_surf) dshow_surf <- c(dshow_surf, "Ceiling")
            if (length(dshow_surf)) {
                geoms$surface <- geoms$surface[!J(dshow_surf), on = "surface_type"]
            }
        }

        if (nrow(geoms$subsurface)) {
            if ("Door" %chin% dshow_subsurf) dshow_subsurf <- c(dshow_subsurf, "GlassDoor")
            if (length(dshow_subsurf)) {
                geoms$subsurface <- geoms$subsurface[!J(dshow_subsurf), on = "surface_type"]
            }
        }

        if (nrow(geoms$shading) && "shading" %chin% dshow) {
            geoms$shading <- geoms$shading[0L]
        }
    }
    # }}}

    # subset geoms by spaces {{{
    if (!is.null(space)) {
        if (is.integer(space)) {
            geoms$space <- geoms$space[J(space), on = "id", nomatch = NULL]
        } else {
            set(geoms$space, NULL, "name_lower", stri_trans_tolower(geoms$space$name))
            geoms$space <- geoms$space[J(stri_trans_tolower(space)), on = "name_lower", nomatch = NULL]
            set(geoms$space, NULL, "name_lower", NULL)
        }
        geoms$zone <- geoms$zone[J(geoms$space$zone), on = "name", nomatch = NULL]

        if (!nrow(geoms$space) || !nrow(geoms$surface)) {
            geoms$surface <- geoms$surface[0L]
            geoms$subsurface <- geoms$subsurface[0L]
            geoms$shading <- geoms$shading[0L]
            geoms$daylighting_point <- geoms$daylighting_point[0L]
        } else {
            geoms$surface <- geoms$surface[J(geoms$space$name), on = "space_name", nomatch = NULL]

            if (nrow(geoms$subsurface)) {
                geoms$subsurface <- geoms$subsurface[J(geoms$surface$name), on = "building_surface_name", nomatch = NULL]
            }

            if (nrow(geoms$shading)) {
                geoms$shading <- geoms$shading[J(geoms$surface$name), on = "base_surface_name", nomatch = NULL]
            }
        }
    }
    # }}}

    # subset geoms by zones {{{
    if (!is.null(zone)) {
        if (is.integer(zone)) {
            geoms$zone <- geoms$zone[J(zone), on = "id", nomatch = NULL]
        } else {
            set(geoms$zone, NULL, "name_lower", stri_trans_tolower(geoms$zone$name))
            geoms$zone <- geoms$zone[J(stri_trans_tolower(zone)), on = "name_lower", nomatch = NULL]
            set(geoms$zone, NULL, "name_lower", NULL)
        }
        geoms$space <- geoms$space[J(geoms$zone$name), on = "zone", nomatch = NULL]

        if (!nrow(geoms$zone) || !nrow(geoms$surface)) {
            geoms$surface <- geoms$surface[0L]
            geoms$subsurface <- geoms$subsurface[0L]
            geoms$shading <- geoms$shading[0L]
            geoms$daylighting_point <- geoms$daylighting_point[0L]
        } else {
            geoms$surface <- geoms$surface[J(geoms$zone$name), on = "zone_name", nomatch = NULL]

            if (nrow(geoms$subsurface)) {
                geoms$subsurface <- geoms$subsurface[J(geoms$surface$name), on = "building_surface_name", nomatch = NULL]
            }

            if (nrow(geoms$shading)) {
                geoms$shading <- geoms$shading[J(geoms$surface$name), on = "base_surface_name", nomatch = NULL]
            }
        }
    }
    # }}}

    # subset geoms by surfaces {{{
    if (!is.null(surface)) {
        if (is.integer(surface)) {
            on <- "id"
        } else {
            surface <- stri_trans_tolower(surface)
            on <- "name_lower"
        }
        if (nrow(geoms$surface)) {
            if (is.character(surface)) {
                set(geoms$surface, NULL, "name_lower", stri_trans_tolower(geoms$surface$name))
            }
            geoms$surface <- geoms$surface[J(surface), on = on, nomatch = NULL]
            if (is.character(surface)) {
                set(geoms$surface, NULL, "name_lower", NULL)
            }
        }
        if (nrow(geoms$subsurface)) {
            if (is.character(surface)) {
                set(geoms$subsurface, NULL, "name_lower", stri_trans_tolower(geoms$subsurface$name))
            }
            # get name of sufaces whose subsurfaces have been removed
            geoms$subsurface <- geoms$subsurface[J(surface), on = on, nomatch = NULL]
            if (is.character(surface)) {
                set(geoms$subsurface, NULL, "name_lower", NULL)
            }
        }
        if (nrow(geoms$shading)) {
            if (is.character(surface)) {
                set(geoms$shading, NULL, "name_lower", stri_trans_tolower(geoms$shading$name))
                geoms$shading <- geoms$shading[J(surface), on = on, nomatch = NULL]
                set(geoms$shading, NULL, "name_lower", NULL)
            }
        }
    }
    # }}}

    # subset daylighting points by zones {{{
    if ((!is.null(zone) || !is.null(surface) || !is.null(space)) && NROW(geoms$daylighting_point)) {
        if (!nrow(geoms$surface)) {
            geoms$daylighting_point <- geoms$daylighting_point[0L]
        } else if (nrow(geoms$daylighting_point)) {
            geoms$daylighting_point <- geoms$daylighting_point[
                J(c(geoms$surface$zone_name, geoms$surface$space_name)),
                on = "zone_name", nomatch = NULL]
        }
    }
    # }}}

    vid <- unique(c(geoms$surface$id, geoms$subsurface$id, geoms$shading$id, geoms$daylighting_point$id, geoms$hole$id))
    if (!length(vid)) {
        geoms$vertices <- geoms$vertices[0L]
        if (NROW(geoms$vertices2)) geoms$vertices2 <- geoms$vertices2[0L]
    } else if (nrow(geoms$vertices)) {
        geoms$vertices <- geoms$vertices[J(vid), on = "id"]
        if (NROW(geoms$vertices2)) geoms$vertices2 <- geoms$vertices2[J(vid), on = "id"]
    }
    geoms
}
# }}}

# align_coord_system {{{
align_coord_system <- function(geoms, detailed = NULL, simple = NULL, daylighting = NULL) {
    assert_choice(detailed, c("world", "relative"), null.ok = TRUE)
    assert_choice(simple, c("world", "relative"), null.ok = TRUE)
    assert_choice(daylighting, c("world", "relative"), null.ok = TRUE)

    if (is.null(detailed) && is.null(simple) && is.null(daylighting)) return(geoms)
    if (!nrow(geoms$zone)) return(geoms)

    add_zone_space_name(geoms)

    # init
    empty <- data.table(id = integer(), zone_name = character(), mult = integer())
    if (nrow(geoms$surface)) {
        set(geoms$surface, NULL, "mult", 0L)
        on.exit(set(geoms$surface, NULL, "mult", NULL), add = TRUE)
    } else {
        geoms$surface <- empty
    }
    if (nrow(geoms$subsurface)) {
        set(geoms$subsurface, NULL, "mult", 0L)
        on.exit(set(geoms$subsurface, NULL, c("mult", "zone_name"), NULL), add = TRUE)
    } else {
        geoms$subsurface <- empty
    }
    if (nrow(geoms$shading)) {
        set(geoms$shading, NULL, "mult", 0L)
        on.exit(set(geoms$shading, NULL, c("mult", "zone_name"), NULL), add = TRUE)
    } else {
        geoms$shading <- empty
    }
    if (nrow(geoms$daylighting_point)) {
        set(geoms$daylighting_point, NULL, "mult", 0L)
        on.exit(set(geoms$daylighting_point, NULL, "mult", NULL), add = TRUE)
    } else {
        geoms$daylighting_point <- empty
    }

    # indicates whether detailed/simple class names have been checked
    has_checked <- FALSE
    has_changed <- FALSE

    if (!is.null(detailed) && detailed != geoms$rules$coordinate_system) {
        has_checked <- TRUE
        has_changed <- TRUE

        is_det_surf <- stri_endswith_fixed(geoms$surface$class, "Detailed")
        is_det_subsurf <- stri_endswith_fixed(geoms$subsurface$class, "Detailed")
        is_det_shading <- stri_endswith_fixed(geoms$shading$class, "Detailed")

        # update rules
        geoms$rules$coordinate_system <- detailed

        # -1 for world to relative and 1 for relative to world
        mult <- if (detailed == "relative") -1L else 1L

        if (any(is_det_surf)) {
            set(geoms$surface, which(is_det_surf), "mult", mult)
        }
        if (any(is_det_subsurf) && nrow(geoms$surface)) {
            set(geoms$subsurface, which(is_det_subsurf), "mult", mult)
        }
        if (any(is_det_shading) && nrow(geoms$surface)) {
            set(geoms$shading, which(is_det_shading), "mult", mult)
        }
    }

    if (!is.null(simple) && simple != geoms$rules$rectangular_surface_coordinate_system) {
        has_changed <- TRUE
        if (has_checked) {
            is_sim_surf <- !is_det_surf
            is_sim_subsurf <- !is_det_subsurf
            is_sim_shading <- !is_det_shading
        } else {
            is_sim_surf <- !stri_endswith_fixed(geoms$surface$class, "Detailed")
            is_sim_subsurf <- !stri_endswith_fixed(geoms$subsurface$class, "Detailed")
            is_sim_shading <- !stri_endswith_fixed(geoms$shading$class, "Detailed")
        }

        # update rules
        geoms$rules$rectangular_surface_coordinate_system <- simple

        # -1 for world to relative and 1 for relative to world
        mult <- if (simple == "relative") -1L else 1L

        if (any(is_sim_surf)) {
            set(geoms$surface, which(is_sim_surf), "mult", mult)
        }
        if (any(is_sim_subsurf) && nrow(geoms$surface)) {
            set(geoms$subsurface, which(is_sim_subsurf), "mult", mult)
        }
        if (any(is_sim_shading) && nrow(geoms$surface)) {
            set(geoms$shading, which(is_sim_shading), "mult", mult)
        }
    }

    if (!is.null(daylighting) && daylighting != geoms$rules$daylighting_reference_point_coordinate_system) {
        has_changed <- TRUE
        # update rules
        geoms$rules$daylighting_reference_point_coordinate_system <- daylighting

        if (nrow(geoms$daylighting_point)) {
            # -1 for world to relative and 1 for relative to world
            mult <- if (daylighting == "relative") -1L else 1L
            set(geoms$daylighting_point, NULL, "mult", mult)
        }
    }

    if (!has_changed) return(geoms)

    # combine
    meta <- rbindlist(list(
        fast_subset(geoms$surface, names(empty)),
        fast_subset(geoms$subsurface, names(empty)),
        fast_subset(geoms$shading, names(empty)),
        fast_subset(geoms$daylighting_point, names(empty))
    ))

    # add data to the vertices table
    add_joined_cols(meta, geoms$vertices, "id", c("zone_name", "mult"))

    # transform
    geoms$vertices[geoms$zone, on = c("zone_name" = "name"),
        c("x", "y", "z") := {
            x <- x + mult * i.x
            y <- y + mult * i.y
            z <- z + mult * i.z

            deg <- mult * (i.dir_relative_north)

            # rotate by z-axis
            # NOTE: use formula specific for z-rotation, avoid grouping to speed up
            rot <- deg != 0.0
            sina <- sin(deg_to_rad(deg[rot]))
            cosa <- cos(deg_to_rad(deg[rot]))

            x[rot] <- x[rot] *  cosa + y[rot] * sina
            y[rot] <- x[rot] * -sina + y[rot] * cosa
            list(x, y, z)
        }
    ]

    set(geoms$vertices, NULL, c("zone_name", "mult"), NULL)

    if (!nrow(geoms$surface)) geoms$surface <- data.table()
    if (!nrow(geoms$subsurface)) geoms$subsurface <- data.table()
    if (!nrow(geoms$shading)) geoms$shading <- data.table()
    if (!nrow(geoms$daylighting_point)) geoms$daylighting_point <- data.table()
    geoms
}
# }}}

# set_geom_vertices {{{
set_geom_vertices <- function(idf, geom, digits = NULL) {
    if (!NROW(geom$meta)) return(idf)

    # only works for detailed geometry classes
    fldid <- get_first_vertex_field_index(idf$version())
    map <- data.table(class = names(fldid), first_vertex = fldid)
    meta <- geom$meta[map, on = "class", nomatch = NULL, list(id, first_vertex)]
    if (!nrow(meta)) return(idf)

    vert <- geom$vertices[meta, on = "id", nomatch = NULL]
    if (!is.null(digits)) {
        assert_count(digits)
        vert[, c("x", "y", "z") := lapply(.SD, round, digits = digits), .SDcols = c("x", "y", "z")]
    }

    vert <- melt.data.table(vert, id.vars = c("id", "index", "first_vertex"))
    setorderv(vert, c("id", "index"))
    vert[, field_index := first_vertex - 1L + seq_len(.N), by = "id"]

    add_field_property(get_priv_env(idf)$idd_env(), get_priv_env(idf)$idf_env()$value, "field_index")
    get_priv_env(idf)$idf_env()$value[vert, on = c("object_id" = "id", "field_index"),
        `:=`(value_chr = as.character(i.value), value_num = i.value)]
    set(get_priv_env(idf)$idf_env()$value, NULL, "field_index", NULL)

    # log
    get_priv_env(idf)$log_new_order(unique(vert$id))
    get_priv_env(idf)$log_unsaved()
    get_priv_env(idf)$log_new_uuid()

    idf
}
# }}}

# add_zone_space_name {{{
add_zone_space_name <- function(geoms) {
    if (!nrow(geoms$surface)) return(geoms)

    if (nrow(geoms$subsurface)) {
        geoms$subsurface[geoms$surface, on = c("building_surface_name" = "name"),
            `:=`(zone_name = i.zone_name, space_name = i.space_name)
        ]
    }
    if (nrow(geoms$shading)) {
        geoms$shading[geoms$surface, on = c("base_surface_name" = "name"),
            `:=`(zone_name = i.zone_name, space_name = i.space_name)
        ]
    }
    geoms
}
# }}}

# del_zone_space_name {{{
del_zone_space_name <- function(geoms) {
    if (nrow(geoms$subsurface) && has_names(geoms$subsurface, "zone_name")) {
        set(geoms$subsurface, NULL, c("zone_name", "space_name"), NULL)
    }
    if (nrow(geoms$shading) && has_names(geoms$shading, "zone_name")) {
        set(geoms$shading, NULL, c("zone_name", "space_name"), NULL)
    }
    geoms
}
# }}}

# remove_incomplete_vertices {{{
remove_incomplete_vertices <- function(vertices) {
    # only keep rows that have valid x, y, z values from the beginning
    vertices_valid <- na.omit(vertices, cols = c("x", "y", "z"))
    if (nrow(vertices_valid) != nrow(vertices)) {
        vertices <- vertices[, by = "id", {
            index <- index[index == seq_len(.N)]
            list(index = index, x = x[index], y = y[index], z = z[index])
        }]
    }
    vertices
}
# }}}

# reverse_idf_detailed_vertices {{{
reverse_idf_detailed_vertices <- function(idf, geom_class = NULL) {
    if (is.null(geom_class)) geom_class <- get_geom_class(idf)

    detailed <- geom_class[J("Detailed"), on = "subtype", nomatch = NULL]
    if (!nrow(detailed)) return(idf)

    # only works for detailed geometry classes
    fldid <- get_first_vertex_field_index(idf$version())
    map <- data.table(class = names(fldid), first_vertex = fldid)
    detailed <- detailed[map, on = "class", nomatch = NULL, list(class, first_vertex)]

    dt <- idf$to_table(class = detailed$class)
    set(dt, NULL, "field_index", dt$index)

    dt <- dt[detailed, on = list(class, field_index >= first_vertex)][,
        by = "id", value := {
            i <- (index - field_index + 1L) %% 3L
            value[i == 1L] <- rev(value[i == 1L])
            value[i == 2L] <- rev(value[i == 2L])
            value[i == 0L] <- rev(value[i == 0L])
            value
        }
    ]

    idf$update(dt, .default = FALSE, .empty = TRUE)

    idf
}
# }}}

# apply_upper_left_corner_rule {{{
apply_upper_left_corner_rule <- function(vertices) {
    trans <- align_face(vertices)

    vertices[trans, on = "id", by = .EACHI,
        c("x", "y", "z") := {
            if (.N < 3L) {
                list(x, y, z)
            } else {
                trans_inv <- solve(i.trans[[1L]])
                align_vert <- apply(matrix(c(x, y, z, rep(1.0, .N)), ncol = 4L), 1, function(x) trans_inv %*% x)[1:3,]

                if (any(align_vert[3L, ] >= 0.001)) abort("invalid align transformation")

                max_y <- -Inf
                min_x <- Inf
                ulc_index <- 1L
                for (i in seq_len(.N)) {
                    if (max_y < align_vert[2, i] || (max_y < align_vert[2, i] + 1E-5 && min_x > align_vert[1, i])) {
                        ulc_index <- i
                        max_y <- align_vert[2, i]
                        min_x <- align_vert[1, i]
                    }
                }

                if (ulc_index == 1L) {
                    list(x, y, z)
                } else {
                    i <- c(ulc_index:.N, 1:(ulc_index - 1L))
                    list(x[i], y[i], z[i])
                }
            }
        }
    ]

    vertices
}
# }}}

# get_vertices_from_specs {{{
get_vertices_from_specs <- function(azimuth, tilt, length, height, x0, y0, z0) {
    cos_azimuth <- cos(deg_to_rad(azimuth))
    sin_azimuth <- sin(deg_to_rad(azimuth))
    cos_tilt <- cos(deg_to_rad(tilt))
    sin_tilt <- sin(deg_to_rad(tilt))

    x_init <- list(0.0, 0.0, length, length)
    y_init <- list(height, 0.0, 0.0, height)

    x <- mapply(
        function(x, y) x0 - cos_azimuth * x - cos_tilt * sin_azimuth * y,
        x = x_init, y = y_init, SIMPLIFY = FALSE
    )

    y <- mapply(
        function(x, y) y0 + sin_azimuth * x - cos_tilt * cos_azimuth * y,
        x = x_init, y = y_init, SIMPLIFY = FALSE
    )

    z <- lapply(y_init, function(y) z0 + sin_tilt * y)

    list(x = x, y = y, z = z)
}
# }}}

# align_face {{{
align_face <- function(vertices) {
    norm <- get_outward_normal(vertices)
    # get z' with outward normal
    norm[, by = "id", trans := list(list(align_z_prime(x, y, z)))]

    dt_trans <- setDT(data.table::transpose(norm$trans))
    dt_inv_trans <- setDT(data.table::transpose(lapply(norm$trans, solve.default)))
    set(dt_trans, NULL, "id", norm$id)
    set(dt_inv_trans, NULL, "id", norm$id)

    add_joined_cols(dt_inv_trans, vertices, "id", sprintf("V%i", 1:16))
    vertices[, `:=`(
        inv_x = x * V1 + y * V5 + z * V9  + V13,
        inv_y = x * V2 + y * V6 + z * V10 + V14,
        inv_z = x * V3 + y * V7 + z * V11 + V15
    )]
    vert <- vertices[, by = "id", list(inv_x = min(inv_x), inv_y = min(inv_y), inv_z = min(inv_z))]
    # clean
    set(vertices, NULL, setdiff(names(vertices), c("id", "index", "x", "y", "z")), NULL)

    add_joined_cols(dt_trans, vert, "id", sprintf("V%i", 1:16))

    # 4 X 4 matrix multiplication
    vert[, `:=`(
        V13 = inv_x * V1 + inv_y * V5 + inv_z * V9  + V13,
        V14 = inv_x * V2 + inv_y * V6 + inv_z * V10 + V14,
        V15 = inv_x * V3 + inv_y * V7 + inv_z * V11 + V15,
        V16 = inv_x * V4 + inv_y * V8 + inv_z * V12 + V16
    )]

    vert[, by = "id", list(
        trans = list(matrix(
            c(V1, V2, V3, V4, V5, V6, V7, V8, V9, V10, V11, V12, V13, V14, V15, V16),
            ncol = 4L
        ))
    )]
}
# }}}

# get_newall_vector {{{
get_newall_vector <- function(vertices) {
    # Reference: https://www.khronos.org/opengl/wiki/Calculating_a_Surface_Normal#Newell.27s_Method
    vertices[, by = "id", {
        nx <- seq_len(.N) %% .N + 1L
        # calculate the distance from the origin to the first point on each polygon
        list(
            x = sum((z + z[nx]) * (y - y[nx])),
            y = sum((x + x[nx]) * (z - z[nx])),
            z = sum((y + y[nx]) * (x - x[nx]))
        )
    }]
}
# }}}

# get_outward_normal {{{
get_outward_normal <- function(vertices) {
    # calculate normal vector of surfaces using Newell Method
    # Reference: https://www.khronos.org/opengl/wiki/Calculating_a_Surface_Normal#Newell.27s_Method
    vertices <- get_newall_vector(vertices)
    vertices[, by = "id", c("x", "y", "z") := as.list(normalize(c(x, y, z)))]
    vertices
}
# }}}

# align_z_prime {{{
align_z_prime <- function(x, y, z) {
    axis_x <- c(1, 0, 0)
    axis_y <- c(0, 1, 0)
    axis_z <- c(0, 0, 1)
    axis_x_neg <- c(-1, 0, 0)

    zp <- normalize(c(x, y, z))

    dot_zp <- as.numeric(zp %*% axis_z)

    if (is.na(dot_zp) || is.nan(dot_zp)) {
        return(matrix(rep(NA_real_, 16L), ncol = 4L))
    }

    # check if face normal is up or down
    # not facing up or down, set yPrime along zAxis
    if (abs(dot_zp) < 0.99) {
        yp <- normalize(axis_z - as.numeric(zp %*% axis_z) * zp)
        xp <- crossproduct(yp, zp)
    } else {
        xp <- normalize(axis_x_neg - as.numeric(zp %*% axis_x_neg) * zp)
        yp <- crossproduct(zp, xp)
    }

    trans <- diag(nrow = 4L)
    trans[1:3, 1] <- xp
    trans[1:3, 2] <- yp
    trans[1:3, 3] <- zp
    trans
}
# }}}

# crossproduct {{{
crossproduct <- function(v1, v2) {
    v1[c(2L, 3L, 1L)] * v2[c(3L, 1L, 2L)] - v1[c(3L, 1L, 2L)] * v2[c(2L, 3L, 1L)]
}
# }}}

# normalize {{{
normalize <- function(v) v / sqrt(sum(v^2))
# }}}

# deg_to_rad {{{
deg_to_rad <- function(x) x / 180 * pi
# }}}

# rad_to_deg {{{
rad_to_deg <- function(x) x / pi * 180
# }}}

# get_angle {{{
get_angle <- function(v1, v2) {
    normalize(v1) %*% normalize(v2)
    d <- rad_to_deg(acos(normalize(v1) %*% normalize(v2)))[1]
    if (v1[[1]] < 0) d <- d + 180
    d
}
# }}}

# get_tilt {{{
get_tilt <- function(out_norm) {
    get_angle(out_norm, c(0, 0, 1))
}
# }}}

# get_azimuth {{{
get_azimuth <- function(out_norm) {
    get_angle(out_norm, c(0, 1, 0))
}
# }}}

# get_area {{{
get_area <- function(newall) {
    sqrt(sum(newall ^ 2)) / 2.0
}
# }}}

# vim: set fdm=marker: