• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
1# Copyright 2014 Google Inc. All rights reserved.
2#
3# Licensed under the Apache License, Version 2.0 (the "License");
4# you may not use this file except in compliance with the License.
5# You may obtain a copy of the License at
6#
7#     http://www.apache.org/licenses/LICENSE-2.0
8#
9# Unless required by applicable law or agreed to in writing, software
10# distributed under the License is distributed on an "AS IS" BASIS,
11# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12# See the License for the specific language governing permissions and
13# limitations under the License.
14
15Encode <- function(value, map, strs, params, N, id = NULL,
16                   cohort = NULL, B = NULL, BP = NULL) {
17  # Encode value to RAPPOR and return a report.
18  #
19  # Input:
20  #    value: value to be encoded
21  #    map: a mapping matrix describing where each element of strs map in
22  #         each cohort
23  #    strs: a vector of possible values with value being one of them
24  #    params: a list of RAPPOR parameters described in decode.R
25  #    N: sample size
26  # Optional parameters:
27  #    id: user ID (smaller than N)
28  #    cohort: specifies cohort number (smaller than m)
29  #    B: input Bloom filter itself, in which case value is ignored
30  #    BP: input Permanent Randomized Response (memoized for multiple colections
31  #        from the same user
32
33  k <- params$k
34  p <- params$p
35  q <- params$q
36  f <- params$f
37  h <- params$h
38  m <- params$m
39  if (is.null(cohort)) {
40    cohort <- sample(1:m, 1)
41  }
42
43  if (is.null(id)) {
44    id <- sample(N, 1)
45  }
46
47  ind <- which(value == strs)
48
49  if (is.null(B)) {
50    B <- as.numeric(map[[cohort]][, ind])
51  }
52
53  if (is.null(BP)) {
54    BP <- sapply(B, function(x) sample(c(0, 1, x), 1,
55                                       prob = c(0.5 * f, 0.5 * f, 1 - f)))
56  }
57  rappor <- sapply(BP, function(x) rbinom(1, 1, ifelse(x == 1, q, p)))
58
59  list(value = value, rappor = rappor, B = B, BP = BP, cohort = cohort, id = id)
60}
61
62ExamplePlot <- function(res, k, ebs = 1, title = "", title_cex = 4,
63                        voff = .17, acex = 1.5, posa = 2, ymin = 1,
64                        horiz = FALSE) {
65  PC <- function(k, report) {
66    char <- as.character(report)
67    if (k > 128) {
68      char[char != ""] <- "|"
69    }
70    char
71  }
72
73  # Annotation settings
74  anc <- "darkorange2"
75  colors <- c("lavenderblush3", "maroon4")
76
77  par(omi = c(0, .55, 0, 0))
78  # Setup plotting.
79  plot(1:k, rep(1, k), ylim = c(ymin, 4), type = "n",
80       xlab = "Bloom filter bits",
81       yaxt = "n", ylab = "", xlim = c(0, k), bty = "n", xaxt = "n")
82  mtext(paste0("Participant ", res$id, " in cohort ", res$cohort), 3, 2,
83        adj = 1, col = anc, cex = acex)
84  axis(1, 2^(0:15), 2^(0:15))
85  abline(v = which(res$B == 1), lty = 2, col = "grey")
86
87  # First row with the true value.
88  text(k / 2, 4, paste0('"', paste0(title, as.character(res$value)), '"'),
89       cex = title_cex, col = colors[2], xpd = NA)
90
91  # Second row with BF: B.
92  points(1:k, rep(3, k), pch = PC(k, res$B), col = colors[res$B + 1],
93         cex = res$B + 1)
94  text(k, 3 + voff, paste0(sum(res$B), " signal bits"), cex = acex,
95       col = anc, pos = posa)
96
97  # Third row: B'.
98  points(1:k, rep(2, k), pch = PC(k, res$BP), col = colors[res$BP + 1],
99         cex = res$BP + 1)
100  text(k, 2 + voff, paste0(sum(res$BP), " bits on"),
101       cex = acex, col = anc, pos = posa)
102
103  # Row 4: actual RAPPOR report.
104  report <- res$rappor
105  points(1:k, rep(1, k), pch = PC(k, as.character(report)),
106         col = colors[report + 1], cex = report + 1)
107  text(k, 1 + voff, paste0(sum(res$rappor), " bits on"), cex = acex,
108       col = anc, pos = posa)
109
110  mtext(c("True value:", "Bloom filter (B):",
111          "Fake Bloom \n filter (B'):", "Report sent\n to server:"),
112        2, 1, at = 4:1, las = 2)
113  legend("topright", legend = c("0", "1"), fill = colors, bty = "n",
114         cex = 1.5, horiz = horiz)
115  legend("topleft", legend = ebs, plot = FALSE)
116}
117
118PlotPopulation <- function(probs, detected, detection_frequency) {
119    cc <- c("gray80", "darkred")
120    color <- rep(cc[1], length(probs))
121    color[detected] <- cc[2]
122    bp <- barplot(probs, col = color, border = color)
123    inds <- c(1, c(max(which(probs > 0)), length(probs)))
124    axis(1, bp[inds], inds)
125    legend("topright", legend = c("Detected", "Not-detected"),
126           fill = rev(cc), bty = "n")
127    abline(h = detection_frequency, lty = 2, col = "grey")
128}
129