Feature suggestion: wrapper function for aggregated tables

[jnlb]

This issue is about a special feature I asked about a long time ago. It really is kind of like a misuse of the Gauss Algorithm, so I think this issue could also be allowed to contain any discussion related to why this feature should or should not exist. However, you did also invite me to write an issue about this feature, so here we are.

There may be special cases where a suppression function meant for readily aggregated tables could be used safely. For such a function, one cannot use the charVar feature, and much of the singleton handling features of the package will be unusable. Despite this, I can see a few use cases:

1. In extremely big data applications where aggregation is not possible on the computing platform due to the extreme size of the underlying microdata.
2. If one wants to quickly choose between many alternative ways to form the output table, either via coarsening hierarchical classes or simply excluding output dimensions.
3. If there is no need for contributor handling and the statistician is used to applying cell suppression patterns on an otherwise publish-ready table.

In my current opinion, this could probably best be handled by a new wrapper function.

[jnlb]

In order to justify my assertion that a new wrapper function probably should be implemented, please consider the code below.

library(SSBtools)
library(GaussSuppression)
library(dplyr)

df <- SSBtoolsData("magnitude1")
df$freq <-1

# return top n values (fixed length, pad with NA)
# checked: works with SSBtools::aggregate_multiple_fun
topn <- function(x, n = 2) {
  v <- sort(x, decreasing = TRUE)
  if (length(v) < n) v <- c(v, rep(NA, n - length(v)))
  setNames(v[seq_len(n)], paste0("max", seq_len(n)))
}

df_input <- aggregate_multiple_fun(
  df, 
  by = df[c("sector4", "sector2", "geo", "eu")], 
  vars = c(sum = "value", sum = "freq", topn = "value"), 
  fun = list(sum = sum, topn = topn)
)

df_input <- df_input %>% 
  rename(
    value = "value_sum",
    freq = "freq_sum",
    max1 = "value_topn.max1", 
    max2 = "value_topn.max2"
  )

df_aggregated <- model_aggregate(
  df_input,
  formula = ~(sector4 + sector2)*(eu + geo),
  sum_vars = c("value", "freq"),
  fun_vars = c(max = "max1", max = "max2"),
  fun = c(sum = sum, max = max)
)

df_aggregated <- df_aggregated %>%
  rename(
    max1 = "max1_max", 
    max2 = "max2_max"
  )

print(df_aggregated)

## this is my suggested prototype primary function for dominance rule
## note the required data_aggregated and maxVars parameters!
agg_dominance <- function(data_aggregated, crossTable, num, n, k, maxVars, 
                          protectZeros = FALSE, ...) {
  
  prim <- rep(FALSE, nrow(crossTable))
  #print(data)
  #print(num)
  #print(crossTable)
  
  for (n in n) {
    
    max_contr <- rep(0.0, nrow(crossTable))
    for (i in 1:n) {
      max_contr <- max_contr + data_aggregated[,maxVars[i]]
      
    }
    prim <- prim | ifelse(max_contr == 0, FALSE, max_contr/num > k[n]/100.0)
  }
  
  prim
}

# df_input does not contain margin cells
# df_aggregated does
out <- GaussSuppressionFromData(
  data = df_input,
  data_aggregated = df_aggregated,
  formula = ~(sector4 + sector2)*(eu + geo),
  numVar = "value", 
  freq = "freq",
  maxVars = c("max1", "max2"),
  n=c(1,2), k=c(85, 75),
  preAggregate = FALSE, # no pre-aggregation needed
  extraAggregate = FALSE,
  primary = agg_dominance,
  protectZeros = FALSE,
  singletonMethod = "none" # turn off singleton handling
)

print(out)

I probably made some beginner mistake and I get the warning message:

Warning message:
In aggregate_multiple_fun(data = data, ind = x_i_1L, by = x_j_1L,  :
  Not all fun elements will be used

However, I think the aggregated values are correct and that the primary function still works with my inelegant hack.

Technical comments:

1. It is impossible to directly feed data=df_aggregated into GaussSuppressionFromData. This will ALWAYS lead to errors due to the model matrix backend.
2. I was not able to find any way to bring the max-variables as separate value vectors, such as num is used internally in the functions. Presumably, allDominance enables some way of keeping track of the max_contributor variables, but I have still not found a way.
3. It is technically possible to pre-compute primary suppressions on df_aggregated and then use PrimarySuppressionsFromData and SuppressedData.
4. If one pre-computes primary suppressions on df_input and uses SuppressedData=df_input, then one will miss potential primary suppressions in margin cells.
5. Given that total codes are in use (or one known "Total" is used), then a wrapper function could separate the input data from the margin cells as the first step.

At this point, I am a bit stumped. This could in principle be implemented in the way I outlined here, but I feel like it is best to bring up here and expose this to further comments/discussion.

For the record, I was using the following environment:

• R 4.5.1
• SSBtools 1.8.4
• GaussSuppression 1.2.0

[olangsrud]

Thanks for this. As a basis for further discussion, here is some code.

# Even though this may just be for discussion purposes, I think it’s best if the example is correct. 
# Therefore, I recalculate df_aggregated so that max2 is also computed correctly.
df_aggregated_old <- df_aggregated
df_aggregated <- model_aggregate(df, 
        formula = ~(sector4 + sector2) * (eu + geo), 
        sum_vars = c("value", "freq"), 
        fun_vars = list(`max1,max2` = list(topn = "value")), 
        fun = c(topn = topn))


# The priority order is an important element. 
# I therefore create a simple function based on the size of "value".
candidates <- function(num, ...) order(num[[1]], decreasing = TRUE)


# Now I recalculate using your method with this modification.
out1 <- GaussSuppressionFromData(
  data = df_input,
  data_aggregated = df_aggregated,
  formula = ~(sector4 + sector2)*(eu + geo),
  numVar = "value", 
  freq = "freq",
  maxVars = c("max1", "max2"),
  n=c(1,2), k=c(85, 75),
  preAggregate = FALSE, # no pre-aggregation needed
  extraAggregate = FALSE,
  primary = agg_dominance,
  protectZeros = FALSE,
  singletonMethod = "none", # turn off singleton handling
  candidates = candidates
)


# The result now matches exactly what we get from SuppressDominantCells().
out0 <- SuppressDominantCells(df, 
          formula = ~(sector4 + sector2) * (eu + geo), 
          k = c(85, 75), 
          dominanceVar = "value", 
          freqVar = "freq", 
          singletonMethod = "none")



# However, if the output data are calculated manually in advance, 
# it might make sense to also compute 'primary' at that stage.
prim <- agg_dominance(data_aggregated = df_aggregated, 
                      crossTable = df_aggregated, 
                      num = df_aggregated["value"], 
                      n = c(1, 2), k = c(85, 75), 
                      maxVars = c("max1", "max2"))


# The model matrix used can be generated by using the 'select' parameter, 
# ensuring that it matches the output data already available.
x <- ModelMatrix(df_input, formula = ~(sector4 + sector2) * (eu + geo), select = df_aggregated[1:2])


# Secondary suppression can now be found by running SSBtools::GaussSuppression() directly.
sec <- GaussSuppression(x = x, candidates = candidates(num = df_aggregated["value"]), primary = which(prim))


# These steps can now be combined to produce the desired output.
out2 <- cbind(df_aggregated[c(1, 2, 4, 3)], primary = prim, suppressed = prim)
out2$suppressed[sec] <- TRUE
  

# Note that 'list_return' and 'pre_return' can be used to get more output from model_aggregate(). 
# This provides the equivalents of df_input and x. The order is different, but that doesn’t matter. 
m <- model_aggregate(df, 
      formula = ~(sector4 + sector2) * (eu + geo), 
      sum_vars = c("value", "freq"), 
      fun_vars = list(`max1,max2` = list(topn = "value")), 
      fun = c(topn = topn), 
      list_return = TRUE,
      pre_return = TRUE)

# For example, one can use this to compute secondary suppression.
GaussSuppression(x = m$x, candidates = candidates(num = df_aggregated["value"]), primary = which(prim))


# It is also possible to provide x, crossTable, and primary (as a vector) directly as input.
out3 <- GaussSuppressionFromData(
  data = df_input,
  x =x, 
  crossTable = df_aggregated[1:2],
  numVar = "value", 
  freq = "freq",
  preAggregate = FALSE, # no pre-aggregation needed
  extraAggregate = FALSE,
  primary = prim,
  protectZeros = FALSE,
  singletonMethod = "none", # turn off singleton handling
  candidates = candidates
)


# You mentioned the use of suppressedData, and this can be done via AdditionalSuppression().
out4 <- AdditionalSuppression(data = df_input,
              formula = ~(sector4 + sector2)*(eu + geo),
              numVar = "value", 
              freq = "freq",
              primary = NULL,
              protectZeros = FALSE,
              singletonMethod = "none",
              suppressedData = cbind(df_aggregated[c(1,2)], suppressed = prim),
              makeForced = FALSE,
              candidates = candidates)


# Now all output is identical except for a few attributes.  
all.equal(out1, out0, check.attributes = FALSE)
all.equal(out1, out2, check.attributes = FALSE)
all.equal(out1, out3, check.attributes = FALSE)
all.equal(out1, out4, check.attributes = FALSE)

As shown above, there are many ways to reach the goal. The function GaussSuppressionFromData is not made for this specific problem (1). It actually seems like a detour when both the output data and the primary suppressions are calculated in other ways. The best approach might be similar to how out2 is calculated.

Regarding the max variables (2): only summation takes place inside GaussSuppressionFromData. But it is possible to get extra output from the primary functions, so anything can be programmed there.

Yes, primary suppressions cannot be input in that way (4), but there are other possibilities, see the calculation of out3.

Yes, it is possible to have one dataset as input to a wrapper (5). But then the question is how such a wrapper should be designed.

Note that the warning “Not all fun elements will be used” appears because you included sum = sum. The variables in sum_vars aren’t about using the sum function, but about the variables that are summed by matrix multiplication.