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.
\[\mathbb{P}=\left\{\begin{array}{ll}1-\frac{365 !}{365^{n}(365-n) !} & 1 \leq n \leq 365 \\ 1 & n>365\end{array} ; \quad \mathbb{P}=1-\left(\frac{364}{365}\right)^{n}\right.\]
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ú. 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.
```r
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
}
<!-- rnb-source-end -->
<!-- rnb-chunk-end -->
<!-- rnb-text-begin -->
La función para la segunda probabilidad sería de la siguiente manera
<!-- rnb-text-end -->
<!-- rnb-chunk-begin -->
<!-- rnb-source-begin eyJkYXRhIjoiYGBgclxuYGBgclxuUGFyYWRveDIgPC0gZnVuY3Rpb24obil7XG4gIDEgLSAoKDM2NC8zNjUpXm4pXG59XG5cbmBgYFxuYGBgIn0= -->
```r
```r
Paradox2 <- function(n){
1 - ((364/365)^n)
}
<!-- rnb-source-end -->
<!-- rnb-chunk-end -->
<!-- rnb-text-begin -->
Combinemos las funciones Paradox1 y Paradox2 en una sola función
<!-- rnb-text-end -->
<!-- rnb-chunk-begin -->
<!-- rnb-source-begin eyJkYXRhIjoiYGBgclxuYGBgclxuQmlydGhfUGFyYWRveCA8LSBmdW5jdGlvbihuKXtcbiAgdW5vIDwtIFBhcmFkb3gxKG4pXG4gIGRvcyA8LSBQYXJhZG94MihuKVxuICBcbiAgYSA8LSBwYXN0ZShcXEVuIHVuIGdydXBvIGNvblxcLG4sXFxwZXJzb25hczpcXClcbiAgYiA8LSBwYXN0ZShcXExhIHByb2JhYmlsaWRhZCBkZSBxdWUgZG9zIHBlcnNvbmFzIGN1bXBsYW4gYcODwrFvcyBlbCBtaXNtbyBkw4PCrWEgZXNcXCx1bm8pXG4gIGMgPC0gcGFzdGUoXFxMYSBwcm9iYWJpbGlkYWQgZGUgcXVlIGFsZ3VpZW4gY3VtcGxhIGHDg8Kxb3MgZWwgbWlzbW8gZGlhIHF1ZSB0w4PCuiBlc1xcLGRvcylcbiAgdG9kbyA8LSBjKGEsYixjKVxuICByZXR1cm4odG9kbylcbn1cbmBgYFxuYGBgIn0= -->
```r
```r
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)
}
<!-- rnb-source-end -->
<!-- rnb-chunk-end -->
<!-- rnb-text-begin -->
Probemos la función Birth_Paradox para dos grupos de personas
<!-- rnb-text-end -->
<!-- rnb-chunk-begin -->
<!-- rnb-source-begin eyJkYXRhIjoiYGBgclxuYGBgclxuQmlydGhfUGFyYWRveCg3MCkgI1BhcmEgdW4gZ3J1cG8gZGUgNzAgcGVyc29uYXNcbmBgYFxuYGBgIn0= -->
```r
```r
Birth_Paradox(70) #Para un grupo de 70 personas
<!-- rnb-source-end -->
<!-- rnb-output-begin eyJkYXRhIjoiWzFdIFxcRW4gdW4gZ3J1cG8gY29uIDcwIHBlcnNvbmFzOlxcICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgXG5bMl0gXFxMYSBwcm9iYWJpbGlkYWQgZGUgcXVlIGRvcyBwZXJzb25hcyBjdW1wbGFuIGHDg8Kxb3MgZWwgbWlzbW8gZMODwq1hIGVzIDAuOTk5MTU5NTc1OTY1MTU3XFxcblszXSBcXExhIHByb2JhYmlsaWRhZCBkZSBxdWUgYWxndWllbiBjdW1wbGEgYcODwrFvcyBlbCBtaXNtbyBkaWEgcXVlIHTDg8K6IGVzIDAuMTc0NzI5NDU3NTgzMTRcXFxuIn0= -->
[1] un grupo con 70 personas:
[2] probabilidad de que dos personas cumplan años el mismo dÃa es 0.999159575965157
[3] probabilidad de que alguien cumpla años el mismo dia que tú es 0.17472945758314
<!-- rnb-output-end -->
<!-- rnb-chunk-end -->
<!-- rnb-text-begin -->
<!-- rnb-text-end -->
<!-- rnb-chunk-begin -->
<!-- rnb-source-begin eyJkYXRhIjoiYGBgclxuYGBgclxuQmlydGhfUGFyYWRveCgyMDApICNQYXJhIHVuIGdydXBvIGRlIDIwMCBwZXJzb25hc1xuYGBgXG5gYGAifQ== -->
```r
```r
Birth_Paradox(200) #Para un grupo de 200 personas
<!-- rnb-source-end -->
<!-- rnb-output-begin eyJkYXRhIjoiWzFdIFxcRW4gdW4gZ3J1cG8gY29uIDIwMCBwZXJzb25hczpcXCAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIFxuWzJdIFxcTGEgcHJvYmFiaWxpZGFkIGRlIHF1ZSBkb3MgcGVyc29uYXMgY3VtcGxhbiBhw4PCsW9zIGVsIG1pc21vIGTDg8KtYSBlcyAxXFwgICAgICAgICAgICAgICAgIFxuWzNdIFxcTGEgcHJvYmFiaWxpZGFkIGRlIHF1ZSBhbGd1aWVuIGN1bXBsYSBhw4PCsW9zIGVsIG1pc21vIGRpYSBxdWUgdMODwrogZXMgMC40MjIyOTgwNDMzMDA5MzRcXFxuIn0= -->
[1] un grupo con 200 personas:
[2] probabilidad de que dos personas cumplan años el mismo dÃa es 1
[3] probabilidad de que alguien cumpla años el mismo dia que tú es 0.422298043300934
<!-- rnb-output-end -->
<!-- rnb-chunk-end -->
<!-- rnb-text-begin -->
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
<!-- rnb-text-end -->
<!-- rnb-chunk-begin -->
<!-- rnb-source-begin eyJkYXRhIjoiYGBgclxuYGBgclxuI2NyZWFyZW1vcyBkb3MgdmVjdG9yZXMgdmFjaW9zIHF1ZSBhbG1hY2VuZW4gbGFzIHByb2JhYmlsaWRhZGVzIGNhbGN1bGFkYXNcbmRhdGExIDwtIGMoKVxuZGF0YTIgPC0gYygpXG5cbiNoYWdhbW9zIGVsIGNhbGN1bG8gZGUgYW1hYmFzIHByb2JhYmlsaWRhZGVzIHBhcmEgZGlmZXJlbnRlcyBncnVwb3MgKGRlIDEgYSAyMDAwKVxuZm9yKGkgaW4gMToyMDAwKXtcbiAgZGF0YTFbaV0gPC0gUGFyYWRveDEoaSlcbiAgZGF0YTJbaV0gPC0gUGFyYWRveDIoaSlcbn1cblxucGxvdChjKDAsIDIwMDApLCBjKDAsIDEpLCB0eXBlID0gXFxuXFwsIHhsYWIgPSBcXE7Dg8K6bWVybyBkZSBwZXJzb25hc1xcLFxuICAgICAgeWxhYiA9IFxcUHJvYmFiaWxpZGFkXFwsIG1haW4gPSBcXFBhcmFkb2phIGRlbCBjdW1wbGXDg8Kxb3NcXClcbmxpbmVzKGRhdGExLCBwY2ggPSAxOSwgY29sID0gXFxkYXJrb3JjaGlkMVxcKVxuYGBgXG5gYGByXG5saW5lcyhkYXRhMiwgcGNoID0gMTksIGNvbCA9IFxcZGFya29yY2hpZDRcXClcbmdyaWQoKVxuYGBgXG5gYGByXG5sZWdlbmQoXFxib3R0b21yaWdodFxcLCBsZWdlbmQgPSBjKFxcRnVuY2nDg8KzbiAxXFwsXFxGdW5jacODwrNuIDJcXCksIHBjaCA9IGMoMTksIDE5KSwgXG4gICAgICAgY29sID0gYyhcXGRhcmtvcmNoaWQxXFwsXFxkYXJrb3JjaGlkNFxcKSlcbmBgYFxuYGBgIn0= -->
```r
```r
#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\))
<!-- rnb-source-end -->
<!-- rnb-plot-begin -->
<img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAZ4AAAD/CAMAAAD2fUB2AAAAwFBMVEUAAAAAADoAAGYAOjoAOmYAOpAAZpAAZrY6AAA6ADo6AGY6OgA6Ojo6OmY6ZpA6ZrY6kLY6kNtmAABmADpmOgBmOjpmkJBmkLZmkNtmtrZmtttmtv9oIouQOgCQZgCQZjqQkGaQkLaQtpCQttuQtv+Q29uQ2/+2ZgC2Zjq2kDq2kGa225C227a229u22/+2/9u2//+/Pv/T09PbkDrbkGbbtmbbtpDb27bb29vb////tmb/25D/27b//7b//9v////Yrw7vAAAACXBIWXMAAA7DAAAOwwHHb6hkAAAPM0lEQVR4nO2di3bbuBGGaceu5LrrVEq2bSKrSTetmba7rmXuJjVlie//Vos7QIqkcBWH1Pzn2KYpcADj8wxA4sKsQgFWNnQBUH1CPKCFeEAL8YAW4gEtxANaiAe0EA9oIR7QQjyghXhAC/GAFuJx1tfs7nF783CSvIbAU2RcPzzaXpFnl0/m7/t1dv1imbg37VEdXr2d07LXy5NMQ+LJLmz/BSHhKS+fXn/MFt4WnTQoHut6a+JxSRwbz0k1DB5Wf69L5j7f3tM498DOX/z0Prt8NE5V+6/z7OqLqPFvP2bZm7++qEoz0lXNxPuvxDvfvjQq+LdbYuFjJRnulsQNyLfZt9vs4mP1K7n8gX/4M8nq6lFdrazRQv6L/HLFc1UlqqpfiemLO+t4bacB8dC/9KEqdZwrhEcZp0jtcNErCuVyvNKMdExmYlLnVFdPNTw5/3zRxMN1KzPKdfDlV2tryvUv+D+UCgKFLmdEDYjn+5L8JH/+H15oc7tgf+H1Y/V/8xQhMHuh/7rkCnKG1ENBa5dVmpmOyUycUy9knxl4SII/v7wuxecmnkX1G6nbj9w6xUOuJmdm4mptjaYgXsXTGSWiLvhCL4nbKEFoe77/55bWBD2/EknkKVWLqkbZD1XlMh2TkZjVO/9HMPDwBMXdL03v4Q5yLWHnvCAqJ8OaKCRJp0rHfpATV7/Er6rBe277T/x4JoJdZZ4ilcPq3kRCU/Fj41J2mZGY935ZFhpPPczV2p5KfJd4WLWrnAxropAsdaNEmWqG4mlAPKwdpX/W1T++Lw08xileZ7y+5DGJUCsZ3NSlVGbiMmvHIx1NEGA0OvGonAxrJh6zRNXre57in1GrasiuARWvj52Jxzglq7bVe8xLqczE5DMZJ/u8px+PmZO01uU95Mfr51uHewU7DY2nlKF8of5M81Rf22OmY6q3PdJRDtqe8ocvMq8y68Bz0PbMdOEVHrNEIq+/R+66DY2HdX5e11nde9Qp3hnLW3tuZjomM3FO72NelzwGGj23tywmrrgZenEHnmbPTVqr4TFKxDqFNMJNy3vUvUq97VFNvrwFabnvqaVjMhKLOxV151JLMJNPzrJOPNJO7b6H35xpPOZ9z1fjdiiehsZT0e7X1RfRZ9U9N3Gq2v97Tm7zzacGf6tkwDLTcVtG4tdPBMDdY9tTA2qh2pKm/O7nzp7b/z7VrlbW6nh0ibhph6e8dhrngILZB0sgp0d8STVOPK9LxANXeRb74UnTPuLxF+0TvE2ZAeJBWQnxgBbiAS3EA1qIB7QQD2ghHtBCPKAVGU+m9ZyFK4YNMAUxbQyFRx8+RzAXwwaYghg2AOBBdQvxgNaJ8ej4SjxYfD3r483G8+s54FqAX6puAHiPDLWbjb85mG3PvZ9Atj0hdIZUX0UHGweEJ24GiZSCQY8A4BG+HIQnZXBzgjG9jjVMPJ7uMT08XEBi22lilrUQjxAoKkoA8HBfDsMTElMUF3yo02ZuODwNhxk/HrW8MgtcHTl0cIMYyVrk4T0lm9lXhs3hHhDPSMgwuePZr/m02KJvBUSeZTO2MGDVkWCg4NZLZvzBraLxjVd52RPcCrbUhU3n75hD28QT6Dw2tXLUaSaBZ7/mNZ53ew9LwqNfl481800d28YTz2ryanuo+xQ9bQ9zMO5dXT52Sjwjamua8ulYs+5bX8vj5j1pg5sDmkkENxuptkdGwj5zCfG4uc3Z4HHquTElCG7jDWlaHnjkrWnU29LoeCbApvLCQ7psxazazrscwzXfBMHNz3EmEdzorUxJV+lbLcwvjvfcouPxdZyJ4FlV2z8+sS9ntc3Uifx1f5/O9sm//G5Ld+8e/PAcmhOK1PZMoTtgyqPtofEqX1gGN4t84wW3QDaTCG6kbzATewt1S+6T0pkoAZ5gx5kInuMq5G4CZde2AtGD28SimlASPMazglM9Ep0knESjpXLMobJ6JEp9OZDOfYyYMpHgdny01M17gvHUpyX7axJ4bEZLC/mszbbtCcAzzUZHKM1oqQqCnQij4ZkynESjpW75hgQ36ToY3NTR8dFSJ3MheJTrIB59eHS01M0clReeSbc6XABmiVL54Jk+HBB4/IJb3XUwuEXIt92cF56G6yAe9n23XKgHBzEHs13xnENgowLgPVSOeM6FDgQ8zsGtBQ4Gtwj5tptzxdPmOoiHfU+1vscBz9kENioAm7bQr4399Ij7oadnwJ4KEke+wa3DdzC4Rci33ZwDns7AhnjY92Hve86q2WEC4D1UVnjOjw4EPLbBrY8OBjd9GHlA4TmcDuJJNxxXWeE5w8hWgRjMrmzwnCedVFNBXPK1CW7H6GBwkwdW207Ym7PCc5Jd7qaBJ8WmLUfwnGlkqxI/Eu1Z4OiCByAd6w33Q2VdIIfCW0B0CW4WdE4d3CLfBYbn41QgMXfXznuO4bFxHsSjjmwWzu+WtOMQJbgBDG2g8dgtnM9J1yEGHpB0AOOxXThfZIsIwc2SDgY3eWC9cH47fxOMx9Z3EI88sF84v193bqljG9xARrYKMp7oC+erbjxQ6UDGY7NwXslu05YOPPbdAgxucbKTMmaj0Fcjhc5oeQ68PtkMmtD6ip7Qx1yr98DsUnNBxhN/+VU7nqAM0gowHpvRUsdNW9rwODkPtj3ywGa01GnTlnY8p39tzjTwWIyWOm/a0obHtmCDqL/actH/6bzrU3WYzQ4/NG8ok4yWum3aUrXhgU2nWfzGawltp2G07lO8W16G4EmxacsBHtde26DBbbNp8AmZJVPWGuw0o6VOm7Y8R3CeIfFsNk0+Cg8LI+TbbvlhyWNdQSpuJsILIUGrR3/Izi3KMO+xkdumLYfO45TZAHLGQ2JNIb7YPPUV7wHvlpSV+EDoBHjczDXxQL4h5XLGs2CDk/KFLPQ8bwFIGyE/lFeH4tnOiV+ETdTpDW4edIC1PbLjpvHwnxICG5Rhx4zZqrM35d01KLq7jW7mWvC4mxv2vqez53aA5+ZBned4jA/l1WF4ZLcs4oBC/Y+DH9qO3vd04knvPdEn8R7gCTB7KlnjWdQIdLQ9oL2nEdy86MB6qKPw7NfXL3TMWBGgHTRyX9/ouY2o7fELbUDxsBuMD2bz0nrfExVP7J5bPbiNIbRBfiSaIF8Dzxj6BRVkPJ3vG/PNtxbcPOnACm7x5N9zi5avicfXdxCPOgrrUbflq/CMJLRBxhO07UTbTJ0x7pcDF0/0fHVw83ceDG7J8jXweJuDhSdgMJvNodF9L2c8RV+29mpre0bT8jSrrbmhtv9g9n5Nx340NFc8Rf+yHWu14gm2ejLVin/wTm7/wWxetXrmsyMezjvscVszXxncQugMGdzu75t8AgazmfQ8Due5BsxueNf63PA4DGaT6329JwUeEdxGFNo88DgMZpvzZ8DgGVG/oDra9oQNZhvdOQB4eHALozNsx7qz5+YzmF2bewYBTwTnAXbfEzCYXdRmBqaZhui0QiGC85xcyQazG6OcaZ4auL1WdjO2lifdYPZ2Xq+vJHgc51hvwp0HaHBzHswueNDxve+xk+NrZTfhzgMLTzwB8B4S3EYW2kaOx/G1spuxtTxjx+O0QuF5E04Hg1uyfBFPhHwSTqQaXWibDh6LTVsQT4R84hSoY9OW4KkZuGlLsnxjtBvY9gyUL0yNHI/TI9ERatx4XDdtCRYGNwejNg91tJ6zcMWwEcdIZKXAY/FI1NNyShtgCuJjI7L3BJYmhQ0wBUmNx+KRaGBpUtgAU5DkeI4/Eg0sTQobYAqSHs+pLSOeCPmms4x4IuSbzjLiiZBvOsuIJ0K+6Swjngj5opIJ8YAW4gEtxANaiAe0EA9oIR7QQjyghXhAC/GAFuIBLcQDWogHtBLhKb339OXj5TPThrMx8aKpQwMOlriNgNLoPcICypEGD93cp+9FTT2SWzhoG87GxIumDg04WBI2/Euj9wgLKUcSPHzGVd7yArXjkjPolA1nY+JFU4cGHCzJl1X5l0btERZUjiR4mtuXuaiYNWy4GpMvmjo0YG9JvawqtDTER0LKkQgPCwl+e8Dkf+IhW9nwMMbxHBhwssSThZYmb8vewUYSPDyuejU+uyWdQ5cvtA0PY+wvPzTgZInZCC0Nna4ZVA5oeISByycQeAJLU8qeASw8IcGNG5ivYAS3oNLwqc7wgltI14AbuGlpUe0vD+4aVHU8fqURq6HgdQ0COta86GVbf9ReZXDHuobYrzRyvQC8jnXIbSkrNWmMA25LxX9+0G2p7Ll5l0bvEQbutpTtkOXbMaA7dspdtrgNZ2MiMB0acLAkbHiXxtgjLKAc+EgUtBAPaCEe0EI8oIV4QAvxgBbiAS3EA1qIB7QQD2ghHtBCPKCFeEAL8YAW4gEtxANaiAe0EA9oIR7QQjyghXhAC/GAFuIBLcQDWogHtBAPaCEe0IKLZ78Ws5zZlvOFxWsBGgpY/gVGkPGw/QQ4HuPtGtZCPCm1X79hq8hymxc2tAnxpNR+PWPL1gke+fL27fzDMssW2zlf1FHwVdO7d5/pJgSl3ISj4h9dfBaLN+TZ7c1Pc/FL7UpqLqu9Kp7mQk/I1SMqxckFGg/DUsPDdtogLOjKv4L8Qhc58eXTJam/3VKsOMsZLppYpKEilbxiyepXshVwpfiIWtgtxYV07RVPKlKcXqDxsLc41fAsxLIzUmO7Ja318vKJHfDGScQzvuYwv3hQafhZ+ktBzZlX1jf+KMVFNIN3D9xUwBrmUMHGQ6ushmcl6p584ygYJ3lWfNeLF1WaSv0wzwq7kt6qdpZbyphLDcYHNh5a0Z14xFvyTDyiUguFR6ahZ8V6deMsT862jlppCwoPaaEu/0vPihQDCDieKl/0e08lmPR5j5DGU7uSKZd73xjeo3MTKdL/zQeCjmd7cysaC7r5g4lH1S07aGl7CtqMGP/zvO2RtNWV8shoezgevrdIdpD2lIKOh3Rur1/2a/qV1fGwThVv/3mv2Oi50Y9Uz03+47N+n+q5qSv1UnbVc9Pes1vKXXGGuYsCj4d1fummhB8awY3fvZD/cN2Kd9z3iIZ9O//LXK+C11eWYn27vu/Rbc/FQ87A+e8DECa4eKJLNSMjEuIBLcQDWmeEZ4xCPKCFeEAL8YAW4gEtxANaiAe0EA9oIR7QQjyghXhAC/GAFuIBLcQDWogHtBAPaCEe0EI8oIV4QAvxgBbiAa3fASlk+EB8w0UDAAAAAElFTkSuQmCC" />
<!-- rnb-plot-end -->
<!-- rnb-chunk-end -->
<!-- rnb-text-begin -->
# 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
$$\left(\begin{array}{c}F_{n} \\ F_{n-1}\end{array}\right)=\left(\begin{array}{cc}1 & 1 \\ 1 & 0\end{array}\right)\left(\begin{array}{c}F_{n-1} \\ F_{n_{2}}\end{array}\right)$$
0. Crea una función para obtener el n-ésimo número de Fibonacci.
1. 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).
2. 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.
3. En la misma gráfica coloca la recta sobre la que pasa el eigen vector correspondiente al eigen valor del punto 1.
4. 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ó?
5. ¿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, …
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
<!-- rnb-text-end -->
<!-- rnb-chunk-begin -->
<!-- rnb-source-begin eyJkYXRhIjoiYGBgclxuYGBgclxuZmliX24gPC0gZnVuY3Rpb24obikge1xuICAgIGlmKG4gPT0gMCl7XG4gICAgICByZXR1cm4oMClcbiAgICB9ZWxzZSBpZihuID09IDEpe1xuICAgICAgcmV0dXJuKDEpXG4gICAgfWVsc2UgaWYgKG4gPT0gMikge1xuICAgIHJldHVybigxKVxuICAgIH1lbHNlIGlmKG4gPiAyKXtcbiAgICByZXR1cm4oZmliX24obiAtIDEpICsgZmliX24obiAtIDIpKVxuICAgIH1cbiAgfVxuYGBgXG5gYGAifQ== -->
```r
```r
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))
}
}
<!-- rnb-source-end -->
<!-- rnb-chunk-end -->
<!-- rnb-text-begin -->
Debemos recordar que n representa la posición que el número tiene en la serie
<!-- rnb-text-end -->
<!-- rnb-chunk-begin -->
<!-- rnb-source-begin eyJkYXRhIjoiYGBgclxuYGBgclxuZmliX251bWJlciA8LSBmdW5jdGlvbihuKXtcbiAgeCA8LSBmaWJfbihuKVxuICBwYXN0ZShcXEVsIFxcLCBuLCBcXMOCwrAgbsODwrptZXJvIGRlIEZpYm9uYWNjaSBlcyBcXCwgeClcbn1cbmBgYFxuYGBgIn0= -->
```r
```r
fib_number <- function(n){
x <- fib_n(n)
paste(\El \, n, \° número de Fibonacci es \, x)
}
<!-- rnb-source-end -->
<!-- rnb-chunk-end -->
<!-- rnb-text-begin -->
Veamos si podemos obtener las primeras 7 posiciones de los números de Fibonacci
<!-- rnb-text-end -->
<!-- rnb-chunk-begin -->
<!-- rnb-source-begin eyJkYXRhIjoiYGBgclxuYGBgclxuZmliX251bWJlcigwKVxuXG5gYGBcbmBgYCJ9 -->
```r
```r
fib_number(0)
<!-- rnb-source-end -->
<!-- rnb-chunk-end -->
<!-- rnb-chunk-begin -->
<!-- rnb-source-begin eyJkYXRhIjoiYGBgclxuYGBgclxuZmliX251bWJlcigxKVxuXG5gYGBcbmBgYCJ9 -->
```r
```r
fib_number(1)
<!-- rnb-source-end -->
<!-- rnb-chunk-end -->
<!-- rnb-text-begin -->
Ahora calculemos el número áureo a partir de la siguiente matriz
A=(1110
<!-- rnb-text-end -->
<!-- rnb-chunk-begin -->
<!-- rnb-source-begin eyJkYXRhIjoiYGBgclxuYGBgclxuQSA8LSByYmluZChjKDEsMSksIGMoMSwwKSkgXG5cbmVpZ0EgPC0gZWlnZW4oQSkgI0xhIGZ1bmNpw4PCs24gZWlnZW4oKSBjYWxjdWxhIGxvcyBlaWdlbnZhbG9yZXMgeSBlaWdlbnZlY3RvcmVzXG5cbmVpZ0EkdmFsdWVzICNFaWdlbnZhbG9yZXMgZGUgQVxuYGBgXG5gYGAifQ== -->
```r
```r
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
<!-- rnb-source-end -->
<!-- rnb-chunk-end -->
<!-- rnb-text-begin -->
<!-- rnb-text-end -->
<!-- rnb-chunk-begin -->
<!-- rnb-source-begin eyJkYXRhIjoiYGBgclxuYGBgclxub3JvIDwtIGVpZ0EkdmFsdWVzWzFdXG5cbnBhc3RlKFxcRWwgbsODwrptZXJvIMODwqF1cmVvIGVzIGVsIGVpZ2VudmFsb3IgcG9zaXRpdm8gZGUgbGEgbWF0cml6IEFcbmBgYCJ9 -->
```r
```r
oro <- eigA$values[1]
paste(\El número áureo es el eigenvalor positivo de la matriz AAhora vamos a crear una función que grafique n elementos de la serie de Fibonacci, los puntos tendrán coordenadas (Fn, Fn−1) y deben graficarse a partir de n=1 puesto que el número F0−1=F−1 no existe.
Sobre esta misma gráfia agregaremos el eigenvector correspondiente al número de oro
```r
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\)
}
<!-- rnb-source-end -->
<!-- rnb-chunk-end -->
<!-- rnb-text-begin -->
Para n=10 veamos como sería nuestra grafica
<!-- rnb-text-end -->
<!-- rnb-chunk-begin -->
<!-- rnb-source-begin eyJkYXRhIjoiYGBgclxuYGBgclxuZ3JhZmljYV9maWIoMTApXG5cbmBgYFxuYGBgIn0= -->
```r
```r
grafica_fib(10)
<!-- rnb-source-end -->
<!-- rnb-chunk-end -->
<!-- rnb-text-begin -->
Veamos que pasa cuando multiplicamos algún punto de los graficados anteriormente (m) por el número áureo
<!-- rnb-text-end -->
<!-- rnb-chunk-begin -->
<!-- rnb-source-begin eyJkYXRhIjoiYGBgclxuYGBgclxuIyBuIGVzIHBhcmEgbGEgY2FudGlkYWQgZGUgcHVudG9zIGEgZ3JhZmljYXJcbiMgbSBlcyBwYXJhIGVsIHB1bnRvIGEgbXVsdGlwbGljYXIgcG9yIGVsIG7Dg8K6bWVybyBkZSBvcm9cbmdyYWZfbmV3UG9pbnQgPC0gZnVuY3Rpb24obiwgbSl7IFxuICB4IDwtIGMoKVxuICB5IDwtIGMoKVxuICBcbiAgZm9yKGkgaW4gMTpuKXtcbiAgICB4W2ldIDwtIGZpYl9uKGkpXG4gICAgeVtpXSA8LSBmaWJfbihpLTEpXG4gIH1cbiAgXG4gIHBvaW50IDwtIGMoeFttXSwgeVttXSlcbiAgbmV3X3BvaW50IDwtIHBvaW50ICogb3JvXG4gIFxuICBwbG90KHgsIHksIHhsYWIgPSBleHByZXNzaW9uKFxcRlxcW25dKSwgeWxhYiA9IGV4cHJlc3Npb24oXFxGXFxbbi0xXSksIFxuICAgICAgbWFpbiA9IHBhc3RlKFxcRWwgbW92aW1pZW50byBkZWwgcHVudG9cXCwgbSksIHBjaCA9IDE5KVxuICBsaW5lcyhuZXdfcG9pbnRbMV0sIG5ld19wb2ludFsyXSwgdHlwZSA9IFxccFxcLCBwY2ggPSAxOCwgY29sID0gXFxyZWRcXClcbiAgYWJsaW5lKGEgPSAgMCwgYiA9IGVpZ0EkdmVjdG9yc1syLDFdL2VpZ0EkdmVjdG9yc1sxLDFdLCBjb2wgPSBcXGZpcmVicmljazJcXClcbiAgYWJsaW5lKHYgPSAoc2VxKDAsIDEwMCwgMikpLCBjb2w9XFxsaWdodGdyYXlcXCwgbHR5PVxcZG90dGVkXFwpXG4gIGFibGluZShoID0gKHNlcSgwLCAxMDAsIDIpKSwgY29sPVxcbGlnaHRncmF5XFwsIGx0eT1cXGRvdHRlZFxcKVxufVxuYGBgXG5gYGAifQ== -->
```r
```r
# 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\)
}
<!-- rnb-source-end -->
<!-- rnb-chunk-end -->
<!-- rnb-text-begin -->
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
<!-- rnb-text-end -->
<!-- rnb-chunk-begin -->
<!-- rnb-source-begin eyJkYXRhIjoiYGBgclxuYGBgclxuZ3JhZl9uZXdQb2ludCgxMCw5KVxuXG5gYGBcbmBgYCJ9 -->
```r
```r
graf_newPoint(10,9)
<!-- rnb-source-end -->
<!-- rnb-chunk-end -->
<!-- rnb-text-begin -->
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.
1. Derivada. Para comprobar determina si la derivada de $2x2$ en algún punto se aproxima con tu función.
2. Integral. Puedes usar funciones positivas para comprobar tu función utilizando la interpretación de la integral.
3. 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 se 🙈, 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:
1. Cantidad de letras.
2. Cantidad de vocales.
3. Cantidad de espacios.
4. 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
<!-- rnb-text-end -->
<!-- rnb-chunk-begin -->
<!-- rnb-source-begin eyJkYXRhIjoiYGBgclxuYGBgclxubGlicmFyeSh0b2tlbml6ZXJzKVxubGlicmFyeShyZWFkcilcbmxpYnJhcnkod29yZGNsb3VkKVxubGlicmFyeShkcGx5cilcbmxpYnJhcnkocmVhZHIpXG5saWJyYXJ5KGdncGxvdDIpXG5saWJyYXJ5KHN0cmluZ3IpXG5saWJyYXJ5KGV4dHJhZm9udClcbmxpYnJhcnkodG0pXG5saWJyYXJ5KFJDb2xvckJyZXdlcilcbmBgYFxuYGBgIn0= -->
```r
```r
library(tokenizers)
library(readr)
library(wordcloud)
library(dplyr)
library(readr)
library(ggplot2)
library(stringr)
library(extrafont)
library(tm)
library(RColorBrewer)
<!-- rnb-source-end -->
<!-- rnb-chunk-end -->
<!-- rnb-text-begin -->
Primero debemos cargar nuestro documento, y hacerle una “limpieza” con el fin de facilitar nuestro análisis
<!-- rnb-text-end -->
<!-- rnb-chunk-begin -->
<!-- rnb-source-begin eyJkYXRhIjoiYGBgclxuYGBgclxuQ2FyZ2FfZG9jdW1lbnRvIDwtIGZ1bmN0aW9uKGRvY3VtZW50byl7XG5cbiAgI1V0aWxpemEgbGEgZnVuY2nDg8KzbiBmaWxlLCBjb24gZWwgcGFyw4PCoW1ldHJvIHIgKGRlIFxccmVhZFxcLCBsZWVyKVxuICBsZWVyX2RvY3VtZW50byA8LSBmaWxlKGRvY3VtZW50bywgb3BlbiA9IFxcclxcKVxuXG4gICNBcGxpY2EgbGEgZnVuY2nDg8KzbiByZWFkTGluZXMgcGFyYSBsZWVyIGxhcyBsw4PCrW5lYXMgZGVsIGFyY2hpdm8sIFxuICAjZsODwq1qYXRlIHF1ZSBlbCBlbmNvZGluZyBzZWEgVVRGLThcbiAgdGV4dG9fbGluZWFzIDwtIHJlYWRMaW5lcyhsZWVyX2RvY3VtZW50bywgZW5jb2RpbmcgPSBcXFVURi04XFwpXG5cbiAgI0p1bnRhIHRvZGFzIGxhcyBsaW5lYXMgKHDDg8KhcnJhZm9zKSBlbiB1bm8gc29sb1xuICB0ZXh0b19jb21wbGV0byA8LSBwYXN0ZSh0ZXh0b19saW5lYXMsIGNvbGxhcHNlID0gXFxcXG5cXClcbiAgXG4gICNSZXRpcmVtb3MgbG9zIHNpZ25vcyBkZSBwdW50dWFjacODwrNuXG4gIHRleHRvX3NpblNpZ25vcyA8LSByZW1vdmVQdW5jdHVhdGlvbih0ZXh0b19jb21wbGV0bylcblxuICAjVmFtb3MgYSBjYW1iaWFyIGxvcyBcXFxcblxcIHF1ZSByZXByZXNlbnRhbiBsb3Mgc2FsdG9zIGRlIGxpbmVhIHBvciBlc3BhY2lvcyBlbiBibGFuY29cbiAgdGV4dG9fU2luU2FsdG9zIDwtIHN0cl9yZXBsYWNlX2FsbCh0ZXh0b19zaW5TaWdub3MsIFxcXFxuXFwsIFxcIFxcKVxuXG4gICNWYW1vcyBhIGVsaW1pbmFyIGxvcyBlc3BhY2lvcyBlbiBibGFuY28gbcODwrpsdGlwbGVzXG4gIHRleHRvX1NpbkVzcGFjaW9zIDwtIHN0cl9yZXBsYWNlX2FsbCh0ZXh0b19TaW5TYWx0b3MsIFxcW1xcXFxzXStcXCwgXFwgXFwpXG59XG5cbmBgYFxuYGBgIn0= -->
```r
```r
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]+\, \ \)
}
<!-- rnb-source-end -->
<!-- rnb-chunk-end -->
<!-- rnb-text-begin -->
documento <- "Romeo_and_Juliet.txt"
Carga_documento(documento)```{r}
Es bien conocido el teorema que abordamos en este ejercicio y sólo para recordar, si \(X_{1},X_{2},…\) es una sucesión de variables aleatorias independientes e idénticamente distribuidas, con media \(μ\) y varianza finita \(σ2\), la función de distribución de la variable aleatoria \(Z\) descrita por \[Z=\frac{\left(X_{1}+\cdots+X_{n}\right)-n \mu}{\sqrt{n \sigma^{2}}}\] tiende a la función de distribución normal estándar cuando \(n→∞\). 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”.
Suerte! Ojala que no la necesites 🤭