1 files changed, 156 insertions, 0 deletions
diff --git a/apps/rappor-sim/server.R b/apps/rappor-sim/server.R
new file mode 100755
index 0000000..f4a847b
--- /dev/null
+++ b/apps/rappor-sim/server.R
@@ -0,0 +1,156 @@
+library(shiny)
+source("../../analysis/R/decode.R")
+source("../../analysis/R/simulation.R")
+source("../../analysis/R/encode.R")
+
+Plot <- function(x, color = "grey") {
+  n <- nrow(x)
+  if (n < 16) {
+    par(mfrow = c(n, 1), mai = c(0, .5, .5, 0))
+  } else if (n < 64) {
+    par(mfrow = c(n / 2, 2), mai = c(0, .5, .5, 0))
+  } else {
+    par(mfrow = c(n / 4, 4), mai = c(0, .5, .5, 0))
+  }
+  for (i in 1:nrow(x)) {
+    barplot(x[i, ], main = paste0("Cohort ", i), col = color, border = color)
+  }
+}
+
+shinyServer(function(input, output) {
+  # Example state global variable.
+  es <- list()
+
+  # Example buttons states.
+  ebs <- rep(0, 3)
+
+  Params <- reactive({
+    list(k = as.numeric(input$size),
+         h = as.numeric(input$hashes),
+         m = as.numeric(input$instances),
+         p = as.numeric(input$p),
+         q = as.numeric(input$q),
+         f = as.numeric(input$f))
+  })
+
+  PopParams <- reactive({
+    list(as.numeric(input$nstrs),
+      as.numeric(input$nonzero),
+      input$decay,
+      as.numeric(input$expo),
+      as.numeric(input$background)
+      )
+  })
+
+  DecodingParams <- reactive({
+    list(as.numeric(input$alpha),
+         input$correction)
+  })
+
+  Sample <- reactive({
+    input$sample
+    N <- input$N
+    params <- Params()
+    pop_params <- PopParams()
+    decoding_params <- DecodingParams()
+    prop_missing <- input$missing
+    fit <- GenerateSamples(N, params, pop_params,
+                    alpha = decoding_params[[1]],
+                    correction = decoding_params[[2]],
+                    prop_missing = prop_missing)
+    fit
+  })
+
+  # Results summary.
+  output$pr <- renderTable({
+    Sample()$summary
+  },
+                           include.rownames = FALSE, include.colnames = FALSE)
+
+  # Results table.
+  output$tab <- renderDataTable({
+     Sample()$fit
+   },
+                                options = list(iDisplayLength = 100))
+
+  # Epsilon.
+  output$epsilon <- renderTable({
+    Sample()$privacy
+  },
+                                include.rownames = FALSE, include.colnames = FALSE, digits = 4)
+
+  # True distribution.
+  output$probs <- renderPlot({
+    samp <- Sample()
+    probs <- samp$probs
+    detected <- match(samp$fit[, 1], samp$strs)
+    detection_frequency <- samp$privacy[7, 2]
+    PlotPopulation(probs, detected, detection_frequency)
+  })
+
+  # True bits patterns.
+  output$truth <- renderPlot({
+    truth <- Sample()$truth
+    Plot(truth[, -1, drop = FALSE], color = "darkblue")
+  })
+
+  # Lasso plot.
+  output$lasso <- renderPlot({
+    fit <- Sample()$lasso
+    if (!is.null(fit)) {
+      plot(fit)
+    }
+  })
+
+  output$resid <- renderPlot({
+    resid <- Sample()$residual
+    params <- Params()
+    plot(resid, xlab = "Bloom filter bits", ylab = "Residuals")
+    abline(h = c(-1.96, 1.96), lty = 2, col = 2)
+    sq <- qnorm(.025 / length(resid))
+    abline(h = c(sq, -sq), lty = 2, col = 3, lwd = 2)
+    abline(h = c(-3, 3), lty = 2, col = 4, lwd = 2)
+    abline(v = params$k * (0:params$m), lty = 2, col = "blue")
+    legend("topright", legend = paste0("SD = ", round(sd(resid), 2)), bty = "n")
+  })
+
+  # Estimated bits patterns.
+  output$ests <- renderPlot({
+    ests <- Sample()$ests
+    Plot(ests, color = "darkred")
+  })
+
+  # Estimated vs truth.
+  output$ests_truth <- renderPlot({
+    plot(unlist(Sample()$ests), unlist(Sample()$truth[, -1]),
+         xlab = "Estimates", ylab = "Truth", pch = 19)
+    abline(0, 1, lwd = 4, col = "darkred")
+  })
+
+  output$example <- renderPlot({
+    params <- Params()
+    strs <- Sample()$strs
+    map <- Sample()$map
+    samp <- Sample()
+
+    # First run on app start.
+    value <- sample(strs, 1)
+    res <- Encode(value, map, strs, params, N = input$N)
+
+    if (input$new_user > ebs[1]) {
+      res <- Encode(es$value, map, strs, params, N = input$N)
+      ebs[1] <<- input$new_user
+    } else if (input$new_value > ebs[2]) {
+      res <- Encode(value, map, strs, params, cohort = es$cohort, id = es$id,
+                    N = input$N)
+      ebs[2] <<- input$new_value
+    } else if (input$new_report > ebs[3]) {
+      res <- Encode(es$value, map, strs, params, B = es$B,
+                    BP = es$BP, cohort = es$cohort, id = es$id, N = input$N)
+      ebs[3] <<- input$new_report
+    }
+    es <<- res
+    ExamplePlot(res, params$k, c(ebs, input$new_user, input$new_value, input$new_report))
+  })
+
+})