Commit 11c5ef23 by Walmes Marques Zeviani

### Usa a predict.mle2 na Poisson Generalizada:

  - Remove todo codigo extenso e usa o metodo predict;
- Adiciona 3x3 com a distribuiçao;
- Adiciona curvas da relaçao media variancia.
parent f6bed42d
Pipeline #4770 failed with stage
This diff is collapsed.
This diff is collapsed.
 ... ... @@ -55,12 +55,61 @@  - *Note que o espaço paramétrico de $\gamma$ é dependente do parâmetro $\theta$*. {r} grid <- expand.grid(lambda = c(2, 8, 15), alpha = c(-0.05, 0, 0.05)) y <- 0:35 py <- mapply(FUN = dpgnz, lambda = grid$lambda, alpha = grid$alpha, MoreArgs = list(y = y), SIMPLIFY = FALSE) grid <- cbind(grid[rep(1:nrow(grid), each = length(y)), ], y = y, py = unlist(py)) useOuterStrips(xyplot(py ~ y | factor(lambda) + factor(alpha), ylab = expression(f(y)), xlab = expression(y), data = grid, type = "h", panel = function(x, y, ...) { m <- sum(x * y) panel.xyplot(x, y, ...) panel.abline(v = m, lty = 2) }), strip = strip.custom( strip.names = TRUE, var.name = expression(lambda == ""), sep = ""), strip.left = strip.custom( strip.names = TRUE, var.name = expression(alpha == ""), sep = "")) #----------------------------------------------------------------------- # Relação média variância. curve(lambda * (1 + 0 * lambda)^2, from = 0, to = 10, xname = "lambda", ylab = expression(lambda %.% (1 + alpha %.% lambda)^2), xlab = expression(lambda)) alpha <- seq(-0.25, 0.25, by = 0.025) col <- brewer.pal(n = 5, name = "Spectral") col <- colorRampPalette(colors = col)(length(alpha)) for (a in seq_along(alpha)) { curve(lambda * (1 + alpha[a] * lambda)^2, add = TRUE, xname = "lambda", col = col[a], lwd = 2) }  ## Modelo de Regressão com a Distribuição Poisson Generalizada ## `{r} #----------------------------------------------------------------------- # Gráfico do espaço paramétrico de lambda x alpha. y <- 0:400 fun <- Vectorize(vectorize.args = c("lambda", "alpha"), FUN = function(lambda, alpha) { sum(dpgnz(y = y, lambda = lambda, alpha = alpha)) ... ... @@ -222,7 +271,7 @@ ai <- a == max(a) L <- t(replicate(sum(ai), rbind(coef(m3) * 0), simplify = "matrix")) L[, ai] <- diag(sum(ai)) # Cáclculo da estatística Chi-quadrado. # Cálculo da estatística Chi-quadrado. # t(L %*% coef(m3)) %*% # solve(L %*% vcov(m3) %*% t(L)) %*% # (L %*% coef(m3)) ... ... @@ -248,9 +297,6 @@ pred <- transform(pred, umid = factor(umid)) pred <- list(pois = pred, pgen = pred) # Quantil normal. qn <- qnorm(0.975) * c(lwr = -1, fit = 0, upr = 1) # Preditos pela Poisson. # aux <- predict(m0, newdata = pred$pois, se.fit = TRUE) # aux <- exp(aux$fit + outer(aux$se.fit, qn, FUN = "*")) ... ... @@ -261,18 +307,10 @@ colnames(aux)[1] <- "fit" pred$pois <- cbind(pred$pois, exp(aux)) str(pred$pois) # Matrix de covariância completa e sem o alpha (marginal). V <- vcov(m3) V <- V[-1, -1] U <- chol(V) aux <- sqrt(apply(X %*% t(U), MARGIN = 1, FUN = function(x) { sum(x^2) })) pred$pgen$eta <- c(X %*% coef(m3)[-1]) pred$pgen <- cbind(pred$pgen, apply(outer(aux, qn, FUN = "*"), MARGIN = 2, FUN = function(x) { exp(pred$pgen$eta + x) })) # Predito para a Poisson Generalizada. aux <- predict(m3, newdata = X, interval = "confidence", type = "response") pred$pgen <- cbind(pred$pgen, aux[, c(2, 1, 3)]) pred <- ldply(pred, .id = "modelo") pred <- arrange(pred, umid, K, modelo) ... ... @@ -392,9 +430,6 @@ pred <- transform(pred, umid = factor(umid)) pred <- list(pois = pred, quasi = pred, pgen = pred) # Quantil normal. qn <- qnorm(0.975) * c(lwr = -1, fit = 0, upr = 1) # Preditos pela Poisson. aux <- confint(glht(m0, linfct = X), calpha = univariate_calpha())$confint ... ... @@ -408,17 +443,9 @@ colnames(aux)[1] <- "fit" pred$quasi <- cbind(pred$quasi, exp(aux)) # Preditos pela Poisson Generalizada. V <- vcov(m3) V <- V[-1, -1] U <- chol(V) aux <- sqrt(apply(X %*% t(U), MARGIN = 1, FUN = function(x) { sum(x^2) })) pred$pgen$eta <- c(X %*% coef(m3)[-1]) pred$pgen <- cbind(pred$pgen, apply(outer(aux, qn, FUN = "*"), MARGIN = 2, FUN = function(x) { exp(pred$pgen$eta + x) })) aux <- predict(m3, newdata = X, interval = "confidence", type = "response") pred$pgen <- cbind(pred$pgen, aux[, c(2, 1, 3)]) # Junta o resultado dos 3 modelos. pred <- ldply(pred, .id = "modelo") ... ... @@ -558,9 +585,6 @@ head(X) pred <- list(pois = pred, quasi = pred, pgen = pred) # Quantil normal. qn <- qnorm(0.975) * c(lwr = -1, fit = 0, upr = 1) # Preditos pela Poisson. aux <- confint(glht(m0, linfct = X), calpha = univariate_calpha())$confint ... ... @@ -574,17 +598,9 @@ colnames(aux)[1] <- "fit" pred$quasi <- cbind(pred$quasi, exp(aux)) # Preditos pela Poisson Generalizada. V <- vcov(m3) V <- V[-1, -1] U <- chol(V) aux <- sqrt(apply(X %*% t(U), MARGIN = 1, FUN = function(x) { sum(x^2) })) pred$pgen$eta <- c(X %*% coef(m3)[-1]) pred$pgen <- cbind(pred$pgen, apply(outer(aux, qn, FUN = "*"), MARGIN = 2, FUN = function(x) { exp(pred$pgen$eta + x) })) aux <- predict(m3, newdata = X, interval = "confidence", type = "response") pred$pgen <- cbind(pred$pgen, aux[, c(2, 1, 3)]) # Junta o resultado dos 3 modelos. pred <- ldply(pred, .id = "modelo") ... ... @@ -717,9 +733,6 @@ pred <- with(capdesfo, expand.grid(est = levels(est), X <- model.matrix(formula(m0)[-2], data = pred) pred <- list(pois = pred, quasi = pred, pgen = pred) # Quantil normal. qn <- qnorm(0.975) * c(lwr = -1, fit = 0, upr = 1) # Preditos pela Poisson. aux <- confint(glht(m0, linfct = X), calpha = univariate_calpha())$confint ... ... @@ -733,17 +746,9 @@ colnames(aux)[1] <- "fit" pred$quasi <- cbind(pred$quasi, exp(aux)) # Preditos pela Poisson Generalizada. V <- vcov(m3) V <- V[-1, -1] U <- chol(V) aux <- sqrt(apply(X %*% t(U), MARGIN = 1, FUN = function(x) { sum(x^2) })) pred$pgen$eta <- c(X %*% coef(m3)[-1]) pred$pgen <- cbind(pred$pgen, apply(outer(aux, qn, FUN = "*"), MARGIN = 2, FUN = function(x) { exp(pred$pgen$eta + x) })) aux <- predict(m3, newdata = X, interval = "confidence", type = "response") pred$pgen <- cbind(pred$pgen, aux[, c(2, 1, 3)]) pred <- ldply(pred, .id = "modelo") pred <- arrange(pred, est, des, modelo) ... ... @@ -889,9 +894,6 @@ X <- model.matrix(~cult, data = pred) pred <- list(pois = pred, quasi = pred, pgen = pred) # Quantil normal. qn <- qnorm(0.975) * c(lwr = -1, fit = 0, upr = 1) # Preditos pela Poisson. aux <- confint(glht(m0, linfct = X), calpha = univariate_calpha())$confint ... ... @@ -905,17 +907,9 @@ colnames(aux)[1] <- "fit" pred$quasi <- cbind(pred$quasi, exp(aux)) # Preditos pela Poisson Generalizada. V <- vcov(m3) V <- V[-1, -1] U <- chol(V) aux <- sqrt(apply(X %*% t(U), MARGIN = 1, FUN = function(x) { sum(x^2) })) pred$pgen$eta <- c(X %*% coef(m3)[-1]) pred$pgen <- cbind(pred$pgen, apply(outer(aux, qn, FUN = "*"), MARGIN = 2, FUN = function(x) { exp(pred$pgen$eta + x) })) aux <- predict(m3, newdata = X, interval = "confidence", type = "response") pred$pgen <- cbind(pred$pgen, aux[, c(2, 1, 3)]) pred <- ldply(pred, .id = "modelo") pred <- arrange(pred, cult, modelo) ... ...
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!