## ----ktab, echo=FALSE---------------------------------------------------------
## Tables through kableExtra. Math written as $...$ in headers, cells
## and captions becomes \( ... \) and `code` becomes <code>, because
## pandoc does not process math inside a raw HTML table.
ktab <- function(x, ..., col.names = names(x), caption = NULL) {
    tex <- function(s)
        gsub("`([^`]*)`", "<code>\\1</code>",
             gsub("\\$([^$]+)\\$", "\\\\(\\1\\\\)", s))
    chr <- vapply(x, is.character, logical(1))
    x[chr] <- lapply(x[chr], tex)
    tab <- knitr::kable(x, format = "html", escape = FALSE,
                        col.names = tex(col.names),
                        caption = if (!is.null(caption)) tex(caption), ...)
    kableExtra::kable_styling(tab, bootstrap_options = c("striped", "condensed"),
                              full_width = TRUE)
}

## ----echo=F-------------------------------------------------------------------
knitr::opts_chunk$set(
  message = FALSE,
  warning = FALSE,
  error = FALSE,
  tidy = FALSE,
  cache = FALSE
)

## -----------------------------------------------------------------------------
set.seed(130)
sample_size <- c(60, 15, 25)
query_data <- local({
    tmp   <- c(0, cumsum(sample_size))
    start <- tmp[1:3] + 1
    end   <- tmp[-1]
    id_list <- Map(seq, from = start, to = end)
    lapply(seq_along(sample_size), function(i) {
        data.frame(
            id  = sprintf("P%4d", id_list[[i]]),
            sex = sample(c("F", "M"), sample_size[i], replace = TRUE),
            age = sample(40:70,      sample_size[i], replace = TRUE),
            bm  = rnorm(sample_size[i]),
            stringsAsFactors = FALSE)
    })
})

## -----------------------------------------------------------------------------
query <- quote(age < 50 & sex == "F" & bm < 0.2)

pooled <- do.call(rbind, query_data)
cleartext_count <- sum(eval(query, pooled))
cleartext_count

## -----------------------------------------------------------------------------
library(homomorpheR)

cc <- openfhe.R::fhe_context("BFV",
                             plaintext_modulus    = 65537L,
                             multiplicative_depth = 1L,
                             features             = c(openfhe.R::Feature$MULTIPARTY))

## -----------------------------------------------------------------------------
local_count <- function(data, query) sum(eval(query, data))

workers <- Map(
    function(nm, d) make_worker(nm, data = d, contribution_fn = local_count),
    c("Site 1", "Site 2", "Site 3"),
    query_data)

## -----------------------------------------------------------------------------
master <- make_threshold_master("Aggregator",
                                crypto_context = cc,
                                sites          = workers)

## -----------------------------------------------------------------------------
encrypted_count <- master_aggregate(master, theta = query)
encrypted_count

## -----------------------------------------------------------------------------
comparison <- data.frame(
    method = c("pooled cleartext", "threshold-BFV distributed"),
    count  = c(cleartext_count, as.integer(encrypted_count)))
ktab(comparison, col.names = c("Method", "Count"),
             caption = "Distributed encrypted query count vs. the pooled answer")

## -----------------------------------------------------------------------------
stopifnot(identical(as.integer(encrypted_count), as.integer(cleartext_count)))