domRule <- function(object, params, type) {
  p_rule <- function(params) {
    stopifnot(is_scalar_double(params$cell_tot))

    cont1 <- params$top_contr[1]
    cont2 <- params$top_contr[2]
    stopifnot(is_scalar_double(cont1))
    stopifnot(is_scalar_double(cont2))
    stopifnot(is_scalar_integerish(params$p))
    stopifnot(params$p > 0, params$p <= 100)

    # if TRUE, cell needs to be suppressed
    (params$cell_tot - sum(cont1, cont2)) < (params$p / 100 * cont1)
  }
  pq_rule <- function(params) {
    stopifnot(is_scalar_double(params$cell_tot))
    cont1 <- params$top_contr[1]
    cont2 <- params$top_contr[2]
    stopifnot(is_scalar_double(cont1))
    stopifnot(is_scalar_double(cont2))
    stopifnot(is_integerish(params$pq))
    p <- params$pq[1]
    q <- params$pq[2]

    # if TRUE, cell needs to be suppressed
    (params$cell_tot - sum(cont1, cont2)) < (p / q) * cont1
  }
  nk_rule <- function(params) {
    stopifnot(is_scalar_double(params$cell_tot))
    stopifnot(is_scalar_integerish(params$n))
    # if TRUE, cell needs to be suppressed
    sum(params$top_contr) > (params$k / 100 * params$cell_tot)
  }

  if (type == "p") {
   fun <- p_rule
  }
  if (type == "pq") {
    fun <- pq_rule
  }
  if (type == "nk") {
    fun <- nk_rule
  }

  # compute inputs (cell total and top two contributing) units
  # for a given vector of cell values and weights `w`
  # values are replicated times their weights which are randomly
  # rounded to integers in case they are floating numbers
  .comp_weighted_inputs <- function(vals, w, n) {
    if (length(vals) == 0) {
      return(NULL)
    }

    # replicate by weights: what to do with non-integerish weights?
    # consistently round up (1, 3, ...) and downwards (2, 4, ...)
    if (!is_integerish(w)) {
      idx <- seq(1, length(w), by = 2)
      w[idx] <- ceiling(w[idx])
      if (length(w) > 1) {
        idx <- seq(2, length(w), by = 2)
        w[idx] <- floor(w[idx])
      }
    }
    # division is required here because in makeProblem()
    # all numVars-variables are aggregated on cell-level
    vals <- rep(vals / w, times = w)

    top_contr <- rep(0, n)
    v <- rev(tail(sort(vals), n))
    top_contr[1:length(v)] <- v
    list(
      cell_tot = sum(vals),
      top_contr = top_contr
    )
  }

  if (!is_scalar_character(type)) {
    stop("`type` needs to be a scalar character.", call. = FALSE)
  }
  if (!type %in% c("pq", "p", "nk")) {
    stop("`type` needs to be either `pq`, `p` or `nk`.", call. = FALSE)
  }

  if (!g_is_microdata(g_dataObj(object))) {
    e <- "dominance rules can only be applied if micro-data are available!"
    stop(e, call. = FALSE)
  }

  if (type %in% c("p", "pq")) {
    n <- 2
  } else {
    n <- params$n
    if (n < 1) {
      stop("Parameter `n` must be >= 1 for nk-dominance rule.", call. = FALSE)
    }
  }

  pI <- g_problemInstance(object)
  dataObj <- g_dataObj(object)
  strIDs <- g_strID(pI)
  raw_data <- g_raw_data(dataObj)
  numVal <- raw_data[[params$numVarName]]

  if (any(na.omit(numVal) < 0)) {
    e <- c(
      "dominance rules can only be applied to numeric variables",
      "with only positive values!"
    )
    stop(paste(e, collapse = " "), call. = FALSE)
  }

  # sampweights
  samp_weights <- g_sampweight_ind(dataObj)
  if (!is.null(samp_weights)) {
    samp_weights <- slot(dataObj, "rawData")[[samp_weights]]
  } else {
    samp_weights <- rep(1, length(numVal))
  }

  # calculate contributing indices
  nr_cells <- g_nrVars(pI)

  # we check if we need to compute contributing indices
  indices <- attributes(raw_data)[["computed_indices"]]
  if (is.null(indices)) {
    # indices of contributing units have not yet been computed
    indices <- contributing_indices(
      prob = object,
      ids = strIDs
    )
    attr(raw_data, "computed_indices") <- indices
    object@dataObj@rawData <- raw_data
    object <<- object
  }

  # values and totals of contributing units
  inp <- lapply(1:nr_cells, function(x) {
    ii <- indices[[x]]
    .comp_weighted_inputs(
      vals = numVal[ii],
      w = samp_weights[ii],
      n = n
    )
  })

  # suppStatus: TRUE: unsafe, FALSE: safe
  supp_state <- sapply(1:nr_cells, function(x) {
    inp <- inp[[x]]
    # cells with value 0!
    if (is.null(inp)) {
      FALSE
    } else {
      fun(params = append(params, inp))
    }
  })

  # in case of dominance rules; empty cells (frequency = 0)
  # are never marked as sensitive
  supp_index <- which(supp_state == TRUE & g_freq(pI) > 0)
  if (length(supp_index) > 0) {
    s_sdcStatus(pI) <- list(
      index = supp_index,
      vals = rep("u", length(supp_index))
    )
  }
  s_problemInstance(object) <- pI
  validObject(object)
  return(object)
}

# returns all contributing codes for each dimensions
# of a sdcProblem-object; dimensions are stored as attributes
# in sdcProblem-objects; thus we can use sdcHierarchies::hier_info()
# this is used in createRegSDCInput() and contributing_indices()
.get_all_contributing_codes <- function(x) {
  stopifnot(inherits(x, "sdcProblem"))
  dims_hier <- attributes(x)$hierinfo

  dims_info <- lapply(dims_hier, function(x) {
    sdcHierarchies::hier_info(x)
  })

  all_contr_codes <- lapply(dims_info, function(x) {
    lapply(x, function(y) {
      list(
        is_root = y$is_rootnode,
        contr_codes = y$contributing_codes
      )
    })
  })
  all_contr_codes
}

.tmpweightname <- function() {
  "weight.for.suppression"
}

# returns a relevant row from a protected dataset (slot "results") or
# the current status (from "problemInstance") depending on the inputs
# specs is a named vector and complete allows to return the entire row
# or only the id
cell_id <- function(x, specs, complete = TRUE, addDups = FALSE) {
  stopifnot(inherits(x, "sdcProblem"))
  df <- slot(x, "results")
  if (is.null(df)) {
    df <- sdcProb2df(
      obj = x,
      dimCodes = "original",
      addNumVars = TRUE,
      addDups = addDups
    )
  }

  stopifnot(rlang::is_scalar_logical(complete))

  # check inputs
  if (!rlang::is_named(specs)) {
    stop("input `specs` must be a named character vector", call. = FALSE)
  }
  if (!rlang::is_character(specs)) {
    stop("input `specs` must be a named character vector", call. = FALSE)
  }

  di <- slot(x, "dimInfo")
  vnames <- slot(di, "vNames")

  if (length(specs) != length(vnames)) {
    stop("length of input `specs` does not match number of dimensions.", call. = FALSE)
  }

  idx <- match(names(specs), vnames)
  if (any(is.na(idx))) {
    stop("names of input `specs` does not match names of dimensions.", call. = FALSE)
  }

  specs <- specs[idx]
  df$id <- 1:nrow(df)
  for (v in vnames) {
    df <- df[get(v) == specs[v]]
  }
  if (nrow(df) != 1) {
    stop("0 or > 1 cells identified, check inputs `specs`", call. = FALSE)
  }
  if (complete) {
    return(df)
  } else {
    return(df$id)
  }
}

# computes the constraint-matrix (m) for a given problem instance;
# this replaces the old method `c_gen_m` available in versions <= 0.32
# convert: if TRUE; a (internal) simpleTripet matrix is returned;
# else a simple-triplet matrix in the format from the slam pkg
# add_info_df: if true, an attribute "infodf" is added containing
# a data.frame with all cell ids and TRUE|FALSE depending on wheather
# the cell is an internal cell or not
create_m_matrix <- function(obj, convert = TRUE, add_info_df = FALSE) {
  # Setup
  stopifnot(inherits(obj, "sdcProblem"))
  stopifnot(rlang::is_scalar_logical(convert))
  stopifnot(rlang::is_scalar_logical(add_info_df))

  full_dt <- sdcProb2df(obj, addDups = FALSE)
  full_dt$id <- seq_len(nrow(full_dt))

  dim_info <- slot(obj, "dimInfo")
  dim_names <- slot(dim_info, "vNames")
  dims <- slot(dim_info, "dimInfo")

  all_i <- list()
  all_j <- list()
  all_v <- list()
  current_row <- 0

  # Iterate through dimensions
  for (d_idx in seq_along(dims)) {
    d_var <- dims[[d_idx]]
    d_name <- dim_names[d_idx]
    dl <- slot(d_var, "dims")

    # Identify the dimensions used for grouping/blocking
    other_dims <- setdiff(dim_names, d_name)

    for (i in seq_along(dl)) {
      # Subset for specific hierarchy level
      tmp <- full_dt[get(d_name) %in% dl[[i]]]
      if (nrow(tmp) == 0) next

      # Sort by 'fixed' dimensions then current 'dim'
      data.table::setorderv(tmp, c(other_dims, d_name))

      nr_elements <- length(dl[[i]])
      nr_constraints <- nrow(tmp) / nr_elements

      # Generate vectors
      row_indices <- rep(current_row + seq_len(nr_constraints), each = nr_elements)
      col_indices <- tmp$id
      values <- rep(c(-1, rep(1, nr_elements - 1)), times = nr_constraints)

      all_i[[length(all_i) + 1]] <- row_indices
      all_j[[length(all_j) + 1]] <- col_indices
      all_v[[length(all_v) + 1]] <- values

      current_row <- current_row + nr_constraints
    }
  }

  # Construct Matrix
  mat <- slam::simple_triplet_matrix(
    i = unlist(all_i),
    j = unlist(all_j),
    v = unlist(all_v),
    nrow = current_row,
    ncol = nrow(full_dt)
  )

  # Metadata Handling
  if (add_info_df) {
    colnames(mat) <- full_dt$strID
    index_subtots <- unique(mat$j[mat$v == -1])
    infodf <- data.frame(
      str_id = colnames(mat),
      is_inner = TRUE,
      stringsAsFactors = FALSE
    )
    infodf$is_inner[index_subtots] <- FALSE
    attr(mat, "infodf") <- infodf
  } else {
    mat$dimnames <- list(NULL, NULL)
  }

  if (!convert) return(mat)

  # Conversion to simpleTripet (if required)
  st <- new("simpleTriplet",
    i = mat$i,
    j = mat$j,
    v = mat$v,
    nrRows = mat$nrow,
    nrCols = mat$ncol
  )
  if (add_info_df) {
    attr(st, "infodf") <- attr(mat, "infodf")
  }
  return(st)
}
