PROVA I

Questões:

1. Como é a sintaxe geral de uma função customizada? Crie um exemplo.

Resposta: sintaxe da funçao : \(nome <- function(elemnto1,...elemento n){comandos da funçao}\)
Exemplo : Uma função que, dado dois valores, retorna o maior entre eles.

maior = function (a,b) {

     if (a < b) {

         return (b)

      } else { 

      return (a)

      }

}
maior(5,20)
## [1] 20

2. Escreva uma função que substitua todos os valores faltantes em um vetor de dados pela média de todos os dados presentes.
Por exemplo, ao considerar o vetor:
\(a <- c(1,2,3,NA,4,5,NA,NA)\)

A resposta esperada é:

\(1, 2, 3, 3, 4, 5, 3, 3\)

Resposta:

valor_ausente <- function(x){
  a <- mean(x,na.rm = T)
  b <- replace(x,list = is.na(x),values = a)
  return(b)
}

q <- c(1,2,3,NA,4,5,NA,NA)
valor_ausente(q)
## [1] 1 2 3 3 4 5 3 3

3.Sendo \(H = 1/1 + 3/5 + 9/25 + 27/125 + · · ·\), construa a função H, de argumento n, que calcula o valor da série H com n termos.

Resposta:

h <- function(n){
  somar <- sum((3^n)/(5^n))
  return(somar)
}

h(0)
## [1] 1

4. Construa a função wg_mean em linguagem R que calcula a média geométrica ponderada(weighted geometric mean) de um vetor x = (x1, · · · , xn) com pesos w = (w1, · · · , wn) e retorna uma mensagem de erro se algum elemento de x ou w for negativo ou nulo. A média geométrica ponderada de x = (x1, · · · , xn) com pesos w = (w1, · · · , wn) é calculada por:
\[ wg_mean = (\prod_{i=1}^{n}xi^wi)^1/\sum_{i=1}^{n}wi \]

ou

\[ wg_maean = exp\left\{ \frac{\sum_{i=1}^{n}w_ilog_exi}{\sum_{i=1}^{n}w_i}\right\} \]

Sugestão: considere a função any() e stop().

Resposta:

wg_mean  <- function(x,y){
  if(any(x <= 0)) stop("apenas valores >0.")
  media <- prod(x^y)^(1/length(y))
  return(wg_mean  = media)
}
n <-(c(2,3,5))
p <- (c(9,6,3))
wg_mean(n,p)
## [1] 360

5. Mostrar os comandos que podem ser usados para criar as sequências: [1] 2.00 2.75 3.50 4.25 5.00
[1] 0.0000000 0.8333333 1.6666667 2.5000000 3.3333333 4.1666667 5.0000000
[1] 1 1 1 2 2 3
[1] 0 0 1 1 2 2 2
[1] 0 5 5 10 10 10 15 15 15 15 20 20 20 20 20

Resposta:

seq(2,5,by = 0.75) #(a)
## [1] 2.00 2.75 3.50 4.25 5.00
(0:6)*(5/6)#b
## [1] 0.0000000 0.8333333 1.6666667 2.5000000 3.3333333 4.1666667 5.0000000
rep(1:3,times=3:1)#c
## [1] 1 1 1 2 2 3
rep(0:3, each = 2)#(d)
## [1] 0 0 1 1 2 2 3 3
x <- seq(0,20, by = 5)#(e)
y <- rep(x, times = 1:5)
y
##  [1]  0  5  5 10 10 10 15 15 15 15 20 20 20 20 20

6.A sequência de Fibonacci é definida por: \[ f_1=1 \] \[ f_2=1 \] \[ f_n = f_n-1+f_n-2, n>2 \]

Por Exemplo, para \(n = 3\), tem-se, \(f_3=f_3-1 +f_3-2 = f_2 +f_1 = 1+1 = 2\) ou então para \(n= 4\) tem-se \(f_4 = f_4-1 + f_4-2 = f_3+f_2 = 2+1 = 3\), e assim sucessivamente, resultando na sequência: 1,1,2,3,4,8,13,…

  1. Dada a definição da sequência de fibonacci, construa uma função em R que calcule e mostre n valores da sequência de fibonacci. Sendo n um argumento da função.
    Resposta:
seqfi<- function(n){
  x <- c(0,1)# para definir os 2 primeros termos, geralmente (0,1)
  for(i in 3:n) x[i] = x[i-1] + x[i-2]
  return(x)
}
seqfi(10)
##  [1]  0  1  1  2  3  5  8 13 21 34

7. Descreva a função a seguir linha por linha. O que ela calcula?

tri_ret <- function(n){
is.integer2 <- function(n) n %% 1L == 0
n <- n %/% 1L
if(n < 4) stop("Considere n maior que 4.")
catetos <- combn(n, 2)
hipotenusas <- sqrt(apply(catetos^2,2,sum))
triangulos <- data.frame(cat1 = catetos[1,],
cat2 = catetos[2,],
hip = hipotenusas)
triangulos <- triangulos[is.integer2(triangulos$hip),]
return(triangulos)
}
tri_ret(7.5)
##    cat1 cat2 hip
## 12    3    4   5

Resposta:

tri_ret <- function(n){# mostra os argumentos da funcao 
  is.integer2 <- function(n) n %% 1L == 0 # vai verificar o resto, se e o numero e inteiro
  n <- n %/% 1L # se for interio se tem o mesmo valor
  if(n < 4) stop("Considere n maior que 4.") # se o valor de n for menor que 4 retornara um erro
  catetos <- combn(n, 2) # combinaçao de n com 2
  hipotenusas <- sqrt(apply(catetos^2,2,sum))# Realiza o calculo da hipotenusa com a combinaçao de n com 2
  triangulos <- data.frame(cat1 = catetos[1,],# data frame onde o cat1 representa o cateto 1 e esta na priemira coluna
                           cat2 = catetos[2,],# cateto 2 na segunda coluna
                           hip = hipotenusas)# hipotenusa na terceira coluna
  triangulos <- triangulos[is.integer2(triangulos$hip),] # separa os valores inteiros
  return(triangulos) # mostra a soma dos lados dos triagulos , a hipotenusa e os catetos em uma tabela/data frame
}

Quando Colocarmos um n<4 dará erro, por conta da condição imposta na função.

tri_ret(20) # n = 20
##     cat1 cat2 hip
## 38     3    4   5
## 77     5   12  13
## 87     6    8  10
## 119    8   15  17
## 127    9   12  15
## 158   12   16  20
## 180   15   20  25

Resultado da Tabela

a funçao calcula a soma dos lados de um triangulo retangulo,com valores de n>4.

PROVA II

1.Uma variável aleatória contínua X tem distribuição Dagum de parâmetros a, b e p se a função de distribuição acumulada de X for \[ F(x) = \left(1+\left(\frac{x}{b}\right)^{-a}\right)^{-p} \] em que a, b, p > 0 e x > 0. Construa a função ’rdagum“ em linguagem R que gera n realizações da distribuição Dagum(a, b, p) utilizando o método da transformação inversa.

Resposta:

rdagum <- function(n,a,b,p){
  u <- runif(n)
  x <- (b*(u^(-1/p)-1)^(-1/a))
  return(x)
}
set.seed(123)
rdagum(3,0.5,0.5,0.5)
## [1] 0.004064131 1.347235551 0.020171982

2.Uma variável aleatória contínua X tem distribuição exponencial exponencializada (EE) de parâmetros λ e α se a função de distribuição acumulada de X for \[ F(x,\lambda,\alpha) = \left(1-e^{-\lambda x}\right)^\alpha \] em que x > 0, λ > 0 e α > 0.

Construa a função ree em linguagem R que gera n realizações da distribuição EE(λ, α) utilizando o método da transformação inversa.

Resposta:

ree <- function(n,lambda,alpha){
  u <- runif(n)
  x <- (-log(1-u^(1/alpha))/lambda)
  return(x)
}
set.seed(123)
ree(3,2,2)
## [1] 0.3842184 1.0940281 0.5101497

3.Utilize o método aceitação e rejeição para gerar realizações da distribuição Beta(4,3), cuja função densidade é: \[ f(x) = 60x^3(1-x)^2 , 0<x<1 \]

Resposta:

#função Beta (4,3)

fbeta<- function(n){
  beta <- NULL
  while(length(beta) < n) {
    x <- runif(1)
    u <- runif(1)
    if (u <= (60*x^3*(1-x)^2)/2.0736) beta <- c(beta, x)
  }
  return(fbeta = beta)
}
set.seed(123)
fbeta(10)
##  [1] 0.9404673 0.5281055 0.5514350 0.6775706 0.2460877 0.6557058 0.5440660
##  [8] 0.2891597 0.6907053 0.7584595

4.Utilize o método aceitação e rejeição para gerar realizações da distribuição Gama(3/2,1), cuja função densidade é: \[ f(x) = \frac{2}{\pi}x^{1/2}e^{-x} , x>0 \]

No método aceitação e rejeição, considere a distribuição exponencial de média 3/2, ou seja, de função densidade:
\[ g(x) = \frac{2}{3}e^{\frac{-2x}{3}}, x>0 \]

Resposta:

# função Gama


fgama <- function(n){
  gama <- NULL
  while(length(gama) < n) {
    x <- runif(1)
    u <- runif(1)
    if (u <= (sqrt(2*exp(x))/exp(x))) gama <- c(gama, x)
  }
  return(fgama = gama)
}
set.seed(123)
fgama(10)
##  [1] 0.2875775 0.4089769 0.9404673 0.5281055 0.5514350 0.9568333 0.6775706
##  [8] 0.1029247 0.2460877 0.3279207

PROVA III

1.Calcule as integrais utilizando o método de Monte Carlo.

a.\(\int_0^2 e^{-x}dx.\)

b.\(\int_0^5 \frac{x}{(x^2+2)^1/3}\)

c.\(\int_0^2 \sqrt{x}-log(1/x^2)dx.\)

d.\(\int_0^1 \frac{e^x-1}{e^x+1}dx.\)

e.\(\int_0^\infty xe^{-x}dx.\)

Respostas:

A) a = 0 , b = 2

# A) a = 0 , b = 2
I.exp <- function(a,b, n = 100){
   x = runif(n,a,b)
   y = exp(-x)
   I = (b-a)*mean(y)
   return(I)
   }
 set.seed(123)
 I.exp(0,2)
## [1] 0.8615495

B) a = 0 b =5 

#B) a = 0 b =5 
I.fr <- function(a,b,n=100){
  x = runif(n,a,b)
  y = x/(x^(2)+2)^1/3
  I = (b-a)*mean(y)
  return(I)
}
set.seed(123) 
I.fr(0,5)
## [1] 0.4417603

C) a = 0 b = 2

# C) a = 0 b = 2
I.rz <- function(a,b,n = 100){
  x = runif(n,a,b)
  y = (x^(1/2)- log(1/x^(2)))
  I= (b-a)*mean(y)
  return(I)
}
set.seed(123)
I.rz(0,2)
## [1] 0.6984973

D) a = 0 b = 1

# D) a = 0 b = 1
I.exp2 <- function(a,b,n = 100){
  x = runif(n,a,b)
  y = ((exp(x)-1)/(exp(x)+1))
  I = (b-a)*mean(y)
  return(I)
}
set.seed(123)
I.exp2(0,1)
## [1] 0.2396981

E) a = 0 b = \(\infty\)

# E) a = 0 b = +00
## gerar valores Rexp(1)com parametro lambda = 1
set.seed(123)
x <- rexp(100, rate = 1)
mean(x)
## [1] 1.045719
# calcular a probabilidade da dist exponencial com lambda = 1
# exemplo com P(1<X<3)
set.seed(123)
n <- 100
x <- rexp(n, rate = 1)
y <- x > 1 & x < 3
sum(y)/n
## [1] 0.42
# Probabilidade exata 
pexp(3) - pexp(1)
## [1] 0.3180924

2.Considerando o método bootstrap não paramétrico e os dados referentes ao tempo de vida, em dias, de n = 20 insetos, obtenha intervalos de 95% de confiança para a média. Utilize o IC de bootstrap que preferir. \[ \overline{6,63 3,31 1,86 9,51 4,98 0,58 1,50 0,48 1,04 0,30 3,15 5,36 12,58 2,03 0,60 0,45 3,60 7,83 1,38 1,93} \]

Resposta:

dados<-c(6.63,3.31,1.86,9.51,4.98,0.58,1.50,0.48,1.04,0.30,
3.15,5.36,12.58,2.03,0.60,0.45,3.60,7.83,1.38,1.93)
hist(dados)

Calculando a média

mean(dados)
## [1] 3.455

bootstrap não paramétrico

B <- 2000
dist.mean<-NULL
for(i in 1:B){
  #Reamostragem do vetor dos dados
  amostra<-sample(dados,replace = TRUE)
  dist.mean<-c(dist.mean,mean(amostra))
}
dist.mean
##    [1] 3.3110 3.5195 3.1205 2.7560 3.9175 5.0385 2.2865 3.8790 2.2070 4.7090
##   [11] 3.3855 3.3145 2.1710 2.0445 2.1455 3.2400 3.9065 4.4225 2.6390 3.7850
##   [21] 3.0520 4.0390 3.1050 2.7730 1.8485 3.6370 2.6145 4.9710 3.1435 2.9985
##   [31] 2.6675 2.7680 5.3140 3.2885 2.5935 4.5915 3.6470 2.8940 3.3180 3.7020
##   [41] 2.7225 3.3205 3.7485 3.4910 3.7985 2.8930 4.0110 1.9405 3.0450 4.2345
##   [51] 3.6480 3.3785 2.9705 3.9130 3.5745 2.9580 2.5570 3.6775 3.3770 2.4690
##   [61] 3.8190 3.3125 2.9820 4.4845 2.9080 5.1725 2.8910 3.1760 2.4840 3.7590
##   [71] 2.9130 3.2470 3.2365 2.9170 3.0295 2.9870 3.3835 2.5880 3.5100 3.7060
##   [81] 2.7795 3.1120 3.1965 2.7760 3.3580 4.3310 3.4795 2.1135 2.9120 3.0315
##   [91] 4.1360 2.8615 3.1045 3.1475 3.9700 2.3895 2.9575 2.7175 2.2540 4.3205
##  [101] 3.3575 3.2635 3.1075 3.4835 3.8470 3.2895 3.4960 3.3110 4.0780 2.9170
##  [111] 3.3900 4.4050 4.1900 4.1120 1.9040 4.0685 3.8170 4.0420 3.4615 4.7225
##  [121] 3.2060 4.0550 2.5730 2.7240 3.5420 4.2680 3.9380 3.9100 4.5035 2.5940
##  [131] 2.4705 3.5625 3.9985 3.3185 2.8500 3.8705 3.9320 4.1915 3.9650 3.8525
##  [141] 3.6095 3.4350 2.3705 3.0930 2.5275 2.7930 3.8375 2.5760 4.3170 4.5740
##  [151] 2.9495 3.3230 3.0665 2.3690 3.2505 5.0100 3.8225 3.6505 3.2780 3.3315
##  [161] 4.4885 3.6350 2.5485 4.9915 3.7075 3.2360 3.3610 3.8540 3.0770 3.5215
##  [171] 3.6735 4.4580 4.5290 4.5130 3.9165 3.7040 3.1570 3.6995 3.2295 3.5080
##  [181] 5.3860 1.9990 2.6005 4.2855 4.1970 4.3025 3.6475 2.6295 5.4195 4.2490
##  [191] 1.8130 4.4265 3.8080 4.1285 3.8915 3.2355 4.1860 5.0340 3.6245 3.3365
##  [201] 2.7975 3.4850 3.1310 2.4005 2.7905 3.4175 3.8130 4.1495 4.0180 1.9930
##  [211] 2.4680 3.7740 2.8340 2.6115 3.1320 3.5220 3.2525 3.5435 4.1600 3.6530
##  [221] 3.4550 3.0725 2.8725 4.3655 4.4565 4.3920 2.2935 2.3460 2.8935 3.6005
##  [231] 2.9170 2.5880 3.9525 4.3095 3.9180 3.2125 4.3065 2.8380 3.3095 3.5835
##  [241] 2.0860 3.8600 2.9230 2.3590 4.2790 3.6425 1.8900 3.3790 2.7470 3.3705
##  [251] 4.9110 2.7860 4.1885 2.1420 3.2595 2.7745 2.9690 3.3835 3.9900 2.7465
##  [261] 3.3230 3.3985 4.5530 3.3635 3.5735 3.7830 4.0085 3.9100 3.3215 3.5520
##  [271] 2.4640 4.1920 2.9080 3.4565 2.6305 4.3520 3.0560 3.4560 3.0180 3.4375
##  [281] 2.9600 2.6680 2.5540 3.6440 2.7530 3.5700 2.2145 3.6915 3.4345 2.6670
##  [291] 3.3265 3.1080 2.6650 5.1415 3.2185 4.3190 3.3485 4.3505 4.4725 4.6145
##  [301] 3.4585 3.3965 5.2260 2.9490 4.8130 3.8050 3.1890 2.8620 3.2080 3.0160
##  [311] 3.9150 3.4795 2.9130 4.1785 2.9545 2.6795 2.7415 3.5545 3.9715 2.2310
##  [321] 3.5720 2.3300 3.0740 4.3875 4.9310 3.0100 3.0285 4.5550 2.0205 3.0555
##  [331] 3.5960 4.4285 3.7395 3.5140 3.9365 2.9840 3.2370 3.2860 2.9375 3.4755
##  [341] 5.1340 3.4725 3.4185 2.9135 3.4560 4.2215 3.7795 2.3685 4.2225 3.2585
##  [351] 3.0585 4.1875 3.2465 3.8040 4.6820 4.1425 3.0410 3.0340 1.7140 3.3065
##  [361] 3.8930 4.0045 2.3215 3.4860 2.9350 3.0550 2.0040 3.0275 2.7995 2.7960
##  [371] 2.0930 4.5485 2.6290 3.4715 3.3815 3.6760 2.9200 3.8540 3.6900 3.9105
##  [381] 2.7350 3.3725 2.5530 2.7380 2.8050 4.4730 3.7400 3.0965 2.7030 3.1655
##  [391] 4.9060 3.7905 2.9860 3.7365 2.9095 4.2875 2.8855 2.5865 4.8445 3.0635
##  [401] 3.2185 2.7340 4.2915 3.6335 4.1845 2.4770 3.7635 2.8795 4.0865 3.4770
##  [411] 3.3830 3.5785 3.1005 4.0925 4.2760 4.4560 3.5895 3.8840 3.2665 2.9500
##  [421] 3.7090 2.4780 4.0790 3.2065 2.9730 4.0135 4.1140 2.3520 3.0495 2.9075
##  [431] 4.1775 3.6555 2.9100 3.7440 2.1720 2.0525 3.0210 3.2955 2.9355 3.2025
##  [441] 3.0240 2.9830 4.5705 2.8400 3.6475 4.0710 3.2360 4.1135 2.8960 3.4525
##  [451] 2.4285 2.6410 3.1960 2.5645 3.2655 3.9440 3.2090 3.9635 3.7290 3.0895
##  [461] 2.8890 4.0115 4.1910 3.4550 4.5695 3.1395 3.2870 2.5150 2.9735 4.0730
##  [471] 4.6660 3.3580 1.9925 3.9845 3.6335 4.4390 3.8160 3.4175 3.7670 3.2625
##  [481] 3.8695 3.8735 2.7860 3.6435 4.0435 3.8690 3.4080 4.1665 2.6855 4.2085
##  [491] 4.2435 4.7775 5.0430 4.0170 3.0865 4.3430 2.6150 3.5945 4.1845 3.1095
##  [501] 3.9685 3.7340 2.8335 3.3095 4.3930 3.5975 5.2645 4.6385 5.0840 2.2290
##  [511] 4.0720 3.0980 4.1755 2.4355 2.9585 2.5315 2.4815 2.9725 3.7335 2.6750
##  [521] 3.2500 2.6475 4.2350 2.5925 3.1590 4.3485 2.8570 3.7730 3.3490 3.0295
##  [531] 4.2430 3.4545 5.3910 3.4300 3.9150 3.9105 2.7245 4.1300 3.1160 3.1860
##  [541] 4.8165 3.5060 6.0475 3.8750 3.8410 3.4535 3.4565 4.2350 2.3180 4.0590
##  [551] 2.5010 2.7685 2.6915 2.5070 2.7765 5.2840 3.2915 3.3830 2.3700 2.7160
##  [561] 2.9470 2.9955 3.4040 2.0755 4.4385 2.5520 3.4535 4.3525 4.4705 2.6510
##  [571] 3.1290 3.4780 2.1840 2.6265 4.9930 2.8350 3.7610 2.9645 4.3350 2.4970
##  [581] 3.3350 3.2875 2.9835 3.7425 3.8965 2.9520 3.5770 2.9560 3.3290 2.8620
##  [591] 2.6955 3.5515 2.4585 4.5250 3.9630 2.6390 3.4430 3.5880 4.1935 2.6635
##  [601] 4.2480 3.7295 3.0715 3.5050 4.0195 2.5680 2.5485 4.4555 4.1255 3.5500
##  [611] 3.4000 3.8410 2.6545 3.3385 3.7320 3.0900 4.0495 3.5835 2.9350 2.5010
##  [621] 2.8100 4.0355 3.7650 2.5310 3.0315 4.5580 2.3630 2.4275 2.7815 2.9755
##  [631] 4.9190 3.2020 3.9350 4.3305 4.0745 4.3365 2.8915 1.9320 3.0995 4.9065
##  [641] 2.4880 2.7390 3.3640 4.0775 4.4470 3.7075 2.4780 3.0335 3.1090 3.1470
##  [651] 2.6590 4.1200 3.5945 2.8565 3.8500 3.5050 3.6460 3.4390 2.4800 3.1380
##  [661] 2.5685 3.2180 2.7530 4.1760 3.5545 2.4260 4.1335 3.2410 3.8920 3.7600
##  [671] 2.1940 3.6005 3.3445 2.6495 2.8655 3.6380 2.5935 2.4720 3.8555 3.2630
##  [681] 2.8130 2.5075 3.2525 2.5080 4.0475 3.3760 4.0125 3.3090 2.9090 2.5555
##  [691] 2.8030 4.2780 4.7235 3.1270 2.8500 2.7840 3.6115 4.4035 5.0925 2.9955
##  [701] 3.3660 2.6285 3.0085 4.5720 3.9060 3.5265 2.7815 3.4625 4.6315 2.6065
##  [711] 3.0695 3.9395 4.1030 3.2940 2.8180 3.4995 4.4920 2.7205 2.7645 4.2600
##  [721] 4.6435 2.9440 3.0920 3.0610 3.8040 3.5585 3.9490 3.2740 3.5805 3.4350
##  [731] 5.3385 2.6125 3.6985 3.4385 3.0430 3.1360 3.7445 4.4425 3.8380 4.6070
##  [741] 3.2305 3.6245 4.4605 3.5965 3.7740 5.6200 2.9065 3.3115 3.4805 3.6885
##  [751] 3.8685 3.3380 3.0490 4.1990 3.7235 3.1715 2.5185 3.6425 3.4300 3.7715
##  [761] 3.0410 3.7890 4.4115 3.3740 3.8100 3.3705 2.5035 2.9735 2.7825 2.7155
##  [771] 3.8010 5.2195 3.0515 3.2120 2.9010 3.7040 3.8240 2.9825 3.5350 3.1925
##  [781] 2.4350 4.7190 3.3770 3.3640 2.0055 2.5465 2.4745 3.6125 4.5305 2.2585
##  [791] 4.9550 3.3550 2.6905 2.2950 4.1985 3.9015 3.7560 2.8505 4.7025 2.7320
##  [801] 4.2490 2.9465 2.6520 3.9750 3.8300 4.1370 3.4605 4.1020 3.5425 4.0590
##  [811] 3.3680 4.0780 2.9825 3.2660 2.7055 4.4450 4.6265 4.7030 4.3350 2.3415
##  [821] 4.0035 3.0995 3.8850 3.7490 2.7345 3.0145 3.5420 3.8880 2.3905 3.1710
##  [831] 3.5295 3.6455 4.2505 3.1675 2.8745 4.7070 4.3870 2.8805 2.8625 2.1250
##  [841] 3.7100 4.7005 5.3150 3.3705 3.2915 5.1940 2.9500 3.0575 2.6640 2.8330
##  [851] 4.3705 3.3595 3.4370 4.7510 2.1000 3.7570 3.0740 2.2245 3.4590 3.3115
##  [861] 4.3105 2.3080 4.6620 2.6385 5.9235 2.9550 3.9810 2.0645 3.3940 3.2670
##  [871] 3.0160 4.4450 2.7395 2.0630 4.1290 3.0790 3.9865 5.0065 3.7070 4.7770
##  [881] 2.6205 2.4360 2.1895 2.6130 2.7855 4.4945 2.9815 3.3205 4.3295 2.5965
##  [891] 4.5415 4.5570 3.0665 3.1885 4.2220 4.1645 3.5730 3.6085 5.1490 3.0570
##  [901] 2.2725 4.2450 4.1005 2.3555 4.1690 2.7255 3.6545 4.2030 4.2555 2.0180
##  [911] 3.9565 4.2110 3.3610 3.6230 3.1620 2.6050 3.2630 3.4305 3.6265 3.7515
##  [921] 2.5040 3.4910 3.6895 2.5945 3.0020 2.5270 3.6130 5.9225 4.0920 3.8720
##  [931] 5.0040 2.2270 3.5995 3.6695 3.0800 2.9945 2.6955 2.7625 3.8805 3.1290
##  [941] 2.9980 4.3050 3.2360 3.5755 3.2500 4.0005 3.4530 2.5330 1.7160 3.0130
##  [951] 3.7165 4.2550 3.1690 2.8860 2.9665 3.5540 3.4050 4.7900 3.4180 3.9165
##  [961] 2.7215 3.1730 4.3575 2.7700 3.4690 5.0320 3.0760 2.9075 2.9240 4.3300
##  [971] 3.8920 3.6885 3.6605 3.8270 3.2675 4.6180 3.9680 3.0160 4.2455 3.1940
##  [981] 2.8725 4.0615 3.9390 4.3245 4.9010 4.6350 3.2785 2.5530 2.5805 4.3570
##  [991] 2.4360 3.9170 2.4585 5.5525 4.2585 3.2910 2.4390 2.9650 4.0620 4.4380
## [1001] 3.4750 3.7325 3.3825 4.5920 3.1735 3.1280 4.0425 3.6855 3.7325 3.8275
## [1011] 3.3565 3.5855 2.9160 5.1240 4.7135 2.7650 4.2520 4.5030 4.8005 4.4135
## [1021] 3.3385 3.9015 1.8895 2.5325 4.2715 2.1230 2.1790 3.6620 4.2925 3.5160
## [1031] 2.9670 2.7670 2.6990 4.6620 3.5065 3.5015 2.8810 4.6140 5.6440 3.7890
## [1041] 2.8200 2.4530 3.2970 2.8505 4.0685 4.0755 3.6950 3.9630 4.1565 4.0800
## [1051] 2.4940 4.1685 4.0485 4.6835 3.6270 1.7385 2.9185 4.4920 5.6035 3.7825
## [1061] 3.6515 3.3795 3.4300 1.9230 3.8875 3.8380 6.3785 2.4945 3.3410 4.4245
## [1071] 4.6375 3.6260 2.1050 3.4750 4.5745 5.2265 4.0330 4.2250 3.4470 4.8395
## [1081] 3.4670 3.0655 3.0220 2.4110 2.6510 4.3120 3.3635 3.9555 3.6395 3.9235
## [1091] 3.0940 2.9590 3.5630 4.1505 3.9140 3.2810 4.2880 3.9895 3.1940 3.0935
## [1101] 2.6840 3.5430 3.7220 3.3920 3.1425 3.7505 3.2235 3.9690 2.5875 3.6440
## [1111] 4.5395 3.3350 3.7190 4.3895 5.3260 3.3750 2.7065 3.1175 2.5490 2.2380
## [1121] 2.5560 3.4945 3.9040 4.9205 1.8320 1.6530 3.2735 3.3270 3.0500 3.1850
## [1131] 4.8860 4.5240 3.2650 3.4755 4.1550 3.9005 3.0435 2.8135 3.5980 2.9125
## [1141] 2.5275 3.1850 2.7930 3.4520 3.4015 3.4445 2.0295 2.4925 3.8720 2.3410
## [1151] 4.6160 2.0375 4.1140 3.1210 3.2440 3.2785 3.0815 6.0765 3.0520 4.6645
## [1161] 2.8805 3.2055 2.7545 3.9860 2.7870 5.0865 3.1940 2.8935 3.8105 3.7000
## [1171] 3.0505 4.0455 4.0035 2.8245 3.0355 4.1350 3.2565 3.8370 3.6170 3.3335
## [1181] 3.1305 2.6615 3.6405 2.2850 4.0980 4.3810 3.5150 3.0445 4.1340 2.7635
## [1191] 3.0440 3.6705 3.0030 3.3880 3.0565 3.3705 4.6095 4.5600 2.4480 4.6690
## [1201] 3.3520 2.1360 3.0510 3.5405 3.4655 3.5745 2.1745 2.5560 3.6000 3.6120
## [1211] 4.6565 3.8385 2.8000 2.4765 4.9050 3.0870 1.6190 3.2955 3.6480 3.1615
## [1221] 1.8725 3.7115 3.5360 2.8820 3.0630 3.3020 3.4095 2.3395 3.1000 2.7175
## [1231] 4.2430 3.3270 3.5375 5.1975 3.7020 4.7180 3.0425 4.7245 3.4675 2.6985
## [1241] 3.5540 4.8685 3.7250 2.9750 3.6745 3.1035 3.5840 3.2130 3.7265 3.9995
## [1251] 2.8080 2.7755 3.4725 3.6625 3.6000 3.9770 1.9910 3.9305 3.2325 3.0405
## [1261] 3.1795 4.3070 3.1680 2.8940 1.5865 5.0320 3.8385 3.0470 3.7395 2.2775
## [1271] 3.6515 3.5215 5.2495 3.3850 3.4765 3.5760 3.3580 4.4025 3.1990 3.1160
## [1281] 3.6280 4.6910 2.8965 3.4870 2.1260 2.3855 3.7320 3.2080 2.9425 3.7450
## [1291] 3.1670 3.4755 4.3465 3.4465 3.3070 2.7965 3.6065 4.1860 3.4500 3.8050
## [1301] 3.0215 4.9535 3.5670 3.7870 2.7015 2.8245 3.6390 4.6760 2.3275 4.0070
## [1311] 3.7630 3.7700 4.2070 2.9790 4.1250 4.6545 2.8080 3.8295 3.7570 3.0225
## [1321] 3.5700 4.1425 4.4990 3.3740 2.2975 3.0785 4.2640 3.0835 3.3805 2.9775
## [1331] 4.0500 4.2210 4.3815 4.6240 3.8500 4.1035 3.4860 3.8505 2.9740 5.1945
## [1341] 3.4505 4.0820 3.3835 3.3190 3.3780 2.7695 2.8965 3.6355 2.5530 3.6390
## [1351] 3.1410 4.6320 4.3265 2.9220 2.4270 3.3735 4.0555 2.2670 3.3140 2.5865
## [1361] 3.2145 3.4840 3.5445 4.0265 3.0300 3.9390 3.1865 3.5415 3.9280 4.3815
## [1371] 3.2080 4.2640 2.7215 3.4585 4.4670 3.6765 3.8465 3.4340 4.2010 4.5960
## [1381] 3.3040 4.8445 3.1755 1.9690 3.4155 3.3620 2.7895 3.7625 3.4790 3.6095
## [1391] 3.0060 2.9705 2.1290 3.4120 3.9800 3.4120 4.0150 3.0225 4.3480 3.5620
## [1401] 2.9080 1.9215 4.1160 4.1155 3.1755 1.7800 4.0135 3.2290 2.7555 3.4390
## [1411] 2.1670 4.1550 3.3490 3.9725 2.9800 3.6590 4.6150 3.5675 3.9660 5.0170
## [1421] 3.6625 3.2860 3.0900 2.1940 2.9005 2.2290 3.5510 2.4445 3.3000 3.1055
## [1431] 5.1485 4.6360 4.2575 3.3600 3.4045 4.0030 3.3360 4.0030 4.4375 2.6285
## [1441] 3.1455 2.8485 3.4020 2.6230 2.5975 2.7640 5.2280 2.9840 3.8915 3.1390
## [1451] 3.8405 4.6175 3.6130 3.9180 2.5635 4.5960 2.3565 2.8955 3.7925 3.6315
## [1461] 4.9050 3.9780 3.4470 4.0495 4.1055 3.2905 2.2160 3.6125 2.8390 3.2345
## [1471] 3.4590 4.1485 3.1490 4.1980 3.6195 3.9860 3.8690 2.6425 4.3015 3.2355
## [1481] 3.3785 3.5720 4.5790 4.8295 3.0370 4.7890 3.7180 3.5265 3.5205 1.4545
## [1491] 3.4850 3.0650 4.2520 2.9055 3.8135 4.0555 3.4645 3.0240 1.8345 3.1465
## [1501] 4.1760 2.9610 4.1190 2.5025 3.2365 3.2330 2.7845 3.8255 2.6790 3.8250
## [1511] 2.7050 2.8235 3.8880 3.0940 3.7165 4.8435 2.3755 3.4090 3.3235 2.8275
## [1521] 3.5715 3.1840 2.9280 3.7690 4.0435 2.6600 3.9690 4.5335 2.8055 4.7010
## [1531] 5.1490 3.1160 3.1665 5.2230 3.9315 2.6720 3.5615 4.7005 4.0600 3.9510
## [1541] 4.1125 3.5915 3.2025 3.6695 2.7150 4.1315 3.3235 3.9345 2.7470 3.4900
## [1551] 2.5440 4.7815 3.7855 4.6735 2.2880 3.4870 3.6915 3.0730 1.8880 3.6725
## [1561] 3.8830 3.0430 2.8475 4.3185 2.9535 2.7715 2.6550 2.2655 3.2110 4.4895
## [1571] 3.5955 3.1855 3.9120 2.9150 3.0680 3.5360 3.8945 2.8105 3.4405 3.6380
## [1581] 4.8600 5.3565 3.6370 3.3180 4.4360 3.6270 5.2245 2.9755 3.5790 2.7840
## [1591] 2.9520 3.0315 2.7990 2.8170 4.0250 3.8575 5.2940 3.7095 2.5460 2.3630
## [1601] 3.7065 3.2425 3.3740 3.4285 3.7450 3.9460 3.3765 2.9635 2.8650 2.9550
## [1611] 3.0190 2.6125 3.1895 3.5235 3.4705 2.9585 3.2675 4.9350 3.8920 4.7695
## [1621] 3.3520 3.0875 3.4405 3.0805 2.4450 3.7245 3.5765 2.9925 3.0590 3.2220
## [1631] 3.5935 2.4770 3.1510 3.0240 2.9865 2.8295 3.0200 4.1025 4.5840 2.9120
## [1641] 3.4380 4.5020 4.3940 2.6690 1.9210 3.4550 4.3625 3.5775 3.7645 2.5630
## [1651] 2.1780 3.7905 3.9585 3.5940 3.5015 5.1580 3.1245 4.3685 3.2180 4.4345
## [1661] 3.2090 3.4745 3.2385 3.4770 4.4025 2.4425 3.2535 4.2065 2.4725 3.8450
## [1671] 3.1890 3.2945 2.7505 2.8485 3.0325 3.4545 2.4255 4.0615 3.4515 3.2775
## [1681] 2.4980 4.6125 2.6010 4.1425 4.7360 3.6105 4.3585 3.2345 2.3865 4.8475
## [1691] 3.6390 2.5930 2.7155 3.8670 4.3690 3.0240 4.0025 3.0490 2.7325 4.4580
## [1701] 3.2680 2.9985 3.0345 2.9545 2.0365 3.3780 3.8515 2.7430 3.3510 3.9555
## [1711] 3.0510 3.7965 3.3895 5.2780 2.5025 3.3810 4.1645 4.4710 3.4550 3.5345
## [1721] 5.4785 2.9315 3.3815 4.0365 3.5980 2.8340 4.0245 4.5070 3.7800 4.4130
## [1731] 3.0675 3.1560 2.8135 3.3710 3.0595 4.2500 2.3915 2.4090 2.7025 1.8940
## [1741] 2.1605 3.3690 3.6020 3.4580 3.6670 4.1980 2.4785 3.3150 3.0015 2.9390
## [1751] 5.0420 3.2435 2.9850 3.2680 4.7525 3.1835 3.7195 4.3435 3.7635 3.5225
## [1761] 2.9805 3.7910 3.5435 4.0190 3.7975 3.2525 3.8950 3.4390 3.4555 3.7270
## [1771] 4.2315 3.0680 4.3845 3.7850 4.0165 3.5740 2.0875 2.5915 3.6210 2.8675
## [1781] 3.1355 3.1625 3.4830 3.6485 2.7440 4.1205 3.9430 4.3360 3.9015 3.4460
## [1791] 3.2550 3.8780 3.5820 3.9890 2.9645 3.2655 3.9460 3.2465 3.0080 2.9260
## [1801] 3.2265 3.5295 4.0185 3.8040 4.1640 3.4675 3.8890 3.1420 4.7705 4.5160
## [1811] 3.3605 2.9500 2.4605 4.2915 3.2220 4.6620 2.9855 2.2320 3.1990 4.7255
## [1821] 3.0045 3.0405 3.7620 3.3410 3.3325 2.7460 2.3010 3.8730 2.5175 3.4990
## [1831] 3.1055 3.7265 3.4590 1.6390 2.9050 2.0775 3.5210 2.8015 4.5715 3.2710
## [1841] 4.1505 3.0235 3.3440 3.3245 2.6590 4.1615 4.0785 4.4040 3.2720 2.3705
## [1851] 3.6935 2.1845 3.7600 3.3430 3.1760 3.1225 3.5610 3.6195 3.0805 3.9210
## [1861] 2.6700 4.2595 4.4835 3.3595 2.8505 2.8435 3.7685 3.9210 2.3160 3.3155
## [1871] 3.1245 4.3235 3.3630 3.4755 2.6505 3.5650 2.9530 3.2605 2.3335 3.8190
## [1881] 3.6015 4.1690 3.2850 3.2680 3.5210 4.1760 4.1720 3.4070 3.4320 4.1120
## [1891] 4.2585 4.3390 3.8625 5.8360 3.7305 2.9655 2.8415 2.2755 2.7695 3.9600
## [1901] 4.9750 2.4355 2.7335 3.9940 4.0280 4.3940 2.9850 3.6175 4.2870 2.5215
## [1911] 3.0870 2.7695 4.2165 2.5965 3.1980 4.8185 3.7410 3.5805 1.7860 2.8875
## [1921] 2.4990 2.5995 4.3470 3.6875 3.0025 1.9390 4.0040 3.4500 2.3440 2.5985
## [1931] 2.8895 4.4105 3.8900 3.3900 2.7025 3.2585 3.8520 3.5480 2.8850 3.0985
## [1941] 4.0565 4.6600 4.2760 1.7915 4.2955 3.5995 3.3060 2.3325 3.2425 3.2990
## [1951] 3.7275 3.4005 2.9090 3.2700 3.9720 2.9665 4.1815 3.1695 3.0320 2.2690
## [1961] 2.2745 4.6000 3.3475 3.5445 3.2220 4.1905 2.5380 4.1915 3.0455 3.6020
## [1971] 2.1575 2.5310 4.8850 4.0105 3.4850 3.9385 3.6905 3.8880 4.0135 2.7055
## [1981] 3.3100 2.3225 3.4950 3.8595 3.4305 1.8425 3.7565 3.8965 3.5435 4.0185
## [1991] 3.9485 3.2330 3.4270 4.3035 3.6315 3.3640 3.0035 3.0995 3.6285 4.3115

Estimativa da média

est.mean <- mean(dist.mean)
est.mean
## [1] 3.463138

Estimativa ajustada

est.ajust <- 2*est.mean-mean(dist.mean)
est.ajust
## [1] 3.463138

IC Padrão

s<-sd(dist.mean)
alpha<-0.05
z<-qnorm(1-alpha/2)
ICpadrao<-c(est.mean-z*s,est.mean+z*s)
ICpadrao
## [1] 2.017329 4.908948

IC percentilico

alpha <- 0.05
z <- qnorm(1 - alpha/2)
dist.mean.pe<- sort(dist.mean)
k1 <- trunc((B+1)*(alpha/2))
k2 <- trunc((B+1)*(1 - alpha/2))
IC.perc <- c(dist.mean.pe[k1], dist.mean.pe[k2])
IC.perc
## [1] 2.100 5.017

IC básico

alpha <- 0.05
z <- qnorm(1 - alpha/2)
dist.mean.ICb <- sort(dist.mean)
k1 <- trunc((B+1)*(alpha/2))
k2 <- trunc((B+1)*(1 - alpha/2))
IC.basico <- c(2 * est.mean - dist.mean.ICb[k2], 2 * est.mean - dist.mean.ICb[k1])
IC.basico
## [1] 1.909277 4.826277

Amplitude

ampli <- c(ICpadrao[2] - ICpadrao[1],IC.perc[2] - IC.perc[1],
IC.basico[2] - IC.basico[1])
ampli
## [1] 2.891618 2.917000 2.917000

3.Um dado experimento aleatório consiste em lançar dois dados não viesados (um dado de 6 faces e o outro de 12 faces) e observar a soma obtida. Por meio de um procedimento de MC, obtenha a probabilidade aproximada da soma ser par. Simule para N = 10, 100, 1000 e 10000, em que N é o número de réplicas de MC. O que você observa? Explique.

Resposta:

d6 <- c(1,2,3,4,5,6)
d12 <- c(1,2,3,4,5,6,7,8,9,10,11,12)

##método de MC
lançamentos <- function(n){
  lc1 <- sample(d6 , n , replace = T)
  lc2 <- sample(d12, n ,replace = T)
  d <- lc1 + lc2
  dsoma <- sum((d==2)|(d==4)|(d==6)|(d==8)|(d==10)|(d==12)|(d==14)|(d==16)|(d==18))
  pr <- dsoma/length(d)
  return(pr)
}
lanc1 <- 10
lanc2 <- 100
lanc3 <- 1000
lanc4 <- 10000
lançamentos(lanc1)
## [1] 0.7
lançamentos(lanc2)
## [1] 0.59
lançamentos(lanc3)
## [1] 0.505
lançamentos(lanc4)
## [1] 0.5064

Explicação: Quanto mais realizações forem feitas atravez do método de Monte Carlo, mais próximo o valor da probabilidade obtida pelo método chegará a probabilidade verdadeira, no caso a probabilidade verdadeira é de 0.5.

4.Considerando o método bootstrap não paramétrico com \(B = 1000\) iterações, valores das variáveis \(X\) e \(Y\) e a estatística diferença de médias, \(D = \bar{X} − \bar{Y}\) , construa o intervalo de 95% confiança para D. Utilize o IC de bootstrap não paramétrico que preferir. Após a implementação, comente os resultados. É possível afirmar estatisticamente que \(\bar{X}\) é diferente de \(\bar{Y}\) ? 

X <- c(14.98, 13.51, 14.87, 18.88, 15.97, 10.91, 17.85, 16.08, 14.93, 14.96,
25.21, 18.20, 11.97, 15.87, 16.80, 13.02, 14.89, 16.65, 14.49, 14.56,
25.62, 14.88, 13.89, 14.72, 18.77, 16.75, 13.17, 12.51, 14.28, 17.66,
35.59, 13.60, 16.76, 14.73, 12.76, 15.92, 18.05, 15.87, 15.38, 13.69,
46.14, 12.86, 11.69, 14.91, 14.93, 19.73, 12.57, 15.34, 16.61, 17.10,
15.18, 15.52, 15.42, 14.25, 12.73, 15.51, 10.81, 12.16, 12.85, 12.84)
Y <- c(37.29, 12.14, 24.46, 28.07, 18.21, 13.78, 14.27, 33.99, 7.47, 33.41,
16.98, 26.68, 20.38, 18.21, 8.13, 13.73, 9.80, 11.66, 23.74, 10.87,
41.60, 12.76, 13.88, 25.31, 9.13, 8.56, 10.31, 20.70, 21.72, 12.35,
55.67, 26.78, 22.39, 14.69, 14.45, 23.34, 16.57, 5.21, 6.67, 11.68,
65.02, 11.48, 20.84, 17.16, 12.46, 18.27, 12.40, 8.54, 6.11, 13.00,
17.13, 15.91, 12.76, 17.60, 21.31, 12.52, 17.69, 20.71, 18.52, 22.92)

Resposta:

X <- c(14.98, 13.51, 14.87, 18.88, 15.97, 10.91, 17.85, 16.08, 14.93, 14.96,
       25.21, 18.20, 11.97, 15.87, 16.80, 13.02, 14.89, 16.65, 14.49, 14.56,
       25.62, 14.88, 13.89, 14.72, 18.77, 16.75, 13.17, 12.51, 14.28, 17.66,
       35.59, 13.60, 16.76, 14.73, 12.76, 15.92, 18.05, 15.87, 15.38, 13.69,
       46.14, 12.86, 11.69, 14.91, 14.93, 19.73, 12.57, 15.34, 16.61, 17.10,
       15.18, 15.52, 15.42, 14.25, 12.73, 15.51, 10.81, 12.16, 12.85, 12.84)
Y <- c(37.29, 12.14, 24.46, 28.07, 18.21, 13.78, 14.27, 33.99, 7.47, 33.41,
       16.98, 26.68, 20.38, 18.21, 8.13, 13.73, 9.80, 11.66, 23.74, 10.87,
       41.60, 12.76, 13.88, 25.31, 9.13, 8.56, 10.31, 20.70, 21.72, 12.35,
       55.67, 26.78, 22.39, 14.69, 14.45, 23.34, 16.57, 5.21, 6.67, 11.68,
       65.02, 11.48, 20.84, 17.16, 12.46, 18.27, 12.40, 8.54, 6.11, 13.00,
       17.13, 15.91, 12.76, 17.60, 21.31, 12.52, 17.69, 20.71, 18.52, 22.92)

Bootstrap não Paramétrico

B <- 1000
dist <- NULL
for(i in 1:B){ 
  x <- sample(X, replace = TRUE) 
  y <- sample(Y, replace = TRUE) 
  d <- mean(x) - mean(y) 
  dist <- c(dist, d)
}
hist(dist)

Intervalo de confiança

alpha <- 0.05
z <- qnorm(1 - alpha/2)
dist2 <- sort(dist) 
k1 <- trunc((B+1)*(alpha/2)) 
k2 <- trunc((B+1)*(1 - alpha/2)) 
c(dist2[k1], dist2[k2]) 
## [1] -5.8730  0.4595

O desvio médio está entre os limites obtidos, indicado pelo intervalo de confiança, como 0 pode ser verdadeiro(pelos limites obtidos), não podemos afirmar que as médias de X e Y são diferentes.