Paradoja del Cumpleaños

Autor : Gianfranco David Chamorro Rodriguez

Se conoce como paradoja del cumpleaños al resultado contraintuivo que tiene el calcular la probabilidad que dos personas de un grupo cumplan años el mismo día, debido a que no se necesita un número muy amplio de personas para que la probabilidad supere el 50%. Debemos entender que esta situación no es igual a calcular la probabilidad que alguien cumpla años el mismo día de alguien en específico dentro de un grupo de personas.

#Paradoja del Cumpleaños para un grupo de 50 personas
  total <- 1 
  n <- 50
  data <- NULL
  
  for(i in 1:n) { 
    total=total*((365-i+1)/365)
    fila <- data.frame(i, 1-total)
    data <- rbind(data, fila)
    if (i==n) {
      print(data) # Observamos que es un grupo de 23 personas o más la probabilidad que dos personas cumplan años el mismo días es mayor al 50%
      plot(data, xlab="Número de Personas",ylab="Probabilidad", main="Paradoja del Cumpleaños")
    }
  }

##     i  X1...total
## 1   1 0.000000000
## 2   2 0.002739726
## 3   3 0.008204166
## 4   4 0.016355912
## 5   5 0.027135574
## 6   6 0.040462484
## 7   7 0.056235703
## 8   8 0.074335292
## 9   9 0.094623834
## 10 10 0.116948178
## 11 11 0.141141378
## 12 12 0.167024789
## 13 13 0.194410275
## 14 14 0.223102512
## 15 15 0.252901320
## 16 16 0.283604005
## 17 17 0.315007665
## 18 18 0.346911418
## 19 19 0.379118526
## 20 20 0.411438384
## 21 21 0.443688335
## 22 22 0.475695308
## 23 23 0.507297234
## 24 24 0.538344258
## 25 25 0.568699704
## 26 26 0.598240820
## 27 27 0.626859282
## 28 28 0.654461472
## 29 29 0.680968537
## 30 30 0.706316243
## 31 31 0.730454634
## 32 32 0.753347528
## 33 33 0.774971854
## 34 34 0.795316865
## 35 35 0.814383239
## 36 36 0.832182106
## 37 37 0.848734008
## 38 38 0.864067821
## 39 39 0.878219664
## 40 40 0.891231810
## 41 41 0.903151611
## 42 42 0.914030472
## 43 43 0.923922856
## 44 44 0.932885369
## 45 45 0.940975899
## 46 46 0.948252843
## 47 47 0.954774403
## 48 48 0.960597973
## 49 49 0.965779609
## 50 50 0.970373580

#Observamos la distribución acumulativa 
k = 365  
p <- numeric(k)  
for (i in 1:k)      {
            q <- 1 - (0:(i - 1))/365  
            p[i] <- 1 - prod(q)  }
plot(p, main="Paradoja del cumpleaños", xlab ="Número de Personas", ylab = "Probabilidad", col="Red")

n <-c(seq(1,365,1))
Prob <- format(p, digits=7)
probs <- cbind(n, Prob )   
#Creamos un buscador del número de personas necesario según la probabilidad que deseemos tener
DT::datatable(probs, rownames=FALSE, options = list(autowidth=TRUE, sClass="alignCenter", className = 'dt-Center', pageLength=5))