2ª Avaliação Parcial, Modelagem e Simulação.
Jessé
21/11/2022
Para as questões 1 e 2 considerar um valor de semente igual a matricula de um dos componentes da equipe.
1. Você está interessado em gerar uma amostra de valores exponencialmente distribuídos. Gere a amostra com e sem aplicação de técnica de redução de variância. A técnica de redução de variância deverá ser a do Hipercubo Latino. Depois de gerados os valores, peça o histograma e faça o teste Kolmogorov-Smirnov para ambas as amostras e comente. OBS: Você não pode utilizar as funções rexp e randomLHS.
Função de Densidade: \[f(x) = \lambda e^{-\lambda x}\] Função de Distribuição: \[F(x) = 1 - e^{-\lambda x}\] Número aleatório: \[F^{-1}(u) = x >> - \frac{\log(u)}{\lambda}\]
Em runif:
set.seed(141)
n = 100
lambda = 1
u = runif(n)
x = -log(runif(n))/lambda
hist(x)
Usando a técnica de redução de variância, hipercubo latino:
HL <- c()
for(i in 1:n){
y <- -log((i - runif(1))/n)/lambda
HL[i] <- y
}
hist(HL)
##### Teste KS
ks.test(x,pexp,1)##
## Asymptotic one-sample Kolmogorov-Smirnov test
##
## data: x
## D = 0.055657, p-value = 0.9161
## alternative hypothesis: two-sidedks.test(HL,pexp,1)##
## Asymptotic one-sample Kolmogorov-Smirnov test
##
## data: HL
## D = 0.0099514, p-value = 1
## alternative hypothesis: two-sided2. Você está interessado em gerar uma amostra de valores exponencialmente distribuídos. Gere a amostra com e sem aplicação de técnica de redução de variância. A técnica de redução de variância deverá ser a da Amostragem Descritiva. Depois de gerados os valores, peça o histograma e faça o teste Kolmogorov-Smirnov para ambas as amostras e comente. OBS: Você não pode utilizar a função rexp.
Função de Densidade: \[f(x) = \lambda .\exp{(-\lambda.x)}\] Função de Distribuição: \[F(x) = 1 - \exp{(-\lambda.x)}\] Número aleatório: \[F^{-1}(u) = x >> - \log(u)/\lambda\]
Em runif:
n = 100
lambda = 1
u <- runif(n)
x <- -log(runif(n))/lambda
hist(x)
Usando a técnica de redução de variância, amostragem descritiva:
n = 100
lambda = 1
AD <- c()
for(i in 1:n){
y <- -log((i - 0.5)/n)/lambda
AD[i] <- y
}
hist(AD)
ks.test(AD,pexp,1)##
## Asymptotic one-sample Kolmogorov-Smirnov test
##
## data: AD
## D = 0.005, p-value = 1
## alternative hypothesis: two-sided3. Para a modelagem de um contrato de seguro discreto e temporário por 5 anos através de simulação monte carlo:
a) Simule as mortes considerando distribuição poisson;
b) Idade de contrato 50 anos;
c) Tábua AT83;
d) Benefício de R$10.000;
e) Juros 6%;
f) Quantidade de apólices: 1000;
g) Simule o VP financeiro da obrigação, considerando 1000 simulações;
h) Calcule o prêmio individual.Seguro discreto e temporário por 5 anos - Poisson
## Loading required package: ggplot2 # Simula Distribuição de VP Financeiro da Obrigação
n.sim <- 10000
qx <- read.table('tabua.txt',header=F,dec=',')
#na idade 1
qx <- qx[,1]
idade.atual <- 50
temp <- 5 # temporaneidade do contrato
benefit <- 10000
juro <- 0.06
v <- 1/(1+juro)
S <- rep(0,n.sim)
loss.50 <- c()
for (i in 1:n.sim){
n.apol <- 1000
for (j in idade.atual:(idade.atual+temp-1)){
mortes <- rpois(1,n.apol*qx[j])
# VPF da perda na data do contrato
loss.50[i] <- mortes*benefit*(v^(j-50+1))
n.apol <- n.apol-mortes
S[i] <- S[i]+loss.50[i]
}
}
n.apol<-1000
mean(S)## [1] 423304.8 premio.ind<-mean(S)/n.apol
premio.ind## [1] 423.3048 S <- S/1000
# histograma/densidade 1
ggplot(data.frame(S), aes(x = S)) +
geom_histogram(color = "gray", fill = "gray", alpha=0.7, position = 'identity') +
scale_fill_manual() +
theme_bw() + labs(title="Simulação dos Valor Presente futuro da Obrigação Agregada, n = 10.000",
x ="Valor presente agregado, em milhares", y = "Distribuição do Valor presente agregado")
4. Através da Simulação Bootstrap não paramétrica, construa um intervalo de confiança (α = 5%) para a média do VP financeiro da obrigação calculado na questão anterior. Você deve considerar uma amostra aleatória com 20 elementos. A quantidade de reamostragens deve ser igual a 100. Você pode escolher simular no R ou Excel.
Simulação Bootstrap – Método não paramétrico Amostra escolhida.
# amostra <- loss.50[1:20], Usar quando o arquivo tiver unido
amostra <- loss.50[1:20]
bootstrap <- function (amostra, B, alpha){
amostra <- amostra
size <- length(amostra)
mediasB <- rep(0,B)
amostraB <- rep(0,size)
for (i in 1:B){
for (j in 1:size){
y <- trunc(runif(1)*size) + 1
amostraB[j] <- amostra[y]
}
mediasB[i] <- mean(amostraB)
}
ordem <- sort(mediasB)
q1 <- quantile(ordem, alpha/2)
q2 <- quantile(ordem, 1-alpha/2)
cat("\n Média da Amostra inicial.\n")
print(mean(amostra))
cat("\n Médias das ",B,"reamostras Bootstrap.\n")
print(mediasB)
icb <- round(c(q1,q2),2)
cat("\n Intervalo Bootstrap com ",(1-alpha)*100,"% de confianca, usando",B,"reamostras.\n")
print(icb)
}
x = bootstrap(amostra, 100, 0.05)##
## Média da Amostra inicial.
## [1] 85934.69
##
## Médias das 100 reamostras Bootstrap.
## [1] 82945.66 87802.84 84066.54 93407.27 87429.21 98264.45 92660.01 85934.69
## [9] 88176.46 87802.84 96769.93 84813.80 79956.62 87055.58 95649.05 81824.77
## [17] 80703.88 90791.87 92660.01 79583.00 89670.98 91165.50 76967.59 83319.29
## [25] 91165.50 88923.72 84813.80 85561.06 87429.21 79956.62 92286.38 82198.40
## [33] 78462.11 89297.35 92286.38 76593.96 81451.14 87802.84 88923.72 90044.61
## [41] 82945.66 88176.46 79583.00 86308.32 87055.58 87055.58 82198.40 87055.58
## [49] 81077.51 83319.29 89297.35 86681.95 92660.01 91539.13 86681.95 83692.92
## [57] 85934.69 88923.72 85934.69 86308.32 82198.40 78462.11 79583.00 84066.54
## [65] 78088.48 78835.74 83319.29 91165.50 81824.77 84813.80 83319.29 84440.17
## [73] 87802.84 88550.09 88176.46 85561.06 75473.08 87429.21 82198.40 88550.09
## [81] 83692.92 84440.17 90791.87 88550.09 82945.66 87802.84 78462.11 85187.43
## [89] 86308.32 88550.09 86681.95 83319.29 92660.01 76593.96 84813.80 83319.29
## [97] 80330.25 91165.50 81077.51 85934.69
##
## Intervalo Bootstrap com 95 % de confianca, usando 100 reamostras.
## 2.5% 97.5%
## 76771.44 94584.20