“Paradoja” del cumpleaños
Seguramente haz escuchado de la “paradoja” del cumpleaños donde se desea determinar la probabilidad de que dos personas en un salón cumplan el mismo día. Para fines de este ejercicio considera que se tienen \(n\) personas, los años bisiestos no son contados ni se admiten las personas gemelas; además de que los posibles 365 cumpleaños tienen la misma probabilidad de ocurrir.
En resumen, se tienen las siguientes expresiones para determinar la probabilidad, bajo las condiciones anteriores, de que dos personas cumplan el mismo día y de que otra persona cumpla el mismo día que tú.
\[ \mathbb{P}=\left\{ \begin{array}{cl} 1- \frac{365!}{365^{n}(365-n)!} & \mbox{si } 1 \leq n \leq 365\\ 1 & \mbox{si } n > 365 \end{array}\right. ~~~~ , ~~~~ \mathbb{P} = 1 - \left(\frac{364}{365}\right)^{n} \]
- Crea una función que, de acuerdo a una \(n\) válida, determine ambas probabilidades.
- Crea una gráfica donde se tengan la distribución de cada una de las probabilidades y determina si existe algún momento en el que hay la misma probabilidad, para una \(n\), de que dos personas cumplan el mismo día y de que otra personas cumpla el mismo día que tú.
Para facilitarnos la programación de la primer probabilidad podemos considerar lo siguiente \[\mathbb{P} = 1 - \frac{365!}{365^{n}(365-n)!} = 1- \left(\frac{365}{365} \cdots \frac{365-n+1}{365}\right)\] Entonces la función para el calculo de la primera probabilidad quedaría de la siguiente manera
Paradox1 <- function(n){
p <- 1
#Se realiza un ciclo for para calcular las probabilidades
for(i in 1:n) {
p = p * ((365 - i + 1) / 365) #Casos favorables entre casos totales
}
1 - p
}La función para la segunda probabilidad sería de la siguiente manera
Combinemos las funciones Paradox1 y Paradox2 en una sola función
Birth_Paradox <- function(n){
uno <- Paradox1(n)
dos <- Paradox2(n)
a <- paste("En un grupo con",n,"personas:")
b <- paste("La probabilidad de que dos personas cumplan años el mismo día es",uno)
c <- paste("La probabilidad de que alguien cumpla años el mismo dia que tú es",dos)
todo <- c(a,b,c)
return(todo)
}Probemos la función Birth_Paradox para dos grupos de personas
## [1] "En un grupo con 70 personas:"
## [2] "La probabilidad de que dos personas cumplan años el mismo día es 0.999159575965157"
## [3] "La probabilidad de que alguien cumpla años el mismo dia que tú es 0.17472945758314"## [1] "En un grupo con 200 personas:"
## [2] "La probabilidad de que dos personas cumplan años el mismo día es 1"
## [3] "La probabilidad de que alguien cumpla años el mismo dia que tú es 0.422298043300934"Ahora veamos si existe la posibilidad de que las funciones Paradox1 y Paradox2 converjan.
Para ello vamos a graficar ambas funciones para distintos grupos de personas.
#crearemos dos vectores vacios que almacenen las probabilidades calculadas
data1 <- c()
data2 <- c()
#hagamos el calculo de amabas probabilidades para diferentes grupos (de 1 a 2000)
for(i in 1:2000){
data1[i] <- Paradox1(i)
data2[i] <- Paradox2(i)
}
plot(c(0, 2000), c(0, 1), type = "n", xlab = "Número de personas",
ylab = "Probabilidad", main = "Paradoja del cumpleños")
lines(data1, pch = 19, col = "darkorchid1")
lines(data2, pch = 19, col = "darkorchid4")
grid()
legend("bottomright", legend = c("Función 1","Función 2"), pch = c(19, 19),
col = c("darkorchid1","darkorchid4"))
Podemos observar que las funciones se aproximan cuando \(n = 1\) o cuando \(n \to \infty\)
Relación Fibonacci-Eigen (vectores/valores)
Existen aplicaciones muy interesantes donde se utilizan los conocidos eigen vectores/valores de una matriz. Una de ellas es la relación que tienen estos con los conocidos números de Fibonacci. Recuerda que los números de Fibonacci quedan representados por la ecuación recursiva \(F_n=F_{n−1}+F_{n−2}\) y de una manera muy sencilla se puede ver que
\[ \begin{pmatrix} F_n\\ F_{n−1} \end{pmatrix} = \begin{pmatrix} 1 & 1\\ 1 & 0 \end{pmatrix} \begin{pmatrix} F_{n−1}\\ F_{n-2} \end{pmatrix} \]
- Crea una función para obtener el \(n\)-ésimo número de Fibonacci.
- Determina mediante el uso de R el eigen valor positivo correspondiente a dicha matriz (es decir, el famoso número áureo o número de oro).
- Crea una gráfica, para un \(n\) que desees, donde cada punto corresponda a \((F_{n−1}, ~ F_{n−2})\) o \((F_n, ~ F_{n−1})\). Dichos puntos deben ser de color de negro.
- En la misma gráfica coloca la recta sobre la que pasa el eigenvector correspondiente al eigenvalor del punto 1.
- Elige algún punto de los graficados en el punto dos y multiplícalo por el eigen valor del punto 1 y grafícalo en color rojo ¿Qué sucedió?
- ¿Qué concluyes de todo esto?
La sucesión de Fibonacci es la sucesión de números: \[0, ~~~ 1, ~~~ 1, ~~~ 2, ~~~ 3, ~~~ 5, ~~~ 8, ~~~ 13, ~~~ 21, ~~~ 34, ~ \ldots\]
En donde cada número se calcula sumando los dos anteriores a él. Vamos a crear una función que calcule el los números de Fibonacci
fib_n <- function(n) {
if(n == 0){
return(0)
}else if(n == 1){
return(1)
}else if (n == 2) {
return(1)
}else if(n > 2){
return(fib_n(n - 1) + fib_n(n - 2))
}
}Debemos recordar que \(n\) representa la posición que el número tiene en la serie
Veamos si podemos obtener las primeras 7 posiciones de los números de Fibonacci
## [1] "El 0 ° número de Fibonacci es 0"## [1] "El 1 ° número de Fibonacci es 1"## [1] "El 2 ° número de Fibonacci es 1"## [1] "El 3 ° número de Fibonacci es 2"## [1] "El 4 ° número de Fibonacci es 3"## [1] "El 5 ° número de Fibonacci es 5"## [1] "El 6 ° número de Fibonacci es 8"Ahora calculemos el número áureo a partir de la siguiente matriz \[ A = \begin{pmatrix} 1 & 1\\ 1 & 0 \end{pmatrix} \]
A <- rbind(c(1,1), c(1,0))
eigA <- eigen(A) #La función eigen() calcula los eigenvalores y eigenvectores
eigA$values #Eigenvalores de A## [1] 1.618034 -0.618034oro <- eigA$values[1]
paste("El número áureo es el eigenvalor positivo de la matriz A, es decir", oro)## [1] "El número áureo es el eigenvalor positivo de la matriz A, es decir 1.61803398874989"Ahora vamos a crear una función que grafique \(n\) elementos de la serie de Fibonacci, los puntos tendrán coordenadas \((F_n, ~ F_{n−1})\) y deben graficarse a partir de \(n=1\) puesto que el número \(F_{0-1} = F_{-1}\) no existe.
Sobre esta misma gráfia agregaremos el eigenvector correspondiente al número de oro
grafica_fib <- function(n){
x <- c()
y <- c()
for(i in 1:n){
x[i] <- fib_n(i)
y[i] <- fib_n(i-1)
}
plot(x, y, xlab = expression("F"[n]), ylab = expression("F"[n-1]),
main = paste( n, "Números de Fibonacci y el eigenvector"), pch = 19)
abline(a = 0, b = eigA$vectors[2,1]/eigA$vectors[1,1], col = "firebrick2")
abline(v = (seq(0, 100, 2)), col="lightgray", lty="dotted")
abline(h = (seq(0, 100, 2)), col="lightgray", lty="dotted")
}Para \(n = 10\) veamos como sería nuestra grafica
Veamos que pasa cuando multiplicamos algún punto de los graficados anteriormente (\(m\)) por el número áureo
# n es para la cantidad de puntos a graficar
# m es para el punto a multiplicar por el número de oro
graf_newPoint <- function(n, m){
x <- c()
y <- c()
for(i in 1:n){
x[i] <- fib_n(i)
y[i] <- fib_n(i-1)
}
point <- c(x[m], y[m])
new_point <- point * oro
plot(x, y, xlab = expression("F"[n]), ylab = expression("F"[n-1]),
main = paste("El movimiento del punto", m), pch = 19)
lines(new_point[1], new_point[2], type = "p", pch = 18, col = "red")
abline(a = 0, b = eigA$vectors[2,1]/eigA$vectors[1,1], col = "firebrick2")
abline(v = (seq(0, 100, 2)), col="lightgray", lty="dotted")
abline(h = (seq(0, 100, 2)), col="lightgray", lty="dotted")
}En mi caso yo quiero graficar 10 puntos de la suceción de Fibonacci y quiero multiplicar el 9° elemento por el número de oro
De la grafica anterior podemos concluir que el número áureo es la razón de cambio de la sucesión de Fibonacci
Iteraciones
En la mayoría de cursos que haz visto se ha tenido una gran cantidad de teoría sin ver algoritmos que te permitan comprobar dichas cosas. Vamos a arreglar un poco esto y crea alguna función o método iterativo para aproximar lo siguiente. En cada uno de los casos da un ejemplo para comprobar el funcionamiento de tu solución.
- Derivada. Para comprobar determina si la derivada de $2x^{2} en algún punto se aproxima con tu función.
- Integral. Puedes usar funciones positivas para comprobar tu función utilizando la interpretación de la integral.
- Perímetro de una circunferencia. Investiga un poco sobre la relación que existe entre el número de lados de un polígono regular y su perímetro, así como la longitud de los lados de un polígono inscrito en una circunferencia de radio r. Con esto tienes las bases para crear una función, que de acuerdo a un numero de lados n se vaya acercando al perímetro de una circunferencia. Al final puedes comprobar tus resultados con la formula ya conocida.
Procesamiento de textos
La idea será sencilla aunque la implementación no lo sé, por lo que podrías obtener más resultados de los que coloco aquí. De acuerdo a un archivo .txt que se te será proporcionado determinar lo siguiente:
- Cantidad de letras.
- Cantidad de vocales.
- Cantidad de espacios.
- Porcentaje que representa cada letra en el texto.
No importa si consideras a los caracteres especiales como letras o no, tampoco si haces distinción entre mayúsculas y minúsculas, ni tampoco las veces que tengas que cargar el archivo.
Para este ejercicio primero debemos cargar algunas librerias
library(tokenizers)
library(readr)
library(wordcloud)
library(dplyr)
library(readr)
library(ggplot2)
library(stringr)
library(extrafont)
library(tm)
library(RColorBrewer)Primero debemos cargar nuestro documento, y hacerle una “limpieza” con el fin de facilitar nuestro análisis
Carga_documento <- function(documento){
#Utiliza la función file, con el parámetro r (de "read", leer)
leer_documento <- file(documento, open = "r")
#Aplica la función readLines para leer las líneas del archivo,
#fíjate que el encoding sea UTF-8
texto_lineas <- readLines(leer_documento, encoding = "UTF-8")
#Junta todas las lineas (párrafos) en uno solo
texto_completo <- paste(texto_lineas, collapse = "\n")
#Retiremos los signos de puntuación
texto_sinSignos <- removePunctuation(texto_completo)
#Vamos a cambiar los "\n" que representan los saltos de linea por espacios en blanco
texto_SinSaltos <- str_replace_all(texto_sinSignos, "\n", " ")
#Vamos a eliminar los espacios en blanco múltiples
texto_SinEspacios <- str_replace_all(texto_SinSaltos, "[\\s]+", " ")
}Para esta actividad trabajaremos con el archivo “Romeo_and_Juliet.txt” proporcionado por el ayudante.
Para nuestro texto obtendriamos lo siguiente
* Letras
analisis_letras <- function(documento){
texto <- Carga_documento(documento)
#Para dividir el documento en caracteres
letras_texto <- tokenize_characters(texto)
#Obtén la frecuencia de las letras
tabla_letras <- table(letras_texto[[1]])
#Convierte tu tabla para las letras en un data frame
letras_df <- data_frame(letra = names(tabla_letras),
frecuencia = as.numeric(tabla_letras))
letras_df <- arrange(letras_df, desc(frecuencia))
#Para saber la cantidad total de letras del texto
Total_letras <- colSums(letras_df[-1], na.rm = TRUE)
#Crea una gráfica para ver la información de mejor manera
ggplot(data = letras_df, aes(x = letra, y = frecuencia, fill = letra)) +
geom_bar(stat = "identity", position = "dodge") +
labs(x = "Letras", y = "Frecuencia") +
ggtitle(paste("Grafica de frecuencia de un texto con", Total_letras, "letras"))
}
* Vocales
analisis_vocales <- function(documento){
texto <- Carga_documento(documento)
#Para dividir el documento en caracteres
letras_texto <- tokenize_characters(texto)
#Obtén la frecuencia de las letras
tabla_letras <- table(letras_texto[[1]])
#Convierte tu tabla para las letras en un data frame
letras_df <- data_frame(letra = names(tabla_letras),
frecuencia = as.numeric(tabla_letras))
letras_df <- arrange(letras_df, desc(frecuencia))
#Vamos a extraer las filas que incluyen a las vocales
a <- letras_df[letras_df$letra== "a",]
e <- letras_df[letras_df$letra== "e",]
i <- letras_df[letras_df$letra== "i",]
o <- letras_df[letras_df$letra== "o",]
u <- letras_df[letras_df$letra== "u",]
vocales_df <-rbind(a, e, i, o, u)
#Para saber el numero total de vocales vamos a sumar los valores de la columna frecuencia
Total_Vocales <- colSums(vocales_df[-1], na.rm = TRUE)
#Crea una gráfica para ver la información de mejor manera
ggplot(data = vocales_df, aes(x = letra, y = frecuencia, fill = letra)) +
geom_bar(stat = "identity", position = "dodge") +
labs(x = "Vocales", y = "Frecuencia") +
ggtitle(paste("Grafica de frecuencia de un texto con", Total_Vocales, "vocales"))
}
*Espacios en blanco
analisis_espacios <- function(documento){
texto <- Carga_documento(documento)
elementos_totales <- count_characters(texto)
#Para dividir el documento en caracteres
letras_texto <- tokenize_characters(texto)
#Obtén la frecuencia de las letras
tabla_letras <- table(letras_texto[[1]])
#Convierte tu tabla para las letras en un data frame
letras_df <- data_frame(letra = names(tabla_letras),
frecuencia = as.numeric(tabla_letras))
letras_df <- arrange(letras_df, desc(frecuencia))
#Para saber la cantidad total de letras del texto
Total_letras <- colSums(letras_df[-1], na.rm = TRUE)
#Ahora vamos a hacer una resta
cant_esp <- elementos_totales - Total_letras
paste("En este texto hay", cant_esp, "espacios en blanco")
}## [1] "En este texto hay 25636 espacios en blanco"* Porcentaja de aparición de cada letra
porcentajeAparicion <- function(documento){
texto <- Carga_documento(documento)
#Para dividir el documento en caracteres
letras_texto <- tokenize_characters(texto)
#Obtén la frecuencia de las letras
tabla_letras <- table(letras_texto[[1]])
#Convierte tu tabla para las letras en un data frame
letras_df <- data_frame(letra = names(tabla_letras),
frecuencia = as.numeric(tabla_letras))
letras_df <- arrange(letras_df, desc(frecuencia))
#Para saber la cantidad total de letras del texto
Total_letras <- colSums(letras_df[-1], na.rm = TRUE)
porcentaje_df <- mutate(letras_df,
porcentaje_aparición = (frecuencia / Total_letras)*100)
#Crea una nube de palabras con la siguiente función
set.seed(4363)
wordcloud(words = letras_df$letra, freq = letras_df$frecuencia,
min.freq = 1,
max.words=1000, random.order=FALSE, rot.per=0.35,
colors=brewer.pal(8, "Dark2"), family = "Broadway")
knitr::kable(porcentaje_df, align = c("c", "c", "c"),
caption = "Porcentaje que las letras representan")
}
| letra | frecuencia | porcentaje_aparición |
|---|---|---|
| e | 12818 | 12.1114198 |
| t | 9709 | 9.1738005 |
| o | 8805 | 8.3196326 |
| a | 8240 | 7.7857777 |
| i | 6909 | 6.5281479 |
| h | 6787 | 6.4128730 |
| s | 6585 | 6.2220081 |
| r | 6488 | 6.1303551 |
| n | 6468 | 6.1114576 |
| l | 4975 | 4.7007578 |
| d | 3934 | 3.7171419 |
| u | 3759 | 3.5517887 |
| m | 3358 | 3.1728934 |
| y | 2623 | 2.4784096 |
| w | 2519 | 2.3801425 |
| c | 2284 | 2.1580966 |
| f | 2030 | 1.9180982 |
| g | 1838 | 1.7366820 |
| b | 1715 | 1.6204622 |
| p | 1551 | 1.4655026 |
| v | 1109 | 1.0478674 |
| k | 831 | 0.7851919 |
| j | 277 | 0.2617306 |
| x | 125 | 0.1181095 |
| q | 65 | 0.0614169 |
| z | 32 | 0.0302360 |
Teorema central del límite
Es bien conocido el teorema que abordamos en este ejercicio y sólo para recordar, si \(X_1, X_2, \ldots\) es una sucesión de variables aleatorias independientes e idénticamente distribuidas, con media \(\mu\) y varianza finita \(\sigma^{2}\), la función de distribución de la variable aleatoria \(Z\) descrita por:
\[ Z = \frac{(X_1 + \ldots + X_n) - n\mu}{\sqrt{n\sigma^{2}}} \]
tiende a la función de distribución normal estándar cuando \(n \to \infty\). Entonces, tu objetivo será crear una función que, de acuerdo a una distribución (pueden ser tantas como conozcas) que sean adaptables a las condiciones del teorema, incluyendo como parámetros de la función la media y la varianza de dicha distribución y una \(n\), se creen simulaciones de dicha distribución, al igual que la v.a. \(Z\). Finalmente se tiene que dar las gráficas de probabilidad acumulada y de densidad correspondiente (puedes guardar todo en una lista). Al final, con un \(n\) grande dado en la función, se debería poder ver una “comprobación visual de dicho teorema”.