Location via proxy:   [ UP ]  
[Report a bug]   [Manage cookies]                
0% encontró este documento útil (0 votos)
13 vistas35 páginas

Taller 1 Simulacion

Descargar como pdf o txt
Descargar como pdf o txt
Descargar como pdf o txt
Está en la página 1/ 35

Taller 1 R studio

2024-03-26

PUNTO 1 “PRACTICA”

Supongamos que nos reagalan un álbum con n = 75 cromos, que se vendern sobres con m = 6cromos por 0.8 euros,
y que estamos interesados en el número de sobres para completar la colección a partir de nsim = 1000 simulaciones
de coleccionistas de cromos: Podemos aproximar la distribución del número de sobres para completar la colección
a partir de nsim = 1000 simulaciones de coleccionistas de cromos:

n = 75
m <- 6
repe <- T
nsim <- 1000
nsobres <- numeric(nsim)
set.seed(1)
for(isim in 1:nsim){album <- logical(n)
i <- 0
while(sum(album) < n ){i <- i + 1
album[sample(n,m,replace= repe)]<-T}
nsobres[isim]<-i}

Se grafica los datos generados a partir de un histograma y una grafica de densidad.

hist(nsobres,breaks = "FD", freq = F,main = "",xlab = "Numeros de sobres",col = "lightgreen")


lines(density(nsobres),lwd = 2,lty=1,col = "darkred")
0.030
Density

0.015
0.000

40 60 80 120 160

Numeros de sobres

Aproximación por simulación del número medio de sobres para completar la colección:

1
sol <- mean(nsobres)
sol

## [1] 61.775

Número mínimo de sobres para asegurar de que se completa la colección con una probabilidad de 95 %:

nmin <- quantile(nsobres, probs = 0.95)


ceiling(nmin)

## 95%
## 92

# Reserva de dinero para poder completar la colección el 95 % de las veces:


ceiling(nmin)+0.8

## 95%
## 92.8

hist(nsobres, breaks = "FD", freq = F, main = "",xlab = "Numero de sobres",col = "lightpink")


lines(density(nsobres),col = "blue",lty = 1,lwd= 2)
abline(v=sol,col = "darkred",lwd = 2)
abline(v=nmin,lty=2,col = "darkgreen",lwd = 2)
0.030
Density

0.015
0.000

40 60 80 120 160

Numero de sobres

Figure 1: Aproximaciones por simulación de la distribución del número de sobres para completar la colección de su
valor esperado (línea vertical continua) y del cuantil 0.95 (línea vertical discontinua)

En el anterior grafico se encuentra una distribución de los datos con un sesgo a la derecha, lo que indica que no
tienen una distribución normal, la curva azul describe un ajuste de densidad.
por supuesto, la distribución del gasto necesario para completar la colección es esta misma reescalada.

2
##install.packages('https://github.com/rubenfcasal/simres/releases/download/v0.1/simres_0.1.3.zip',
# repos = NULL)
#library(simres)
res <- simres::mc.plot(nsobres*0.8)

Exploratory plots of nsobres * 0.8

Mean and error range


0.03

52
Density

0.00

46
20 40 60 80 120 0 200 400 600 800

Simulated values Number of generations


Sample Quantiles

Simulated values
120

120
40

40

−3 −1 0 1 2 3 0 200 400 600 800

Quantiles of Standard Normal Index

En el recuadro anterior los dos graficos de la iquierda me describen la normalidad de los datos; aunque hay algunos
sobre la linea del grafico qqplot, en mayoría tienden a estar alejados de la linea lo que indica que los datos no estan
distribuidos normalmente.
En los graficos de la derecha muestra como se comportan los datos al rededor de la media de los datos con una
rango de error.
Aproximación del gasto medio:

res$approx

## [1] 49.42

en el Ejercicio 1.5 se propone modificar este código para obtener información adicional sobre la evolución de número
de cromos distintos dependiendo de los sobres comprados por un coleccionista.

PUNTO 2

Hacer un modelo de promedios moviles con cte = 0, theta1= o.8, theta1 = -0.6, theta1 = 0.5

3
ts.sim <- arima.sim(list(order=c(0,0,1),ma=0.8), n=500)
ts.sim <- ts.sim[201:500]
#res2 <- simres::mc.plot(ts.sim*0.8)
par.old <- par(mfrow = c(3, 1))
#windows()
ts.plot(ts.sim)
acf(ts.sim)
pacf(ts.sim)
ts.sim

−3 2

0 50 100 150 200 250 300

Time

Series ts.sim
ACF

0.0

0 5 10 15 20

Lag

Series ts.sim
Partial ACF

−0.2

5 10 15 20

Lag

En el anterior gráfico describe el comportamiento en los datos a partir de peridos de tiempo, en el primer gráfico
se determina que los datos tienen un comportamiento estacionario, debido a que se tienen una oscilación sobre la
media, en el segundo gráfico se observa que los datos tienen un un decrecimiento exponencial hasta encontrar los
datos establecidos en la banda de confianza, en el tercer gráfico los datos estan en la banda de confianza.

PUNTO 3

n = 2500
phi = -1
sigma = 5
datossim = rep(0,n)

for(k in 2:n){
datossim[k]=phi*datossim[k-1]+rnorm(1,0,sigma)
}
datoss = datossim[501:n]

head(datoss)

4
## [1] -43.23009 39.96201 -34.19727 34.16535 -33.95494 40.43940

tail(datoss)

## [1] 169.1894 -169.6148 164.9983 -163.5853 162.8210 -174.0761

shapiro.test(datoss)

##
## Shapiro-Wilk normality test
##
## data: datoss
## W = 0.97107, p-value < 2.2e-16

library(car)

## Loading required package: carData

qqPlot(datoss,distribution="norm")

1873
200
100
datoss

0
−100
−200

1874

−3 −2 −1 0 1 2 3

norm quantiles

## [1] 1873 1874

boxplot(datoss)

5
200
100
0
−100
−200

par.old <- par(mfrow = c(3, 1))


ts.plot(datoss)
acf(datoss)
pacf(datoss)

6
datoss

−200

0 500 1000 1500 2000

Time

Series datoss
ACF

−1.0

0 5 10 15 20 25 30

Lag

Series datoss
Partial ACF

−1.0

0 5 10 15 20 25 30

Lag

PUNTO 4

4.1: Se va a aplicar el metodo de inversión para generar números aleatorios de las distribuciones de cauchy,triangular,
paretto, weibul.
metodo de inversión para cauchy:

1 𝑎𝑟𝑐𝑡𝑎𝑛(𝑥)
𝐹 (𝑥) = + defición de la función de cauchy
2 𝜋
𝑈 = 𝐹 (𝑥) igualando a una distribución uniforme
1 𝑎𝑟𝑐𝑡𝑎𝑛(𝑥)
𝑈= + sustitución de F(x)
2 𝜋
1 𝑎𝑟𝑐𝑡𝑎𝑛(𝑥)
𝑈− = suma de opuestos aditivos
2 𝜋
𝜋
𝜋 𝑈 − = 𝑎𝑟𝑐𝑡𝑎𝑛(𝑥) producto
2
1
𝑡𝑎𝑛(𝜋 (𝑈 − )) = 𝑥 inversa trigonometrica
2
cauchy <- function(nsim){
x <- rep(0,nsim)
for (i in 1:nsim){
u <- runif(1,0,1)
x[i] <- tan(pi*u)
}
return(x)
}

7
curvacauchy <- function(x){
c1 <- 1/(pi*(1+x*x))
}
X = cauchy(1000)
#par.old = par(mfrow = c(2, 1))
hist(cauchy(1000),breaks = "FD",col = "lightblue",freq=F)
curve(curvacauchy(x),add = T,col = "blue",lwd = 2,lty= 2,)

Histogram of cauchy(1000)
0.30
0.20
Density

0.10
0.00

0 500 1000

cauchy(1000)

ks.test(X,rcauchy(1000))

##
## Asymptotic two-sample Kolmogorov-Smirnov test
##
## data: X and rcauchy(1000)
## D = 0.042, p-value = 0.341
## alternative hypothesis: two-sided

En el anterior código se describe el método de inversión para la función de cauchy, tanto el histograma de los datos
generados como la curva graficada a partir de la función por default que trae R son se sobreponen de manera que
coiciden, ademas el la prueba Kolmogórov-Smirnov no rechaza la hipótesis nula.
4.2: La segunda distribución que se va a verficar para el metodo de inversión, es la distribución triangular:

8
4 𝑥2
(𝑥 − ) = 𝐹 (𝑥); 0 ≤ 𝑥 ≤ 𝑎 def de función de distribución triangular
𝑎 2𝑎
𝑈 = 𝐹 (𝑥) igualando a una distribución uniforme
2
2 𝑥
(𝑥 − )=𝑈 sustitución de F(x)
𝑎 2𝑎
𝑥2 𝑎𝑈
𝑥− = producto de inversos
2𝑎 2
2 𝑎 𝑥 − 𝑥2 = 𝑎 2 𝑈 producto de inversos y p - cancelativa
2 2
−𝑥 + 2 𝑎 𝑥 − 𝑎 𝑈 = 0 opuestos adictivos
las suluciones de la ecuación son:
√ √
𝑥1 = 𝑎 (1 + 1 − 𝑈 ) 𝑥2 = 𝑎 (1 − 1 − 𝑈 )

triangular = function(a,nsim){
v1 = rep(0,nsim)
v2 = rep(0,nsim)
for ( i in 1:nsim){
U = runif(1,0,1)
v1[i] = a*(1-sqrt(U))+0.5
v2[i] = a*(1+sqrt(U))-0.5
}
return(c(v2,v1))
}
Tr = triangular(0.5,10000)
hist(Tr,freq = F,breaks = "FD",col="lightsalmon")
curve(dtri(x),add=T,col="darkgreen",lty=2,lwd=3)

Histogram of Tr
2.0
1.5
Density

1.0
0.5
0.0

0.0 0.2 0.4 0.6 0.8 1.0

Tr

9
ks.test(Tr,rtri(10000,min = 0,max = 1,mode = 1/2))

##
## Asymptotic two-sample Kolmogorov-Smirnov test
##
## data: Tr and rtri(10000, min = 0, max = 1, mode = 1/2)
## D = 0.0104, p-value = 0.4666
## alternative hypothesis: two-sided

El anterior código describe el método de inversión aplicado para la función triangular, como los datos generados
y graficados en el histograma coinciden con la curva generada por el programa, se puede deducir que los datos
provienen de una función triangular, puesto que se le ha realizado un ajuste para que coincidieran los datos graficos,
ademas el test de Kolmogórov-Smirnov confirma que los datos si son de una distribución triangular.
4.3: método de inversión para la distribución de pareto

𝑎
𝑏
𝐹 (𝑥) = 1 − ( ) ; 𝑎, 𝑏 ≥ 0 def de función de pareto
𝑥
𝐹 (𝑥) = 𝑈 se iguala una distribución uniforme
𝑎
𝑏
1−( ) =𝑈 sustitución de F(x)
𝑥
𝑎
𝑏
( ) =𝑈 −1 suma opuestos aditivos
𝑥
𝑏 1
= (𝑈 − 1) 𝑎 inversa de exponente a
𝑥
𝑏
1 = 𝑥 inversos multiplicativos
(𝑈 − 1) 𝑎

pareto = function(nsim,a,b){
v = rep(0,nsim)
for (i in 1:nsim) {
U = runif(1,0,1)
v[i] = b/(U^(1/a))
}
return(v)
}
m = pareto(1000,3,2)
#par(mfrow=c(2,1))
hist(m,breaks = "FD",freq = F,col = "green")
curve(dpareto(x,2,2),add = T,col = "darkred",lty=1,lwd=2)

10
Histogram of m
1.2
1.0
0.8
Density

0.6
0.4
0.2
0.0

5 10 15 20 25 30 35

ks.test(m,rpareto(1000,2,2))

##
## Asymptotic two-sample Kolmogorov-Smirnov test
##
## data: m and rpareto(1000, 2, 2)
## D = 0.139, p-value = 8.129e-09
## alternative hypothesis: two-sided

el código anterior genera datos a partir de una distribución de pareto generado por el método de inversión, aunque
el método está realizado a partir de la demostración, Y los datos gráficos coiciden, el test de Kolmogórov-Smirnov
rechaza la hipótesis nula, es decir los datos no provienen de una distribución de pareto, sin embargo, el error se
debe al cambio de parametros que se hace en al final para la comparación de los datos.
4.4: Método de inversión para la distribución de weibull

𝑥) 𝛼
𝐹 (𝑋) = 1 − 𝑒−(𝜆 ; 𝑠𝑖 𝑥 ≥ 0 def de distribución de weibul
𝐹 (𝑥) = 𝑈 se iguala a una distribución uniforme
𝑥) 𝛼
1 − 𝑒−(𝜆 =𝑈 se sutituye F(x)
−(𝜆 𝑥) 𝛼
−𝑒 =𝑈 −1 suma de opuestos
𝛼
−(𝜆 𝑥) = 𝑙𝑛(𝑈 − 1) se toma el logaritmo natural
1
𝜆 𝑥 = −(𝑙𝑛(𝑈 − 1)) 𝛼
función inversa exponente a
1
−(𝑙𝑛(𝑈 − 1)) 𝛼

𝑥= inverso multiplicativo
𝜆

11
bull = function(alpha,lambda,nsim){
v = rep(0,nsim)
for (i in 1:nsim){
u = runif(1,0,1)
v[i] = (-log(u))^(1/alpha)/lambda
}
return(v)
}

wl = bull(3,1,10000)
hist(wl,breaks = "FD",freq = F,col = "darkred")
#hist(rweibull(100,3,1),freq = F,breaks = "FD")
curve(dweibull(x,3,1),add = T,col = "green",lty = 1,lwd=3)

Histogram of wl
1.2
1.0
0.8
Density

0.6
0.4
0.2
0.0

0.0 0.5 1.0 1.5 2.0

wl

ks.test(wl,rweibull(10000,3,1))

##
## Asymptotic two-sample Kolmogorov-Smirnov test
##
## data: wl and rweibull(10000, 3, 1)
## D = 0.0132, p-value = 0.3483
## alternative hypothesis: two-sided

El código anterior describe el metodo practico para generar datos con distribución weibull a partir del método de
inversión, la curva se ajusta al histograma, y ademas el tes de Kolmogórov-Smirnov no rechaza la hipotesis nula, es
decir que los datos si provienen de una destribución de weibull.

12
Punto 5

EJERCICIO 2.12
Pasando al ejemplo 2.2 A. Genere variables aleatorias de gamma y beta de acuerdo con 2.1.
Variables aleatorias para la función gamma

gamma1 = function(nsim,alpha,beta){
v = rep(0,nsim)
for (i in 1:nsim){
U = runif(1,0,1)
v[i] = -log(U)
}
A = matrix(v,nrow = alpha)
#print(dim(A))
r = beta*apply(A,2,sum)
return(r)
}
r = gamma1(3*10^4,4,15)
ks.test(r,rgamma(7500,4,15))

##
## Asymptotic two-sample Kolmogorov-Smirnov test
##
## data: r and rgamma(7500, 4, 15)
## D = 1, p-value < 2.2e-16
## alternative hypothesis: two-sided

par.old = par(mfrow=c(2,2))
hist(r,breaks = "Fd",freq = F)
# curve(dgamma(x,3000,1500),add = T)
hist(rgamma(7500,4,15),breaks = "Fd",freq = F)
pacf(r)
acf(r)

13
0.015
Histogram of r Histogram of rgamma(7500, 4, 15)
Density

Density

2.0
0.000

0.0
0 50 100 150 200 0.0 0.2 0.4 0.6 0.8 1.0 1.2

r rgamma(7500, 4, 15)

Series r Series r
Partial ACF

−0.02 0.02

0.6
ACF

0.0
0 10 20 30 0 10 20 30

Lag Lag

En el código anterior se verifica una distribución beta a partir de una sumatoria, aplicando el método de inversión,
aunque los histogramas son parecidos, la distribución de los datos en escalas es diferente, puesto que los datos
generados a partir del codigo son sumatorioas de columnas con tres filas de una matriz, aunque las graficas de
autocorrelación son significativas, puesto que los datos no se salen de los intervalos de confianza,
Generando variables aleatorias para la función beta

alpha = 10
beta = 30
U1 = runif(3*10^4)
U2 = matrix(U1,nrow = alpha)
U3 = matrix(U1,nrow = alpha + beta)
X1 = -log(U2)
X2 = -log(U3)
X3 = apply(X1,2,sum)/apply(X2,2,sum)
ks.test(X3,rbeta(3000,10,30))

##
## Asymptotic two-sample Kolmogorov-Smirnov test
##
## data: X3 and rbeta(3000, 10, 30)
## D = 0.070333, p-value = 7.177e-07
## alternative hypothesis: two-sided

par.old = par(mfrow = c(1,2))


hist(X3,breaks = "FD",freq = F)
curve(dbeta(x,10,30),add = T)
hist(rbeta(3000,10,30),breaks = "FD",freq = F)

14
Histogram of X3 Histogram of rbeta(3000, 10, 30)

6
4

5
4
3
Density

Density

3
2

2
1

1
0

0.1 0.3 0.5 0.7 0 0.1 0.2 0.3 0.4 0.5

X3 rbeta(3000, 10, 30)

El código anterios esta hecho a partir del cociente de dos sumatorias, aplicando el método de inversión, en el test no
se observa que los datos sean de una distribución beta, y los histogramas no tienen una similitud, ademas la curva
adicionada sobre el histograma de los datos generados con el codigo, no se ajusta a los mismos datos. B. Muestre
que si U ~ u[0,1], entonces X = -log(U)/lambda ~ Exp(lambda) df

𝐹 (𝑥) = 1 − 𝑒−𝜆⋅𝑥 def de distribuicón exponencial.


𝑈 = 𝐹 (𝑥) se iguala a una distribución uniforme.
−𝜆⋅𝑥
𝑈 =1−𝑒 sustitución de la función.
−𝜆⋅𝑥
𝑈 − 1 = −𝑒 suma de opuestos aditivos.
𝑙𝑜𝑔(1 − 𝑈 ) = −𝜆 ⋅ 𝑥 se obtiene el logaritmo.
𝑙𝑜𝑔(1 − 𝑈 )
− =𝑥 inverso multiplicativo.
𝜆

Así, se ha verificado que 𝑠𝑖 𝑈 ∼ 𝑢[0, 1], 𝑒𝑛𝑡𝑜𝑛𝑐𝑒𝑠 𝑋 = −𝑙𝑜𝑔(𝑈 )/𝜆


en el siguiente código se observa la comparación de la función generada anteriormente por el método de inversión
y comparado con la función del mismo programa.

func = function(nsim,lambda){
v = rep(0,nsim)
for (i in 1:nsim) {
U = runif(1,0,1)
v[i] = -log(U)/lambda
}
return(v)
}
v = func(1000,6)

15
v1 = rexp(1000,6)
ks.test(v,rexp(1000,6))

##
## Asymptotic two-sample Kolmogorov-Smirnov test
##
## data: v and rexp(1000, 6)
## D = 0.032, p-value = 0.6852
## alternative hypothesis: two-sided

par.old = par(mfrow = c(2,2))


hist(v,breaks = "FD",freq = F)
hist(v1,breaks = "FD",freq = F)
acf(v)
pacf(v)

Histogram of v Histogram of v1

4
Density

Density
4

2
2
0

0.0 0.2 0.4 0.6 0.8 1.0 0.0 0.5 1.0 1.5

v v1

Series v Series v
Partial ACF

−0.06 0.02
0.6
ACF

0.0

0 5 10 15 20 25 30 0 5 10 15 20 25 30

Lag Lag

El anterior código se observa que al comparar los histogramas, tienen similitud, ademas de los graficos de correlación
las espigas no sobrepasan los intervalos de confianza, la prueba ks no rechaza la hipotesis nula, concluyendo así que
los datos generados si provienen de una exponencial con parametro lambda.
C. Muestre que si U ~ u[0,1], entonces X = log(u/(1-u)) es una variable aleatoria logistica(0,1)

16
1
𝐹 (𝑥) = −(𝑥−𝜇)
def de distribución logistica.
1+𝑒 𝑠

1
𝑈= −(𝑥−𝜇)
se iguala a una distribución uniforme.
1+𝑒 𝑠

−(𝑥−𝜇)
𝑈 ⋅ (1 + 𝑒 𝑠 )=1 inversos multiplicativos
−(𝑥−𝜇) 1
1+𝑒 𝑠 = inversos multiplicativos
𝑈
−(𝑥−𝜇) 1
𝑒 𝑠 = −1 opuestos aditivos
𝑈
−(𝑥 − 𝜇) 1
= 𝑙𝑜𝑔 ( − 1) obtener el logaritmo
𝑠 𝑈
1
−𝑥 + 𝜇 = 𝑠 ⋅ 𝑙𝑜𝑔 ( − 1) inversos multiplicativos
𝑈
1
−𝑥 = 𝑠 ⋅ 𝑙𝑜𝑔 ( − 1) − 𝜇 opuestos aditivos
𝑈
1
𝑥 = −𝑠 ⋅ 𝑙𝑜𝑔 ( − 1) + 𝜇 elemento neutro negativo
𝑈
−𝑠
1
𝑥 = 𝑙𝑜𝑔 (( − 1) ) + 𝜇 propiedad de logaritmos
𝑈
𝑠
𝑈
𝑥 = 𝑙𝑜𝑔 (( ) )+𝜇 propiedad de fraccioes y exponentes negativos
1−𝑈

de lo anterior si se toma en cuenta los parametros s = 1 y 𝜇 = 0 entonces la ecuación se simplifica;


𝑈
𝑥 = 𝑙𝑜𝑔 ( ) que era lo que se quería demostrar.
1−𝑈
En el siguiente código se observa se realiza el codigo a partir del método de inversión generado a partir de la
distribución uniforme, comparado con la función logistica que tiene incorporada el programa r.

func2 = function(nsim){
v = rep(0,nsim)
for (i in 1:nsim) {
U = runif(1)
v[i] = log(U/(1-U))
}
return(v)
}
b = func2(1000) # función generada por el método de invesión
b1 = rlogis(1000) # función integrada en r
par.old = par(mfrow = c(1,2))
hist(b)
hist(b1)

17
Histogram of b Histogram of b1

250
400

200
300

150
Frequency

Frequency
200

100
100

50
0

−10 −5 0 5 0 −5 0 5

b b1

ks.test(b,rlogis(1000))

##
## Asymptotic two-sample Kolmogorov-Smirnov test
##
## data: b and rlogis(1000)
## D = 0.048, p-value = 0.1995
## alternative hypothesis: two-sided

De los anteriores datos el test ks me indica que los datos si provienen de una distribución logistica.
EJERCICIO 2.16 Un algoritmo para generar variables aleatorias beta se dio en Ejemplo 2.2 para 𝛼 ≥ 1 𝑦 𝛽 ≥ 1.
Otro algoritmo se basa en la siguiente propiedad: Si U y V son iid U[0,1], la distribución de

1
𝑈𝛼
1 1
𝑈𝛼 +𝑉 𝛽

condicional en 𝑈 (1/𝛼) + 𝑉 1/𝛽 ≤ 1, es la distribución 𝐵𝑒(𝛼, 𝛽). Comparar este algoritmo con rbeta y el algoritmo del
Ejemplo 2.2 para valores pequeños y grandes de 𝛼, 𝛽.

alg = function(alpha,beta,nsim){
vzero = rep(0,nsim)
for (i in 1:nsim){
U = runif(1,0,1)
V = runif(1,0,1)
if (U^(1/alpha)+V^(1/beta) <= 1) {
vzero[i] = U^(1/alpha)/(U^(1/alpha)+V^(1/beta))

18
}
else{
vzero[i] = NA
}
}
v = na.omit(vzero)
v1 = as.vector(v)
return(v1)
}
v3 = alg(10,30,3000) # función generada por el método de inversión
v3

## numeric(0)

# par.old = par(mfrow = c(1,2))

# el siguiente codigo describe la función a partir de los codigos del ejemplo 2.2
alpha = 10
beta = 30
U1 = runif(3*10^4)
U2 = matrix(U1,nrow = alpha)
U3 = matrix(U1,nrow = alpha + beta)
dim(U2)

## [1] 10 3000

X1 = -log(U2)
X2 = -log(U3)
X3 = apply(X1,2,sum)/apply(X2,2,sum)
# se grafican los histogramas de los tres metodos distintos
par.old = par(mfrow = c(1,3))
hist(X3,breaks = "FD",freq = F)
hist(rbeta(3000,10,30),freq = F,breaks = "FD") # histograma generado a partir de la función beta integrada
hist(alg(0.9,0.9,3000),breaks = "FD",freq = F,col = "lightyellow") # histograma generado a parit de la func
curve(dbeta(x,0.9,0.9),add = T,col = "darkgreen",lty = 2,lwd = 3)

19
Histogram of X3 Histogram of rbeta(3000, 10, 30) Histogram of alg(0.9, 0.9, 3000)

1.2
6
4

1.0
5

0.8
3

4
Density

Density

Density

0.6
3
2

0.4
2
1

0.2
1

0.0
0

0.2 0.4 0.6 0.8 0.1 0.2 0.3 0.4 0.5 0.0 0.2 0.4 0.6 0.8 1.0

X3 rbeta(3000, 10, 30) alg(0.9, 0.9, 3000)

En los anteriores códigos se observa que las funciónes no funcionan todas para los mismos valores a la vez, en el
histograma generado por el ejemplo, solo funciona para valores enteros mayores que 1, en el grafico generado a
partir de la función generada por el programa, aplica para culquier valor mayor que 0, en el gráfico generado por la
función sugerida, solo funciona para valores menores que 1.
EJERCICIO 2.18

fx = function(x)exp((-(x^2))/2)*((sin(6*x)^2)+(3*cos(x)^2)*(sin(4*x)^2) + 1)
gx = function(x)exp((-x^2)/2)/sqrt(2*pi)
rx = function(x){
fx =exp((-(x^2))/2)*((sin(6*x)^2)+(3*cos(x)^2)*(sin(4*x)^2) + 1)
gx =exp((-x^2)/2)/sqrt(2*pi)
return(fx/gx)
}
M = optimise(rx,interval = c(-1,1),maximum = T)$objective
fung = function(nsimm){
v = numeric(nsimm)
v2 = numeric(nsimm)
for (i in 1:nsimm){
f1 = function(){
n = 1
while(T){
u = runif(1)
T1 = rnorm(1,0,1)
if(u <= fx(T1)/(M*gx(T1))){
return(c(T1,n))
}
n = n + 1
}

20
}
v[i] = f1()[1]
v2[i] = f1()[2]
}
return(c(v,sum(v2)))
}
# numeros aleatorios generados
X = fung(2500)[-2501]
hist(X)

Histogram of X
500
Frequency

300
100
0

−4 −2 0 2

# numero de rechazos
n = fung(2500)[2501]
# taza de rechazo
taza_rechazo = 1 - 1000/n # el metodo no es eficiente para valores muy grades.
taza_rechazo

## [1] 0.7807979

# tes de kolmogorow smirnov


ks.test(X,rnorm(2500,0,1))

##
## Asymptotic two-sample Kolmogorov-Smirnov test
##
## data: X and rnorm(2500, 0, 1)
## D = 0.076, p-value = 1.071e-06
## alternative hypothesis: two-sided

21
curve(fx(x),from = -4,to=3,col = "darkgreen",lwd = 2,ylim = c(0,4.5))
curve(M*gx(x),from = -4,to= 4,col="darkred",lwd = 2,add = T)
4
3
fx(x)

2
1
0

−4 −3 −2 −1 0 1 2 3

En el siguiente codigo se presenta el el ejercicio 2.18, con la sugerencia enviada en el correo.

fundex = function(which = 1){


f = function(x)exp((-(x^2))/2)*((sin(6*x)^2)+(3*cos(x)^2)*(sin(4*x)^2) + 1)
if (which == 1)
curve(f,-4,4,lwd=2,n=500)
M = 5*sqrt(2*pi)
if(which == 2){
curve(f,-4,4,lwd = 2,n = 500,ylim = c(0,5))
x = seq(-4,4,length = 200)
lines(x,M*dnorm(x),lwd=2,col="blue")
}
if(which == 3){
n = 1e+05
x = rep(0,n)
for ( i in 1:n){
repeat{
y = rnorm(1)
u = runif(1,0,M*dnorm(y))
if (u < f(y)){
x[i] = y
break
}
}
}

22
hist(x,breaks=250,freq = F,main="")
}
}
par.old = par(mfrow = c(1,2))
fundex(2)
fundex(3)
5

0.6
4
3

0.4
Density
f(x)

0.2
1

0.0
0

−4 −2 0 2 4 −4 −2 0 2 4

x x

EJERCICIO 2.20 En cada uno de los siguientes casos, construya un algoritmo de aceptación-rechazo, Genere
una muestra de las variables aleatorias correspondientes y dibuje la función de densidad en la parte superior del
histograma.

a. Genere variables aleatorias normales utilizando un candidato de Cauchy en Aceptar-Rechazar.

curve(dcauchy(x,0,1),lwd = 2,col = "darkgreen",from = -15,to=30,ylim=c(0,0.6))


curve(dnorm(x,0,1),lwd = 2,col = "darkred",add = T)

23
0.6
0.5
dcauchy(x, 0, 1)

0.4
0.3
0.2
0.1
0.0

−10 0 10 20 30

# función de interes es f(x) = normal


fx = function(x){
return(dnorm(x,0,1)/dcauchy(x,0,1))
}
curve(fx,from = -10,to=10)

24
1.5
1.0
fx(x)

0.5
0.0

−10 −5 0 5 10

M = optimise(fx,interval = c(-5,5),maximum = T)$objective


# curve(M*dcauchy(x,0,1),lwd = 2,col = "darkgreen",from = -15,to=30)
# curve(dnorm(x,0,1),lwd = 2,col = "darkred",add = T)
name <- function() {
while (T) {
U = runif(1)
T1 = rcauchy(1,0,1)
if ( U <= dnorm(T1,0,1)/(M*dcauchy(T1,0,1))){
return(T1)
}
}
}
func1 = function(nsim){
v = numeric(nsim)
for(i in 1:nsim){
v[i] = name()
}
return(v)
}
X = func1(1000)
hist(X,breaks = "FD",freq = F)
curve(dnorm(x,0,1),add = T)

25
Histogram of X
0.4
0.3
Density

0.2
0.1
0.0

−3 −2 −1 0 1 2 3 4

ks.test(X,rnorm(1000,0,1))

##
## Asymptotic two-sample Kolmogorov-Smirnov test
##
## data: X and rnorm(1000, 0, 1)
## D = 0.038, p-value = 0.4658
## alternative hypothesis: two-sided

El anterior código esta estructurado para ejecutar el método de aceptación y rechazo, con la función te interes de
distribución normal y la función auxiliar una distribución de cauchy, la curva de la función por default tiene una
paridad con los datos generados por el código, ademas a medida que se aumenta el número de simulaciones se ajusta
cada vez mas al histograma, ademas la prueba Ks confirma que los datos si provienen de una distribución normal.

b. Genere variables aleatorias gamma G(4.3, 6.2) utilizando una candidata gamma G(4, 7)

fg= function(x) {
dgamma(x, shape = 4.3, rate = 6.2) / dgamma(x,shape = 4, rate = 7)
}
par(mfrow=c(2,2)) #Grafica varias graficas en una misma ventana
optimize(f = function(x) dgamma(x,shape=4.3,rate=6.2)/dgamma(x,shape=4,rate=7), maximum = TRUE, interval =

## [1] 4.395428

26
M=4.395428 #Valor maximo
curve(dgamma(x,shape=4.3,rate=6.2),col="darkgreen",ylab="gamma",xlim=c(-0.5,2),ylim=c(0,1.5)) #Grafica la f
curve(M*dgamma(x,shape=4,rate=7),xlim=c(-0.5,2),ylim=c(0,1.5),add=T,col="darkblue",) #Grafica la funcion de
legend("topright", legend = c("Gamma(4.3,6.7", "M*Gamma(4,7"), col = c("darkgreen", "darkblue"), lwd = c(2,
ngen=0
rgammaAR=function() {
# Simulación por aceptación-rechazo
# Normal estandar a partir de doble exponencial
M=4.395428
#Lambda.opt=1
while (TRUE) {
U=runif(1)
Y=rgamma(1,4,7)
ngen <<- ngen + 1 # Comentar esta línea para uso normal
if (M * U * dgamma(Y,4,7) <= dgamma(Y,4.3,6.2)) return(Y)
}
}
X=replicate(1000,rgammaAR())
rgammaARn=function(n = 1000) {
# Simulación n valores N(0,1)
x=numeric(n)
for(i in 1:n) x[i]=rgammaAR()
return(x)
}
X=rgammaARn(n=5000)
ngen

## [1] 26395

hist(X, breaks = 30,freq=F, main = "Variables Aleatorias Gamma(4.3, 6.2)", xlab = "x", col = "lightblue") #
curve(dgamma(x, shape = 4.3, rate = 6.2),col = "darkgreen", xlim=c(-0.5,2),ylim=c(0,1.5), add = TRUE) #Graf
curve(dgamma(x, shape = 4, rate = 7), col = "darkblue", add = TRUE) ##Grafica la funcion de densidad de la
legend("topright", legend = c("Datos Generados", "Gamma(4.3, 6.2)", "M*Gamma(4, 7)"), col = c("lightblue",
acf(X)
pacf(X)

27
Variables Aleatorias Gamma(4.3, 6.2)

Gamma(4.3,6.7 Datos Generados


gamma

Density
1.0

M*Gamma(4,7 Gamma(4.3, 6.2)

0.8
M*Gamma(4, 7)
0.0

0.0
−0.5 0.0 0.5 1.0 1.5 2.0 0.0 0.5 1.0 1.5 2.0 2.5

x x

Series X Series X

Partial ACF

0.01
0.6
ACF

−0.03
0.0

0 5 10 15 20 25 30 35 0 5 10 15 20 25 30 35

Lag Lag

Box.test(X,lag=22,type="Ljung")

##
## Box-Ljung test
##
## data: X
## X-squared = 12.693, df = 22, p-value = 0.9414

ks.test(X,rgamma(5000,4.3,6.2))

##
## Asymptotic two-sample Kolmogorov-Smirnov test
##
## data: X and rgamma(5000, 4.3, 6.2)
## D = 0.016, p-value = 0.5441
## alternative hypothesis: two-sided

system.time(X <- rgammaARn(5000))

## user system elapsed


## 0.21 0.04 0.47

Conclusión: Este código se utiliza para demostrar el método de aceptación-rechazo para simular variables aleatorias
de una distribución gamma con parámetros (4.3, 6.2) a partir de una distribución gamma con parámetros (4, 7),
por ultimo verificamos si los datos generados provienen de una gamma(4.3, 6.2) mediante el test de Kolmogorov-
Smirnov, luego medimos el tiempo utilizado por el computador realizando este proceso. Tambien mediante la prueba

28
de Ljung-Box y el acf, pacf podemos ver que el rezago #22 se sale levemente de las bandas de confianza, con la
prueba se confirma que no hay autocorrelacion en ese rezago.
EJERCICIO 2.23

# Función de densidad de la distribución objetivo, posterior


posterior = function(theta,x){
#calcular la verosimilitud
verosimilitud = prod(dnorm(x,mean = theta,sd = 1))
# calcular la densidad de la distribución prior
prior = dcauchy(theta,location = 0, scale = 1)
# Retornar el producto de la verosimilitud y la priori
return(verosimilitud*prior)
}

# implementar algoritmo de Aceptacion-rechazo para distribución


# posterior usando cauchy como candidata
aceptacion_rechazo_cauchy = function(x,theta0,nsim){
muestras = numeric(nsim)
contador = 1
while ( contador <= nsim){
candidato = rcauchy(1,location = 0,scale = 1)
u = runif(1)
if ( u <= posterior(candidato,x)/posterior(theta0,x)){
muestras[contador] = candidato
contador = contador + 1
}
}
return(muestras)
}
# parametros
theta0 = 3 # valor verdadero de theta
n = 10 # tamaño de la muestra
nsim = 10000 # Número de simulaciones

# Generar muestra ddatoss


set.seed(123)
datos = rnorm(n,mean = theta0,sd = 1)

# aplicar el algoritmo de aceptación-rechazo


muestras_posterior = aceptacion_rechazo_cauchy(datos,theta0,nsim)

# Gráfico del histograma de las muestras de la distribución posterior


hist(muestras_posterior,freq = F,main = "Histograma de la distribución posterior")
abline(v=theta0,col = "red",lwd=2)

29
Histograma de la distribución posterior
1.2
1.0
0.8
Density

0.6
0.4
0.2
0.0

1.5 2.0 2.5 3.0 3.5 4.0 4.5

muestras_posterior

EJERCICIOS ADICIONALES

1. SI Z ~ N(0,1), entonces V = Z ^ 2 ~ X^2(1)

nsim = 1000
X = numeric(nsim)
for(k in 1:nsim){
z = rnorm(1)
X[k] = z^2
}
X = X[201:1000]
hist(X,freq = F,breaks = "FD",col = "darkgreen")
curve(dchisq(x,df=1), add = T,col= "darkred",lwd = 3)

30
Histogram of X
1.5
1.0
Density

0.5
0.0

0 5 10 15

ks.test(X,rchisq(800,df=1))

##
## Asymptotic two-sample Kolmogorov-Smirnov test
##
## data: X and rchisq(800, df = 1)
## D = 0.0775, p-value = 0.01638
## alternative hypothesis: two-sided

El anterior código verifica que si una variable aleatoria tiene distribución normal entonces su cuadrado tiene una
distribución chi cuadrada, lo cual se verifica a partir del test ks, el histograma describe el comportamiento de los
datos, al gráficar la curva de la función chi por defaut sobre el histograma esta coincide con los puntos medios mas
altos de cada intervalo de clase, a medida que se aumenta el número de simulaciones.

2. SI U ~ X^2(m), y V~X^2(n) son independientes, entonces F = (U/m)/(V/n) tiene la distribución F con (m,n)
grados de libertad.

nsim = 1000
m = 5
n = 3
X = numeric(nsim)
for(i in 1:nsim){
U = rchisq(1,df=5)
V = rchisq(1,df=3)
X[i] = (U/5)/(V/3)
}
X = X[201:1000]

31
hist(X,freq = F,breaks = "FD",col = "darkgreen")
curve(df(x,df1 = 5,df2=3), add = T,col= "darkred",lwd = 3)

Histogram of X
0.5
0.4
0.3
Density

0.2
0.1
0.0

0 20 40 60 80 100

ks.test(X,rf(800,df1=5,df2 = 3))

##
## Asymptotic two-sample Kolmogorov-Smirnov test
##
## data: X and rf(800, df1 = 5, df2 = 3)
## D = 0.0475, p-value = 0.3275
## alternative hypothesis: two-sided

El anterior código se cocluye que los datos si provienen de una distribución F con (m,n) grados de libertad, primero
se observa una paridad entre el histograma y la curva de la función F sobrepuesta sobre este, ademas la prueba ks
me indica que los datos si provienen de una distribución F.
3 Si Z ~ N(0,1) y V~X^2(n) son independientes, entonces F = Z/sqrt(V/n) tiene la distribución t con n grados de
libertad

nsim = 1000
n = 3
X = numeric(nsim)
for (i in 1:nsim){
Z = rnorm(1,0,1)
V = rchisq(1,df = n)
X[i] = Z/sqrt(V/n)
}
ks.test(X,rt(1000,df=n))

32
##
## Asymptotic two-sample Kolmogorov-Smirnov test
##
## data: X and rt(1000, df = n)
## D = 0.035, p-value = 0.5727
## alternative hypothesis: two-sided

Del código anterior se concluye que los datos si provienen de una distribución t con n grados de liberta, puesto que
la prueba ks no rechaza la hipotesis nula.
4 Si 𝑈1 y 𝑈2 son iid 𝒰[0,1] , las variables 𝑋1 y 𝑋2 definidas por:

𝑋1 = √−2 log(𝑈1 ) cos(2𝜋𝑈2 ). 𝑋2 = √−2 log(𝑈1 ) sin(2𝜋𝑈2 )

n=10000 #Número de muestras


#Genera n valores aleatorios uniformemente distribuidos en el intervalo [0, 1] y
U1=runif(n)
U2=runif(n)
#Calcula una serie de valores utilizando el método de Box-Muller.
x1=sqrt(-2 * log(U1)) * cos(2 * pi * U2)
x2=sqrt(-2 * log(U1)) * sin(2 * pi * U2)
ks.test(x1, rnorm(10000,0,1)) # Prueba de bondad de ajuste para x1

##
## Asymptotic two-sample Kolmogorov-Smirnov test
##
## data: x1 and rnorm(10000, 0, 1)
## D = 0.0083, p-value = 0.8811
## alternative hypothesis: two-sided

ks.test(x2, rnorm(10000,0,1)) # Prueba de bondad de ajuste para x2

##
## Asymptotic two-sample Kolmogorov-Smirnov test
##
## data: x2 and rnorm(10000, 0, 1)
## D = 0.012, p-value = 0.4676
## alternative hypothesis: two-sided

library(car)
par(mfrow=c(2,4)) #Grafica varios graficos en una misma ventana
hist(x1,freq=F,main="Histograma X1") #Realiza el histograma de X1
curve(dnorm(x,0,1),add=T,lwd=3,col="29") # Dibuja una curva de densidad de probabilidad de una distribución
hist(x2,freq=F,main="Histograma X2") #Realiza el histograma de X2
curve(dnorm(x,0,1),add=T,lwd=3,col="23") # Dibuja una curva de densidad de probabilidad de una distribución

33
0.0 0.1 0.2 0.3 0.4
Histograma X1 Histograma X2

0.4
Density

Density

0.2
0.0
−4 0 2 4 −4 0 2

x1 x2

El anterior codigo verifica que las variables provienen de una distribución normal, esto le aplica a partir de las
varibles iniciales con una distribución uniforme, mediante una combinación aritmetica se crean dos variables X1,X2
que determinan la distribución de los datos, verificando su normalidad a partir de la prueba ks para cada conjunto
de datos.

5. Si U ~ Gamma(r,p) y V~Gamma(s,p) son independientes, entonces X = U/(U+V) tiene la distribución


Beta(r,s)

nsim = 500
X = numeric(nsim)
r = 1
lambda = 3
s = 2
for (i in 1:nsim){
U = rgamma(1,r,lambda)
V = rgamma(1,s,lambda)
X[i] = U/(U+V)

}
hist(X,breaks = "FD",freq = F,lwd= 2,col="red")
curve(dgamma(x,r,s),add = T,col = "darkgreen",lwd=2)

34
Histogram of X
1.5
1.0
Density

0.5
0.0

0.0 0.2 0.4 0.6 0.8 1.0

ks.test(X,rgamma(500,r,s))

##
## Asymptotic two-sample Kolmogorov-Smirnov test
##
## data: X and rgamma(500, r, s)
## D = 0.162, p-value = 4.001e-06
## alternative hypothesis: two-sided

El anterior código genera dos variables aleatorias con una distribución gamma, y luego al hacer el cociento entre
una y la suma de las dos, da como resultado una distribución beta, ademas se verifica que el cociente si da lugar a
una distribución beta, a partir de la prueba ks.

35

También podría gustarte