## ----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
)

## -----------------------------------------------------------------------------
library(openfhe.R)

cc <- fhe_context("CKKS",
                  multiplicative_depth = 2L,
                  scaling_mod_size     = 50L,
                  batch_size           = 8L)
keys <- key_gen(cc, eval_mult = TRUE)

## 8 patients, each with 4 biomarker values. We pack each biomarker
## across patients: one encrypted value per biomarker, with the patient
## values in its slots, so one operation acts on every patient at once.
biomarker1 <- c(1.2, 0.8, 1.5, 0.3, 2.1, 0.9, 1.1, 1.8)
biomarker2 <- c(0.5, 1.1, 0.3, 0.8, 0.2, 1.4, 0.7, 0.6)
biomarker3 <- c(2.0, 1.5, 2.3, 1.0, 1.8, 2.1, 1.6, 2.5)
biomarker4 <- c(0.1, 0.4, 0.2, 0.6, 0.3, 0.1, 0.5, 0.2)

ct1 <- encrypt(keys@public, make_ckks_packed_plaintext(cc, biomarker1), cc = cc)
ct2 <- encrypt(keys@public, make_ckks_packed_plaintext(cc, biomarker2), cc = cc)
ct3 <- encrypt(keys@public, make_ckks_packed_plaintext(cc, biomarker3), cc = cc)
ct4 <- encrypt(keys@public, make_ckks_packed_plaintext(cc, biomarker4), cc = cc)

## -----------------------------------------------------------------------------
## Lab's proprietary model weights (never shared with the hospital)
w <- c(0.35, -0.20, 0.50, 0.15)
b <- 1.2

## Encrypted score = w1*x1 + w2*x2 + w3*x3 + w4*x4 + b
ct_score <- ct1 * w[1] + ct2 * w[2] + ct3 * w[3] + ct4 * w[4] + b

## -----------------------------------------------------------------------------
result <- decrypt(ct_score, keys@secret, cc = cc)
set_length(result, 8L)
scores <- get_real_packed_value(result)[1:8]

for (i in seq_len(8)) {
    risk <- if (scores[i] > 2.0) "HIGH"
            else if (scores[i] > 1.5) "MODERATE"
            else "LOW"
    cat(sprintf("  Patient %d: %.3f (%s)\n", i, scores[i], risk))
}

## -----------------------------------------------------------------------------
cleartext_scores <- w[1] * biomarker1 + w[2] * biomarker2 +
                    w[3] * biomarker3 + w[4] * biomarker4 + b
max_error <- max(abs(scores - cleartext_scores))
sprintf("Maximum error vs cleartext: %.2e", max_error)

## ----echo=FALSE---------------------------------------------------------------
ktab(data.frame(
    party = c("Hospital", "Lab"),
    view  = c("Patient biomarkers (local), decrypted scores",
              "Encrypted values only — no cleartext biomarker values, no cleartext scores")),
    col.names = c("Party", "Cleartext view"))

## -----------------------------------------------------------------------------
## Lab pipeline wrapped as a function. Closes over `w` and `b`;
## the caller (hospital) never reads either.
lab_score <- function(ct_bio) {
    ct_bio[[1]] * w[1] + ct_bio[[2]] * w[2] +
    ct_bio[[3]] * w[3] + ct_bio[[4]] * w[4] + b
}

## Hospital crafts five probes packed across slots 1..5.
## Slot 1 is e_0 (all zeros, probes b). Slot j+1 is e_j (a one in
## position j, probes w_j + b).
probe_bio1 <- c(0, 1, 0, 0, 0, 0, 0, 0)
probe_bio2 <- c(0, 0, 1, 0, 0, 0, 0, 0)
probe_bio3 <- c(0, 0, 0, 1, 0, 0, 0, 0)
probe_bio4 <- c(0, 0, 0, 0, 1, 0, 0, 0)

ct_probe <- list(
    encrypt(keys@public, make_ckks_packed_plaintext(cc, probe_bio1), cc = cc),
    encrypt(keys@public, make_ckks_packed_plaintext(cc, probe_bio2), cc = cc),
    encrypt(keys@public, make_ckks_packed_plaintext(cc, probe_bio3), cc = cc),
    encrypt(keys@public, make_ckks_packed_plaintext(cc, probe_bio4), cc = cc)
)

ct_probe_score <- lab_score(ct_probe)
probe_result   <- decrypt(ct_probe_score, keys@secret, cc = cc)
set_length(probe_result, 5L)
probe_scores <- get_real_packed_value(probe_result)[1:5]

b_hat <- probe_scores[1]
w_hat <- probe_scores[2:5] - b_hat

recovered <- rbind(
    true      = c(b, w),
    recovered = c(b_hat, w_hat)
)
colnames(recovered) <- c("b", "w1", "w2", "w3", "w4")
round(recovered, 6)

## -----------------------------------------------------------------------------
tdir <- tempdir()
fhe_serialize(cc, file.path(tdir, "context.bin"))
fhe_serialize(keys@public, file.path(tdir, "pubkey.bin"))
fhe_serialize(ct1, file.path(tdir, "patient_bm1.bin"))

## Lab receives the serialized files
cc_lab <- fhe_deserialize(file.path(tdir, "context.bin"), "CryptoContext")
ct_lab <- fhe_deserialize(file.path(tdir, "patient_bm1.bin"), "Ciphertext")

## Lab applies its weights to the deserialized encrypted value
ct_weighted <- ct_lab * 0.35

## Lab returns the result
fhe_serialize(ct_weighted, file.path(tdir, "weighted.bin"))

## Hospital receives, deserializes, decrypts
ct_recv <- fhe_deserialize(file.path(tdir, "weighted.bin"), "Ciphertext")
result  <- decrypt(ct_recv, keys@secret, cc = cc)
set_length(result, 8L)
get_real_packed_value(result)[1:8]