Gen.estandar.min <- function(n,a,m,c, sem=as.numeric(Sys.time())){
U=numeric(n)
U[1] <- sem
for(i in 1:(n-1)){
U[i+1]<- (a*U[i]+c)%%m
}
return(U/m) #genero una secuencia de numeros pseudoaleatorios (aproximac. de uniformes)
}
a=7^5; m= 2^31-1; c=0
p1<- Gen.estandar.min(200,a,m,c) #tomo una muestra de tamaño n=200
summary(p1) #verifico que sean Uniformes(0,1)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.001864 0.220450 0.479852 0.486603 0.730848 0.998973
Al implementar el algoritmo ‘Gen.estandar.min’ en la consola se obtuvo una muestra de 200 observaciones de una variable aleatoria aproximada a la Uniforme en (0,1)
Luego traté de corroborar que el generador mínimo estandar efectivamente satisface la Proposición 2.1 de las notas; sin embargo como c=0 eso genera que la primer condición no se cumpla. Es decir, el máximo común divisor mcd(c,m)=m= 2^31-1 y es distinto de la unidad.
rachas <- factor()
datos_dicotomicos <- function(datos){ #genero una funcion que convierta datos de U(0,1) en dicotomicos
for (i in 1:length(datos)){
a<-0
if(datos[i]>0.5) {a<-1} #defino punto de corte
rachas<-c(rachas,a)
}
return(rachas)
}
(p2<-datos_dicotomicos(p1)) #asigno rachas a valores generados por p1
## [1] 1 1 0 0 0 1 0 1 0 1 1 0 1 0 0 0 1 0 1 1 0 1 1 0 1 1 0 0 0 0 1 1 0 0 1
## [36] 0 1 0 0 1 0 1 1 1 0 0 1 1 0 1 0 1 0 1 0 1 1 1 0 0 1 0 0 1 1 0 0 0 1 1
## [71] 1 1 1 0 0 1 1 1 0 0 1 0 1 0 0 1 0 1 1 0 0 1 0 1 0 1 1 0 1 0 0 0 0 1 1
## [106] 1 0 1 0 1 0 0 1 1 1 0 0 1 1 1 1 0 0 1 0 0 1 1 0 0 1 0 0 1 1 1 1 0 1 1
## [141] 1 1 1 1 0 0 0 1 1 1 0 1 1 0 1 0 1 0 0 0 0 0 0 0 0 0 0 0 1 0 0 1 0 0 1
## [176] 1 1 1 0 0 0 1 0 0 0 1 1 0 0 1 1 1 0 0 0 0 1 1 0 0
##Aplico prueba de rachas para ver si los datos conservan su aleatoriedad
library(adehabitatLT)
wawotest(p2)
## a ea va za p
## -8.0428171 -1.0000000 197.9983913 -0.5005133 0.6916431
## Aplico prueba de Anderson-Darling para ver que distribuyen U(0,1)
library(ADGofTest)
ad.test(p2,punif,0,1)
##
## Anderson-Darling GoF Test
##
## data: p2 and punif
## AD = Inf, p-value = 3e-06
## alternative hypothesis: NA
Primero, genere la función ‘datos_dicotomicos’ que convierte los datos que se le ingresen en dicotómicos para poder aplicar las pruebas estadísticas
Como resultado de la prueba de rachas obtuve un p-value = 0.07147075 > 0.5 por lo cual acepto H0 que indica que los datos si son aleatorios y de la prueba de A-D obtuve un p-value = 3e-06 por lo cual también se corrobora que los datos distibuyen U(0,1)
dist.empirica <- ecdf(p1)
x=rnorm(200) #muestra de tamaño n=200
qqplot=qqnorm(x)
plot(dist.empirica,col="blue",lwd=3)
points(qqplot$y,qqplot$x,col="red")
Al observar la gráfica se verifica que son muy parecidas ambas curvas. Además,dichas curvas son muy parecidas a la identidad y eso quiere decir que x% de los valores de la muestra son menores o iguales que x
x<-c();y<-c();z<-c()
wichman_hill <- function(n,a,b,c){
if(a>0 & a<30000 & b>0 & b<30000 & c>0 & c<30000){ #defino intervalo de las variables
v <- c(30269,30307,30323)
u <- rep(0,n)
u[1]<-(sum(c(a,b,c)/v)) %% 1
x[1]=a; y[1]=b; z[1]=c #los valores iniciales (semillas) otorgados por el usuario
for(i in 1:(n-1)){
if(x[i]>0){x[i+1] <- (171*x[i])%%177 - (2*x[i]/177)}
else{x[i+1]=x[i]+30269}
if(y[i]>0){y[i+1] <- (172*y[i])%%176 - (35*y[i]/176)}
else{y[i+1]=y[i]+30307}
if(z[i]>0){z[i+1] <- (170*z[i])%%178 - (63*x[i]/178)}
else{z[i+1]=z[i]+30323}
u[i+1] <- ((x[i+1]/30269)+(y[i+1]/30307)+(z[i+1]/30323))%%1
}
} else{print("Los números recibidos por la función no están en el intervalo (0,30000)")}
return(u) #regresa los numeros generados
}
p4<-wichman_hill(500,0.5,7000,18065)
evaluar<-datos_dicotomicos(p4) #hago dicotomicos para hacer pruebas estadisticas
ad.test(evaluar,punif,0,1) #p-value=1.2e-06 entonces si distribuyen U(0,1)
##
## Anderson-Darling GoF Test
##
## data: evaluar and punif
## AD = Inf, p-value = 1.2e-06
## alternative hypothesis: NA
library(randtests)
runs.test(evaluar,threshold=0.5) #rechazo aleatoriedad (p-value < 2.2e-16)
##
## Runs Test
##
## data: evaluar
## statistic = -22.22, runs = 2, n1 = 53, n2 = 447, n = 500, p-value
## < 2.2e-16
## alternative hypothesis: nonrandomness
Implementé el algoritmo propuesto por wichman & Hill para generar números pseudoaleatorios realizando 500 iteraciones dados los valores iniciales a=0.5, b=7000 y c=18065 que están dentro del intervalo (0,30000) y luego apliqué el test de rachas y el de bondad de ajuste.
Los resultados que obtuve es que los datos si distribuyen U(0,1) y rechazo aleatoriedad con punto de corte en p=0.5 y eso se ve claramente por la manera en la que fueron arrojados los valores luego de hacerlos dicotómicos (en la variable evaluar) por lo cual el generador no es confiable
generador_continua<- function(n){
V<-numeric(n)
for(i in 1:n){
U<-runif(1)
V[i]<- (U)^(1/2)}
return(V)
}
p5<-generador_continua(50)
summary(p5)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.1340 0.4471 0.7385 0.6559 0.8328 0.9870
Por ser una función continua decidí usar la función inversa para obtener 50 valores aleatorios en (0,1) y debido al ‘summary’ mostrado anteriormente se puede corroborar que los datos permanecen en dicho intervalo.
Tinv_discretas <- function(n,D){
if(sum(D)!=1)stop("El vector de densidades debe sumar 1")
muestra<-numeric(n)
for(i in 1:n){
k<-0
U<-runif(1) #genero 1000 uniformes(0,1)
F<-0
while(F<U){
F<-F +D[k+1]
if(F<U){
k<-k+1
}else{F<-1}
}
muestra[i]<-k
}
return(muestra)
}
p6<-Tinv_discretas(1000,c(1/3,1/5,1/6,1/6,4/30))
table(p6)
## p6
## 0 1 2 3 4
## 351 198 151 163 137
Con el uso del algoritmo ‘Tinv_discretas’ de la Transformada Inversa para el caso de las variables discretas generé una muestra de tamaño n=1000 según la distribución que se indicó y obtuve los resultados anteriores.
p7_a<- Tinv_discretas(1000,c(rep(1/10,10)))
table(p7_a)
## p7_a
## 0 1 2 3 4 5 6 7 8 9
## 100 86 84 111 100 94 113 100 116 96
Usando el mismo algoritmo que en el ejercicio anterior obtengo los resultados enunciados para cada valor que toma la Uniforme
G.bin.inv.recursiva<-function(n,p){ #generador de observaciones Bin(n,p) por inversa generalizada
V<-numeric(n)
for(j in 1:n){
c<- (p/(1-p))
pr<- (1-p)^n
F<- pr
i<- 0
U<- runif(1)
if(F<U){
while(F<U){
i<-i+1
pr<- c*((n-i+1)/i)*pr
F<-F+pr
}
}
V[j]<-i
}
return(V)
}
(p7_b<- G.bin.inv.recursiva(40,1/2))
## [1] 23 15 19 19 21 17 20 19 17 21 21 21 21 22 22 20 26 20 24 23 19 20 24
## [24] 24 18 16 16 23 23 22 20 19 28 28 23 22 16 17 24 18
Con la implementación de las probabilidades iterativas de la variable Binomial se pudieron simular n=40 valores de X con una probabilidad de p=1/2 con el algoritmo ‘G.bin.inv.recursiva’ y los valores obtenidos son los que se guardaron en la variable p7_b
G.poi.inv.recursiva<-function(n,lambda){
V<-numeric(n)
for(j in 1:n){
p<-exp(-lambda)
F<-p
i<-0
U<-runif(1)
if(F<U){
while(F<U){
i<-i+1
p<-p*lambda/i
F<-F+p
}
}
V[j]<-i
}
return(V)
}
p7_c<- G.poi.inv.recursiva(100,9) ; p7_c
## [1] 8 8 11 15 8 8 10 11 8 10 10 9 13 5 9 16 5 6 13 12 6 9 10
## [24] 7 16 12 7 12 8 9 12 11 9 6 13 9 10 10 14 13 9 14 8 8 16 6
## [47] 11 7 10 9 9 12 15 11 4 4 8 13 10 6 9 12 8 11 5 6 10 9 9
## [70] 11 11 12 9 4 11 6 9 5 6 13 9 8 7 9 9 6 7 6 5 6 5 6
## [93] 12 10 12 6 6 9 5 8
plot(rpois(100,9));plot(p7_c)
Usando el generador de observaciones Poisson por medio de la inversa generalizada con las probabilidades iterativas de dicha distribución simule una muestra de tamaño n=100 con lambda=9 y luego comparé graficamente dichos valores con la función teórica de probabilidad y en efecto se parecen mucho los valores simulados a los datos reales
G.geom.inv <-function(n,p){
V<-numeric(n)
for(j in 1:n){
for(i in 1:400){
U<-runif(1)
if(p<U){i<-i+1}
else{
break
}
}
V[j]<-i
}
return(V)
}
p7_d<- G.geom.inv(200,1/4)
table(p7_d)
## p7_d
## 1 2 3 4 5 6 7 8 9 10 11 12 14 16
## 60 34 26 18 16 10 12 4 8 4 1 4 2 1
Dado que X ~ Geometrica (1/4) entonces el número esperado de iteraciones resulta menor a 3 y dado que X = número esperado de ensayos necesarios para que ocurra por PRIMERA VEZ un éxito entonces generé una función llamada ‘G.geom.inv’ cuya finalidad es simular n = 200 valores aleatorios que distribuyan Geom(1/4)
Generador_binomial <- function(muestra,n,p){
X<-numeric(n)
r<-numeric(muestra)
for(j in 1:muestra) {
for(i in 1:n){ #realizamos tantas Blli como n
U<-runif(1)
if(U<=p){X[i]<-1}
else{X[i]<-0}
}
r[j]<-sum(X)
}
return(r)
}
p8<-Generador_binomial(40,50,1/2) #obtengo una muestra de 40 observaciones de una Bin(n,p)
table(p8)
## p8
## 17 19 20 22 23 24 25 26 27 28 29 30 31
## 1 1 3 1 3 3 7 6 6 4 2 2 1
Implementé la función ‘Generador_binomial(40,50,1/2)’ generando 40 valores que distribuyen Binom(50,1/2) y obtuve los resultados anteriores
p9<- G.bin.inv.recursiva(1000,1/2)
summary(p9)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 445.0 490.0 501.0 500.5 511.0 558.0
Implementando el algoritmo ‘G.bin.inv.recursiva’ utilizado y definido anteriormente obtengo una simulación de la variable Bin(1000,1/2)
Generador_binomial_negativa <- function(n,k,p){ #n>> grande
geom<- G.geom.inv(n,p)
if(length(geom)>k){ #cuento los éxitos
texto <- paste("la cantidad de ensayos de una Blli necesarios para que ocurra el k-esimo éxito (",k, ") son ",sum(geom[1:k]))
print(texto)
} else{
print("el tamaño de n debe de ser aún mayor para alcanzar el k-esimo éxito")
}
}
p10_a<-Generador_binomial_negativa(200,195,1/4)
## [1] "la cantidad de ensayos de una Blli necesarios para que ocurra el k-esimo éxito ( 195 ) son 717"
Con la implementación del algoritmo ‘G.geom.inv’ implementado en ejercicios anteriores generé la función ‘Generador_binomial_negativa’ para una variable BinNeg(k,p) que contará la cantidad de ensayos que tienen que llevarse a cabo para que ocurra el k-esimo éxito y el parámetro n que se solicita en la función ‘Generador_binomial_negativa’ indica la cantidad de veces que se va a generar una variable Geométrica. De preferencia n tiene que ser grande.
G.bin.negativa.recursiva<-function(r,p){ #generador de observaciones Bin(n,p) por inversa generalizada
V<-numeric(r)
for(j in 1:r){
c<- (1-p)
pr<- ((1+p)^(-r))
F<- pr
i<- 0
U<- runif(1)
if(F<U){
i<-i+1
pr<- c*pr*((i-1)/(i-r))
F<-F+pr
}
V[j]<-i
}
return(V)
}
p10_c<- G.bin.negativa.recursiva(195,1/4)