inst/doc/usage.R

In sdcHierarchies: Create and (Interactively) Modify Nested Hierarchies

## ----echo=FALSE, include=FALSE------------------------------------------------
library(rmarkdown)
library(sdcHierarchies)
library(data.table)

## ----eval = FALSE-------------------------------------------------------------
# library(sdcHierarchies)

## -----------------------------------------------------------------------------
h <- hier_create(root = "Total", nodes = LETTERS[1:5])
hier_display(h)

## -----------------------------------------------------------------------------
## adding nodes below the node specified in argument `node`
h <- hier_add(h, root = "A", nodes = c("a1", "a2"))
h <- hier_add(h, root = "B", nodes = c("b1", "b2"))
h <- hier_add(h, root = "b1", nodes = c("b1_a", "b1_b"))

# deleting one or more nodes from the hierarchy
h <- hier_delete(h, nodes = c("a1", "b2"))
h <- hier_delete(h, nodes = c("a2"))

# rename nodes
h <- hier_rename(h, nodes = c("C" = "X", "D" = "Y"))
hier_display(h)

## -----------------------------------------------------------------------------
# about a specific node
info <- hier_info(h, nodes = c("b1", "E"))

## -----------------------------------------------------------------------------
info$b1

## -----------------------------------------------------------------------------
# conversion to a "@;label"-based format
res_df <- hier_convert(h, as = "df")
print(res_df)

## -----------------------------------------------------------------------------
code <- hier_convert(h, as = "code"); cat(code, sep = "\n")

## ----eval=FALSE---------------------------------------------------------------
# hier_export(h, as = "argus", path = file.path(tempdir(), "hierarchy.hrc"))

## -----------------------------------------------------------------------------
n_df <- hier_import(inp = res_df, from = "df")
hier_display(n_df)

## -----------------------------------------------------------------------------
geo_m <- c(
  "01051", "01053", "01054", "01055", "01056", "01057", "01058", "01059", "01060", "01061", "01062",
  "02000",
  "03151", "03152", "03153", "03154", "03155", "03156", "03157", "03158", "03251", "03252", "03254", "03255",
  "03256", "03257", "03351", "03352", "03353", "03354", "03355", "03356", "03357", "03358", "03359", "03360",
  "03361", "03451", "03452", "03453", "03454", "03455", "03456",
  "10155")

## -----------------------------------------------------------------------------
# Using end positions (e.g., level 1 ends at index 2, level 2 at 3, level 3 at 5)
v1 <- hier_compute(
  inp = geo_m, 
  dim_spec = c(2, 3, 5), 
  root = "Tot", 
  method = "endpos", 
  as = "df"
)

# Using lengths (e.g., level 1 is 2 chars, level 2 is 1 char, level 3 is 2 chars)
v2 <- hier_compute(
  inp = geo_m, 
  dim_spec = c(2, 1, 2), 
  root = "Tot", 
  method = "len",
  as = "df"
)

identical(v1, v2)
hier_display(v1)

## -----------------------------------------------------------------------------
geo_m_with_tot <- paste0("Tot", geo_m)
head(geo_m_with_tot)

v3 <- hier_compute(
  inp = geo_m_with_tot, 
  dim_spec = c(3, 2, 1, 2), 
  method = "len"
)
hier_display(v3)

## -----------------------------------------------------------------------------
## Example with unequal string lengths; overall total provided via 'root'
yae_h <- c(
  "1.1.1.", "1.1.2.",
  "1.2.1.", "1.2.2.", "1.2.3.", "1.2.4.", "1.2.5.", "1.3.1.",
  "1.3.2.", "1.3.3.", "1.3.4.", "1.3.5.",
  "1.4.1.", "1.4.2.", "1.4.3.", "1.4.4.", "1.4.5.",
  "1.5.", "1.6.", "1.7.", "1.8.", "1.9.", "2.", "3.")

v1 <- hier_compute(
  inp = yae_h, 
  dim_spec = c(2, 2, 2), 
  root = "Tot", 
  method = "len"
)
hier_display(v1)

## -----------------------------------------------------------------------------
yae_ll <- list()
yae_ll[["Total"]] <- c("1.", "2.", "3.")
yae_ll[["1."]]    <- paste0("1.", 1:9, ".")
yae_ll[["1.1."]]  <- paste0("1.1.", 1:2, ".")
yae_ll[["1.2."]]  <- paste0("1.2.", 1:5, ".")
yae_ll[["1.3."]]  <- paste0("1.3.", 1:5, ".")
yae_ll[["1.4."]]  <- paste0("1.4.", 1:6, ".")

d <- hier_compute(inp = yae_ll, root = "Total", method = "list") 
hier_display(d)

## -----------------------------------------------------------------------------
h1 <- hier_create("Total", nodes = LETTERS[1:3])
h1 <- hier_add(h1, root = "A", node = "a1")
h1 <- hier_add(h1, root = "a1", node = "aa1")
hier_display(h1)

h2 <- hier_create("Total", letters[1:5])
h2 <- hier_add(h2, root = "b", node = "b1")
h2 <- hier_add(h2, root = "d", node = "d1")
hier_display(h2)

## -----------------------------------------------------------------------------
# cell_id is a unique string created by concatenating default codes
r <- hier_grid(h1, h2, add_dups = FALSE, add_levs = TRUE)
print(r)

## -----------------------------------------------------------------------------
# Create an SDC-optimized grid
r_sdc <- hier_grid(h1, h2, add_dups = FALSE, add_contributing_cells = TRUE)

# Genrate microdata using base-level codes for region and sector
# Note: 'aa1', 'b1', and 'd1' are the granular leaf nodes
microdata <- data.table(
  region = c("aa1", "B", "C", "aa1", "B"),
  sector = c("a", "b1", "c", "d1", "e"),
  val = c(10, 20, 30, 40, 50)
)

# Map microdata to base-level IDs using a named list
microdata[, leaf_id := hier_create_ids(
  data = microdata, 
  dims = list("region" = h1, "sector" = h2)
)]

print(microdata)

# Fast aggregation: Summing 'Total_Total' using integer lookups
total_ids <- r_sdc[v1 == "Total" & v2 == "Total", contributing_leaf_ids[[1]]]
print(total_ids)

sum(microdata[leaf_id %in% total_ids, val])

## -----------------------------------------------------------------------------
# Isolate primary cells for primary suppression
primary_cells <- r_sdc[!is.na(leaf_id)]

# Isolate aggregate cells for marginal consistency checks
sub_totals <- r_sdc[is.na(leaf_id)]

## ----eval=FALSE---------------------------------------------------------------
# # Start the app and store the modified result upon closing
# d_modified <- hier_app(d)