Não foi possível enviar o arquivo. Será algum problema com as permissões?
CE-083: Estatística Computacional II

CE-083: Estatística Computacional II

"The purpose of computing is insight, not numbers." (Richard Hamming)

Detalhes da oferta da disciplina


Scripts, notas e documentos


##-----------------------------------------------------------------------------
 
require(bbmle)
 
##-----------------------------------------------------------------------------
 
y <- rnorm(100, mean=0, sd=1)
crt <- 1.5
r <- y<crt
y[!r] <- crt
r <- as.integer(r)
plot(ecdf(y))
table(r)
 
ll <- function(theta, y, r){
    ys <- split(y, r)
    ll1 <- dnorm(ys[["1"]],
                 mean=theta[1],
                 sd=exp(theta[2]),
                 log=TRUE)
    ll2 <- pnorm(ys[["0"]],
                 mean=theta[1],
                 sd=exp(theta[2]),
                 lower.tail=FALSE,
                 log=TRUE)
    ll12 <- sum(ll1)+sum(ll2)
    ## Tem que retornar o negativo da soma. A mle2() minimiza.
    return(-ll12)
}
 
##-----------------------------------------------------------------------------
## Estimação com a bbmle.
 
parnames(ll) <- c("mu", "lsigma")
m0 <- mle2(minuslogl=ll, start=list(mu=0, lsigma=log(1)),
           vecpar=TRUE, data=list(y=y, r=r), method="BFGS")
 
coef(m0)
summary(m0)
ci <- confint(m0, method="quad")
ci
 
htheta <- coef(m0)
logL <- c(logLik(m0))
 
##-----------------------------------------------------------------------------
 
llv <- Vectorize(
    FUN=function(th1, th2, y, r){
        -ll(c(th1, th2), y=y, r=r)
    },
    vectorize.args=c("th1", "th2"))
 
th1 <- seq(-0.4, 0.4, l=30)
th2 <- seq(-0.1, 0.4, l=30)
 
lla <- outer(th1, th2, llv, y=y, r=r)
 
contour(th1, th2, lla,
        xlab=expression(mu),
        ylab=expression(log(sigma)))
abline(v=htheta[1], h=htheta[2], lty=2)
contour(th1, th2, lla, add=TRUE,
        levels=(logL-0.5*qchisq(0.95, df=length(htheta))),
        col=2)
abline(v=ci[1,], h=ci[2,], lty=3, col=2)
 
plot(profile(m0))
 
 
##--------------------------------------------
## Implementação conforme sugestão do Wikipedia.
 
require(rootSolve)
 
n <- rbinom(1, size=200, p=0.8)
y <- c(rpois(n, lambda=exp(2)), rep(0, 200-n))
length(y)
 
barx <- mean(y)
p <- sum(y==0)/length(y)
 
f <- function(lambda, L){
    L$barx*(1-exp(-lambda))-lambda*(1-L$p)
}
 
L <- list(barx=barx, p=p)
gradient(f, x=2, L=L)
 
curve(f(x, L=L), 0, 15); abline(h=0)
 
## Newton-Raphson.
maxiter <- 50; i <- 1          ## Número máximo de iterações e contador.
tol <- 1e-5; error <- 100*tol  ## Tolerância e erro inicial.
theta <- matrix(NA, nrow=1, ncol=1)
theta[1,] <- barx
while(i <= maxiter & error>tol){
    theta <- rbind(theta, rep(NA,1))
    G <- f(theta[i,], L)
    H <- gradient(f=f, x=theta[i,], L=L)
    theta[i+1,] <- theta[i,]-solve(H)%*%G
    error <- sum(abs((theta[i+1,]-theta[i,])/theta[i+1,]))
    i <- i+1
    ## print(c(theta[i,], G))
    print(cbind(H, G, theta[i,]))
}
 
lam <- theta[i,]        ## Estimativa do lambda.
pii <- 1-barx/theta[i,] ## Estimativa do pi.
 
##-----------------------------------------------------------------------------
## Vendo os contornos da verossimilhança.
 
llmax <- ll(th=c(log(pii/(1-pii)), log(lam)), y=y)
 
th1 <- seq(-7, 5, l=50)
th2 <- seq(-1, 4, l=50)
lla <- outer(th1, th2, llv, y=y)
 
contour(th1, th2, lla,
        ## levels=seq(from=llmax-30, to=llmax, by=10),
        nlevels=20,
        xlab="theta1: logit(p)",
        ylab="theta2: log(lambda)")
abline(v=log(pii/(1-pii)), h=log(lam), col=2)

  1. Instruções de como enviar os trabalhos/atividades: datafilehost.

Avaliações

Discussão

GRR20115299, 2014/11/21 18:11

http://www.datafilehost.com/d/2d9d15cc

Cintia Maestrelli Consulin, 2014/11/21 17:02

trabalho 04

http://www.datafilehost.com/d/3fa65aa3

Eduardo Elias Ribeiro Junior, 2014/11/21 09:08

Distribuição COM-Poisson: http://www.datafilehost.com/d/815f14e4

Damiane Ferreira, 2014/11/21 01:10

GRR20124688

TRABALHO 4 http://www.datafilehost.com/d/9761e59c

Ana Flávia do Carmo Santos, 2014/11/20 23:07

Trabalho 4 http://www.datafilehost.com/d/21cf5ed0

Michele Mottin, 2014/11/20 17:11

Último Trabalho

http://www.datafilehost.com/d/43451b0b

Fernando Gomes Moro, 2014/11/19 11:09

GRR:20115303

Reenvio trabalho 4 Disciplina:CE089

Link: http://www.datafilehost.com/d/d0b3d011

Emerson Rigoni, 2014/11/18 11:41

GRR: 20110249

Trabalho 4: http://www.rigoni.com.br/20110249_T4.zip

Henrique Ap. Laureano, 2014/11/17 23:11

GRR: 20115307

Trabalho 04: http://www.datafilehost.com/d/172e83e2

Fernando Gomes Moro , 2014/11/16 21:15

GRR20115303 - Último trabalho

http://www.datafilehost.com/d/e7e5e316

Eduardo Elias Ribeiro Junior, 2014/10/04 00:46

GRR20124689

http://www.datafilehost.com/d/b5cd6889

Letícia Primon de Orneles, 2014/10/03 23:59

trabalho 3

https://www.dropbox.com/s/6uy3ng0tm3f8vb2/20096755%20trab03.zip?dl=0

GRR20115299, 2014/10/03 23:41

http://www.datafilehost.com/d/8367e630

Clovis, 2014/10/03 23:26

Trabalho 3

http://www.datafilehost.com/d/61987f4c

Ana Flávia do Carmo Santos, 2014/10/03 22:48

Trabalho 3 - GRR20124690 http://www.datafilehost.com/d/a75e70b2

Emerson Rigoni, 2014/10/03 14:15

http://www.rigoni.com.br/20110249_T3.zip

Fernando Moro, 2014/10/03 13:04

Trabalho 3- Níveis de cobertura

http://www.datafilehost.com/d/3cca0d68

Michele Mottin, 2014/10/03 10:58

GRR20115305

http://www.datafilehost.com/d/d4f93136

Damiane Ferreira, 2014/10/02 16:01

GRR 20124688

http://www.datafilehost.com/d/5df7ac8f

Henrique Ap. Laureano, 2014/10/02 13:50

GRR20115307

Trabalho 03: http://www.datafilehost.com/d/c1e4b939

Cintia Maestrelli Consulin, 2014/10/02 10:12

Trabalho 03

http://www.datafilehost.com/d/a063f914

Michele Mottin GRR20115305, 2014/09/30 16:39

http://www.datafilehost.com/d/69b88086

GRR 20124688, 2014/09/30 11:54

http://www.datafilehost.com/d/8209ac32

Cintia Maestrelli Consulin, 2014/09/30 10:06

Trabalho 02

http://www.datafilehost.com/d/c9b73004

Letícia Primon de Orneles, 2014/09/30 00:10

O estudo é referente a curva de poder dos teste t e Wilcoxon.

https://www.dropbox.com/s/ms0pl2lcmaee35i/20096755.zip?dl=0

Insira seu comentário. Sintaxe wiki é permitida:
S W H J Q
 

QR Code
QR Code disciplinas:ce089-2014-02 (generated for current page)