2

Estou realizando o gráfico de análise de resíduos half-normal plot. Vejam que utilizando a função default é possível fazer com que no gráfico apareça a informação associada a contagem de pontos fora do envelope.

library(gamlss)
library(hnp)

head(Orange)

mod1 = gamlss(circumference ~ age, 
              family=NO, data = Orange)
mod2 = gamlss(circumference ~ age, 
              family=GA, data = Orange)

old_par <- par(mfrow=c(1,2))
hnp(mod1$residuals,how.many.out = T,print.on = T,
    xlab = "Quantis Teóricos N(0,1)", half = T,
    ylab = "Resíduos quantílicos aleatorizados")
hnp(mod2$residuals,how.many.out = T,print.on = T,
    xlab = "Quantis Teóricos N(0,1)", half = T,
    ylab = "Resíduos quantílicos aleatorizados")
par(old_par)

inserir a descrição da imagem aqui

No entanto, ao realizar o mesmo gráfico via ggplot2 tais informações não aparecem.

Ga = hnp(mod1$residuals,how.many.out = T,print.on = T,
         xlab = "Quantis Teóricos N(0,1)", half = T,
         ylab = "Resíduos quantílicos aleatorizados")
G1a <- with(Ga, data.frame(x, lower, upper, median, residuals))
p1=ggplot(data = G1a, aes(x)) +
  geom_point(aes(y = residuals)) +
  geom_ribbon(aes(ymin = lower, ymax = upper),
              alpha = 0.5)+
  coord_cartesian(ylim = c(0,4)) +
  geom_line(aes(y = median), linetype = 2, col="black") + 
  ylab("Resíduos quantílicos aleatorizados") +
  xlab("Quantis Teóricos N(0,1)")  +
  theme(legend.title = element_text(size = 25),
        legend.text = element_text(size = 25),
        axis.text.x = element_text(size = 25,color = "black"),
        axis.text.y = element_text(size = 25,color = "black"),
        axis.title.x = element_text(size = 15),
        axis.title.y = element_text(size = 15),
        axis.text = element_text(size = 25),
        plot.title = element_text(size = 15, hjust = 0.5))
Gb = hnp(mod2$residuals,how.many.out = T,print.on = T,
         xlab = "Quantis Teóricos N(0,1)", half = T,
         ylab = "Resíduos quantílicos aleatorizados")
G1b <- with(Gb, data.frame(x, lower, upper, median, residuals))
p2=ggplot(data = G1b, aes(x)) +
  geom_point(aes(y = residuals)) +
  geom_ribbon(aes(ymin = lower, ymax = upper),
              alpha = 0.5)+
  coord_cartesian(ylim = c(0,4)) +
  geom_line(aes(y = median), linetype = 2, col="black") + 
  ylab("Resíduos quantílicos aleatorizados") +
  xlab("Quantis Teóricos N(0,1)") +
  theme(legend.title = element_text(size = 25),
        legend.text = element_text(size = 25),
        axis.text.x = element_text(size = 25,color = "black"),
        axis.text.y = element_text(size = 25,color = "black"),
        axis.title.x = element_text(size = 15),
        axis.title.y = element_text(size = 15),
        axis.text = element_text(size = 25),
        plot.title = element_text(size = 15, hjust = 0.5))
grid.arrange(p1,p2,ncol=2)

inserir a descrição da imagem aqui

1 Resposta 1

4

Eis uma solução.

São criadas duas funções, hnp_texto e hnp_cores.

  • Só a primeira destas funções é pedida na pergunta.
  • A função hnp_cores é opcional.

É ainda criado uma função theme_* para simplificar o código e unirfomizar o aspeto dos gráficos.

suppressPackageStartupMessages(library(gamlss))
#> Warning: package 'gamlss.dist' was built under R version 4.1.3
library(hnp)
library(ggplot2)
library(gridExtra)

data("Orange", package = "datasets")

hnp_cores <- function(X) {
  out <- X[["residuals"]] < X[["lower"]] | X[["residuals"]] > X[["upper"]]
  c("Dentro", "Fora")[out + 1L]
}
hnp_texto <- function(X) {
  out <- X[["residuals"]] < X[["lower"]] | X[["residuals"]] > X[["upper"]]
  n <- sum(out)
  txt1 <- sprintf("Total de pontos: %d", nrow(X))
  txt2 <- sprintf("Pontos fora do envelope: %d (%2.4g%%)", n, 100*n/nrow(X))
  list(Total = txt1, Fora = txt2)
}
theme_hnp <- function(){ 
  theme(
    legend.title = element_text(size = 25),
    legend.text = element_text(size = 25),
    axis.text.x = element_text(size = 25,color = "black"),
    axis.text.y = element_text(size = 25,color = "black"),
    axis.title.x = element_text(size = 15),
    axis.title.y = element_text(size = 15),
    axis.text = element_text(size = 25),
    plot.title = element_text(size = 15, hjust = 0.5)
  )
}

mod1 <- gamlss(circumference ~ age, 
              family=NO, data = Orange)
#> GAMLSS-RS iteration 1: Global Deviance = 318.9607 
#> GAMLSS-RS iteration 2: Global Deviance = 318.9607
mod2 <- gamlss(circumference ~ age, 
              family=GA, data = Orange)
#> GAMLSS-RS iteration 1: Global Deviance = 316.7644 
#> GAMLSS-RS iteration 2: Global Deviance = 316.7644

Ga <- hnp(mod1$residuals, how.many.out = TRUE, print.on = TRUE,
         xlab = "Quantis Teóricos N(0,1)", half = TRUE,
         ylab = "Resíduos quantílicos aleatorizados")
#> Half-normal plot with simulated envelope generated assuming the residuals are 
#>         normally distributed under the null hypothesis.

G1a <- with(Ga, data.frame(x, lower, upper, median, residuals))

Gb <- hnp(mod2$residuals,how.many.out = T,print.on = T,
          xlab = "Quantis Teóricos N(0,1)", half = T,
          ylab = "Resíduos quantílicos aleatorizados")
#> Half-normal plot with simulated envelope generated assuming the residuals are 
#>         normally distributed under the null hypothesis.

G1b <- with(Gb, data.frame(x, lower, upper, median, residuals))

G1a$cores <- hnp_cores(G1a)
G1a_texto <- hnp_texto(G1a)
G1b$cores <- hnp_cores(G1b)
G1b_texto <- hnp_texto(G1b)

p1 <- ggplot(data = G1a, aes(x)) +
  # original, todos os pontos são da mesma cor
  #geom_point(aes(y = residuals)) +
  geom_point(aes(y = residuals, color = cores), show.legend = FALSE) +
  # o texto novo
  geom_text(x = 0, y = 4, label = G1a_texto$Total, hjust = 0) +
  geom_text(x = 0, y = 3.7, label = G1a_texto$Fora, hjust = 0) +
  #
  geom_ribbon(aes(ymin = lower, ymax = upper),
              alpha = 0.5)+
  geom_line(aes(y = median), linetype = 2, col="black") + 
  scale_color_manual(values = c(Dentro = "black", Fora = "red")) +
  coord_cartesian(ylim = c(0,4)) +
  ylab("Resíduos quantílicos aleatorizados") +
  xlab("Quantis Teóricos N(0,1)")  +
  theme_hnp()

p2 <- ggplot(data = G1b, aes(x)) +
  # original, todos os pontos são da mesma cor
  #geom_point(aes(y = residuals)) +
  geom_point(aes(y = residuals, color = cores), show.legend = FALSE) +
  # o texto novo
  geom_text(x = 0, y = 4, label = G1b_texto$Total, hjust = 0) +
  geom_text(x = 0, y = 3.7, label = G1b_texto$Fora, hjust = 0) +
  #
  geom_ribbon(aes(ymin = lower, ymax = upper),
              alpha = 0.5)+
  geom_line(aes(y = median), linetype = 2, col="black") + 
  coord_cartesian(ylim = c(0,4)) +
  scale_color_manual(values = c(Dentro = "black", Fora = "red")) +
  ylab("Resíduos quantílicos aleatorizados") +
  xlab("Quantis Teóricos N(0,1)") +
  theme_hnp()

grid.arrange(p1, p2, ncol = 2)

Created on 2022-03-12 by the reprex package (v2.0.1)

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .