xref: /aosp_15_r20/external/rappor/apps/rappor-sim/server.R (revision 2abb31345f6c95944768b5222a9a5ed3fc68cc00) 
1library(shiny)
2source("../../analysis/R/decode.R")
3source("../../analysis/R/simulation.R")
4source("../../analysis/R/encode.R")
5
6Plot <- function(x, color = "grey") {
7  n <- nrow(x)
8  if (n < 16) {
9    par(mfrow = c(n, 1), mai = c(0, .5, .5, 0))
10  } else if (n < 64) {
11    par(mfrow = c(n / 2, 2), mai = c(0, .5, .5, 0))
12  } else {
13    par(mfrow = c(n / 4, 4), mai = c(0, .5, .5, 0))
14  }
15  for (i in 1:nrow(x)) {
16    barplot(x[i, ], main = paste0("Cohort ", i), col = color, border = color)
17  }
18}
19
20shinyServer(function(input, output) {
21  # Example state global variable.
22  es <- list()
23
24  # Example buttons states.
25  ebs <- rep(0, 3)
26
27  Params <- reactive({
28    list(k = as.numeric(input$size),
29         h = as.numeric(input$hashes),
30         m = as.numeric(input$instances),
31         p = as.numeric(input$p),
32         q = as.numeric(input$q),
33         f = as.numeric(input$f))
34  })
35
36  PopParams <- reactive({
37    list(as.numeric(input$nstrs),
38      as.numeric(input$nonzero),
39      input$decay,
40      as.numeric(input$expo),
41      as.numeric(input$background)
42      )
43  })
44
45  DecodingParams <- reactive({
46    list(as.numeric(input$alpha),
47         input$correction)
48  })
49
50  Sample <- reactive({
51    input$sample
52    N <- input$N
53    params <- Params()
54    pop_params <- PopParams()
55    decoding_params <- DecodingParams()
56    prop_missing <- input$missing
57    fit <- GenerateSamples(N, params, pop_params,
58                    alpha = decoding_params[[1]],
59                    correction = decoding_params[[2]],
60                    prop_missing = prop_missing)
61    fit
62  })
63
64  # Results summary.
65  output$pr <- renderTable({
66    Sample()$summary
67  },
68                           include.rownames = FALSE, include.colnames = FALSE)
69
70  # Results table.
71  output$tab <- renderDataTable({
72     Sample()$fit
73   },
74                                options = list(iDisplayLength = 100))
75
76  # Epsilon.
77  output$epsilon <- renderTable({
78    Sample()$privacy
79  },
80                                include.rownames = FALSE, include.colnames = FALSE, digits = 4)
81
82  # True distribution.
83  output$probs <- renderPlot({
84    samp <- Sample()
85    probs <- samp$probs
86    detected <- match(samp$fit[, 1], samp$strs)
87    detection_frequency <- samp$privacy[7, 2]
88    PlotPopulation(probs, detected, detection_frequency)
89  })
90
91  # True bits patterns.
92  output$truth <- renderPlot({
93    truth <- Sample()$truth
94    Plot(truth[, -1, drop = FALSE], color = "darkblue")
95  })
96
97  # Lasso plot.
98  output$lasso <- renderPlot({
99    fit <- Sample()$lasso
100    if (!is.null(fit)) {
101      plot(fit)
102    }
103  })
104
105  output$resid <- renderPlot({
106    resid <- Sample()$residual
107    params <- Params()
108    plot(resid, xlab = "Bloom filter bits", ylab = "Residuals")
109    abline(h = c(-1.96, 1.96), lty = 2, col = 2)
110    sq <- qnorm(.025 / length(resid))
111    abline(h = c(sq, -sq), lty = 2, col = 3, lwd = 2)
112    abline(h = c(-3, 3), lty = 2, col = 4, lwd = 2)
113    abline(v = params$k * (0:params$m), lty = 2, col = "blue")
114    legend("topright", legend = paste0("SD = ", round(sd(resid), 2)), bty = "n")
115  })
116
117  # Estimated bits patterns.
118  output$ests <- renderPlot({
119    ests <- Sample()$ests
120    Plot(ests, color = "darkred")
121  })
122
123  # Estimated vs truth.
124  output$ests_truth <- renderPlot({
125    plot(unlist(Sample()$ests), unlist(Sample()$truth[, -1]),
126         xlab = "Estimates", ylab = "Truth", pch = 19)
127    abline(0, 1, lwd = 4, col = "darkred")
128  })
129
130  output$example <- renderPlot({
131    params <- Params()
132    strs <- Sample()$strs
133    map <- Sample()$map
134    samp <- Sample()
135
136    # First run on app start.
137    value <- sample(strs, 1)
138    res <- Encode(value, map, strs, params, N = input$N)
139
140    if (input$new_user > ebs[1]) {
141      res <- Encode(es$value, map, strs, params, N = input$N)
142      ebs[1] <<- input$new_user
143    } else if (input$new_value > ebs[2]) {
144      res <- Encode(value, map, strs, params, cohort = es$cohort, id = es$id,
145                    N = input$N)
146      ebs[2] <<- input$new_value
147    } else if (input$new_report > ebs[3]) {
148      res <- Encode(es$value, map, strs, params, B = es$B,
149                    BP = es$BP, cohort = es$cohort, id = es$id, N = input$N)
150      ebs[3] <<- input$new_report
151    }
152    es <<- res
153    ExamplePlot(res, params$k, c(ebs, input$new_user, input$new_value, input$new_report))
154  })
155
156})
157