teste_priest_klein.Rnw

\documentclass{article}

\usepackage[brazil]{babel}
\usepackage[utf8]{inputenc}


\begin{document}
\SweaveOpts{concordance=TRUE}

\section{Simulação Priest and Klein}

A conjectura afirma que, se $Y$ é uma variável aleatória absolutamente contínua, $\varepsilon_1$ e $\varepsilon_2$, independentes e independentes de $Y$, com distribuição normal com média zero e variância $\sigma_{\varepsilon}^2$ e $0<\Delta<1$, então

$$
\lim_{\sigma_{\varepsilon} \rightarrow 0} P(Y \geq \theta | F_{\varepsilon}(Y+\varepsilon_1-\theta) - F_{\varepsilon}(Y+\varepsilon_2-\theta) > \Delta) = \frac{1}{2}
$$

<<>>=
pktest <- function(x, n, mu, sig, sigeps, delta, theta) {
  Y <- rnorm(n, mu, sig)
  eps1 <- rnorm(n, 0, sigeps)
  eps2 <- rnorm(n, 0, sigeps)
  Y1 <- Y + eps1
  Y2 <- Y + eps2
  # conto o número de vitórias somente se valer a regra de decisão  
  litigio <- pnorm(Y1 - theta, 0, sigeps) - pnorm(Y2 - theta, 0, sigeps) > delta
  if(sum(litigio) > 0) {
    prop <- mean(Y[litigio] < theta)
    return(prop)  
  } else {
    return(NA)
  }
}
@

\subsection{$Y$ tem distribuição normal}

\subsubsection{Teste 1 (variância grande)}

<<fig = T>>=
theta=10; mu=20; sig=10
teste <- sapply(1:1000, pktest, n=10000, mu=mu, 
                sig=sig, sigeps=50, delta=0.2, theta=theta)
mean(teste, na.rm=T)
sd(teste, na.rm=T)
pnorm(theta, mu, sig)
ggplot2::ggplot(data.frame(x=teste), aes(x=x)) + 
  geom_density() + 
  theme_bw()
@

A proporção fica próxima da probabilidade de $Y$ ser maior ou igual a $\theta$.

\subsubsection{Teste 2 (variância pequena)}

<<fig = T>>=
theta=10; mu=20; sig=10
teste <- sapply(1:1000, pktest, n=10000, mu=mu, 
                sig=sig, sigeps=.1, delta=0.2, theta=theta)
mean(teste, na.rm=T)
sd(teste, na.rm=T)
pnorm(theta, mu, sig)
ggplot2::ggplot(data.frame(x=teste), aes(x=x)) + 
  geom_density() + 
  theme_bw()
@

A proporção fica próxima de meio.

\subsubsection{Teste 3 (variância muito pequena)}
<<fig = T>>=
theta=10; mu=20; sig=10
teste <- sapply(1:1000, pktest, n=10000, mu=mu, 
                sig=sig, sigeps=.0001, delta=0.2, theta=theta)
mean(teste, na.rm=T)
sd(teste, na.rm=T)
pnorm(theta, mu, sig)
ggplot2::ggplot(data.frame(x=teste), aes(x=x)) + 
  geom_density() + 
  theme_bw()
@

Não conseguimos observar o evento litígio muitas vezes, então em várias simulações observamos NA, 1 ou 0.

\subsection{Y tem distribuição uniforme}

<<>>=
pktest_unif <- function(x, n, minimo, maximo, sigeps, delta, theta) {
  Y <- runif(n, minimo, maximo)
  eps1 <- rnorm(n, 0, sigeps)
  eps2 <- rnorm(n, 0, sigeps)
  Y1 <- Y + eps1
  Y2 <- Y + eps2
  # conto o número de vitórias somente se valer a regra de decisão  
  litigio <- pnorm(Y1 - theta, 0, sigeps) - pnorm(Y2 - theta, 0, sigeps) > delta
  if(sum(litigio) > 0) {
    prop <- mean(Y[litigio] < theta)
    return(prop)  
  } else {
    return(NA)
  }
}
@

\subsubsection{Teste 1 (variância grande)}

<<fig = T>>=
theta=2; minimo=-10; maximo=10
teste <- sapply(1:1000, pktest_unif, n=10000, minimo=minimo, 
                maximo=maximo, sigeps=10, delta=0.2, theta=theta)
mean(teste, na.rm=T)
sd(teste, na.rm=T)
punif(theta, minimo, maximo)
ggplot2::ggplot(data.frame(x=teste), aes(x=x)) + 
  geom_density() + 
  theme_bw()
@

\subsubsection{Teste 2 (variância pequena)}

<<fig = T>>=
theta=2; minimo=-10; maximo=10
teste <- sapply(1:1000, pktest_unif, n=10000, minimo=minimo, 
                maximo=maximo, sigeps=1, delta=0.2, theta=theta)
mean(teste, na.rm=T)
sd(teste, na.rm=T)
punif(theta, minimo, maximo)
ggplot2::ggplot(data.frame(x=teste), aes(x=x)) + 
  geom_density() + 
  theme_bw()
@


\subsubsection{Teste 3 (variância muito pequena)}
<<fig = T>>=
theta=2; minimo=-10; maximo=10
teste <- sapply(1:1000, pktest_unif, n=10000, minimo=minimo, 
                maximo=maximo, sigeps=.0001, delta=0.2, theta=theta)
mean(teste, na.rm=T)
sd(teste, na.rm=T)
punif(theta, minimo, maximo)
ggplot2::ggplot(data.frame(x=teste), aes(x=x)) + 
  geom_density() + 
  theme_bw()
@


\subsection{Y tem distribuição gama}

<<>>=
pktest_gamma <- function(x, n, alpha, beta, sigeps, delta, theta) {
  Y <- rgamma(n, shape=alpha, scale=beta)
  eps1 <- rnorm(n, 0, sigeps)
  eps2 <- rnorm(n, 0, sigeps)
  Y1 <- Y + eps1
  Y2 <- Y + eps2
  # conto o número de vitórias somente se valer a regra de decisão  
  litigio <- pnorm(Y1 - theta, 0, sigeps) - pnorm(Y2 - theta, 0, sigeps) > delta
  if(sum(litigio) > 0) {
    prop <- mean(Y[litigio] < theta)
    return(prop)  
  } else {
    return(NA)
  }
}
@

\subsubsection{Teste 1 (variância grande)}

<<fig = T>>=
theta=70; alpha=5; beta=10
teste <- sapply(1:1000, pktest_gamma, n=10000, alpha=alpha, 
                beta=beta, sigeps=10, delta=0.2, theta=theta)
mean(teste, na.rm=T)
sd(teste, na.rm=T)
pgamma(theta, shape=alpha, scale=beta)
ggplot2::ggplot(data.frame(x=teste), aes(x=x)) + 
  geom_density() + 
  theme_bw()
@

\subsubsection{Teste 2 (variância pequena)}

<<fig = T>>=
theta=70; alpha=5; beta=10
teste <- sapply(1:1000, pktest_gamma, n=10000, alpha=alpha, 
                beta=beta, sigeps=1, delta=0.2, theta=theta)
mean(teste, na.rm=T)
sd(teste, na.rm=T)
pgamma(theta, shape=alpha, scale=beta)
ggplot2::ggplot(data.frame(x=teste), aes(x=x)) + 
  geom_density() + 
  theme_bw()
@


\subsubsection{Teste 3 (variância muito pequena)}
<<fig = T>>=
theta=70; alpha=5; beta=10
teste <- sapply(1:1000, pktest_gamma, n=10000, alpha=alpha, 
                beta=beta, sigeps=.0001, delta=0.2, theta=theta)
mean(teste, na.rm=T)
sd(teste, na.rm=T)
pgamma(theta, shape=alpha, scale=beta)
ggplot2::ggplot(data.frame(x=teste), aes(x=x)) + 
  geom_density() + 
  theme_bw()
@

\end{document}