Neste documento faremos algumas simulações e anĂ¡lises dos lançamentos de Moeda.
Vamos começar carregando os pacotes necessĂ¡rios.
#Descomente se for necessĂ¡rio instalar os pacotes a seguir:
#install.packages("dplyr")
suppressMessages(library(dplyr))
Vamos começar criando uma funĂ§Ă£o flips. A funĂ§Ă£o flips(v) simula o lançamento de v moedas. As saĂdas de nossas moedas serĂ£o \(\{0,1\}\).
sample.space <- c(-1,1)
theta <- 0.5 # moeda honesta
flips <- function(v){ sample(sample.space,
size = v,
replace = TRUE,
prob = c(theta, 1 - theta))}
# Jogar uma moeda 100 vezes
flips(100)
## [1] 1 -1 -1 1 -1 1 1 1 -1 1 1 1 -1 1 1 1 1 1 1 -1 -1 1 1
## [24] 1 -1 -1 -1 -1 -1 1 -1 -1 1 -1 -1 1 -1 1 1 -1 -1 -1 -1 1 1 -1
## [47] 1 1 -1 1 1 1 -1 -1 -1 1 1 -1 1 1 1 -1 1 -1 1 -1 1 1 1
## [70] -1 1 1 -1 1 1 -1 -1 -1 1 -1 1 1 -1 -1 1 1 -1 -1 1 1 1 -1
## [93] 1 -1 1 1 -1 -1 -1 -1
Vejamos quantas caras e quantas coroas aparecem em 10000 lancamentos
table(flips(10000))
##
## -1 1
## 4913 5087
Vamos calcular as somas parciais das primeiras \(k\) entradas para \(k=1,\dots n\). Ou seja se denotarmos por \(X_i\) o resultado do \(i\)-ésimo lançamento. A soma até \(k\) é definida como \[ S_k=\sum_{i=1}^k X_i\]
A soma \(S_k\) Ă© o que chamamos de passeio aleatĂ³rio unidimensional.
Vejamos as somas parciais.Isso pode ser feito com a funĂ§Ă£o cumsum
temp<-flips(30)
temp
## [1] 1 -1 1 -1 -1 -1 -1 1 1 -1 -1 -1 -1 -1 -1 -1 -1 -1 1 1 1 -1 1
## [24] -1 -1 1 1 1 -1 -1
cumsum(temp)
## [1] 1 0 1 0 -1 -2 -3 -2 -1 -2 -3 -4 -5 -6 -7 -8 -9
## [18] -10 -9 -8 -7 -8 -7 -8 -9 -8 -7 -6 -7 -8
Vamos plotar as somas parciais ou cumulativas.
plot(cumsum(flips(100000)), type = 'l', main="Passeio AleatĂ³rio",ylab ="Somas Parciais" )
Vamos simular o comportamento de cinco somas cumulativas no mesmo grĂ¡fico
plot(cumsum(flips(100000)), type = 'l',col="red", main="Passeios AleatĂ³rios",ylab ="Somas Parciais",ylim=c(-400,400) )
lines(cumsum(flips(100000)), type = 'l',col="green")
lines(cumsum(flips(100000)), type = 'l',col="blue")
lines(cumsum(flips(100000)), type = 'l',col="pink")
lines(cumsum(flips(100000)), type = 'l',col="yellow")
Vamos criar um histograma das posições apĂ³s 1000 lançamentos para 10000 passeios
# Criando uma lista vazia e armazenando as somas cumulativas
resultados <- list()
for(i in 1:12000) {
coinTosses <- cumsum(sample(c(-1,1), 1000, replace = TRUE))
resultados[[i]] <- coinTosses[length(coinTosses)]
}
# Criar um histograma. Defina um tĂtulo e defina a cor e quebra
hist(unlist(resultados), main = "Histograma de todas as posições finais",col = "lightblue", breaks = 100)
#Colocar uma linha vertical em 0 com uma largura de 2 para mostrar a mĂ©dia da distribuiĂ§Ă£o
abline(v = 0, col = "red", lwd = 2)
Esse grĂ¡fico ilustra bem o TCL:
Teorema do Limite Central de Lindeberg–Lévy
Dados \(\{X_1, X_2, …\}\) uma sequĂªncia de variĂ¡veis aleatĂ³rias i.i.d com \(E[X_i] = \mu\) e \(Var[X_i] = \sigma^2 <\infty\). EntĂ£o o limite quando \(n\) tende ao infinito de \(\frac{S_n-n\mu}{\sigma\sqrt{n}}\) converge em distribuiĂ§Ă£o para a distribuiĂ§Ă£o normal \(N(0,1)\).
\[ \text{ CLT: } \quad \lim_{n\rightarrow \infty} P\Bigl(\frac{S_n-n\mu}{\sigma\sqrt{n}} < x \Bigr) = \Phi(x)\]
Vamos analisar a mĂ©dia atĂ© a posiĂ§Ă£o \(n\). Veja que a mĂ©dia converge rapidamente para 0.
plot(cummean(flips(1000)), type = 'l', main="MĂ©dias Parciais ")
Vamos plotar as médias parciais de \(1,\dots,2000\)
mediaseq<-function(v){mean(flips(v))}
s<-lapply(1:2000,mediaseq)
boxplot(s)
Vamos estimar qual a probabilidade que uma sequĂªncia possua mĂ©dia maior que \(p\)
mediasfinais <- list()
for(i in 1:10000) {
mediasfinais[i]<-mean(flips(1000))
}
mediasfinais<-data.frame(mediasfinais)
contamaioresque <-function(p){ length(mediasfinais[ ,which(mediasfinais[1,]>p) ])/10000}
# Veja qual a percentagem das médias é maior que 0.1
contamaioresque(0.1)
## [1] 9e-04
maiores<-lapply(1:20/100,contamaioresque)
barplot(t(maiores))
mediaapos1000<-function(v){mean(flips(1000))}
s<-lapply(1:2000,mediaapos1000)
barplot(t(s), main = "MĂ©dia apĂ³s 1000 lançamentos")
A lei fraca de grandes nĂºmeros (tambĂ©m chamada de lei de Khintchine) afirma que a mĂ©dia da amostra converge em probabilidade para o valor esperado
\[{\bar {X}}_{n}= S_n/n \xrightarrow{P} \mu \qquad \text{ quando }\ n\to \infty . \]
#setting a parameters of Bi(n, p)
n <- 1000;
p <- 0.4;
#dataframe
df <- data.frame(bi = rbinom(n, 1, p) ,count = 0, mean = 0);
ifelse(df$bi[1] == 1, df[1, 2:3] <- 1, 0);
## [1] 0
for (i in 2 : n){
df$count[i] <- ifelse(df$bi[i] == 1, df$count[i]<-df$count[i - 1]+1, df$count[i - 1]);
df$mean[i] <- df$count[i] / i;
};
#graph
plot(df$mean, type='l',
main = "SimulaĂ§Ă£o da Lei Fraca dos Grandes NĂºmeros",
xlab="Numbers", ylab="Sample mean")
abline(h = p, col="red")
A lei forte de grandes nĂºmeros afirma que a mĂ©dia da amostra converge quase com certeza ao valor esperado
A lei fraca afirma que, dado \(n\) um nĂºmero suficientemente grande, a mĂ©dia \({\displaystyle {\overline {X}} _ {n}}\) Ă© provĂ¡vel que esteja perto de \(\mu\). Assim, deixa aberta a possibilidade de que \({\displaystyle | {\overline {X}} _ {n} - \mu |> \varepsilon}\) ocorra um nĂºmero infinito de vezes, embora em intervalos infreqĂ¼entes.
A lei forte mostra que isso quase certamente nĂ£o ocorrerĂ¡. Em particular, isso implica que com a probabilidade 1, temos isso para qualquer \(\varepsilon> 0\) a desigualdade \({\displaystyle | {\overline {X}} _ {n} - \mu | <\varepsilon}\) Ă© vĂ¡lido para \(n\) suficientemente grande.
\[{\displaystyle {\begin{matrix}{}\\{\bar {X}}_{n}\ {\xrightarrow {\text{q.c.}}}\ \mu \qquad {\textrm {quando}}\ n\to \infty .\\{}\end{matrix}}}\]
Isto Ă©
\[\displaystyle P \!\left(\lim _{n\to \infty }{\bar {X}}_{n}=\mu \right)=1.\]
par(mfrow=c(3,3),oma=c(0,0,5,0))
layout(matrix(1:9,nrow=3))
sllnBern <- function(n,p) {
for (i in 1:9) {
seq <- rbinom(n,1,p)
avgs <- cumsum(seq)/(1:n)
plot(avgs,type="l",xlab="n",ylab="MĂ©dia")
abline(h = p)
}
mtext(paste("Lei Forte dos Grandes NĂºmeros ( n = ",n,")"),side=3, font=2,outer=T)
mtext(paste("Experimentos de Bernoulli ( p = ",p,")"),side=3, outer=T, font=2, line =-2)
}
sllnBern(100,.5)
sllnBern(1000,.5)
sllnBern(10000,.5)
#Definir a funĂ§Ă£o limsup
limsup <- function(x){
z = rep(0,length(x))
for(i in 1:length(x)){
z[i] = max(x[i:length(x)])
}
return(z)
}
Vamos plotar as somas parciais de $X_1+\dotsX_n$ e analisar seu crescimento
as<- suppressWarnings(function(n){sqrt(2*n*log(log(n)))})
asx<- suppressWarnings(function(n){-sqrt(2*n*log(log(n)))})
mediaseqit<-function(v){sum(flips(v))}
sit<-as.vector(sapply(seq(5,5000),mediaseqit))
plot(sit, type = 'l',col="darkgreen", main="Passeios AleatĂ³rios",ylab ="Somas Parciais",ylim=c(-400,400) )
suppressWarnings(curve(as, add=TRUE,col="red"))
suppressWarnings(curve(asx, add=TRUE,col="blue"))
legend("topleft", inset=.025, title="Funções",
c("2*n*log(log(n)","-2*n*log(log(n)"), fill=c("red","blue"))