Una base de datos responde a distintos tipos de consultas que requieren de mecanismos privados que dependen, del nivel de precisión del usuario y qué nivel de privacidad se desea preservar.
Recordemos que un mecanismo privado es una función aleatoria que transforma una consulta determinista F(D) sobre una base de datos D en una respuesta ruidosa, garantizando privacidad diferencial.
\(\mathcal{A}(D, f, \varepsilon) = f(D) + (N_1, \ldots, N_M)\)
donde \(N_i\) son variables aletorias independientes que se obtienen a partir de la distribución con parámetro epsilon \(\varepsilon\).
Para convertir la consulta en un mecanismo privado suele usarse ruido geométrico simétrico o laplaciano
ruido_geom <- function(n=1,epsilon) {
p <- 1 - exp(-epsilon)
sign <- sample(c(-1, 1), n, replace = TRUE)
value <- rgeom(n, p)
return(sign * value)
}
# promedio con ruido Laplaciano
library(diffpriv)
## Warning: package 'diffpriv' was built under R version 4.4.3
set.seed(123)
n<-100
c1<-1 #valor max
c0<-0 # valor min
D <- runif(n, min = c0, max = c1) ## vector de datos
sensi<-(c1-c0)/n
fmedia<-function(D,eps=1,sensi)
{ vv<-mean(D)
ni<-length(vv)
noise <- rmutil::rlaplace(n = ni, s = (sensi)/eps)
vp<-vv+noise
vp
}
fm<-fmedia(D,eps= 1,sensi)
cat("promedio privado Laplaciano:", fm)
## promedio privado Laplaciano: 0.5007902
# Promedio con ruido Gaussiano
set.seed(123)
n <- 100
c0 <- 0 # Lower bound
c1 <- 1 # Upper bound
D <- runif(n, c0, c1)
eps<- 1 # eps must be in (0, 1) for approximate differential privacy
delta <- 0.01 # se añade otro parámetro
sensitivity <- (c1-c0)/n
fmediaG<-function(D,eps=1,sensi,delta)
{ vv<-mean(D)
ni<-length(vv)
param <- sqrt(sum(sensi^2)) * (sqrt(stats::qnorm(delta/2)^2 +
2 * eps) - qnorm(delta/2))/(2 * eps)
noise <- rnorm(ni, sd = param)
vp<-vv+noise
vp
}
fp<-fmediaG(D,eps,sensi,delta)
cat("promedio privado Gaussino:", fp)
## promedio privado Gaussino: 0.5055434
Tambien se puede usar la librería en R DPpack que da una función que calcula la media directamente
library(DPpack)
set.seed(123)
n<-100
c1<-1 #valor max
c0<-0 # valor min
D <- runif(n, min = c0, max = c1) ## vector de datos
lb<-0
ub<-1
ml<-meanDP(D, 1, lb, ub,mechanism = "Laplace") #
mg<-meanDP(D, 0.9, lb, ub,mechanism = "Gaussian",delta=0.01) #
cat("Promedio privado Laplaciano", ml,
"\nPromedio privado Gaussiano", mg)
## Promedio privado Laplaciano 0.5007902
## Promedio privado Gaussiano 0.4836385
Se añade ruido geométrico simétrico o Laplaciano a cada celda + una reconcilicación de totales de marginales (IPF o estimación de minimos cuadrados con restricciones)
library(DPpack)
set.seed(123)
x <- MASS::Cars93$Type
y <- MASS::Cars93$Origin
tDP<-tableDP(x,y,eps=1,which.sensitivity='bounded',mechanism='Laplace', type.DP='pDP')
tDP # tabla privada
## y
## x USA non-USA
## Compact 6 9
## Large 13 3
## Midsize 10 12
## Small 10 14
## Sporty 12 11
## Van 0 4
table(x,y) # tabla real
## y
## x USA non-USA
## Compact 7 9
## Large 11 0
## Midsize 10 12
## Small 7 14
## Sporty 8 6
## Van 5 4
Tambien se puede usar el ruido geometrico para agregar ruido a la tabla
set.seed(123)
x <- MASS::Cars93$Type
y <- MASS::Cars93$Origin
t<-table(x,y)
n<-length(t)
epsilon <- 1
ruido <- matrix(ruido_geom(n,epsilon),nrow=nrow(t), ncol = 2)
tDP <- t + ruido
tDP[tDP < 0] <- 0 # Para evitar valores negativos si se desea
tDP
## y
## x USA non-USA
## Compact 7 10
## Large 8 2
## Midsize 8 12
## Small 7 14
## Sporty 8 7
## Van 5 4
set.seed(123)
library(DPpack)
x <- rnorm(500) # Simulate dataset
h<-hist(x, main = "Histograma no privado", ylim=c(0, 110), col="blue")
Lo<-min(h$breaks)
Ls<-max(h$breaks)
private.hist <- histogramDP(x, eps=1,Lo,Ls) # Satisfies (1,0)-DP
plot(private.hist, main = "Histograma privado",
ylim=c(0, 110), col="red")
Estas pueden ser la consulta de una población por bloque, que a su vez se encuentra en un entidad o nacional el ruido añadido puede ser cualquiera de las distribuciones que sabemos cumplen con los mecanismos privados
data <- list(
país = c(1000),
estados = c(300, 400, 300),
municipios = matrix(c(100, 200, 150, 250, 200, 100), nrow = 3, byrow = TRUE)
)
print("Datos originales:")
## [1] "Datos originales:"
print(data)
## $país
## [1] 1000
##
## $estados
## [1] 300 400 300
##
## $municipios
## [,1] [,2]
## [1,] 100 200
## [2,] 150 250
## [3,] 200 100
# Agregar ruido a nivel país
n=length(data$país)
eps<-1
sensi<-10
s<-sensi/eps
pais_noise<-rmutil::rlaplace(n = n, s = s)
noisy_pais = round(data$país + pais_noise)
noisy_pais [noisy_pais <0]=0
noisy_pais
## [1] 1000
#Paso: Ajustar ruido a nivel estado
n=length(data$estados)
s<-5
estados_noise<-rmutil::rlaplace(n = n, s = s)
noisy_estados = data$estados + estados_noise
noisy_estados = noisy_estados / sum(noisy_estados) * noisy_pais
noisy_estados
## [1] 287.0583 408.7466 304.1951
sum(noisy_estados) # la suma ruidosa coincide con el valor ruidoso del país
## [1] 1000
#Paso: ruido a nivel municipio
n=length(data$municipios)
s<-2
mun_noise<-rmutil::rlaplace(n = n, s = s)
d<-data$municipios
mun_noise<-matrix(mun_noise,ncol=ncol(d), nrow=nrow(d))
noisy_mun = data$municipios + mun_noise
noisy_mun = noisy_mun / rowSums(noisy_mun) * (noisy_estados)
print("Datos originales:")
## [1] "Datos originales:"
print(data)
## $país
## [1] 1000
##
## $estados
## [1] 300 400 300
##
## $municipios
## [,1] [,2]
## [1,] 100 200
## [2,] 150 250
## [3,] 200 100
print("Datos con ruido Laplace respetando totales marginales:")
## [1] "Datos con ruido Laplace respetando totales marginales:"
noisy_data <- list(
país = noisy_pais,
estados = noisy_estados,
municipios = noisy_mun
)
noisy_data
## $país
## [1] 1000
##
## $estados
## [1] 287.0583 408.7466 304.1951
##
## $municipios
## [,1] [,2]
## [1,] 96.16113 190.8972
## [2,] 152.52484 256.2218
## [3,] 202.14742 102.0476