R change
Guillermo Aguirre Armada
4 de octubre de 2020
R Change
Comenzaremos por definir la función kfactorial la cual sera el factorial desde a hasta k.
kfactorial <-function(a,k){
i = a
while (i < k){
i = i + 1
a = i * a }
return(a) }
kfactorial(281,365)## [1] 1.496763e+213Crearemos la función que nos permita calcular la probabilidad de que dos personas cumplan años el mismo día
usaremos las propiedades del producto tales que <!-\[ \frac{365!}{365^n(365-n)!} = \frac{((n+1)*(n+2)*...365)!}{365^n} \]->
n=1
p=0
dos_personas <- function(n){
if (n == 0){ p = 1}
if (n <= 123){p = (1- (1/(365^(n))*(kfactorial(365-n,365)/(365-n))))}
if (n >123){p =(1)}
return(p)}
p = dos_personas(2)
p## [1] 0.002739726probabilities <- c()
for (j in 1:365){
probabilities <- c(probabilities,dos_personas(j))
j = j+1 }proba1 = data.frame("Personas" = c(1:365),"Probabilidad" = probabilities)
plot(proba1)
el_mismo_dia <- function(n){
if(n > 10000){p = 1}
else{
p = 1 - (364/365)^n
return(p)}}
el_mismo_dia(9000000)probabilities2 <- c()
for (j in 1:10000){
probabilities2 <- c(probabilities2,el_mismo_dia(j))
j = j+1}proba2 = data.frame("Personas" = c(1:10000),"Probabilidad" = probabilities2)
plot(proba2)
Ahora realizaremos la gráfica con ambas probabilidades
#Para la gráfica de ambas probas crearemos un Data frame con los Valores de Ambas probas.
probabilidades <- data.frame("n" = 1 :100, "probabilidad 1" = probabilities[1:100], "probabilidad 2" = probabilities2[1:100])
ggplot(probabilidades, aes(n))+ ggtitle("Probabilidades de cumpleaños")+
labs(y= "Probabilidad", x = "personas")+theme(plot.title = element_text(hjust = 0.5))+geom_line(aes(y = probabilidad.1),col ="green")+geom_line(aes(y = probabilidad.2),col ="red")
Ahora nos fijaremos en los primeros numeros para notar donde esta la interseccion
ggplot(probabilidades[1:6,], aes(n))+ ggtitle("Probabilidades de cumpleaños")+
labs(y= "Probabilidad", x = "personas")+theme(plot.title = element_text(hjust = 0.5))+geom_line(aes(y = probabilidad.1),col ="green")+geom_line(aes(y = probabilidad.2),col ="red")
Se puede notar que para n = 3 se obtiene la misma probabilidad para ambos eventos.
Relacion Fibonacci-Eigen (vectores/valores)
Recordemos que la susecion de Fibonacci esta representada por <!- $ F_n = F_{n-1} F_{n-2}$ <- Comenzaremos por definir la funcion
Fib<-function(n){
if(n%%1 != 0 | n < 0){
return("Ingresa un entero positivo o cero")
}
if(n == 0){
f = 0
return(0)
}else if(n == 1){
f = 1
return(1)
}else{
f <- Fib(n-1)+Fib(n-2)
return(f)
}
}1 Determina mediante el uso de R el eigen valor positivo correspondiente a dicha matriz (es decir, el famoso numero aureo o numero de oro).
mat <- matrix(c(1,1,1,0),nrow=2,ncol=2)
mat_aurea <- eigen(mat,symmetric=FALSE)
aureo = mat_aurea$values[1]
aureo## [1] 1.618034- Crea una gráfica, para un n que desees, donde cada punto corresponda a <!- \((F_{n1},F_{n2}) o (Fn,Fn1)\) >- .Dichos puntos deben ser de color de negro.
## Usaremos 21 numeros
Fn_1 <- c()
Fn <- c()
for(i in 1:21){
Fn_1 <- c(Fn_1,Fib(i-1))
}
for(i in 1:21){
Fn <- c(Fn,Fib(i))
}
numfib <- data.frame("n" = 1: 21,"Fn" = Fn, "Fn-1" = Fn_1 )Ahora graficaremos
ggplot(numfib, aes(Fn)) + geom_point(aes(y = Fn_1),col ="black")+
ggtitle("Fn vs Fn - 1")+labs(y= "Fibonacci n-1 ", x = "Fibonacci n")+theme(plot.title = element_text(hjust = 0.5))
3 En la misma grafica traza la linea por la que pasa el vector aureo
ggplot(numfib, aes(Fn)) + geom_point(aes(y = Fn_1),col ="black")+
ggtitle("Fn vs Fn - 1")+labs(y= "Fibonacci n-1 ", x = "Fibonacci n")+theme(plot.title = element_text(hjust = 0.5))+geom_abline(intercept = c(0,0), slope = mat_aurea$vectors[2,1]/mat_aurea$vectors[1,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ó
#Elegiré el punto 6
ggplot(numfib, aes(Fn)) + geom_point(aes(y = Fn_1),col ="black")+
ggtitle("Fn vs Fn - 1")+labs(y= "Fibonacci n-1 ", x = "Fibonacci n")+theme(plot.title = element_text(hjust = 0.5))+geom_abline(intercept = c(0,0), slope = mat_aurea$vectors[2,1]/mat_aurea$vectors[1,1])+
geom_point(aes(x=numfib[19,2]*aureo, y=numfib[19,3]*aureo), colour="red")
¡Podemos notar que obtuvimos a su sucesor!
5 ¿Qué concluyes de todo esto?
Concluyo que el vector aureo contiene a todos los numeros de fibonacci y que la funcion iterativa que definí en un inicio sería mucho mas optima si aprovecharamos esta propiedad.
4 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: Cantidad de letras. Cantidad de vocales. Cantidad de espacios. Porcentaje que representa cada letra en el texto.
1.- Número de letras
text <- read.table("C:/Users/memor/Downloads/Romeo_and_Juliet.txt",fill= TRUE,sep = "")
text5 = data.frame("palabras" = c(text$V1,text$V2,text$V3,text$V4,text$V5,text$V6,text$V7,text$V8))
#Separamos los datos en caracteres
e = c()
b = ""
for (i in 1:39456){
for( j in 1: nchar(text5$palabras[i])){
b = substr(text5$palabras[i],j,j)
e = c(e,b)}}
d = strsplit(text5[2,1],b)
#Definimos una función tal que cuente los caracteres
contar <- function(chara){
c = 0
for (i in 1:145710){
if (chara == e[i]){
c = c+1
}
}
return(c)}
min = c("a", "b", "c" ,"d" ,"e" ,"f", "g", "h" ,"i" ,"j", "k", "l", "m", "n", "ñ", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x","z")El texto tiene 103243 letras
- Número de vocales
vowels = c("a","e","i","o","u")
num_vocales = 0
for (i in vowels){
num_vocales = contar(i) + num_vocales
}
num_vocales## [1] 36002El número de vocales es 36002
- Cantidad de espacios
contar(" ")## [1] 1662Tenemos 1662 espacios en el texto
freec = c()
frec = 0
for (i in min){
frec = ((contar("i")/145710) + (contar(toupper(i))/145710))*100
freec = c(freec,frec)
frec =0
}
frecuencia <- data.frame("letras" = min, "frecuencia" = freec)
frecuencia## letras frecuencia
## 1 a 4.569350
## 2 b 4.100611
## 3 c 4.204241
## 4 d 3.994921
## 5 e 4.598174
## 6 f 4.052570
## 7 g 4.020314
## 8 h 4.042276
## 9 i 4.741610
## 10 j 4.043648
## 11 k 3.909135
## 12 l 4.294832
## 13 m 4.241988
## 14 n 4.206986
## 15 ñ 3.904331
## 16 o 4.515819
## 17 p 4.112278
## 18 q 3.905703
## 19 r 4.421110
## 20 s 4.143847
## 21 t 4.589253
## 22 u 4.204928
## 23 v 3.977078
## 24 w 4.139730
## 25 x 3.904331
## 26 z 3.9057035 Teorema del limite central
Distribucion exponencial con <-! $ = 8 $ >-
xej <- seq(0, 12, length=50)
yej <- dexp(xej, rate = 8)
ggplot(data.frame(xej,yej),aes(x=xej,y = yej))+
geom_line()+
ggtitle("Función exponencial") +
labs(y= "funcion", x = "x") +
theme(plot.title = element_text(hjust = 0.5))
Xej <- seq(0, 12, length=50)
Yej <- pexp(Xej, rate = 8)
ggplot(data.frame(Xej,Yej),aes(x=Xej,y = Yej))+
geom_line()+
ggtitle("Función exponencial") +
labs(y= "Probabilidad acumulada", x = "x") +
theme(plot.title = element_text(hjust = 0.5))
Haremos las simulaciones
simulaciones <- rexp(500,8)
hist(simulaciones, main = "Histograma exponencial",breaks = 20)
Si usamos el teorema nos quedaría
vecteorm <- c()
for (i in 1:10000){
simulate <- rexp(500,8)
teorm1 = (sum(simulate)-500*(1/8))/sqrt(500/25)
vecteorm <- c(vecteorm,teorm1)
}
hist(vecteorm, main = "Teorema de Límite Central",xlim = c(-8,8),breaks = 1000)