Bastão de Asclépio & Distribuição Normal

Bastão de Asclépio & Distribuição Normal

suppressMessages(library(aplpack, warn.conflicts=FALSE))
suppressMessages(library(broom, warn.conflicts=FALSE))
suppressMessages(library(calculus, warn.conflicts=FALSE))
suppressMessages(library(car, warn.conflicts=FALSE))
suppressMessages(library(carData, warn.conflicts=FALSE))
suppressMessages(library(cellWise, warn.conflicts=FALSE))
suppressMessages(library(cluster, warn.conflicts=FALSE))
suppressMessages(library(DescTools, warn.conflicts=FALSE))
suppressMessages(library(diptest, warn.conflicts=FALSE))
suppressMessages(library(dplyr, warn.conflicts=FALSE))
suppressMessages(library(effectsize, warn.conflicts=FALSE))
suppressMessages(library(ellipse, warn.conflicts=FALSE))
suppressMessages(library(emmeans, warn.conflicts=FALSE))
suppressMessages(library(far, warn.conflicts=FALSE))
suppressMessages(library(fmsb, warn.conflicts=FALSE))
suppressMessages(library(GGally, warn.conflicts=FALSE))
suppressMessages(library(ggfortify, warn.conflicts=FALSE))
suppressMessages(library(ggplot2, warn.conflicts=FALSE))
suppressMessages(library(HSAUR2, warn.conflicts=FALSE))
# suppressMessages(library(Hotelling, warn.conflicts=FALSE))
suppressMessages(library(knitr, warn.conflicts=FALSE))
suppressMessages(library(lawstat, warn.conflicts=FALSE))
suppressMessages(library(lfda, warn.conflicts=FALSE))
suppressMessages(library(lmboot, warn.conflicts=FALSE))
suppressMessages(library(lmerTest, warn.conflicts=FALSE))
suppressMessages(library(MANOVA.RM, warn.conflicts=FALSE))
suppressMessages(library(MASS, warn.conflicts=FALSE))
suppressMessages(library(MatchIt, warn.conflicts=FALSE)) # distancia robusta
suppressMessages(library(matlib, warn.conflicts=FALSE))
suppressMessages(library(matrixcalc, warn.conflicts=FALSE))
suppressMessages(library(MatrixModels, warn.conflicts=FALSE))
suppressMessages(library(matrixStats, warn.conflicts=FALSE))
suppressMessages(library(missMethods, warn.conflicts=FALSE))
suppressMessages(library(MomTrunc, warn.conflicts=FALSE))
suppressMessages(library(multcomp, warn.conflicts=FALSE))
suppressMessages(library(MultivariateAnalysis, warn.conflicts=FALSE))
suppressMessages(library(MuMIn, warn.conflicts=FALSE))
suppressMessages(library(MVA, warn.conflicts=FALSE)) # An Introduction to Applied Multivariate Analysis with R
suppressMessages(library(MVar.pt, warn.conflicts=FALSE))
suppressMessages(library(mvdalab, warn.conflicts=FALSE))
# suppressMessages(library(MVLM, warn.conflicts=FALSE))
suppressMessages(library(MVN, warn.conflicts=FALSE))
suppressMessages(library(MVTests, warn.conflicts=FALSE)) # T^2 robusta
suppressMessages(library(mvtnorm, warn.conflicts=FALSE))
suppressMessages(library(norm, warn.conflicts=FALSE))
suppressMessages(library(phia, warn.conflicts=FALSE))
suppressMessages(library(plotly, warn.conflicts=FALSE))
suppressMessages(library(pracma, warn.conflicts=FALSE))
suppressMessages(library(profileR, warn.conflicts=FALSE))
suppressMessages(library(psych, warn.conflicts=FALSE))
suppressMessages(library(qcc, warn.conflicts=FALSE))
suppressMessages(library(rcompanion, warn.conflicts=FALSE))
suppressMessages(library(reticulate, warn.conflicts=FALSE))
suppressMessages(library(rgl, warn.conflicts=FALSE))
suppressMessages(library(Rmisc, warn.conflicts=FALSE))
suppressMessages(library(rrcov, warn.conflicts=FALSE))
suppressMessages(library(scatterplot3d, warn.conflicts=FALSE))
suppressMessages(library(SHT, warn.conflicts=FALSE))
suppressMessages(library(sjPlot, warn.conflicts=FALSE))
# suppressMessages(library(skimr, warn.conflicts=FALSE))
suppressMessages(library(tidyr, warn.conflicts=FALSE))
source("summarySEwithin2.R")
source("T2.R")

Adicionar

apaTables::apa.aov.table(fit,
                         conf.level=1-alfa,
                         type=3)
  • lmboot::ANOVA.boot
modelo_boot <- lmboot::ANOVA.boot(Sodium ~ Instructor, 
                                  B=B, 
                                  type="residual", 
                                  wild.dist="normal",  
                                  seed=123,
                                  data=TH, 
                                  keep.boot.resp=FALSE)
d <- density(modelo_boot$bootFStats)
plot(d, 
     main=paste("Independent one-way ANOVA (",bootsamples,
                " replicates)",sep=""), 
     xlab="F", ylab="Density", lwd=2)
Fc <- quantile(modelo_boot$bootFStats,probs = 1-alfa)
abline(v=Fc, lty=3)
Fobs <- qf(1-modelo_boot$`p-values`, modelo_boot$df[1],
           modelo_boot$df[2])
abline(v=Fobs, lty=4)
legend("topright",
       c(expression(H[0]), 
         paste("F(",modelo_boot$df[1],", ",modelo_boot$df[2],
               "; ",1-alfa,") = ",round(Fc,2),sep=""),
         paste("\nF(",modelo_boot$df[1],", ",modelo_boot$df[2],") = ",
               round(Fobs,2),"\n",
               "p = ",round(modelo_boot$`p-values`,5),sep="")
       ),
       lwd=c(2,1,1), lty=c(1,3,4))
cat(paste("F(",modelo_boot$df[1],", ",modelo_boot$df[2],") = ",
          round(Fobs,2),
          ", p = ",round(modelo_boot$`p-values`,5),"\n", sep=""))
cat(paste("(",bootsamples," bootstrap samples)\n", sep=""))

cat("Effect size analysis")
eta2 <- modelo_boot$df[1]*Fobs/(modelo_boot$df[1]*Fobs+modelo_boot$df[2])
cat("eta^2 = ", round(eta2,2), sep="")
es <- effectsize::interpret_eta_squared(eta2)
names(es) <- c("Tamanho de efeito: estimativa pontual")
print(es)
  • MultivariateAnalysis::MANOVA
    • Monteiro, A. L. M. (2024). Pacote do R MultivariateAnalysis e suas aplicações na análise estatística de dados [Dissertação de mestrado, Universidade Federal de Minas Gerais]

Material

Pensamento

“Não é paradoxo dizer que nos nossos momentos de inspiração mais teórica podemos estar o mais próximo possível de nossas aplicações mais práticas.”

WHITEHEAD, AN apud BOYER, CB (1974) História da matemática. São Paulo: Blücher/EDUSP, p. 419.

Sumário

  1. Aspectos de análise multivariada
  2. Álgebra matricial e vetor estocástico
  3. Geometria amostral e amostragem aleatória
  4. Distribuição normal multivariada
  5. Inferência sobre vetor de média
  6. Comparação de várias médias multivariadas
  7. Modelo de regressão linear multivariada
  8. Componentes principais
  9. Análise de fatores e inferência sobre matriz de covariância
  10. Análise de correlação canônica
  11. Discriminação e classificação
  12. Clusterização, métodos de distância e ordination

Comentário gerais sobre o livro-texto

  • Delineamento do estudo e nível de mensuração da variável determinam o teste estatístico
  • Modelo explicativo: teste estatístico multivariado sem dados brutos
  • Arquivo de dados sempre wide
  • Apenas efeito fixo (sem efeito aleatório)
  • Não há GLM multivariado misto com efeito aleatório
  • Bootstrapping com dados completos
  • Missing value é problema com arquivo wide
  • Estimação de tamanho e importância de efeito
  • Estimação de importância de medida (measure)
  • Estimação da importância da VI ou efeito na rejeição da hipótese nula multivariada

Distribuição \(T^2\) de Hotelling

A estatística \(T^2\) é chamada de \(T^2\) de Hotelling em homenagem a Harold Hotelling, um pioneiro na análise multivariada, que primeiro obteve sua distribuição amostral. Aqui, \((1/n)\mathbf{S}\) é a matriz de covariância estimada de \(\overline{\mathbf{X}}\) (consulte o Resultado 3.1).

Se a distância estatística observada \(T^2\) for muito grande — ou seja, se \(\overline{\mathbf{X}}\) estiver “muito longe” de \(\boldsymbol{\mu}_0\) — a hipótese \(H_0: \boldsymbol{\mu} = \boldsymbol{\mu}_0\) é rejeitada. Acontece que tabelas especiais de quantis de \(T^2\) não são necessárias para testes formais de hipóteses. Isso ocorre porque pode ser usada a distribuição \(F\) para realizar testes de hipótese nula envolvendo a estatística \(T^2\).

Se \(F\sim F_{p, \,n-p}\), então

\[ T^2=(n-1)\dfrac{p}{n-p} F \;\overset{H_0}{\sim}\; T^2_{p,\,n-1} \tag{5-5} \]

Sendo que:

\[ T^2_{p,\,n-1}(1-\alpha)=(n-1)\dfrac{p}{n-p} F_{p, \,n-p}(1-\alpha) \]

em que \(F_{p, n-p}\) é distribuição F de Fisher-Snedecor com \(p\) e \(n-p\) graus de liberdade do numerador e denominador, respectivamente.

Se \(n-p\ge200\) e \(p\le6\), então

\[ T^2_{p,\,n-1}(1-\alpha) \approx \chi^2_p(1-\alpha) \]

De forma mais geral, temos que a seguinte relação dos quantis:

\[ T^2_{k_1,\,k_2}(1-\alpha)=k_2\dfrac{k_1}{k_2-k_1+1} F_{k_1,\, k_2-k_1+1}(1-\alpha) \] Funções da distribuição T² de Hotelling:

A função densidade de probabilidade (fdp) é dada por

\[ f_{T^2}(t;k_1,k_2) = \frac{t^{\frac{k_1}{2}-1}} {k_2^{\frac{k_1}{2}}\,B\!\left(\frac{k_1}{2},\,\frac{k_2-k_1+1}{2}\right)} \left(1+\frac{t}{k_2}\right)^{-\frac{k_2+1}{2}}, \quad t>0 \]

sendo que \(B(a,b)\) é a função beta completa:

\[ B(a,b)=\int_0^1 u^{a-1}(1-u)^{b-1}\,du \]

A função distribuição acumulada (cdf) é

\[ F_{T^2}(t;k_1,k_2) = I_{\frac{t}{k_2+t}}\!\left(\frac{k_1}{2},\,\frac{k_2-k_1+1}{2}\right) \]

em que \(I_z(a,b)\) é a beta incompleta regularizada:

\[ I_z(a,b) = \frac{B_z(a,b)}{B(a,b)}, \quad B_z(a,b)=\int_0^z u^{a-1}(1-u)^{b-1}\,du \]

No caso usual de teste de uma amostra, com dimensão \(p\) e tamanho amostral \(n\), temos \(k_1=p\) e \(k_2=n-1\), logo:

\[ \begin{align} T^2&=n\left(\overline{\mathbf{X}}-\boldsymbol{\mu}_0\right)^{\prime}\mathbf{S}^{-1}\left(\overline{\mathbf{X}}-\boldsymbol{\mu}_0\right)\sim T^2_{p,n-1}=\frac{p(n-1)}{n-p}F_{p,n-p}\\\\ f_{T^2}(t;p,n)&=\frac{t^{\frac{p}{2}-1}} {(n-1)^{\frac{p}{2}}\,B\!\left(\frac{p}{2},\,\frac{n-p}{2}\right)} \left(1+\frac{t}{n-1}\right)^{-\frac{n}{2}}\\ F_{T^2}(t;p,n)&=I_{\frac{t}{t+n-1}}\!\left(\frac{p}{2},\,\frac{n-p}{2}\right) \end{align} \]

Observação: caso \(\mathbf{\Sigma}\) conhecida, \(T^2\sim\chi^2_p\).

source("T2.R")

p <- 3 
n <- 75 
k1 <- p 
k2 <- n - 1
alpha <- 0.05
B <- 1e6
set.seed(123)
q_emp <- quantile(rT2(B, k1, k2), 1-alpha)
q_the <- qT2(1-alpha, k1, k2)
print(round(c(emp = unname(q_emp), te = q_the), 4))
   emp     te 
8.4113 8.4231 
# --- fdp: p fixo, variar n ---
plot_fdp_fix_p_var_n <- function(p = 3, ns = c(15, 30, 75, 150), x_max = 30) {
        cols <- 1:length(ns)
        plot(NA, xlim = c(0, x_max), ylim = c(0, 0.25),
             xlab = expression(T^2), ylab = "fdp",
             main = bquote("fdp T"^2*" (p="*.(p)*")"))
        for (i in seq_along(ns)) {
          n <- ns[i]; k1 <- p; k2 <- n - 1
          curve(dT2(x, k1, k2), from = 0, to = x_max, add = TRUE, lwd = 2, col = cols[i])
        }
        legend("topright", legend = paste0("n=", ns), col = cols, lwd = 2, bty = "n")
      }
      
# --- fdp: n fixo, variar p ---
plot_fdp_fix_n_var_p <- function(n = 75, ps = c(2, 3, 5, 10), x_max = 30) {
        cols <- 1:length(ps)
        plot(NA, xlim = c(0, x_max), ylim = c(0, 0.2),
             xlab = expression(T^2), ylab = "fdp",
             main = bquote("fdp T"^2*" (n="*.(n)*")"))
        for (i in seq_along(ps)) {
          p <- ps[i]; k1 <- p; k2 <- n - 1
          curve(dT2(x, k1, k2), from = 0, to = x_max, add = TRUE, lwd = 2, col = cols[i])
        }
        legend("topright", legend = paste0("p=", ps), col = cols, lwd = 2, bty = "n")
      }
      
# --- CDF: p fixo, variar n ---
plot_cdf_fix_p_var_n <- function(p = 3, ns = c(15, 30, 75, 150), x_max = 30) {
        cols <- 1:length(ns)
        plot(NA, xlim = c(0, x_max), ylim = c(0, 1),
             xlab = expression(T^2), ylab = "CDF",
             main = bquote("CDF T"^2*" (p="*.(p)*")"))
        for (i in seq_along(ns)) {
          n <- ns[i]; k1 <- p; k2 <- n - 1
          curve(pT2(x, k1, k2), from = 0, to = x_max, add = TRUE, lwd = 2, col = cols[i])
        }
        legend("bottomright", legend = paste0("n=", ns), col = cols, lwd = 2, bty = "n")
      }
      
# --- CDF: n fixo, variar p ---
plot_cdf_fix_n_var_p <- function(n = 75, ps = c(2, 3, 5, 10), x_max = 30) {
        cols <- 1:length(ps)
        plot(NA, xlim = c(0, x_max), ylim = c(0, 1),
             xlab = expression(T^2), ylab = "CDF",
             main = bquote("CDF T"^2*" (n="*.(n)*")"))
        for (i in seq_along(ps)) {
          p <- ps[i]; k1 <- p; k2 <- n - 1
          curve(pT2(x, k1, k2), from = 0, to = x_max, add = TRUE, lwd = 2, col = cols[i])
        }
        legend("bottomright", legend = paste0("p=", ps), col = cols, lwd = 2, bty = "n")
}

# --- fdp em escala log (semi-log) ---
plot_fdp_log_p_var_n <- function(p = 3, ns = c(15, 30, 75, 150), x_max = 30) {
  cols <- 1:length(ns)
  plot(NA, xlim = c(0, x_max), ylim = c(1e-6, 1), log = "y",
       xlab = expression(T^2), ylab = "fdp (log)",
       main = bquote("fdp T"^2*" log (p="*.(p)*")"))
  for (i in seq_along(ns)) {
    n <- ns[i]; k1 <- p; k2 <- n - 1
    curve(dT2(x, k1, k2), from = 1e-6, to = x_max, add = TRUE,
          lwd = 2, col = cols[i], n = 2001)
  }
  legend("topright", legend = paste0("n=", ns), col = cols, lwd = 2, bty = "n")
}
      
par(mfrow = c(1, 2), mar = c(4, 4, 2, 1))
plot_fdp_fix_p_var_n(p = 3, ns = c(15, 30, 75, 150))
plot_fdp_fix_n_var_p(n = 75, ps = c(2, 3, 5, 10))

par(mfrow = c(1, 2), mar = c(4, 4, 2, 1))
plot_cdf_fix_p_var_n(p = 3, ns = c(15, 30, 75, 150))
plot_cdf_fix_n_var_p(n = 75, ps = c(2, 3, 5, 10))

par(mfrow = c(1, 1), mar = c(4, 4, 2, 1))
plot_fdp_log_p_var_n(p = 3, ns = c(15, 30, 75, 150))

Introdução

Análise estatística multivariada tem que produzir valor p para o teste de hipótese nula omnibus.

As ideias desenvolvidas no Capítulo 5 podem ser estendidas para lidar com problemas envolvendo a comparação de vetores de média.

O teste \(T^2\) de Hotelling foi concebidos por H. Hotelling (1931, 1951).

O teste \(T^2\) de Hotelling para uma condição é o primeiro e mais básico dos testes multivariados.

O teste \(T^2\) de Hotelling para duas condições independentes testa a igualdade de dois centróides multivariados populacionais.

MANOVA foi concebida por Wilks (1932) para testar o efeito de um fator com três ou mais condições.

A teoria é um pouco mais complexa e baseia-se na suposição de distribuição multinormal ou tamanho de amostra grande (TLC) [tamanho de amostra pequeno (bootstrapping)].

Da mesma forma, a notação se torna mais pesada. Para contornar esses problemas, frequentemente revisaremos procedimentos univariados para comparar várias médias e depois generalizaremos para os casos multivariados correspondentes por analogia. Os exemplos numéricos que apresentamos ajudarão a consolidar os conceitos.

Como as comparações de médias frequentemente (e deveriam) emanam de experimentos planejados, aproveitamos a oportunidade para discutir alguns dos princípios de uma boa prática experimental. Um delineamento de medidas repetidas (intraparticipantes), útil em estudos comportamentais, é explicitamente considerado, juntamente com modificações necessárias para analisar curvas de crescimento.

Começamos considerando pares de vetores de média. Nas seções posteriores, discutimos várias comparações entre vetores de média organizados de acordo com os níveis de tratamento. As estatísticas de teste correspondentes dependem de uma divisão da variação total em parcelas de variação atribuíveis às fontes de tratamento e erro. Essa divisão é conhecida como análise de variância multivariada (MANOVA).

Modelo linear geral (GLM) multivariado multifatorial

O modelo linear geral (GLM) multivariado multifatorial nada mais é do que uma forma unificada de tratar regressão multivariada e MANOVA. Ele descreve a relação entre variáveis dependentes (VD) intervalares e uma ou mais variáveis independentes (VI) (que podem ser intervalares e/ou nominais). A VD também pode ser chamada de variável de desfecho, medida (measure) ou variável de resposta. A VI pode ser chamada de fator (VI nominal) ou covariável (VI intervalar).

Em palavras simples: você observa duas ou mais VD e verificar se elas estão conjuntamente relacionadas com uma VI interesse do pesquisador.

GLM multivariado permite o controle estatístico das variáveis de confusão na análise da relação entre as variáveis dependentes (VD) e a variável independente (VI) de interesse. Esse controle é feito pela inclusão das potenciais variáveis de confusão como covariáveis e fatores no modelo, de modo que o efeito estimado da VI sobre a VD seja ajustado e condicional às demais variáveis incluídas. Assim, o coeficiente associado à VI reflete sua associação com a VD mantendo fixos as covariáveis e os fatores de controle.

Exemplo: se as VD são pressão arterial (PA) e massa corporal total (MCT) e a VI de interesse é o fator uso de medicamento (sim/não), com as VI de controle idade (covariável) e sexo (fator), o GLM multivariado testa estatisticamente o efeito do fator medicamento sobre a PA e MCT controlando por idade e sexo.

Ou seja: GLM multivariado é um modelo que responde à pergunta “qual é o efeito da VI de interesse sobre as VD, quando controlo estatisticamente por meio de outras VI (variáveis de confusão)?”.

Controlar estatisticamente significa excluir os efeitos de sexo e idade da relação entre (PA, MCT) e medicamento. Este controle estatistico das variáveis de confusão sexo e idade consiste numa maneira de purificar a relação entre (PA, MCT) e medicamento.

Portanto, GLM multivariado é um modelo explicativo em contraposição ao modelo preditivo.

Além do controle estatístico, em um estudo empírico também se pode recorrer ao controle experimental, que visa aumentar a plausibilidade da relação causal entre as VD e VI. Esse controle se subdivide em estratégias voltadas à validade externa e à validade interna. A validade externa está relacionada à possibilidade de generalizar os resultados, dependendo de fatores como o método de amostragem, o processo de recrutamento e a definição clara da população-alvo por meio de critérios de inclusão e exclusão. Já a validade interna diz respeito à capacidade de assegurar que a relação observada entre as VD e VI não seja espúria, o que pode ser alcançado por técnicas como a randomização, o matching (pareamento) e o controle direto de variáveis de confusão.

Assim, a combinação entre o controle estatístico proporcionado pelo modelo linear geral e os procedimentos de controle experimental fortalece tanto a validade interna quanto a externa do estudo, oferecendo maior veracidade às conclusões sobre a relação entre as VD e VI de interesse.

Comparação de Pares e Delineamento de Medidas Repetidas

Delineamento intraparticipantes com duas condições dependentes

  • \(p\ge1,\; q=2,\; g=1: \; n_1\ge2\)

O número de UE é \(n=n_1\ge2\).

Medições são frequentemente registradas sob diferentes conjuntos de condições experimentais para verificar se as respostas diferem significativamente entre esses conjuntos. Por exemplo, a eficácia de um novo medicamento ou de uma campanha publicitária saturada pode ser determinada ao comparar medições antes do “tratamento” (medicamento ou publicidade) com aquelas após o tratamento. Em outras situações, dois ou mais tratamentos podem ser administrados nas mesmas ou em unidades experimentais semelhantes, e as respostas podem ser comparadas para avaliar os efeitos dos tratamentos.

Uma abordagem racional para comparar dois tratamentos, ou a presença e ausência de um único tratamento, é atribuir ambos os tratamentos à mesma unidade ou unidades idênticas (indivíduos, lojas, lotes de terra, e assim por diante). As respostas em pares podem então ser analisadas calculando suas diferenças, eliminando assim grande parte da variação extrínseca de unidade para unidade.

No caso de uma única resposta (univariada), seja \(X_{i1}\) denotar a resposta ao tratamento 1 (ou a resposta antes do tratamento) e \(X_{i2}\) denotar a resposta ao tratamento 2 (ou a resposta após o tratamento) para a i-ésima tentativa. Ou seja, \((X_{i1},X_{i2})\) são medições registradas na i-ésima unidade ou i-ésimo par de unidades semelhantes. Por delineamento, as \(n\) diferenças

\[ D_i = X_{i1} - X_{i2}, \quad i = 1,2,...,n \tag{6-1} \]

deveriam refletir apenas os efeitos diferenciais dos tratamentos.

Dado que as diferenças \(D_i\) representam observações independentes de uma distribuição \(\mathcal{N}(\delta, \sigma^2_D)\), a variável

\[ T = \dfrac{\overline{D}-\delta}{\dfrac{S_D}{\sqrt{n}}} \sim t_{n-1} \tag{6-2} \]

em que

\[ \overline{D} = \dfrac{1}{n} \sum_{i=1}^{n} D_i \quad \text{e} \quad S_D^2 = \dfrac{1}{n-1} \sum_{i=1}^{n} \left(D_i - \overline{D}\right)^2 \tag{6-3} \]

Consequentemente, um teste de nível \(\alpha\) de

\[ \begin{cases} H_0: \;\delta = 0 \\ H_1: \;\delta \neq 0 \end{cases}\\ \alpha=5\% \]

pode ser realizado comparando-se \(|t|\) com \(t_{n-1}(1-\alpha/2)\). Um intervalo de confiança de \(100(1 - \alpha)\%\) para a diferença média \(\delta = \mathbb{E}(X_{i1}-X_{i2})= \mathbb{E}(X_{i1})-\mathbb{E}(X_{i2})\) é fornecido pelo intervalo de confiança:

\[ \text{IC}^{1-\alpha}(\delta)=\left[\overline{D} \pm t_{n-1}(1-\alpha/2) \dfrac{S_D}{\sqrt{n}}\right]\tag{6-4} \]

Uma notação adicional é necessária para a extensão multivariada do procedimento de comparação pareada. É necessário distinguir entre \(p\) respostas, dois tratamentos e \(n\) unidades experimentais.

Rotulamos as \(p\) respostas dentro da \(j\)-ésima unidade observacional como:

\[ X_{1j1} = \text{variável 1 sob tratamento 1} \\ X_{1j2} = \text{variável 2 sob tratamento 1} \\ \vdots \\ X_{1jp} = \text{variável } p \text{ sob tratamento 1} \]

\[ \text{---------------} \]

\[ X_{2j1} = \text{variável 1 sob tratamento 2} \\ X_{2j2} = \text{variável 2 sob tratamento 2} \\ \vdots \\ X_{2jp} = \text{variável } p \text{ sob tratamento 2} \]

A observação tem a seguinte notação:

\[ X_{\text{tratamento},\,\text{UE},\,\text{medida}}=X_{i,j,k} \]

Sendo que:

\[ \begin{align} i &= 1,2,\ldots,q \\ j &= 1,2,\ldots,n \\ k &= 1,2,\ldots,p \end{align} \]

Sendo que:

\(q\): número de condições experimentais dependentes (tratamentos)

\(n\): número de unidades experimentais (UE)

\(p\): número de medidas (measures) intervalares

As \(p\) variáveis aleatórias de diferença pareada tornam-se:

\[ \begin{align} D_{j1} &= X_{1j1} - X_{2j1} \\ D_{j2} &= X_{1j2} - X_{2j2} \\ \vdots \\ D_{jp} &= X_{1jp} - X_{2jp} \end{align} \tag{6-5} \]

Seja \(\mathbf{D}^{\prime}_j = [D_{j1}\; D_{j2}\; \cdots\; D_{jp}]\) e suponha que, para \(j = 1, 2, \ldots, n\):

\[ \mathbb{E}\left(\mathbf{D}_j\right) = \boldsymbol{\delta} = \begin{bmatrix} \delta_1 \\ \delta_2 \\ \vdots\\ \delta_p \end{bmatrix} \]

e

\[ \mathbb{C}\left(\mathbf{D}_j\right) = \mathbf{\Sigma}_\mathbf{D} \tag{6-6} \]

Se, além disso, \(\{\mathbf{D}_i\}_{i=1}^{n} \sim \mathcal{N}_p\text{IID}(\boldsymbol{\delta}, \mathbf{\Sigma_\mathbf{D}})\), inferências sobre o vetor das diferenças médias \(\boldsymbol{\delta}\) podem ser baseadas em uma estatística \(T^2\). Especificamente,

\[ T^2 = n\left(\overline{\mathbf{D}} - \boldsymbol{\delta}_0\right)^{\prime} \mathbf{S}_\mathbf{D}^{-1} \left(\overline{\mathbf{D}} - \boldsymbol{\delta}_0\right) \tag{6-7} \]

em que

\[ \overline{\mathbf{D}} = \dfrac{1}{n} \sum_{i=1}^{n} \mathbf{D}_i \quad \text{e} \quad \mathbf{S}_\mathbf{D} = \frac{1}{n} \sum_{i=1}^{n} \left(\mathbf{D}_i - \overline{\mathbf{D}}\right)\left(\mathbf{D}_i - \overline{\mathbf{D}}\right)^{\prime} \tag{6-8} \]

Resultado 6.1. Sejam as diferenças \(\{\mathbf{D}_i\}_{i=1}^{n} \sim \mathcal{N}_p\text{IID}(\boldsymbol{\delta}, \mathbf{\Sigma_\mathbf{D}})\). Então

\[ T^2 = n\left(\overline{\mathbf{D}} - \boldsymbol{\delta}_0\right)^{\prime} \mathbf{S}_\mathbf{D}^{-1} \left(\overline{\mathbf{D}} - \boldsymbol{\delta}_0\right) \sim \dfrac{(n - 1)p}{n - p}F_{p, n - p}=T^2_{p,n-1} \]

Se \(n - p \ge 30\), pode-se recorrer ao Teorema Central do Limite, dispensando-se a suposição de multinormalidade.

Se \(n - p \ge200\) e \(p\le6\), \(T^2\) segue aproximadamente uma distribuição \(\chi^2_p\).

  • \(p\ge1,\; q=2,\; g=1: \; n_1\ge2\)

O número de UE é \(n=n_1\ge2\).

GLM multivariado com um fator intraparticipantes:

\[ \begin{align} T^2_{df_1,\,k_2}&=k_2\dfrac{df_1}{df_2}F_{df_1,\,df_2} \\\\ df_1 &= p(q-1) + p(g-1)=p\\ k_2&=n-g=n-1\\ df_2 &= k_2 - df_1+1= n-p\\\\ T^2_{p,\,n-1}&=(n-1)\dfrac{p}{n-p}F_{p,\,n-p} \end{align} \]

Prova. A distribuição exata de \(T^2\) é uma reformulação do resumo em (5-6), com vetores de diferenças para os vetores de observação. A distribuição aproximada de \(T^2\), para \(n - p \ge200\) e \(p\le6\), segue de (4-28).

Portanto, a hipótese nula multivariada é:

\[ \begin{cases} H_0: \;\boldsymbol{\delta} = \boldsymbol{\delta}_0 \\ H_1: \;\boldsymbol{\delta} \neq \boldsymbol{\delta}_0 \end{cases}\\ \alpha=5\% \]

Mais formalmente:

\[ \begin{cases} H_0: \;\boldsymbol{\delta} - \boldsymbol{\delta}_0 =\mathbf{0}\\ H_1: \;\boldsymbol{\delta} - \boldsymbol{\delta}_0\neq\mathbf{0} \end{cases}\\ \alpha=5\% \]

\[\Diamond\]

A condição \(\boldsymbol{\delta} = \boldsymbol{\delta}_0=\mathbf{0}\) é equivalente a “nenhuma diferença média entre os dois tratamentos”. Para a i-ésima variável, \(\delta_i > 0\) implica que o tratamento 1 é maior, em média, do que o tratamento 2. Em geral, inferências sobre \(\delta\) podem ser feitas usando o Resultado 6.1.

Dadas as diferenças observadas \(\mathbf{d}_j = [d_{j1}, d_{j2}, \ldots, d_{jp}]\), \(j = 1, 2, \ldots, n\), correspondendo às variáveis aleatórias em (6-5), um teste de nível \(\alpha\) de \(H_0: \boldsymbol{\delta} = \mathbf{0}\) versus \(H_1: \boldsymbol{\delta} \ne \mathbf{0}\) para uma população \(\mathcal{N}_p(\boldsymbol{\delta}, \mathbf{\Sigma_\mathbf{D}})\) rejeita \(H_0\) se

\[ T^2 = n\bar{\mathbf{d}}^{\prime} \mathbf{s}_\mathbf{d}^{-1} \bar{\mathbf{d}} > \dfrac{(n - 1)p}{n - p} F_{p, n-p}(1-\alpha) \]

Uma região de confiança de \(100(1 - \alpha)\%\) para \(\boldsymbol{\delta}\) consiste em todos os \(\boldsymbol{\delta}\) tais que:

\[ \left(\bar{\mathbf{d}}-\boldsymbol{\delta}\right)^{\prime} \mathbf{s}_\mathbf{d}^{-1} \left(\bar{\mathbf{d}}-\boldsymbol{\delta}\right) \le \dfrac{(n - 1)p}{n(n - p)} F_{p, n-p}(1-\alpha) \tag{6-9} \]

Além disso, intervalos de confiança simultâneos de \(100(1 - \alpha)\%\) para as diferenças médias individuais \(\delta_i\) são dados por:

\[ \text{IC}^{1-\alpha}\left(\delta_i\right)=\left[\bar{d}_i \pm \sqrt{ \dfrac{(n-1)p}{n-p}F_{p,n-p}(1-\alpha)\dfrac{s_{d_i}^2}{n}}\right]\tag{6-10} \]

Os intervalos de confiança simultâneos t de Bonferroni de \(100(1 - \alpha)\%\) para as diferenças médias individuais são:

\[ \text{IC}^{1-\alpha}(\delta_i)=\left[\bar{d}_i \pm t_{n-1}\left(1-\dfrac{\alpha}{2p}\right)\sqrt{\dfrac{s_{d_i}^2}{n}}\right]\tag{6-10a} \]

Exemplo 6.1: Verificando a diferença média com observações pareadas

  • \(p=2,\; q=2,\; g=1:\; n_1=11\)

O número de UE é \(n=n_1=11\).

  • UE: amostra retirada de descarregamento num rio ou afluente, homogeneizada e dividida em duas partes iguais; as duas partes são atribuídas aleatoriamente para cada laboratório

Estações de tratamento de águas residuais municipais são obrigadas por lei a monitorar suas descargas em rios e córregos regularmente. Preocupações sobre a confiabilidade dos dados de um desses programas de auto-monitoramento levaram a um estudo no qual amostras de efluentes foram divididas e enviadas para dois laboratórios para teste. Metade de cada amostra foi enviada para o Laboratório Estadual de Higiene de Wisconsin, e a outra metade foi enviada para um laboratório comercial privado rotineiramente usado no programa de monitoramento. Medidas da demanda bioquímica de oxigênio (DBO) e sólidos suspensos (SS) foram obtidas, para \(n = 11\) divisões de amostras, dos dois laboratórios. Os dados estão exibidos na Tabela 6.1.

Tabela 6.1 Dados do Efluente

Amostra \(j\) Laboratório Comercial (DBO) \(x_{1j1}\) Laboratório Comercial (SS) \(x_{1j2}\) Laboratório Estadual de Higiene (DBO) \(x_{2j1}\) Laboratório Estadual de Higiene (SS) \(x_{2j2}\)
1 6 27 25 15
2 6 23 28 13
3 18 64 36 22
4 8 44 35 29
5 11 30 15 31
6 34 75 44 64
7 28 26 42 30
8 71 124 54 64
9 43 54 34 56
10 33 30 29 20
11 20 14 39 21

Os resultados das análises químicas dos dois laboratórios concordam? Se existem diferenças, qual é a sua natureza?

A estatística \(T^2\) para testar \(H_0: \boldsymbol{\delta}^{\prime} = [\delta_1 \;\delta_2] = [0\;0]\) é construída a partir das diferenças de observações pareadas:

\[ \begin{align} d_{j1} &= x_{1j1} - x_{2j1}: -19, -22, -18, -27, -4, -10, -14, 17, 9, 4, -19\\ d_{j2} &= x_{1j2} - x_{2j2}: 12, 10, 42, 15, -1, 11, -4, 60, -2, 10, -7 \end{align} \]

\[ \bar{\mathbf{d}}= \begin{bmatrix} \bar{d}_1\\ \bar{d}_2 \end{bmatrix}= \begin{bmatrix} -9.36\\ 13.27 \end{bmatrix} \]

\[ \mathbf{s}_\mathbf{d}= \begin{bmatrix} 199.26&88.31\\ 88.31&418.61 \end{bmatrix} \]

\[ T^2=\begin{bmatrix}-9.36&13.27\end{bmatrix} \begin{bmatrix}0.0055&-0.0012\\ -0.0012&0.0026\end{bmatrix} \begin{bmatrix}-9.36\\13.27\end{bmatrix}=13.64 \]

Adotando \(\alpha = 0.05\), encontramos que

\[ \dfrac{p(n - 1)}{n - p} F_{p,n-p}(0.95) = \dfrac{2\times10}{9}F_{2,9}(0.95) = 9.46 \]

Como \(T^2 = 13.6 > 9.47\), rejeitamos \(H_0\) e concluímos que existe uma diferença média não nula entre as medições dos dois laboratórios. Ao inspecionar os dados, parece que o laboratório comercial tende a produzir medições de DBO mais baixas e medições de SS mais altas do que o Laboratório Estadual de Higiene. Os intervalos de confiança simultâneos de 95% para as diferenças médias \(\delta_1\) e \(\delta_2\) podem ser calculados usando a equação (6-10). Estes intervalos são:

\[ \text{IC}^{95\%}(\delta_1)=\left[ -9.36 \pm \sqrt{9.47\dfrac{199.26}{11}} \right]=[-22.45, 3.73] \]

\[ \text{IC}^{95\%}(\delta_2)=\left[ 13.27 \pm \sqrt{9.47\dfrac{418.61}{11}} \right]=[-5.70, 32.25] \]

Os intervalos de confiança simultâneos de 95% incluem zero, mas a hipótese \(H_0: \boldsymbol{\delta} = \mathbf{0}\) foi rejeitada no nível de 5%. O que devemos concluir?

As evidências apontam para diferenças reais. O ponto \(\boldsymbol{\delta} = \mathbf{0}\) está fora da região de confiança de 95% para \(\boldsymbol{\delta}\) (veja o Exercício 6.1), e esse resultado é consistente com o teste \(T^2\). O nível de confiança simultâneo de 95% se aplica ao conjunto inteiro de intervalos que poderiam ser construídos para todas as combinações lineares possíveis da forma \(a_1 \delta_1 + a_2 \delta_2\). Os intervalos particulares correspondentes às escolhas \((a_1 = 1, a_2 = 0)\) e \((a_1 = 0, a_2 = 1)\) contêm zero. Outras escolhas de \(a_1\) e \(a_2\) produzirão intervalos simultâneos que não contêm zero. (Se a hipótese \(H_0: \boldsymbol{\delta} = \mathbf{0}\) não fosse rejeitada, então todos os intervalos simultâneos incluiriam zero.)

Os intervalos simultâneos de Bonferroni também abrangem zero. (Veja o Exercício 6.2.)

Nossa análise assumiu uma distribuição normal para os \(\mathbf{D}_j\). Na verdade, a situação é ainda mais complexa pela presença de um ou, possivelmente, dois valores discrepantes (outliers). (Veja o Exercício 6.3.) Esses dados podem ser transformados para se tornarem mais próximos de uma distribuição normal, mas com uma amostra tão pequena, é difícil remover os efeitos dos outliers. (Veja o Exercício 6.4.)

Os resultados numéricos deste exemplo ilustram uma circunstância incomum que pode ocorrer ao fazer inferências.

A hipótes nula multivariada é:

\[ \begin{cases} H_0: \;\boldsymbol{\delta} - \boldsymbol{\delta}_0 =\mathbf{0}\\ H_1: \;\boldsymbol{\delta} - \boldsymbol{\delta}_0\neq\mathbf{0} \end{cases}\\ \alpha=5\% \]

Neste caso, \(\boldsymbol{\delta}_0 =\mathbf{0}\).

Usando lm:

# Usando lm
suppressMessages(suppressWarnings(
  invisible(Sys.setlocale("LC_ALL", "pt_BR.UTF-8"))))
x <- read.table("JW6Data/T6-1.dat", quote="\"", comment.char="")
names(x) <- c("BOD_C", "SS_C", "BOD_S", "SS_S")
print.data.frame(x)
   BOD_C SS_C BOD_S SS_S
1      6   27    25   15
2      6   23    28   13
3     18   64    36   22
4      8   44    35   29
5     11   30    15   31
6     34   75    44   64
7     28   26    42   30
8     71  124    54   64
9     43   54    34   56
10    33   30    29   20
11    20   14    39   21
d_BOD <- x$BOD_C-x$BOD_S
d_SS <- x$SS_C-x$SS_S
d <- data.frame(d_BOD,d_SS)
p <- dim(d)[2]
H0 <- rep(0, p)
fit <- lm(data=d,
          sweep(cbind(d_BOD , d_SS), 2, H0, "-") ~ 1)
print(car::Anova(fit))
Note: model has only an intercept; equivalent type-III tests substituted.

Type III MANOVA Tests: Pillai test statistic
            Df test stat approx F num Df den Df  Pr(>F)  
(Intercept)  1   0.57698   6.1377      2      9 0.02083 *
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
suppressMessages(suppressWarnings(
  invisible(Sys.setlocale("LC_ALL", "pt_BR.UTF-8"))))
x <- read.table("JW6Data/T6-1.dat", quote="\"", comment.char="")
names(x) <- c("BOD_C", "SS_C", "BOD_S", "SS_S")
print.data.frame(x)
   BOD_C SS_C BOD_S SS_S
1      6   27    25   15
2      6   23    28   13
3     18   64    36   22
4      8   44    35   29
5     11   30    15   31
6     34   75    44   64
7     28   26    42   30
8     71  124    54   64
9     43   54    34   56
10    33   30    29   20
11    20   14    39   21
boxplot(x)

alfa <- 0.05
d_BOD <- x$BOD_C-x$BOD_S
d_SS <- x$SS_C-x$SS_S
d <- data.frame(d_BOD,d_SS)
print.data.frame(d)
   d_BOD d_SS
1    -19   12
2    -22   10
3    -18   42
4    -27   15
5     -4   -1
6    -10   11
7    -14   -4
8     17   60
9      9   -2
10     4   10
11   -19   -7
boxplot(d)

mvn <- MVN::mvn(d, univariate_test = "SW")
print(mvn$multivariate_normality)
           Test Statistic p.value     Method      MVN
1 Henze-Zirkler     0.583   0.079 asymptotic ✓ Normal
print(mvn$univariate_normality)
          Test Variable Statistic p.value    Normality
1 Shapiro-Wilk    d_BOD     0.920   0.322     ✓ Normal
2 Shapiro-Wilk     d_SS     0.819   0.017 ✗ Not normal
centroidif <- colMeans(d)
print(centroidif, 2)
d_BOD  d_SS 
 -9.4  13.3 
s <- cov(d)
print(s, 3)
      d_BOD  d_SS
d_BOD 199.3  88.3
d_SS   88.3 418.6
n <- dim(d)[1]
n
[1] 11
p <- dim(d)[2]
p
[1] 2
T2crit <- ((n-1)*p/(n-p))*qf(1-alfa, p, n-p)
print(T2crit, 2)
[1] 9.5
H0 <- rep(0, p)
T2 <- as.numeric(n*t(centroidif-H0)%*%solve(s)%*%(centroidif-H0)) # 6-7
print(T2, 3)
[1] 13.6
T2 > T2crit
[1] TRUE
F <- T2/((n-1)*p/(n-p))
pv <- 1-pf(F, p, n-p)
cat("\nF(",p,", ",n-p,") = ", round(F,2),", p = ",round(pv,4), "\n", sep="")

F(2, 9) = 6.14, p = 0.0208
a.hat_abs <- abs(solve(s)%*%centroidif)
colnames(a.hat_abs) <- "Importância"
rownames(a.hat_abs) <- c("BOD", "SS")
print(proportions(a.hat_abs), digits=2)
    Importância
BOD        0.59
SS         0.41
me1 <- sqrt(T2crit*s[1,1]/n)
cat("IC95(delta1) = [", round(centroidif[1]-me1,2),", ", round(centroidif[1]+me1,2),"]", sep="")
IC95(delta1) = [-22.45, 3.73]
me2 <- sqrt(T2crit*s[2,2]/n)
cat("IC95(delta2) = [", round(centroidif[2]-me2,2),", ", round(centroidif[2]+me2,2),"]", sep="")
IC95(delta2) = [-5.7, 32.25]
c <- sqrt(T2crit/n)
car::ellipse(center=centroidif,
             shape=s,
             radius=c,
             fill=TRUE,
             fill.alpha=0.1,
             grid=FALSE,
             col="black",
             add=FALSE,
             xlab=expression(mu[BOD[C]]-mu[BOD[S]]), 
             ylab = expression(mu[SS[C]]-mu[SS[S]]), 
             main="Região elíptica de confiança de 95%")
points(H0[1], H0[2], pch=3, col="black")
text(H0[1], H0[2], pos=1, expression(H[0]))

mvdalab::MVcis(d,
               level=1-alfa,
               Vars2Plot=c(1, 2), 
               include.zero=TRUE)

            [,1]     [,2]
d_BOD -22.453272  3.72600
d_SS   -5.700119 32.24557
T2One <- MVTests::OneSampleHT2(d,
                               mu=H0,
                               alpha=alfa) 
print(summary(T2One))
       One Sample Hotelling T Square Test 

Hotelling T Sqaure Statistic = 13.63931 
 F value = 6.138 , df1 = 2 , df2 = 9 , p-value: 0.0208 

                  Descriptive Statistics

          d_BOD     d_SS
N     11.000000 11.00000
Means -9.363636 13.27273
Sd    14.115755 20.46016


                Detection important variable(s)

           Lower    Upper Mu0 Important Variables?
d_BOD -22.453272  3.72600   0                FALSE
d_SS   -5.700119 32.24557   0                FALSE
NULL
result <- MVTests::Mpaired(T1=x[,1:2],
                           T2=x[,3:4])
print(summary(result))
       Multivariate Paired Hotelling T Square Test 

Hotelling T Sqaure Statistic = 13.63931 
 F value = 6.138 , df1 = 2 , df2 = 9 , p-value: 0.0208 

           Descriptive Statistics (The First Treatment) 

         BOD_C     SS_C
Means 25.27273 46.45455
Sd    19.68294 31.84451


           Descriptive Statistics (The Second Treatment) 

         BOD_S     SS_S
Means 34.63636 33.18182
Sd    10.45249 19.07259


           Descriptive Statistics (The Differences) 

          BOD_S      SS_S
Means  9.363636 -13.27273
Sd    14.115755  20.46016


NULL
# Usando lm
fit <- lm(data=d,
          sweep(cbind(d_BOD , d_SS), 2, H0, "-") ~ 1)
print(car::Anova(fit))
Note: model has only an intercept; equivalent type-III tests substituted.

Type III MANOVA Tests: Pillai test statistic
            Df test stat approx F num Df den Df  Pr(>F)  
(Intercept)  1   0.57698   6.1377      2      9 0.02083 *
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Usando matriz de contraste
xmean <- colMeans(x)
sx <- cov(x)
I <- diag(1,p)
C <- cbind(I,-I)
T2_C <- as.numeric(n*t(C%*%xmean)%*%solve(C%*%sx%*%t(C))%*%(C%*%xmean)) # 6-15
print(T2, 3) # 6-7
[1] 13.6
# MANOVA.RM::multRM: non-normal error terms and/or heteroscedastic 
Dados.long <- readxl::read_xlsx("JW6Data/T6-1_long.xlsx")
Dados.long$Amostra <- factor(Dados.long$Amostra)
Dados.long$Lab <- factor(Dados.long$Lab)
print.data.frame(Dados.long)
   Amostra   Lab BOD  SS
1        1   Com   6  27
2        2   Com   6  23
3        3   Com  18  64
4        4   Com   8  44
5        5   Com  11  30
6        6   Com  34  75
7        7   Com  28  26
8        8   Com  71 124
9        9   Com  43  54
10      10   Com  33  30
11      11   Com  20  14
12       1 State  25  15
13       2 State  28  13
14       3 State  36  22
15       4 State  35  29
16       5 State  15  31
17       6 State  44  64
18       7 State  42  30
19       8 State  54  64
20       9 State  34  56
21      10 State  29  20
22      11 State  39  21
alfa <- 0.05
fit <- MANOVA.RM::multRM(cbind(BOD,SS) ~ Lab,
                         data=Dados.long,
                         iter=1e5,
                         alpha=alfa,
                         within="Lab",
                         subject="Amostra")
print(summary(fit))
Call: 
cbind(BOD, SS) ~ Lab
A multivariate repeated measures analysis with  1 within-subject factor(s) ( Lab )and  0 between-subject factor(s). 

Descriptive:
    Lab  n    BOD     SS
1   Com 11 25.273 46.455
2 State 11 34.636 33.182

Wald-Type Statistic (WTS):
    Test statistic df  p-value
Lab "13.639"       "2" "0.001"

modified ANOVA-Type Statistic (MATS):
    Test statistic
Lab          3.348

p-values resampling:
    paramBS (WTS) paramBS (MATS)
Lab "0.021"       "0.031"       
    paramBS (WTS) paramBS (MATS)
Lab "0.021"       "0.031"       

\[\Diamond\]

O pesquisador no Exemplo 6.1 realmente dividiu uma amostra primeiro agitando-a e depois despejando-a rapidamente para frente e para trás em duas garrafas para análise química. Isso foi prudente porque uma simples divisão da amostra em duas partes, obtida despejando a metade superior em uma garrafa e o restante em outra, poderia resultar em mais sólidos suspensos na metade inferior devido à sedimentação. Os dois laboratórios então não estariam trabalhando com as mesmas unidades experimentais, ou mesmo unidades semelhantes, e as conclusões não se relacionariam com a competência do laboratório, técnicas de medição e assim por diante.

Sempre que um investigador pode controlar a atribuição de tratamentos a unidades experimentais, um emparelhamento apropriado de unidades e uma atribuição randomizada de tratamentos podem aprimorar a análise estatística. Diferenças, se houver, entre unidades supostamente idênticas devem ser identificadas e as unidades mais semelhantes emparelhadas. Além disso, uma atribuição aleatória do tratamento 1 a uma unidade e do tratamento 2 à outra unidade ajudará a eliminar os efeitos sistemáticos de fontes não controladas de variação. A randomização pode ser implementada jogando uma moeda para determinar se a primeira unidade de um par recebe o tratamento 1 (cara) ou tratamento 2 (coroa). O tratamento restante é então atribuído à outra unidade. Uma randomização independente separada é realizada para cada par. Pode-se conceber o processo da seguinte forma:

Concluímos nossa discussão sobre comparações pareadas observando que \(\bar{\mathbf{d}}\) e \(\mathbf{s}_\mathbf{d}\), consequentemente, \(T_1\), podem ser calculados a partir das quantidades da amostra completa \(\bar{\mathbf{x}}\) e \(\mathbf{s}\). Aqui, \(\bar{\mathbf{x}}\) é o vetor \(2p \times 1\) das médias amostrais para as \(p\) variáveis nos dois tratamentos, dado por:

\[ \underset{1\times 2p}{\bar{\mathbf{x}}^{\prime}} = [\bar{x}_{11}\; \bar{x}_{12}\; \cdots\;\bar{x}_{1p}\; \bar{x}_{21}\; \bar{x}_{22}\; \cdots\; \bar{x}_{2p}] \tag{6-11} \]

\(\mathbf{s}\) é a matriz \(2p \times 2p\) de variâncias e covariâncias amostrais organizada como:

\[ \underset{2p\times 2p}{\mathbf{s}}= \begin{bmatrix} \underset{p\times p}{\mathbf{s}_{11}} & \underset{p\times p}{\mathbf{s}_{12}} \\ \underset{p\times p}{\mathbf{s}_{21}} & \underset{p\times p}{\mathbf{s}_{22}} \\ \end{bmatrix} \tag{6-12} \]

em que \(\mathbf{s}_{11}, \mathbf{s}_{12}, \mathbf{s}_{21}, \mathbf{s}_{22}\) são matrizes \(p \times p\).

A matriz \(\mathbf{s}_{11}\) contém as variâncias e covariâncias amostrais para as \(p\) variáveis no tratamento 1. Da mesma forma, \(\mathbf{s}_{22}\) contém as variâncias e covariâncias amostrais calculadas para as \(p\) variáveis no tratamento 2. Finalmente, \(\mathbf{s}_{12} = \mathbf{s}_{21}^{\prime}\) são as matrizes de covariâncias amostrais calculadas a partir das observações em pares das variáveis do tratamento 1 e tratamento 2.

Definindo a matriz:

\[ \underset{p\times 2p}{\mathbf{C}}=\left[\underset{p\times p}{\mathbf{I}}\;\;\underset{p\times p}{-\mathbf{I}}\right] \]

Podemos verificar (veja o Exercício 6.9) que:

\[ \begin{align} \mathbf{d}_i &= \mathbf{C}\mathbf{x}_{i}, \quad i = 1, 2, \ldots, n \\\\ \overline{\mathbf{d}}&=\mathbf{C}\bar{\mathbf{x}}\\ \mathbf{s}_{\mathbf{d}}&=\mathbf{C}\mathbf{s}\mathbf{C}^{\prime} \end{align} \tag{6-14} \]

Assim,

\[ T^2 = n\left(\mathbf{C}\bar{\mathbf{x}}\right)^{\prime}\left(\mathbf{C}\mathbf{s}\mathbf{C}^{\prime}\right)^{-1} \mathbf{C}\bar{\mathbf{x}} \tag{6-15} \]

Portanto, não é necessário calcular as diferenças \(\mathbf{d}_1, \mathbf{d}_2, \ldots, \mathbf{d}_{n}\). Por outro lado, é aconselhável calcular essas diferenças para verificar a normalidade e a suposição de uma amostra aleatória.

Cada linha \(\mathbf{c}^{\prime}_i\) da matriz \(\mathbf{C}\) na Equação (6-13) é um vetor de contraste, porque seus elementos somam zero. A atenção geralmente é centrada em contrastes ao comparar tratamentos. Cada contraste é perpendicular ao vetor \(\mathbf{1}^{\prime} = [1\; 1\;\ldots\; 1]\) uma vez que \(\mathbf{c}^{\prime}_i \mathbf{1} = 0\). O componente \(\mathbf{1}^{\prime} \mathbf{x}_i\), representando a soma total do tratamento, é ignorado pela estatística de teste \(T^2\) apresentada nesta seção.

# Usando matriz de contraste
xmean <- colMeans(x)
sx <- cov(x)
I <- diag(1,p)
C <- cbind(I,-I)
T2_C <- as.numeric(n*t(C%*%xmean)%*%solve(C%*%sx%*%t(C))%*%(C%*%xmean)) # 6-15
print(T2_C, 4)
[1] 13.64
print(T2, 4) # 6-7
[1] 13.64

Delineamento de Medidas Repetidas para Comparar Tratamentos

  • \(p=1,\; q\ge2,\; g=1\)

Outra generalização da estatística t pareada univariada surge em situações onde \(q\) tratamentos são comparados em relação a uma única variável resposta. Cada sujeito ou unidade experimental recebe cada tratamento uma vez ao longo de períodos sucessivos de tempo. A i-ésima observação é

\[ \mathbf{X}_{i}= \begin{bmatrix} X_{i1}\\X_{i2}\\\vdots\\X_{iq} \end{bmatrix}\\ i = 1, 2, \ldots ,n \]

em que \(X_{ij}\) é a resposta ao \(j\)-ésimo tratamento na \(i\)-ésima unidade. O nome medidas repetidas deriva do fato de que todos os tratamentos são administrados a cada unidade.

Para fins comparativos, consideramos os contrastes dos componentes de

\[ \boldsymbol{\mu}_i = \mathbb{E}\left(\mathbf{X}_{i}\right) \]

Esses podem ser:

\[ \begin{bmatrix} \mu_1 - \mu_2\\ \mu_1 - \mu_3\\ \vdots\\ \mu_1 - \mu_q \end{bmatrix}=\begin{bmatrix} 1&-1&0&\cdots&0&0\\ 1&0&-1&\cdots&0&0\\ \vdots&\vdots&\vdots&\ddots&\vdots&\vdots\\ 1&0&0&\cdots&0&-1\\ \end{bmatrix}\begin{bmatrix} \mu_{1}\\\mu_{2}\\\vdots\\\mu_{q} \end{bmatrix}= [\mathbf{1}\;-\mathbf{I}] \begin{bmatrix} \mu_{1}\\\mu_{2}\\\vdots\\\mu_{q} \end{bmatrix}= \mathbf{C}_1\boldsymbol{\mu} \]

ou

\[ \begin{bmatrix} \mu_2 - \mu_1\\ \mu_3 - \mu_2\\ \vdots\\ \mu_{q} - \mu_{q-1} \end{bmatrix}= \begin{bmatrix} -1&1&0&\cdots&0&0\\ 0&-1&1&\cdots&0&0\\ \vdots&\vdots&\vdots&\ddots&\vdots&\vdots\\ 0&0&0&\cdots&-1&1\\ \end{bmatrix} \begin{bmatrix} \mu_{1}\\\mu_{2}\\\vdots\\\mu_{q} \end{bmatrix}=\mathbf{C}_2\boldsymbol{\mu} \]

Ambos \(\mathbf{C}_1\) e \(\mathbf{C}_2\) são chamadas de matrizes de contraste, porque suas \(q-1\) linhas são linearmente independentes e cada uma é um vetor de contraste (soma nula e ortogonais ao vetor unitário).

A natureza do desenho elimina grande parte da influência da variação de unidade para unidade nas comparações de tratamento. Claro, o pesquisador deve randomizar a ordem na qual os tratamentos são apresentados a cada sujeito.

Quando as médias dos tratamentos são iguais, \(\mathbf{C}_1\boldsymbol{\mu} = \mathbf{C}_2\boldsymbol{\mu} = \mathbf{0}\). Em geral, a hipótese de que não há diferenças nos tratamentos (médias de tratamento iguais) torna-se \(\mathbf{C}\boldsymbol{\mu} = \mathbf{0}\) para qualquer escolha da matriz de contraste \(\mathbf{C}\).

Consequentemente, com base nos contrastes \(\mathbf{C}\mathbf{X}_i\) nas observações, temos médias \(\mathbf{C}\overline{\mathbf{X}}\) e matriz de covariância \(\mathbf{C}\mathbf{S}\mathbf{C}^{\prime}\), e testamos \(\mathbf{C}\boldsymbol{\mu} = \mathbf{0}\) usando a estatística \(T^2\):

\[ T^2 = n\left(\mathbf{C}\overline{\mathbf{X}}\right)^{\prime}\left(\mathbf{C}\mathbf{S}\mathbf{C}^{\prime}\right)^{-1} \mathbf{C}\overline{\mathbf{X}} \]

Teste para Igualdade de Tratamentos em Delineamento de Medidas Repetidas

Considere uma população \(\mathcal{N}_q(\boldsymbol{\mu}, \mathbf{\Sigma})\) e seja \(\mathbf{C}\) uma matriz de contraste. Um teste de nível \(\alpha\) de \(H_0: \mathbf{C}\boldsymbol{\mu} = \mathbf{0}\) vs. \(H_1: \mathbf{C}\boldsymbol{\mu} \ne \mathbf{0}\) é o seguinte:

Rejeite \(H_0\) se:

\[ \begin{align} T^2 &= n\left(\mathbf{C}\bar{\mathbf{x}}\right)^{\prime}\left(\mathbf{C}\mathbf{s}\mathbf{C}^{\prime}\right)^{-1} \mathbf{C}\bar{\mathbf{x}} \\ T^2 &> \dfrac{(n-1)(q-1)}{n-q+1}F_{q-1, n-q+1}(1-\alpha)=T^2_{q-1,n-1}(1-\alpha) \end{align} \tag{6-16} \]

Pode-se mostrar que \(T^2\) não depende da escolha particular de \(\mathbf{C}\).

Qualquer par de matrizes de contraste \(\mathbf{C}_1\) e \(\mathbf{C}_2\) deve estar relacionado por \(\mathbf{C}_1 = \mathbf{B}\mathbf{C}_2\), com \(\mathbf{B}\) não singular. Isso ocorre porque cada \(\mathbf{C}\) tem o maior número possível, \(q - 1\), de linhas linearmente independentes, todas perpendiculares ao vetor 1. Então, temos:

\[ \begin{align} \mathbf{C}_1^{\prime}(\mathbf{C}_1\mathbf{S}\mathbf{C}_1^{\prime})^{-1}\mathbf{C}_1&=(\mathbf{B}\mathbf{C}_2)^{\prime}(\mathbf{B}\mathbf{C}_2\mathbf{S}\mathbf{C}_2^{\prime}\mathbf{B}^{\prime})^{-1}(\mathbf{B}\mathbf{C}_2) \\ &= \mathbf{C}_2^{\prime}\mathbf{B}^{\prime}(\mathbf{B}^{\prime})^{-1}(\mathbf{C}_2\mathbf{S}\mathbf{C}_2^{\prime})^{-1}\mathbf{B}^{-1}\mathbf{B}\mathbf{C}_2 \\ \mathbf{C}_1^{\prime}(\mathbf{C}_1\mathbf{S}\mathbf{C}_1^{\prime})^{-1}\mathbf{C}_1&= \mathbf{C}_2^{\prime}(\mathbf{C}_2\mathbf{S}\mathbf{C}_2^{\prime})^{-1}\mathbf{C}_2 \end{align} \]

Assim, \(T^2\) calculado com \(\mathbf{C}_2\) ou \(\mathbf{C}_1 = \mathbf{B}\mathbf{C}_2\) produz o mesmo resultado.

Uma região de confiança para os contrastes \(\mathbf{C}\boldsymbol{\mu}\), com \(\boldsymbol{\mu}\) sendo a média de uma população normal, é determinada pelo conjunto de todos \(\mathbf{C}\boldsymbol{\mu}\) tais que:

\[ n\left(\mathbf{C}\bar{\mathbf{x}} - \mathbf{C}\boldsymbol{\mu}\right)^{\prime}\left(\mathbf{C}\mathbf{s}\mathbf{C}^{\prime}\right)^{-1}\left(\mathbf{C}\bar{\mathbf{x}} - \mathbf{C}\boldsymbol{\mu}\right) \leq \dfrac{(n-1)(q - 1)}{n - q+1}F_{q-1, n-q+1}(1-\alpha) \tag{6-17} \]

em que \(\bar{\mathbf{x}}\) e \(\mathbf{s}\) são definidos como na Equação (6-16). Portanto, intervalos de confiança simultâneos de \(100(1 - \alpha)\%\) para contrastes simples \(\mathbf{c}^{\prime}\boldsymbol{\mu}\) (e.g., cada linha de \(\mathbf{C}\)) para quaisquer vetores de contraste de interesse são dados por (veja o Resultado 5A.1):

\[ \text{IC}^{1-\alpha}\left(\mathbf{c}^{\prime}\boldsymbol{\mu}\right)=\left[\mathbf{c}^{\prime}\bar{\mathbf{x}} \pm \sqrt{\dfrac{(n-1)(q - 1)}{n - q+1}F_{q-1, n-q+1}(1-\alpha)\dfrac{\mathbf{c}\mathbf{s}\mathbf{c}^{\prime}}{n}} \right] \tag{6-18} \]

Exemplo 6.2: Testando tratamentos iguais em um delineamento de medidas repetidas

  • \(p=1,\; q=4,\; g=1:\; n=19\)

O número de UE é \(n=19\).

  • UE: cão sob pentabarbitol

Anestésicos melhorados são frequentemente desenvolvidos primeiro estudando seus efeitos em animais não-humanos. Em um estudo, 19 cães foram inicialmente administrados com o medicamento pentobarbitol*. Cada cão foi então administrado com dióxido de carbono (CO\(_2\)) em dois níveis de pressão. Em seguida, halotano (H) foi adicionado, e a administração de CO\(_2\) foi repetida. A resposta, em milissegundos entre batimentos cardíacos, foi medida para as quatro combinações de tratamento:

*: Em contextos reais, o pentobarbitol é um barbitúrico que pode ser usado como anestésico ou sedativo. Em experimentos com animais, pode ser usado para sedar ou anestesiar os animais antes de administrar outros tratamentos ou realizar procedimentos, garantindo assim que os animais estejam calmos e não sintam dor ou desconforto. Neste caso, é possível que o pentobarbitol tenha sido usado para sedar ou anestesiar os cães antes da administração de CO2 e halotano, de modo a controlar variáveis externas, reduzir o estresse ou desconforto dos animais e garantir a segurança do procedimento.

A Tabela 6.2 contém as quatro medições para cada um dos 19 cães, onde:

  • Tratamento 1 = alta pressão CO2 sem H
  • Tratamento 2 = baixa pressão CO2 sem H
  • Tratamento 3 = alta pressão CO2 com H
  • Tratamento 4 = baixa pressão CO2 com H

Os tratamentos sem H precedem os com H.

Tabela: Dados Sleeping-Dog (mili-segundo)

Cão Trat. 1 Trat. 2 Trat. 3 Trat. 4
1 426 609 556 600
2 253 236 392 395
3 359 433 349 357
4 432 431 522 600
5 405 426 513 513
6 324 438 507 539
7 310 312 410 456
8 326 326 350 504
9 375 447 547 548
10 286 286 403 422
11 349 382 473 497
12 429 410 488 547
13 348 377 447 514
14 412 473 472 446
15 347 326 455 468
16 434 458 637 524
17 364 367 432 469
18 420 395 508 531
19 397 556 645 625

Fonte: Dados cortesia do Dr. J. Atlee.

Analisaremos os efeitos anestésicos da pressão CO2 e do halotano a partir deste delineamento de medidas repetidas.

Existem três contrastes de tratamento que podem ser de interesse no experimento. Sejam \(\boldsymbol{\mu}_1, \boldsymbol{\mu}_2, \boldsymbol{\mu}_3\) e \(\boldsymbol{\mu}_4\) as respostas médias para os tratamentos 1, 2, 3 e 4, respectivamente. Então:

  1. Contraste do Halotano representando a diferença entre a presença e a ausência de halotano:

\[ (\boldsymbol{\mu}_3 + \boldsymbol{\mu}_4) - (\boldsymbol{\mu}_1 + \boldsymbol{\mu}_2)\\ -\boldsymbol{\mu}_1 - \boldsymbol{\mu}_2 + \boldsymbol{\mu}_3 + \boldsymbol{\mu}_4 \]

  1. Contraste do CO2 representando a diferença entre alta e baixa pressão CO2:

\[ (\boldsymbol{\mu}_1 + \boldsymbol{\mu}_3) - (\boldsymbol{\mu}_2 + \boldsymbol{\mu}_4) \\ \boldsymbol{\mu}_1 - \boldsymbol{\mu}_2 + \boldsymbol{\mu}_3 - \boldsymbol{\mu}_4 \]

  1. Contraste representando a influência do halotano nas diferenças de pressão CO2 (Interação H:CO2):

\[ (\boldsymbol{\mu}_1 + \boldsymbol{\mu}_4) - (\boldsymbol{\mu}_2 + \boldsymbol{\mu}_3) \\ \boldsymbol{\mu}_1 - \boldsymbol{\mu}_2 - \boldsymbol{\mu}_3 + \boldsymbol{\mu}_4 \]

A matriz de contraste é:

\[ \mathbf{C}= \begin{bmatrix} -1& -1& 1& 1\\ 1& -1& 1& -1\\ 1& -1& -1& 1 \end{bmatrix} \]

A partir da Equação (6-16), temos \(T^2 = 116 > 10.93\), e rejeitamos \(H_0: \mathbf{C}\boldsymbol{\mu} = \mathbf{0}\) (sem efeito populacional de tratamento).

Para determinar quais dos contrastes são responsáveis pela rejeição de \(H_0\), construímos intervalos de confiança simultâneos de 95% para esses contrastes. A partir da Equação (6-18), o contraste

\[ \mathbf{c}^{\prime}\boldsymbol{\mu} = (\boldsymbol{\mu}_3 + \boldsymbol{\mu}_4) - (\boldsymbol{\mu}_1 + \boldsymbol{\mu}_2) = \text{influência do halotano} \]

é estimado pelo intervalo

\[ \begin{align} \text{IC}^{95\%}((\boldsymbol{\mu}_3 + \boldsymbol{\mu}_4) - (\boldsymbol{\mu}_1 + \boldsymbol{\mu}_2)) &=\left[(\bar{x}_3 + \bar{x}_4) - (\bar{x}_1 + \bar{x}_2) \pm \sqrt{\dfrac{18\times3}{16} F_{3,16}(0.95)\dfrac{\mathbf{c}_1^{\prime}\mathbf{s}\mathbf{c}_1}{19}}\right]\\ &= \left[209.31 \pm \sqrt{10.94\dfrac{9432.32}{16}}\right] \\ &= \left[209.31 \pm 73.70\right]\\ \text{IC}^{95\%}((\boldsymbol{\mu}_3 + \boldsymbol{\mu}_4) - (\boldsymbol{\mu}_1 + \boldsymbol{\mu}_2))&=[135.61,283.01] \end{align} \]

em que \(\mathbf{c}_1\) é a primeira linha de \(\mathbf{C}\).

Da mesma forma, os contrastes remanescentes são estimados por:

Influência da pressão CO2:

\[ \text{IC}^{95\%}((\boldsymbol{\mu}_1 + \boldsymbol{\mu}_3) - (\boldsymbol{\mu}_2 + \boldsymbol{\mu}_4))=[-114.05,-6.05] \]

Interação H-CO2:

\[ \text{IC}^{95\%}((\boldsymbol{\mu}_1 + \boldsymbol{\mu}_4) - (\boldsymbol{\mu}_2 + \boldsymbol{\mu}_3))=[-78.76,53.18] \]

A análise dos efeitos principais e de interação é hierárquica. Primeiramente, é analisado o efeito de interação. Se a hipótese nula de ausência de efeito de interação não é rejeitada, os efeitos principais são diretamente analisáveis pelos respectivos intervalos de confiança.

O contraste de interação H-CO2, \((\boldsymbol{\mu}_1 + \boldsymbol{\mu}_4) - (\boldsymbol{\mu}_2 + \boldsymbol{\mu}_3)\) não é significativamente diferente de zero (veja o terceiro intervalo de confiança).

Portanto, o primeiro intervalo de confiança implica que há um efeito do halotano. A presença de halotano produz tempos mais longos entre batimentos cardíacos.

O segundo intervalo de confiança indica que há um efeito devido à pressão CO2: a menor pressão CO2 produz tempos mais longos entre batimentos cardíacos.

Deve-se ter cautela na interpretação dos resultados, pois os ensaios com halotano devem seguir aqueles sem halotano. O aparente efeito do H pode ser devido a uma tendência temporal. (Idealmente, a ordem temporal de todos os tratamentos deveria ser determinada aleatoriamente.)

suppressMessages(suppressWarnings(
  invisible(Sys.setlocale("LC_ALL", "pt_BR.UTF-8"))))
x <- read.table("JW6Data/T6-2.dat", quote="\"", comment.char="")
names(x) <- c("CO2high_Hwithout", "CO2low_Hwithout", 
              "CO2high_Hwith", "CO2low_Hwith")
print.data.frame(x)
   CO2high_Hwithout CO2low_Hwithout CO2high_Hwith CO2low_Hwith
1               426             609           556          600
2               253             236           392          395
3               359             433           349          357
4               432             431           522          600
5               405             426           513          513
6               324             438           507          539
7               310             312           410          456
8               326             326           350          504
9               375             447           547          548
10              286             286           403          422
11              349             382           473          497
12              429             410           488          547
13              348             377           447          514
14              412             473           472          446
15              347             326           455          468
16              434             458           637          524
17              364             367           432          469
18              420             395           508          531
19              397             556           645          625
boxplot(x)

alfa <- 0.05
C <- matrix(c(-1, -1,  1,  1,
               1, -1,  1, -1,
               1, -1, -1,  1),
            nrow=3, byrow=TRUE)
C
     [,1] [,2] [,3] [,4]
[1,]   -1   -1    1    1
[2,]    1   -1    1   -1
[3,]    1   -1   -1    1
mean <- colMeans(x)
print(mean, 4)
CO2high_Hwithout  CO2low_Hwithout    CO2high_Hwith     CO2low_Hwith 
           368.2            404.6            479.3            502.9 
s <- cov(x)
print(s, 3)
                 CO2high_Hwithout CO2low_Hwithout CO2high_Hwith CO2low_Hwith
CO2high_Hwithout             2819            3568          2943         2295
CO2low_Hwithout              3568            7963          5304         4065
CO2high_Hwith                2943            5304          6851         4500
CO2low_Hwith                 2295            4065          4500         4879
n <- dim(x)[1]
n
[1] 19
q <- dim(x)[2]
q
[1] 4
T2crit <- ((n-1)*(q-1)/(n-q+1))*qf(1-alfa, q-1, n-q+1)
print(T2crit, 4)
[1] 10.93
H0 <- rep(0, dim(C)[1])
T2 <- as.numeric(n*t(C%*%mean-H0)%*%solve(C%*%s%*%t(C))%*%(C%*%mean-H0))
print(T2, 5)
[1] 116.02
T2 > T2crit
[1] TRUE
F <- T2/((n-1)*(q-1)/(n-q+1))
pv <- 1-pf(F, q-1, n-q+1)
cat("\nF(",q-1,", ",n-q+1,") = ", round(F,2),", p = ", pv, "\n\n", sep="")

F(3, 16) = 34.38, p = 3.317767e-07
a.hat_abs <- abs(solve(C%*%s%*%t(C))%*%(C%*%mean))
colnames(a.hat_abs) <- "Importância"
rownames(a.hat_abs) <- c("H", "CO2p", "H:CO2p")
print(proportions(a.hat_abs), digits=2)
       Importância
H            0.562
CO2p         0.375
H:CO2p       0.063
# Halotano
c <- C[1,]
me <- sqrt(T2crit*t(c)%*%s%*%c/n)
cat("\nIC95%(Halotano) = [", round(t(c)%*%mean-me, 2),", ", 
    round(t(c)%*%mean+me,2), "]", sep="")

IC95%(Halotano) = [135.65, 282.98]
# Pressão de CO2
c <- C[2,]
me <- sqrt(T2crit*t(c)%*%s%*%c/n)
cat("\nIC95%(Pressão de CO2) = [", round(t(c)%*%mean-me, 2),", ", 
    round(t(c)%*%mean+me, 2), "]", sep="")

IC95%(Pressão de CO2) = [-114.73, -5.38]
# H:CO2p
c <- C[3,]
me <- sqrt(T2crit*t(c)%*%s%*%c/n)
cat("\nIC95%(H:CO2p) = [", round(t(c)%*%mean-me, 2),", ", 
    round(t(c)%*%mean+me, 2), "]", sep="")

IC95%(H:CO2p) = [-78.73, 53.15]

ANOVA bifatorial relacionada

ANOVA bifatorial relacionada (ou para medidas repetidas) (rmANOVA) não-balanceada é possível em arquivo de dados no formato long se a identificação da unidade experimental é modelada como efeito aleatório. No entanto, esta ANOVA bifatorial relacionada usando lmerTest::lmer(heartbeats ~ H*CO2 + (1|UE), data=Dados), car::Anova(modelo,test.statistic="F") e summary(modelo, correl=FALSE) não produz o valor p omnibus, não sendo assim uma autêntica análise multivariada. A maior vantagem desta análise é permitir desbalanceamento num delineamento intraparticipantes. A modelagem multivariada com \(T^2\) usa arquivo de dados no formato wide ou apenas o vetor de média e matriz de covariância amostrais (que pode ser obtida mesmo com dados faltantes, em geral, de maneira inadequada; FIML necessita de valores faltantes aleatoriamente (MAR: Missing At Random)).

suppressMessages(suppressWarnings(
  invisible(Sys.setlocale("LC_ALL", "pt_BR.UTF-8"))))
x <- read.table("JW6Data/T6-2.dat", quote="\"", comment.char="")
names(x) <- c("CO2high_Hwithout", "CO2low_Hwithout", 
              "CO2high_Hwith", "CO2low_Hwith")
x$UE <- factor(1:nrow(x))
dados_wide <- x

# Transformar os dados de formato wide para longo
Dados_long <- tidyr::gather(dados_wide, key = "variavel", 
                            value = "FCLatencia", -UE)

# Separar as variáveis CO2 e H
Dados_long$CO2 <- ifelse(grepl("high", Dados_long$variavel), 
                         "High", "Low")
Dados_long$H <- ifelse(grepl("without", Dados_long$variavel, 
                             ignore.case = TRUE), 
                       "Without", "With")

# Remover a coluna variável
Dados_long$variavel <- NULL
Dados_long$H <- factor(Dados_long$H)
Dados_long$CO2 <- factor(Dados_long$CO2)

print(ftable(Dados_long$UE, Dados_long$H, Dados_long$CO2))
            High Low
                    
1  With        1   1
   Without     1   1
2  With        1   1
   Without     1   1
3  With        1   1
   Without     1   1
4  With        1   1
   Without     1   1
5  With        1   1
   Without     1   1
6  With        1   1
   Without     1   1
7  With        1   1
   Without     1   1
8  With        1   1
   Without     1   1
9  With        1   1
   Without     1   1
10 With        1   1
   Without     1   1
11 With        1   1
   Without     1   1
12 With        1   1
   Without     1   1
13 With        1   1
   Without     1   1
14 With        1   1
   Without     1   1
15 With        1   1
   Without     1   1
16 With        1   1
   Without     1   1
17 With        1   1
   Without     1   1
18 With        1   1
   Without     1   1
19 With        1   1
   Without     1   1
print(xtabs(~UE+H+CO2, data=Dados_long))
, , CO2 = High

    H
UE   With Without
  1     1       1
  2     1       1
  3     1       1
  4     1       1
  5     1       1
  6     1       1
  7     1       1
  8     1       1
  9     1       1
  10    1       1
  11    1       1
  12    1       1
  13    1       1
  14    1       1
  15    1       1
  16    1       1
  17    1       1
  18    1       1
  19    1       1

, , CO2 = Low

    H
UE   With Without
  1     1       1
  2     1       1
  3     1       1
  4     1       1
  5     1       1
  6     1       1
  7     1       1
  8     1       1
  9     1       1
  10    1       1
  11    1       1
  12    1       1
  13    1       1
  14    1       1
  15    1       1
  16    1       1
  17    1       1
  18    1       1
  19    1       1
str(Dados_long)
'data.frame':   76 obs. of  4 variables:
 $ UE        : Factor w/ 19 levels "1","2","3","4",..: 1 2 3 4 5 6 7 8 9 10 ...
 $ FCLatencia: int  426 253 359 432 405 324 310 326 375 286 ...
 $ CO2       : Factor w/ 2 levels "High","Low": 1 1 1 1 1 1 1 1 1 1 ...
 $ H         : Factor w/ 2 levels "With","Without": 2 2 2 2 2 2 2 2 2 2 ...
source("summarySEwithin2.R")
alfa <- 0.05

print(psych::describe(FCLatencia ~ H*CO2, 
                      data=Dados_long), digits=2)

 Descriptive statistics by group 
H: With
CO2: High
           vars  n   mean    sd median trimmed   mad min max range skew
FCLatencia    1 19 479.26 82.77    473  477.18 72.65 349 645   296 0.32
           kurtosis    se
FCLatencia    -0.62 18.99
------------------------------------------------------------ 
H: Without
CO2: High
           vars  n   mean   sd median trimmed   mad min max range  skew
FCLatencia    1 19 368.21 53.1    364  371.12 60.79 253 434   181 -0.43
           kurtosis    se
FCLatencia    -0.92 12.18
------------------------------------------------------------ 
H: With
CO2: Low
           vars  n   mean    sd median trimmed   mad min max range  skew
FCLatencia    1 19 502.89 69.85    513  504.29 65.23 357 625   268 -0.21
           kurtosis    se
FCLatencia    -0.66 16.02
------------------------------------------------------------ 
H: Without
CO2: Low
           vars  n   mean    sd median trimmed   mad min max range skew
FCLatencia    1 19 404.63 89.24    410  402.53 63.75 236 609   373 0.32
           kurtosis    se
FCLatencia    -0.12 20.47
alfaBonf <- alfa/(length(unique(Dados_long$H))*
                 length(unique(Dados_long$CO2)))
ic <- summarySEwithin2(Dados_long,
                       measurevar="FCLatencia",
                       withinvars=c("H","CO2"),
                       idvar="UE",
                       na.rm=TRUE,
                       conf.interval=1-alfaBonf)
print(ic, 2)
        H  CO2 FCLatencia n_obs.x FCLatenciaNormed       sd n_obs.y        se
1    With High   479.2632      19         479.2632 41.53206      19  9.528107
2    With  Low   502.8947      19         502.8947 40.83881      19  9.369066
3 Without High   368.2105      19         368.2105 40.78560      19  9.356859
4 Without  Low   404.6316      19         404.6316 48.36286      19 11.095201
        ci
1 26.43601
2 25.99474
3 25.96087
4 30.78396
grf <- ggplot2::ggplot(ic,
                       ggplot2::aes(x=H,
                                    y=FCLatencia,
                                    colour=CO2)) +
  ggplot2::geom_errorbar(position=ggplot2::position_dodge(.9),
                         width=.1,
                         ggplot2::aes(ymin=FCLatencia-ci,
                                      ymax=FCLatencia+ci)) +
  ggplot2::geom_point(shape=21,
                      size=3,
                      fill="white",
                      position=ggplot2::position_dodge(.9)) +
  ggplot2::ylab("FCLatencia") +
  ggplot2::ggtitle("H & CO2: FCLatencia\nWithin-subject CI95% Bonferroni") +
  ggplot2::theme_bw()
print(grf)

modelo <- lmerTest::lmer(FCLatencia ~ H*CO2 + (1|UE), 
                         data=Dados_long)
cat("\nANOVA")

ANOVA
print(anv <- car::Anova(modelo, test.statistic="F"))
Analysis of Deviance Table (Type II Wald F tests with Kenward-Roger df)

Response: FCLatencia
             F Df Df.res    Pr(>F)    
H     112.5668  1     54 8.071e-15 ***
CO2     9.2655  1     54  0.003604 ** 
H:CO2   0.4203  1     54  0.519558    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
print(summary(modelo, correl=FALSE))
Linear mixed model fit by REML. t-tests use Satterthwaite's method [
lmerModLmerTest]
Formula: FCLatencia ~ H * CO2 + (1 | UE)
   Data: Dados_long

REML criterion at convergence: 797.6

Scaled residuals: 
     Min       1Q   Median       3Q      Max 
-2.06165 -0.42869 -0.00709  0.41075  2.49423 

Random effects:
 Groups   Name        Variance Std.Dev.
 UE       (Intercept) 3779     61.48   
 Residual             1849     43.00   
Number of obs: 76, groups:  UE, 19

Fixed effects:
                Estimate Std. Error      df t value Pr(>|t|)    
(Intercept)       479.26      17.21   30.60  27.846  < 2e-16 ***
HWithout         -111.05      13.95   54.00  -7.961 1.14e-10 ***
CO2Low             23.63      13.95   54.00   1.694    0.096 .  
HWithout:CO2Low    12.79      19.73   54.00   0.648    0.520    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
cat("\nEffect size analysis")

Effect size analysis
eta2g <- as.numeric(MuMIn::r.squaredGLMM(modelo)[2])
Registered S3 methods overwritten by 'MuMIn':
  method        from 
  nobs.multinom broom
  nobs.fitdistr broom
cat("\nTamanho de efeito: eta^2 omnibus =", round(eta2g,2))

Tamanho de efeito: eta^2 omnibus = 0.79
es <- effectsize::interpret_eta_squared(eta2g)
names(es) <- c("Tamanho de efeito omnibus: estimativa pontual")
print(es)
Tamanho de efeito omnibus: estimativa pontual 
                                      "large" 
(Rules: field2013)
eta2 <- effectsize::eta_squared(anv,
                                partial=TRUE,
                                generalized=FALSE,
                                ci=1-alfa/3,
                                alternative="two.sided",
                                verbose=TRUE)
eta2$interpret <- effectsize::interpret_eta_squared(eta2$Eta2)
print(eta2, digits=4)
# Effect Size for ANOVA (Type II)

Parameter | Eta2 (partial) |      98.3333% CI |  interpret
----------------------------------------------------------
H         |         0.6758 | [0.4887, 0.7844] |      large
CO2       |         0.1465 | [0.0050, 0.3612] |      large
H:CO2     |         0.0077 | [0.0000, 0.1460] | very small
# Grafico de perfis de medias
o.par <- par()
fit.means <- phia::interactionMeans(modelo)
plot(fit.means, 
     errorbar=paste0("ci",
                     round((1-alfaBonf)*100,4)),
     abbrev.levels=FALSE)
par(o.par)
Warning in par(o.par): parâmetro gráfico "cin" não pode ser especificado
Warning in par(o.par): parâmetro gráfico "cra" não pode ser especificado
Warning in par(o.par): parâmetro gráfico "csi" não pode ser especificado
Warning in par(o.par): parâmetro gráfico "cxy" não pode ser especificado
Warning in par(o.par): parâmetro gráfico "din" não pode ser especificado

Warning in par(o.par): parâmetro gráfico "page" não pode ser especificado
# plot(effects::effect(c("H"), modelo, 
#                      confidence.level=1-alfa/length(unique(Dados_long$H))), 
#      ci.style = "bars")
# plot(effects::effect(c("CO2"), modelo, 
#                      confidence.level=1-alfa/length(unique(Dados_long$CO2))), 
#      ci.style = "bars")
# plot(effects::effect(c("H", "CO2"), modelo, confidence.level=1-alfaBonf), 
#      multiline = TRUE, ci.style = "bars")

cat("\nPost hoc tests")

Post hoc tests
cat("\n\tH")

    H
EMM.A <- emmeans::emmeans(modelo, 
                          specs=pairwise~"H", 
                          adjust="holm",
                          level=1-alfa,
                          lmer.df="satterthwaite",
                          lmerTest.limit=nrow(Dados_long))
NOTE: Results may be misleading due to involvement in interactions
print(summary(EMM.A$emmeans))
 H       emmean   SE   df lower.CL upper.CL
 With       491 15.7 22.1      458      524
 Without    386 15.7 22.1      354      419

Results are averaged over the levels of: CO2 
Degrees-of-freedom method: satterthwaite 
Confidence level used: 0.95 
print(summary(EMM.A$contrasts, infer=TRUE))
 contrast       estimate   SE df lower.CL upper.CL t.ratio p.value
 With - Without      105 9.86 54     84.9      124  10.610  <.0001

Results are averaged over the levels of: CO2 
Degrees-of-freedom method: satterthwaite 
Confidence level used: 0.95 
print(plot(EMM.A$emmeans, 
           colors="black") + ggplot2::theme_bw())

print(plot(EMM.A$contrasts, 
           colors="black") + ggplot2::theme_bw())

print(multcomp::cld(object=EMM.A$emmeans,
                    level=1-alfa,
                    adjust="holm",
                    Letters=letters,
                    alpha=alfa))
 H       emmean   SE   df lower.CL upper.CL .group
 Without    386 15.7 22.1      349      424  a    
 With       491 15.7 22.1      453      529   b   

Results are averaged over the levels of: CO2 
Degrees-of-freedom method: satterthwaite 
Confidence level used: 0.95 
Conf-level adjustment: bonferroni method for 2 estimates 
significance level used: alpha = 0.05 
NOTE: If two or more means share the same grouping symbol,
      then we cannot show them to be different.
      But we also did not show them to be the same. 
cat("\n\tCO2")

    CO2
EMM.C <- emmeans::emmeans(modelo, 
                          specs=pairwise~"CO2", 
                          adjust="holm",
                          level=1-alfa,
                          lmer.df="satterthwaite",
                          lmerTest.limit=nrow(Dados_long))
NOTE: Results may be misleading due to involvement in interactions
print(summary(EMM.C$emmeans))
 CO2  emmean   SE   df lower.CL upper.CL
 High    424 15.7 22.1      391      456
 Low     454 15.7 22.1      421      486

Results are averaged over the levels of: H 
Degrees-of-freedom method: satterthwaite 
Confidence level used: 0.95 
print(summary(EMM.C$contrasts, infer=TRUE))
 contrast   estimate   SE df lower.CL upper.CL t.ratio p.value
 High - Low      -30 9.86 54    -49.8    -10.2  -3.044  0.0036

Results are averaged over the levels of: H 
Degrees-of-freedom method: satterthwaite 
Confidence level used: 0.95 
print(plot(EMM.C$emmeans, 
           colors="black") + ggplot2::theme_bw())

print(plot(EMM.C$contrasts, 
           colors="black") + ggplot2::theme_bw())

print(multcomp::cld(object=EMM.C$emmeans,
                    level=1-alfa,
                    adjust="holm",
                    Letters=letters,
                    alpha=alfa))
 CO2  emmean   SE   df lower.CL upper.CL .group
 High    424 15.7 22.1      386      462  a    
 Low     454 15.7 22.1      416      492   b   

Results are averaged over the levels of: H 
Degrees-of-freedom method: satterthwaite 
Confidence level used: 0.95 
Conf-level adjustment: bonferroni method for 2 estimates 
significance level used: alpha = 0.05 
NOTE: If two or more means share the same grouping symbol,
      then we cannot show them to be different.
      But we also did not show them to be the same. 

\[\Diamond\]

O teste na Equação (6-16) é apropriado quando a matriz de covariância, \(\mathbb{C}(\mathbf{X}) = \mathbf{\Sigma}\), não pode ser assumida com nenhuma estrutura especial. Se for razoável supor que \(\mathbf{\Sigma}\) tenha uma estrutura particular, os testes projetados com essa estrutura em mente têm maior poder do que o da Equação (6-16). (Para \(\mathbf{\Sigma}\) com a estrutura de correlação igual (8-14), consulte uma discussão sobre o delineamento “bloco randomizado” em [17] ou [22].)

Comparando Vetores de Média de Duas Populações

  • \(p\ge2,\; q=1,\; g=2\)

Um teste \(T^2\) para testar a igualdade de médias vetoriais de duas populações multivariadas pode ser desenvolvido por analogia com o procedimento univariado. (Consulte [11] para uma discussão sobre o caso univariado.) Esta estatística \(T^2\) é apropriada para comparar respostas de um conjunto de condições experimentais (população 1) com respostas independentes de outro conjunto de condições experimentais (população 2). A comparação pode ser feita sem controlar explicitamente a variabilidade de unidade para unidade, como no caso de comparação pareada.

Se possível, as unidades experimentais devem ser atribuídas aleatoriamente aos conjuntos de condições experimentais. A randomização irá, até certo ponto, mitigar o efeito da variabilidade de unidade para unidade em uma subsequente comparação de tratamentos. Embora alguma precisão seja perdida em relação às comparações pareadas, as inferências no caso de duas populações são, normalmente, aplicáveis a uma coleção mais geral de unidades experimentais, simplesmente porque a homogeneidade da unidade não é exigida.

Considere uma amostra aleatória de tamanho \(n_1\) da população 1 e uma amostra de tamanho \(n_2\) da população 2. As observações sobre \(p\) variáveis podem ser organizadas da seguinte forma:

Amostra da População 1

\[ \mathbf{x}_{11}, \mathbf{x}_{12}, \ldots, \mathbf{x}_{1n_1} \]

\[ \bar{\mathbf{x}}_1 = \dfrac{1}{n_1} \sum_{i=1}^{n_1} \mathbf{x}_{1i} \quad \mathbf{s}_1 = \dfrac{1}{n_1} \sum_{i=1}^{n_1} \left(\mathbf{x}_{1i} - \bar{\mathbf{x}}_1\right)\left(\mathbf{x}_{1i} - \bar{\mathbf{x}}_1\right)^{\prime} \]

Amostra da População 2

\[ \mathbf{x}_{21}, \mathbf{x}_{22}, \ldots, \mathbf{x}_{2n_2} \]

\[ \bar{\mathbf{x}}_2 = \dfrac{1}{n_2} \sum_{i=1}^{n_2} \mathbf{x}_{2i} \quad \mathbf{s}_2 = \dfrac{1}{n_2} \sum_{i=1}^{n_2} (\mathbf{x}_{2i} - \bar{\mathbf{x}}_2)(\mathbf{x}_{2i} - \bar{\mathbf{x}}_2)^{\prime} \]

Nesta notação, o primeiro subscrito — 1 ou 2 — denota a população.

Queremos fazer inferências sobre

\[ \text{vetor médio da população 1} - \text{vetor médio da população 2} = \boldsymbol{\mu}_1 - \boldsymbol{\mu}_2 \]

Por exemplo, queremos responder à questão: \(\boldsymbol{\mu}_1 = \boldsymbol{\mu}_2\) (ou, equivalentemente, \(\boldsymbol{\mu}_1 - \boldsymbol{\mu}_2 = \mathbf{0}\))? Além disso, se \(\boldsymbol{\mu}_1 - \boldsymbol{\mu}_2 \neq \mathbf{0}\), quais médias componentes são diferentes?

Com algumas suposições, somos capazes de fornecer respostas para essas perguntas.

Suposições Sobre a Estrutura dos Dados

  1. A amostra \(\mathbf{X}_{11}, \mathbf{X}_{12}, \ldots, \mathbf{X}_{1n_1}\) é uma amostra aleatória de tamanho \(n_1\) de uma população p-variada com vetor médio \(\boldsymbol{\mu}_1\) e matriz de covariância \(\mathbf{\Sigma}_1\).

  2. A amostra \(\mathbf{X}_{21}, \mathbf{X}_{22}, \ldots, \mathbf{X}_{2n_2}\) é uma amostra aleatória de tamanho \(n_2\) de uma população p-variada com vetor médio \(\boldsymbol{\mu}_2\) e matriz de covariância \(\mathbf{\Sigma}_2\).

  3. Além disso, \(\mathbf{X}_{11}, \mathbf{X}_{12}, \ldots, \mathbf{X}_{1n_1}\) são independentes de \(\mathbf{X}_{21}, \mathbf{X}_{22}, \ldots, \mathbf{X}_{2n_2}\). (6-19)

Veremos adiante, para amostra grande, essa estrutura é suficiente para fazer inferências sobre o vetor \(p \times 1\) \(\boldsymbol{\mu}_1 - \boldsymbol{\mu}_2\). No entanto, quando os tamanhos das amostras \(n_1\) e \(n_2\) são pequenos, são necessárias mais suposições.

Suposições adicionais quando \(n_1+n_2-p-1<30\)

  1. Ambas as populações são multivariadas normais.

  2. Além disso, \(\mathbf{\Sigma}_1 = \mathbf{\Sigma}_2\) (homocedasticidade multivariada). (6-20)

A segunda suposição, de que \(\mathbf{\Sigma}_1 = \mathbf{\Sigma}_2\), é muito mais forte que sua contraparte univariada. Aqui estamos supondo que vários pares de variâncias e covariâncias são iguais.

Quando \(\mathbf{\Sigma}_1 = \mathbf{\Sigma}_2 = \mathbf{\Sigma}\),

\[ \sum_{i=1}^{n_1} (\mathbf{x}_{1i} - \bar{\mathbf{x}}_1)(\mathbf{x}_{1i} - \bar{\mathbf{x}}_1)^{\prime} \]

é uma estimativa de \((n_1 - 1)\mathbf{\Sigma}\) e

\[ \sum_{i=1}^{n_2} (\mathbf{x}_{2i} - \bar{\mathbf{x}}_2)(\mathbf{x}_{2i} - \bar{\mathbf{x}}_2)^{\prime} \]

é uma estimativa de \((n_2 - 1)\mathbf{\Sigma}\).

Consequentemente, podemos agrupar as informações em ambas as amostras para estimar a covariância comum \(\mathbf{\Sigma}\).

Definimos

\[ \mathbf{s}_{\text{comb}} = \dfrac{1}{n_1 + n_2 - 2} \left( \sum_{i=1}^{n_1} (\mathbf{x}_{1i} - \bar{\mathbf{x}}_1)(\mathbf{x}_{1i} - \bar{\mathbf{x}}_1)^{\prime} + \sum_{i=1}^{n_2} (\mathbf{x}_{2i} - \bar{\mathbf{x}}_2)(\mathbf{x}_{2i} - \bar{\mathbf{x}}_2)^{\prime} \right) \]

ou, de forma equivalente,

\[ \mathbf{s}_{\text{comb}} = \dfrac{n_1 - 1}{n_1 + n_2 - 2} \mathbf{s}_1 + \dfrac{n_2 - 1}{n_1 + n_2 - 2} \mathbf{s}_2 \tag{6-21} \]

Dado que \(\sum_{i=1}^{n_1} (\mathbf{x}_{1i} - \bar{\mathbf{x}}_1)(\mathbf{x}_{1i} - \bar{\mathbf{x}}_1)^{\prime}\) tem \(n_1 - 1\) graus de liberdade e \(\sum_{i=1}^{n_2} (\mathbf{x}_{2i} - \bar{\mathbf{x}}_2)(\mathbf{x}_{2i} - \bar{\mathbf{x}}_2)^{\prime}\) tem \(n_2 - 1\) graus de liberdade, o divisor \((n_1 - 1) + (n_2 - 1)\) em (6-21) é obtido combinando os dois graus de liberdade componentes. [Veja (4-24)]. Suporte adicional para o procedimento de agrupamento vem da consideração da verossimilhança normal multivariada. (Veja o Exercício 6.11.)

Hipótese nula multivariada:

\[ \begin{cases} H_0:\;\boldsymbol{\mu}_1 - \boldsymbol{\mu}_2 = \boldsymbol{\delta}_0\\ H_1:\;\boldsymbol{\mu}_1 - \boldsymbol{\mu}_2 \ne \boldsymbol{\delta}_0 \end{cases}\\ \alpha=5\% \]

Mais formalmente:

\[ \begin{cases} H_0:\;\boldsymbol{\mu}_1 - \boldsymbol{\mu}_2 - \boldsymbol{\delta}_0 = \mathbf{0}\\ H_1:\;\boldsymbol{\mu}_1 - \boldsymbol{\mu}_2 - \boldsymbol{\delta}_0 \ne \mathbf{0} \end{cases}\\ \alpha=5\% \]

Para testar a hipótese de que \(\boldsymbol{\mu}_1 - \boldsymbol{\mu}_2 = \boldsymbol{\delta}_0\), um vetor especificado, consideramos a distância estatística ao quadrado de \(\overline{\mathbf{X}}_1 - \overline{\mathbf{X}}_2\) para \(\boldsymbol{\delta}_0\). Agora,

\[ \begin{align} \mathbb{E}\left(\overline{\mathbf{X}}_1 - \overline{\mathbf{X}}_2\right) &= \mathbb{E}\left(\overline{\mathbf{X}}_1\right) - \mathbb{E}\left(\overline{\mathbf{X}}_2\right) \\ \mathbb{E}\left(\overline{\mathbf{X}}_1 - \overline{\mathbf{X}}_2\right)&= \boldsymbol{\mu}_1 - \boldsymbol{\mu}_2 \end{align} \]

Dado que a suposição de independência em (6-19) implica que \(\overline{\mathbf{X}}_1\) e \(\overline{\mathbf{X}}_2\) são independentes e, portanto, \(\mathbb{C}\left(\overline{\mathbf{X}}_1, \overline{\mathbf{X}}_2\right) = \mathbf{0}\) (veja o Resultado 4.5), por (3-9), segue-se que:

\[ \begin{align} \mathbb{C}\left(\overline{\mathbf{X}}_1- \overline{\mathbf{X}}_2\right) &= \mathbb{C}\left(\overline{\mathbf{X}}_1\right) + \mathbb{C}\left(\overline{\mathbf{X}}_2\right) \\ &= \dfrac{1}{n_1}\mathbf{\Sigma} + \dfrac{1}{n_2}\mathbf{\Sigma} \\ \mathbb{C}\left(\overline{\mathbf{X}}_1- \overline{\mathbf{X}}_2\right) &= \left( \dfrac{1}{n_1} + \dfrac{1}{n_2} \right)\mathbf{\Sigma} \end{align} \tag{6-22} \]

Como \(\mathbf{S}_{\text{comb}}\) estima \(\mathbf{\Sigma}\), vemos que

\[ \begin{align} \hat{\mathbb{C}}\left(\overline{\mathbf{X}}_1- \overline{\mathbf{X}}_2\right)&=\left( \dfrac{1}{n_1} + \dfrac{1}{n_2} \right)\mathbf{S}_{\text{comb}}\\ \hat{\mathbb{C}}\left(\overline{\mathbf{X}}_1- \overline{\mathbf{X}}_2\right)&=\dfrac{\mathbf{S}_{\text{comb}}}{\dfrac{\bar{n}_h}{2}} \end{align} \]

em que \(\bar{n}_h=\left(\dfrac{n_1^{-1}+n_2^{-1}}{2}\right)^{-1}\) é a média harmônica dos tamanhos de amostra das duas condições independentes, é um estimador de \(\mathbb{C}\left(\overline{\mathbf{X}}_1- \overline{\mathbf{X}}_2\right)\).

O teste da razão de verossimilhança de:

\[ H_0: \boldsymbol{\mu}_1 - \boldsymbol{\mu}_2 - \boldsymbol{\delta}_0=\mathbf{0} \]

é baseado no quadrado da distância estatística, \(T^2\), e é dado por (consulte [1]).

Rejeite \(H_0\) se:

\[ T^2 = (\bar{\mathbf{x}}_1- \bar{\mathbf{x}}_2 - \boldsymbol{\delta}_0)^{\prime} \left(\left( \dfrac{1}{n_1} + \dfrac{1}{n_2} \right)\mathbf{s}_{\text{comb}}\right)^{-1} (\bar{\mathbf{x}}_1- \bar{\mathbf{x}}_2 - \boldsymbol{\delta}_0) > c^2 \tag{6-23} \]

em que a distância crítica \(c^2\) é determinada a partir da distribuição da estatística \(T^2\) de duas condições independentes.

Resultado 6.2. Se \(\{\mathbf{X}_{1i}\}_{i=1}^{n_1} \sim \mathcal{N}_p\text{IID}(\boldsymbol{\mu}_1, \mathbf{\Sigma})\) e \(\{\mathbf{X}_{2i}\}_{i=1}^{n_2} \sim \mathcal{N}_p\text{IID}(\boldsymbol{\mu}_2, \mathbf{\Sigma})\), então:

\[ \begin{align} T^2 &= \left(\overline{\mathbf{X}}_1- \overline{\mathbf{X}}_2 - (\boldsymbol{\mu}_1 - \boldsymbol{\mu}_2)\right)^{\prime} \left(\left( \dfrac{1}{n_1} + \dfrac{1}{n_2}\right) \mathbf{S}_{\text{comb}}\right)^{-1} \left(\overline{\mathbf{X}}_1- \overline{\mathbf{X}}_2 - (\boldsymbol{\mu}_1 - \boldsymbol{\mu}_2)\right) \\ T^2 &\sim \dfrac{(n_1 + n_2 - 2)p}{n_1 + n_2 - p - 1}F_{p, n_1 + n_2 - p - 1}=T^2_{p,n_1 + n_2 - 2} \end{align} \tag{6-24} \]

\[\Diamond\]

Estamos principalmente interessados em regiões de confiança para \(\boldsymbol{\mu}_1 - \boldsymbol{\mu}_2\). A partir de (6-24), concluímos que todos os \(\boldsymbol{\mu}_1 - \boldsymbol{\mu}_2\) dentro da distância estatística ao quadrado \(c^2\) de \(\bar{\mathbf{x}}_1 - \bar{\mathbf{x}}_2\) constituem a região de confiança. Esta região é um elipsoide centrado na diferença observada \(\bar{\mathbf{x}}_1 - \bar{\mathbf{x}}_2\) e cujos eixos são determinados pelos autovalores e autovetores de \(\mathbf{s}_{\text{comb}}\) (ou \(\mathbf{s}_{\text{comb}}^{-1}\)).

Exemplo 6.3: Construindo uma região de confiança para a diferença de dois vetores de média

  • \(p = 2,\; q=1,\; g=2:\; n_1=50,\; n_2=50\)

O número de UE é \(n_1+n_2=100\).

Cinquenta barras de sabão são fabricadas de duas maneiras diferentes. Duas características, \(X_1\) (espumosidade) e \(X_2\) (suavidade), são medidas. As estatísticas resumidas para barras produzidas pelos métodos 1 e 2 são:

\[ \bar{\mathbf{x}}_1 = \begin{bmatrix} 8.3 \\ 4.1 \end{bmatrix} \quad \mathbf{s}_1 = \begin{bmatrix} 2 & 1 \\ 1 & 6 \end{bmatrix} \]

\[ \bar{\mathbf{x}}_2 = \begin{bmatrix} 10.2 \\ 3.9 \end{bmatrix} \quad \mathbf{s}_2 = \begin{bmatrix} 2 & 1 \\ 1 & 4 \end{bmatrix} \]

Obtenha uma região de confiança de 95% para \(\boldsymbol{\mu}_1 - \boldsymbol{\mu}_2\).

Primeiramente, observamos que \(\mathbf{s}_1\) e \(\mathbf{s}_2\) são aproximadamente iguais, então é razoável agrupá-los. Assim, a partir de (6-21), temos:

\[ \mathbf{s}_{\text{comb}} = \dfrac{49}{98} (\mathbf{s}_1 + \mathbf{s}_2) \]

Além disso,

\[ \bar{\mathbf{x}}_1 - \bar{\mathbf{x}}_2 = \begin{bmatrix} -1.9 \\ 0.2 \end{bmatrix} \]

então a elipse de confiança é centrada em \([-1.9, 0.2]^{\prime}\). Os autovalores e autovetores de \(\mathbf{s}_{\text{comb}}\) são obtidos a partir da equação:

\[ \det(\mathbf{s}_{\text{comb}} - \lambda \mathbf{I}) = 0 \]

o que nos dá \(\lambda^2 - 7\lambda + 9 = 0\). Daí, \(\lambda_1 = 5.303\) e \(\lambda_2 = 1.697\). Os autovetores correspondentes, \(\mathbf{e}_1\) e \(\mathbf{e}_2\), determinados a partir de \(\mathbf{S}_{\text{comb}} \mathbf{e}_i = \lambda_i \mathbf{e}_i\), são:

\[ \mathbf{e}_1 = \begin{bmatrix} 0.290 \\ 0.957 \end{bmatrix} \quad \text{e} \quad \mathbf{e}_2 = \begin{bmatrix} 0.957\\ -0.290\end{bmatrix} \]

Pelo Resultado 6.2,

\[ \left(\dfrac{1}{n_1}+\dfrac{1}{n_2}\right)c^2=\dfrac{2}{50} \dfrac{98\times 2}{97} F_{2, 97}(0.95) = 0.25 \]

já que \(F_{2,97}(0.95) = 3.1\).

A elipse de confiança se estende por \(\sqrt{\lambda_1\left(\dfrac{1}{n_1}+\dfrac{1}{n_2}\right)c^2}=\sqrt{\lambda_1\;0.25}\) no autovetor \(\mathbf{e}_i\), ou \(1.15\) unidades na direção do autovetor \(\mathbf{e}_1\) e \(0.65\) unidades na direção \(\mathbf{e}_2\).

A elipse de confiança de 95% é mostrada na Figura 6.1.

Claramente, \(H_0: \boldsymbol{\mu}_1 - \boldsymbol{\mu}_2 = \mathbf{0}\) não está na elipse, e concluímos que os dois métodos de fabricação de sabão produzem resultados diferentes.

Parece que os dois processos produzem barras de sabão com aproximadamente a mesma suavidade (\(X_2\)), mas aquelas do segundo processo têm mais espuma (\(X_1\)).

Figura 6.1 Elipse de confiança de 95% para diferença de duas médias populacionais.

Figura 6.1 Elipse de confiança de 95% para diferença de duas médias populacionais.

Sem dados brutos

suppressMessages(suppressWarnings(
  invisible(Sys.setlocale("LC_ALL", "pt_BR.UTF-8"))))
x1 <- c(8.3, 4.1)
x2 <- c(10.2, 3.9)
centroidif <- x1 - x2
print(centroidif, 2)
[1] -1.9  0.2
s1 <- matrix(c(2, 1,
               1, 6),
             nrow=2, byrow=TRUE)
s2 <- matrix(c(2, 1,
               1, 4),
             nrow=2, byrow=TRUE)
p <- length(centroidif)
p
[1] 2
n1 <- n2 <- 50
sp <- ((n1-1)/(n1+n2-2))*s1+((n2-1)/(n1+n2-2))*s2
print(sp, 2)
     [,1] [,2]
[1,]    2    1
[2,]    1    5
alfa <- 0.05
T2crit <- ((n1+n2-2)*p/(n1+n2-p-1))*qf(1-alfa, p, n1+n2-p-1)
print(T2crit, 3)
[1] 6.24
H0 <- rep(0, p)
T2 <- as.numeric(t(centroidif-H0)%*%solve((1/n1+1/n2)*sp)%*%(centroidif-H0))
print(T2, 4)
[1] 52.47
F <- T2/((n1+n2-2)*p/(n1+n2-p-1))
pv <- 1-pf(F, p, n1+n2-p-1)
cat("\nF(",p,", ",n1+n2-p-1,") = ", round(F,2),", p = ",pv, "\n", sep="")

F(2, 97) = 25.97, p = 9.286081e-10
c <- sqrt(T2crit*(1/n1+1/n2))
car::ellipse(center=centroidif,
             shape=sp,
             radius=c,
             fill=TRUE,
             fill.alpha=0.1,
             grid=FALSE,
             col="black",
             add=FALSE,
             xlab=expression(mu[11] - mu[21]), 
             ylab=expression(mu[12] - mu[22]),
             xlim=c(-3,1),
             ylim=c(-1,2),
             main="Região elíptica de confiança de 95%\nlather vs. mildness")
abline(v=0,h=0,lty=2)
points(H0[1], H0[2], pch=9, col="black")
text(H0[1], H0[2], pos=1, expression(H[0]))

a.hat_abs <- abs(solve(sp)%*%centroidif)
colnames(a.hat_abs) <- "Importância"
rownames(a.hat_abs) <- c("lather", "mildness")
print(proportions(a.hat_abs), digits=2)
         Importância
lather          0.81
mildness        0.19

Com dados brutos: iris

suppressMessages(suppressWarnings(
  invisible(Sys.setlocale("LC_ALL", "pt_BR.UTF-8"))))
Dados <- datasets::iris
vervir <- subset(x=Dados, 
                 subset=Species!="setosa")
vervir$Species <- droplevels(vervir$Species)

# lm
fit <- lm(cbind(Sepal.Length,
                Sepal.Width,
                Petal.Length,
                Petal.Width)~Species, 
          data=vervir)
print(anv <- car::Anova(fit, 
                        test="Pillai"), 
      digits=3)

Type II MANOVA Tests: Pillai test statistic
        Df test stat approx F num Df den Df Pr(>F)    
Species  1     0.784     86.1      4     95 <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
alpha <- 0.05
eta2 <- effectsize::eta_squared(anv,
                                partial=TRUE,
                                generalized=FALSE,
                                ci=1-alpha,
                                alternative="two.sided",
                                verbose=TRUE)
eta2$interpret <- effectsize::interpret_eta_squared(eta2$Eta2)
print(eta2, digits=2)
# Effect Size for ANOVA (Type II)

Parameter | Eta2 (partial) |       95% CI | interpret
-----------------------------------------------------
Species   |           0.78 | [0.71, 0.83] |     large
# Na saída, T.2 é F
DescTools::HotellingsT2Test(cbind(Sepal.Length,
                                  Sepal.Width,
                                  Petal.Length,
                                  Petal.Width)~Species, 
                            test="f",
                            data=vervir)

    Hotelling's two sample T2-test

data:  cbind(Sepal.Length, Sepal.Width, Petal.Length, Petal.Width) by Species
T.2 = 86.148, df1 = 4, df2 = 95, p-value < 2.2e-16
alternative hypothesis: true location difference is not equal to c(0,0,0,0)

Intervalos de Confiança Simultâneos

É possível derivar intervalos de confiança simultâneos para os componentes do vetor \(\boldsymbol{\mu}_1 - \boldsymbol{\mu}_2\). Esses intervalos de confiança são desenvolvidos a partir de uma consideração de todas as possíveis combinações lineares das diferenças nos vetores médios. Assume-se que as populações multivariadas parentais são normais com uma covariância comum \(\mathbf{\Sigma}\).

Resultado 6.3:

\[ \text{IC}^{1 - \alpha}(\boldsymbol{\mu}_{11} - \boldsymbol{\mu}_{21})=\left[\mathbf{a}^{\prime} \left(\overline{\mathbf{X}}_1 - \overline{\mathbf{X}}_2\right) \pm \\\sqrt{\dfrac{(n_1 + n_2 - 2)p}{n_1 + n_2 - p - 1} F_{p,n_1+n_2-p-1}(1-\alpha)\;\mathbf{a}^{\prime}\left(\dfrac{1}{n_1} + \dfrac{1}{n_2}\right) \mathbf{S}_{\text{comb}}\mathbf{a}}\right] \]

Em particular,

\[ \text{IC}^{1 - \alpha}(\mu_{1i}- \mu_{2i})=\left[\overline{X}_{1i} - \overline{X}_{2i} \pm \\\sqrt{\dfrac{(n_1 + n_2 - 2)p}{n_1 + n_2 - p - 1} F_{p,n_1+n_2-p-1}(1-\alpha)\left(\dfrac{1}{n_1} + \dfrac{1}{n_2}\right) S_{ii,\text{comb}}}\right]\\ i = 1,2,...,p \]

Observação. Para testar \(H_0: \boldsymbol{\mu}_1 - \boldsymbol{\mu}_2 = \mathbf{0}\), a combinação linear \(\hat{\mathbf{a}}^{\prime} (\bar{\mathbf{x}}_1 - \bar{\mathbf{x}}_2)\), com vetor de coeficiente \(\hat{\mathbf{a}} \propto \mathbf{s}_{\text{comb}}^{-1} (\bar{\mathbf{x}}_1 - \bar{\mathbf{x}}_2)\), quantifica a maior diferença populacional. Ou seja, se \(T^2\) rejeitar \(H_0\), então \(\hat{\mathbf{a}}^{\prime} (\bar{\mathbf{x}}_1 - \bar{\mathbf{x}}_2)\) terá uma média diferente de zero. Frequentemente, tentamos interpretar os componentes dessa combinação linear como a importância estatística da variável dependente ou efeito para rejeição da hipótese nula multivariada.

Exemplo 6.4: Calculando intervalos de confiança simultâneos para as diferenças nos componentes médios

  • \(p = 2 \;(\text{on-, off-peak}),\; q = 1,\; g = 2 \;(\text{com, sem ar-condicionado}):\;n_1=45,\; n_2=55\)

O número de UE é \(n_1+n_2=100\).

  • “On-peak” refere-se aos períodos do dia em que a demanda por eletricidade é maior, geralmente durante as horas mais quentes do dia quando muitas pessoas estão usando ar condicionado, eletrodomésticos, iluminação, etc. Durante esses períodos, as tarifas de eletricidade podem ser mais altas devido à maior demanda.

  • “Off-peak” refere-se aos períodos de menor demanda, geralmente à noite ou nas primeiras horas da manhã, quando menos dispositivos e aparelhos estão sendo usados. Durante esses períodos, as tarifas de eletricidade podem ser mais baixas.

No contexto fornecido, o texto está comparando o consumo elétrico “on-peak” e “off-peak” entre os proprietários de casas com ar condicionado e aqueles sem ar condicionado. Isso sugere que aqueles com ar condicionado podem consumir mais eletricidade durante os períodos de pico devido ao uso do aparelho de ar condicionado.

Foram coletadas amostras de tamanhos \(n_1 = 45\) e \(n_2 = 55\) de proprietários de casas em Wisconsin com e sem ar-condicionado, respectivamente. (Dados cortesia do Laboratório Estatístico, Universidade de Wisconsin.) Foram consideradas duas medições do uso elétrico (em quilowatt-hora). A primeira é uma medida do consumo total no pico (\(X_1\)) durante julho e a segunda é uma medida do consumo total fora do pico (\(X_2\)) durante julho. As estatísticas resumidas resultantes são:

Com ar-condicionado:

\[ \bar{\mathbf{x}}_1 = \begin{bmatrix} 204.4 \\ 556.6 \end{bmatrix} \quad \mathbf{s}_1 = \begin{bmatrix} 13825.3 & 23823.4 \\ 23823.4 & 73107.4 \end{bmatrix} \quad n_1 = 45 \]

Sem ar-condicionado:

\[ \bar{\mathbf{x}}_2 = \begin{bmatrix} 130.0 \\ 355.0 \end{bmatrix} \quad \mathbf{s}_2 = \begin{bmatrix} 8632.0 & 19616.7 \\ 19616.7 & 55964.5 \end{bmatrix} \quad n_2 = 55 \]

(O consumo fora do pico é maior que o consumo no pico porque há mais horas fora do pico em um mês.)

Vamos encontrar intervalos de confiança simultâneos de 95% para as diferenças nos componentes do vetor de média.

Embora haja alguma discrepância nas variâncias amostrais, para fins ilustrativos, vamos calcular a matriz de covariância da amostra combinada. Aqui:

\[ \mathbf{s}_{\text{comb}} = \dfrac{(n_1 - 1)\mathbf{s}_1 + (n_2 - 1)\mathbf{s}_2}{n_1 + n_2 - 2}= \begin{bmatrix} 10963.7&21505.5\\ 21505.5&63661.3 \end{bmatrix} \]

e

\[ \begin{align} c^2 &= \dfrac{(n_1 + n_2 - 2)p}{n_1 + n_2 - p - 1} F_{p,n_1+n_2-p-1}(1-\alpha)\\ &=\dfrac{98\times2}{97}F_{2,97}(0.95)\\ &=2.02\times3.1\\ c^2 &=6.26 \end{align} \]

Com \(\boldsymbol{\mu}_1^{\prime} - \boldsymbol{\mu}_2^{\prime} = [\mu_{11} - \mu_{21}, \mu_{12} - \mu_{22}]\), os intervalos de confiança simultâneos de 95% para as diferenças populacionais são:

On-peak:

\[ \text{IC}^{95\%}(\mu_{11}- \mu_{21})=\left[ 204.4 - 130.0 \pm \sqrt{6.26\left(\dfrac{1}{45} + \frac{1}{55}\right)10963.7}\right]= [21.7,127.1] \]

Off-peak:

\[ \text{IC}^{95\%}(\mu_{12}- \mu_{22})=\left[ 556.6 - 355.0 \pm \sqrt{6.26\left(\dfrac{1}{45} + \frac{1}{55}\right)63661.3}\right]= [74.7,328.5] \]

Concluímos que há uma diferença no consumo elétrico entre aqueles com ar-condicionado e aqueles sem. Esta diferença é evidente tanto no consumo no pico quanto fora do pico.

A região elíptica de confiança de 95% para \(\boldsymbol{\mu}_1 - \boldsymbol{\mu}_2\) é determinada a partir dos pares de autovalores e autovetores:

\[ \lambda_1 = 71323.5 \quad\mathbf{e}_1 = \begin{bmatrix} 0.336 \\ 0.942 \end{bmatrix} \]

e

\[ \lambda_2 = 3301.5 \quad\mathbf{e}_2 = \begin{bmatrix} 0.942 \\ -0.336 \end{bmatrix} \]

Dado que:

\[ \sqrt{\lambda_1 \left( \dfrac{1}{45} + \dfrac{1}{55} \right) c^2} = \sqrt{71323.5 \left( \frac{1}{45} + \frac{1}{55} \right) 6.26} = 134.3 \]

e

\[ \sqrt{\lambda_2 \left( \dfrac{1}{45} + \dfrac{1}{55} \right) c^2} = \sqrt{3301.5 \left( \dfrac{1}{45} + \dfrac{1}{55} \right) 6.26} = 28.9 \]

Obtemos a região elíptica de confiança de 95% para \(\boldsymbol{\mu}_1 - \boldsymbol{\mu}_2\), ilustrada na Figura 6.2.

Como a região elíptica de confiança para a diferença nas médias não cobre \(\mathbf{0}^{\prime} = [0, 0]\), a estatística de teste \(T^2\) rejeita \(H_0: \boldsymbol{\mu}_1 - \boldsymbol{\mu}_2 = 0\) no nível de 5%.

Figura 6.2: Elipse de confiança de 95% para diferença dos vetores de médias populacionais.

Figura 6.2: Elipse de confiança de 95% para diferença dos vetores de médias populacionais.

suppressMessages(suppressWarnings(
  invisible(Sys.setlocale("LC_ALL", "pt_BR.UTF-8"))))
centroidif <- c(204.4 - 130.0, 
                556.6 - 355.0)
sp <- matrix(c(10963.7, 21505.5,
               21505.5, 63661.3),
             nrow=2, byrow=TRUE)
p <- length(centroidif)
n1 <- 45
n2 <- 55
alfa <- 0.05
T2crit <- ((n1+n2-2)*p/(n1+n2-p-1))*qf(1-alfa, p, n1+n2-p-1)
print(T2crit, 3)
[1] 6.24
H0 <- rep(0, p)
T2 <- as.numeric(t(centroidif-H0)%*%solve((1/n1+1/n2)*sp)%*%(centroidif-H0))
print(T2, 4)
[1] 16.07
T2 > T2crit
[1] TRUE
F <- T2/((n1+n2-2)*p/(n1+n2-p-1))
pv <- 1-pf(F, p, n1+n2-p-1)
cat("\nF(",p,", ",n1+n2-p-1,") = ", round(F,2),", p = ", round(pv,5), "\n", sep="")

F(2, 97) = 7.95, p = 0.00063
c <- sqrt(T2crit*(1/n1+1/n2))
car::ellipse(center=centroidif,
             shape=sp,
             radius=c,
             fill=TRUE,
             fill.alpha=0.1,
             grid=FALSE,
             col="black",
             add=FALSE,
             xlab=expression(mu[11] - mu[21]), 
             ylab=expression(mu[12] - mu[22]),
             xlim=c(-5,130),
             ylim=c(-5,330),
             main="Região elíptica de confiança de 95%\n on- vs. off-peak")
abline(v=0,h=0,lty=2)
points(H0[1], H0[2], pch=9, col="black")
text(H0[1], H0[2], pos=3, expression(H[0]))

a.hat_abs <- abs(solve(sp)%*%centroidif)
colnames(a.hat_abs) <- "Importância"
rownames(a.hat_abs) <- c("on-peak", "off-peak")
print(proportions(a.hat_abs), digits=3)
         Importância
on-peak        0.396
off-peak       0.604

\[\Diamond\]

Os intervalos de confiança simultâneos t de Bonferroni de \(100(1 - \alpha)\)% para as \(p\) diferenças das médias populacionais são

\[ \text{IC}^{1 - \alpha}(\mu_{1i}- \mu_{2i})=\left[\overline{X}_{1i} - \overline{X}_{2i} \pm t_{n_1+n_2-2}\left(\dfrac{\alpha}{2p}\right)\sqrt{\left(\dfrac{1}{n_1} + \dfrac{1}{n_2}\right) S_{ii,\text{comb}}}\right]\\ i = 1,2,...,p \]

Situação de Duas Condições Independentes Heterocedásticas Multivariadamente

Se \(\mathbf{\Sigma}_1 \neq \mathbf{\Sigma}_2\), somos incapazes de encontrar uma medida de distância estatística como \(T^2\), cuja distribuição não depende dos desconhecidos \(\mathbf{\Sigma}_1\) e \(\mathbf{\Sigma}_2\).

O teste de Bartlett é usado para testar a igualdade de \(\mathbf{\Sigma}_1\) e \(\mathbf{\Sigma}_2\) em termos de variâncias generalizadas.

Infelizmente, as conclusões podem ser seriamente enganosas quando as observações aleatórias multivariadas das condições independentes são não normais. Não normalidade e covariâncias desiguais não podem ser separadas com o teste de Bartlett. (Veja também a Seção 6.6.)

Um método de teste da igualdade de duas matrizes de covariância que é menos sensível à suposição de multinormalidade foi proposto por Tiku e Balakrishnan. No entanto, mais experiência prática é necessária com este teste antes de podermos recomendá-lo incondicionalmente.

Sugerimos, sem muito suporte factual, que qualquer discrepância da ordem de \(\mathbf{\sigma}_{1,ii} = 4\mathbf{\sigma}_{2,ii}\) ou vice-versa, provavelmente é séria. Isso é verdade no caso univariado. O tamanho das discrepâncias que são críticas na situação multivariada provavelmente depende, em grande parte, do número de variáveis \(p\).

Transformação não linear pode melhorar as coisas quando as variâncias marginais são bastante diferentes. No entanto, para \(n_1 - p-g\ge30\) e \(n_2 -p-g\ge30\), podemos evitar as complexidades devido a matrizes de covariância desiguais.

Resultado 6.4. Seja o tamanho da amostra tal que \(n_1 - p - g\ge30\) e \(n_2 - p - g\ge30\). Então, a região elíptica de confiança aproximada de \(100(1- \alpha)\%\) para \(\boldsymbol{\mu}_1 - \boldsymbol{\mu}_2\) é dado por todos \(\boldsymbol{\mu}\) que satisfazem

\[ (\bar{\mathbf{x}}_1 - \bar{\mathbf{x}}_2 - (\boldsymbol{\mu}_1 - \boldsymbol{\mu}_2))^{\prime} \left( \dfrac{1}{n_1} \mathbf{s}_1 + \dfrac{1}{n_2} \mathbf{s}_2 \right)^{-1} (\bar{\mathbf{x}}_1 - \bar{\mathbf{x}}_2 - (\boldsymbol{\mu}_1 - \boldsymbol{\mu}_2)) \leq \chi^2_p(1-\alpha) \]

Além disso, intervalos de confiança simultâneos de \(100(1 - \alpha)\%\) para todas as combinações lineares \(\mathbf{a}^{\prime}(\boldsymbol{\mu}_1 - \boldsymbol{\mu}_2)\) são fornecidos por

\[ \text{IC}^{1-\alpha}\left(\mathbf{a}^{\prime}(\boldsymbol{\mu}_1 - \boldsymbol{\mu}_2)\right)= \left[\mathbf{a}^{\prime}(\bar{\mathbf{x}}_1 - \bar{\mathbf{x}}_2) \pm \sqrt{\chi^2_p(1-\alpha)\;\mathbf{a}^{\prime} \left( \dfrac{1}{n_1} \mathbf{s}_1 + \dfrac{1}{n_2} \mathbf{s}_2 \right) \mathbf{a}}\right] \]

Prova.

A partir das equações (6-22) e (3-9), temos:

  1. A esperança de \(\overline{\mathbf{X}}_1 - \overline{\mathbf{X}}_2\) é dada por:

\[ \mathbb{E}\left(\overline{\mathbf{X}}_1 - \overline{\mathbf{X}}_2\right) = \mathbb{E}\left(\overline{\mathbf{X}}_1\right) - \mathbb{E}\left(\overline{\mathbf{X}}_2\right)= \boldsymbol{\mu}_1 - \boldsymbol{\mu}_2 \]

  1. A covariância de \(\overline{\mathbf{X}}_1\) e \(\overline{\mathbf{X}}_2\) é:

\[ \mathbb{C}\left(\overline{\mathbf{X}}_1 - \overline{\mathbf{X}}_2\right) = \mathbb{C}\left(\overline{\mathbf{X}}_1\right) + \mathbb{C}\left(\overline{\mathbf{X}}_2\right) = \dfrac{1}{n_1} \mathbf{S}_1 + \dfrac{1}{n_2} \mathbf{S}_2 \]

Pelo teorema do limite central, \(\overline{\mathbf{X}}_1 - \overline{\mathbf{X}}_2 \underset{a}{\sim} \mathcal{N}_p\left(\boldsymbol{\mu}_1 - \boldsymbol{\mu}_2, \dfrac{1}{n_1} \mathbf{\Sigma}_1 + \dfrac{1}{n_2} \mathbf{\Sigma}_2\right)\).

\[\Diamond\]

Observação: Se \(n_1 = n_2 = n\), então \(\dfrac{n - 1}{n + n - 2} = \dfrac{1}{2}\), assim

\[ \begin{align} \dfrac{1}{n_1} \mathbf{S}_1 + \dfrac{1}{n_2} \mathbf{S}_2 &= \dfrac{1}{n} \left(\mathbf{S}_1 + \mathbf{S}_2\right)\\ &= \dfrac{(n - 1)\mathbf{S}_1 + (n - 1)\mathbf{S}_2}{n + n - 2}\left(\dfrac{1}{n}+\dfrac{1}{n}\right) \\ \dfrac{1}{n_1} \mathbf{S}_1 + \dfrac{1}{n_2} \mathbf{S}_2 &= \mathbf{S}_\text{comb}\left(\dfrac{1}{n}+\dfrac{1}{n}\right) \end{align} \]

Com tamanhos de amostra iguais, o procedimento para amostra grande é essencialmente o mesmo que o procedimento baseado na matriz de covariância agrupada. (Veja o Resultado 6.2.)

Em uma dimensão, é bem conhecido que o efeito de heterocedasticidade é menor quando há balanceamento, i.e., \(n_1 = n_2\), e é maior quanto maior é o desbalanceamento.

Exemplo 6.5: Procedimentos de amostras grandes para inferências sobre a diferença nas médias

  • \(p = 2 \;(\text{on-, off-peak}),\; q = 1,\; g = 2 \;(\text{com, sem ar-condicionado}):\; n_1=45,\; n_2=55\)

O número de UE é \(n_1+n_2=100\).

Vamos analisar os dados de consumo elétrico discutidos no Exemplo 6.4 usando a abordagem de amostras grandes. Primeiro, calculamos:

\[ \begin{align} \dfrac{1}{n_1} \mathbf{s}_1 + \dfrac{1}{n_2} \mathbf{s}_2 &= \dfrac{1}{45} \begin{bmatrix} 13825.3 & 23823.4 \\ 23823.4 & 73107.4 \\ \end{bmatrix} + \dfrac{1}{55} \begin{bmatrix} 8632.0 & 19616.7 \\ 19616.7 & 55964.5 \\ \end{bmatrix}\\ \dfrac{1}{n_1} \mathbf{s}_1 + \dfrac{1}{n_2} \mathbf{s}_2&= \begin{bmatrix} 464.17 & 886.08 \\ 886.08 & 2642.15 \\ \end{bmatrix} \end{align} \]

Os intervalos de confiança simultâneos de 95% para as combinações lineares

\[ \mathbf{a}^{\prime}_1(\boldsymbol{\mu}_1 - \boldsymbol{\mu}_2) = [1\;0]\begin{bmatrix} \mu_{11}-\mu_{21}\\ \mu_{12}-\mu_{22} \end{bmatrix} =\mu_{11} - \mu_{21} \]

e

\[ \mathbf{a}^{\prime}_2(\boldsymbol{\mu}_1 - \boldsymbol{\mu}_2) = [0\;1]\begin{bmatrix} \mu_{11}-\mu_{21}\\ \mu_{12}-\mu_{22} \end{bmatrix}=\mu_{12} - \mu_{22} \]

são (veja o Resultado 6.4):

\[ \begin{align} \text{IC}^{95\%}(\mu_{11} - \mu_{21}) &=\left[74.4 \pm \sqrt{5.99} \sqrt{464.17}\right]\\ \text{IC}^{95\%}(\mu_{11} - \mu_{21})&=[21.7,127.1]\\\\ \text{IC}^{95\%}(\mu_{12} - \mu_{22}) &=\left[201.6 \pm \sqrt{5.99} \sqrt{2642.15}\right]\\ \text{IC}^{95\%}(\mu_{12} - \mu_{22})&=[75.8,327.4] \end{align} \]

Note que esses intervalos diferem desprezivelmente dos intervalos no Exemplo 6.4, em que o procedimento de agrupamento foi empregado.

A estatística \(T^2\) para testar \(H_0: \boldsymbol{\mu}_1 - \boldsymbol{\mu}_2 = \mathbf{0}\) é:

\[ T^2 = (\bar{\mathbf{x}}_1 - \bar{\mathbf{x}}_2)^{\prime} \left( \dfrac{1}{n_1} \mathbf{s}_1 + \dfrac{1}{n_2} \mathbf{s}_2 \right)^{-1} (\bar{\mathbf{x}}_1 - \bar{\mathbf{x}}_2) = 16.07 \]

Para \(\alpha = .05\), o valor crítico é \(\chi^2_2(0.95) = 5.99\) e, como \(T^2 = 16.07 > \chi^2_2(0.95) = 5.99\), rejeitamos \(H_0\).

A combinação linear mais crítica que leva à rejeição de \(H_0\) tem o vetor de coeficiente

\[ \hat{\mathbf{a}} \propto \left( \dfrac{1}{n_1} \mathbf{s}_1 + \dfrac{1}{n_2} \mathbf{s}_2 \right)^{-1} (\bar{\mathbf{x}}_1 - \bar{\mathbf{x}}_2) = \begin{bmatrix} 0.04 \\ 0.06 \\ \end{bmatrix} \]

A diferença no consumo elétrico “on-peak” entre aqueles com ar condicionado e aqueles sem contribui mais do que a diferença correspondente no consumo “off-peak” para a rejeição de \(H_0: \boldsymbol{\mu}_1 - \boldsymbol{\mu}_2 = \mathbf{0}\).

suppressMessages(suppressWarnings(
  invisible(Sys.setlocale("LC_ALL", "pt_BR.UTF-8"))))
centroidif <- c(204.4 - 130.0, 
                556.6 - 355.0)
sdif <- matrix(c(464.17, 886.08,
                 886.08, 2642.15),
               nrow=2, byrow=TRUE)
p <- length(centroidif)
n1 <- 45
n2 <- 55
alfa <- 0.05
X2crit <- qchisq(1-alfa, p)
print(X2crit, 3)
[1] 5.99
H0 <- rep(0, p)
T2 <- as.numeric(t(centroidif-H0)%*%solve(sdif)%*%(centroidif-H0))
print(T2, 4)
[1] 15.66
T2 > X2crit
[1] TRUE
pv <- formatC(1-pchisq(T2, p), 
              format="e", digits=2)
cat("\nX^2(",p,") = ", round(T2,2),", p = ",pv, "\n", sep="")

X^2(2) = 15.66, p = 3.98e-04
c <- sqrt(X2crit)
car::ellipse(center=centroidif,
             shape=sdif,
             radius=c,
             fill=TRUE,
             fill.alpha=0.1,
             grid=FALSE,
             col="black",
             add=FALSE,
             xlab=expression(mu[11] - mu[21]), 
             ylab=expression(mu[12] - mu[22]),
             xlim=c(-5,130),
             ylim=c(-5,330),
             main="Região elíptica de confiança de 95%\n on- vs. off-peak")
abline(v=0,h=0,lty=2)
points(H0[1], H0[2], pch=9, col="black")
text(H0[1], H0[2], pos=3, expression(H[0]))

a.hat_abs <- abs(solve(sp)%*%centroidif)
colnames(a.hat_abs) <- "Importância"
rownames(a.hat_abs) <- c("on-peak", "off-peak")
print(proportions(a.hat_abs), digits=3)
         Importância
on-peak        0.396
off-peak       0.604

\[\Diamond\]

A estatística similar ao \(T^2\) que é menos sensível a observações atípicas para amostras pequenas e de tamanho moderado foi desenvolvida por Tiku e Singh [24]. No entanto, se o tamanho da amostra for moderado a grande, \(n_1-p-g>12\) e \(n_2-p-g>12\), \(T^2\) de Hotelling é notavelmente não afetado por pequenos desvios da normalidade e/ou pela presença de alguns outliers.

Uma Aproximação para a Distribuição de \(T^2\) para Populações Normais Quando os Tamanhos das Amostras Não São Grandes

É possível testar \(H_0: \boldsymbol{\mu}_1 - \boldsymbol{\mu}_2 = \mathbf{0}\) quando as matrizes de covariância da população são desiguais, mesmo que os dois tamanhos de amostra não sejam grandes, desde que as duas populações sejam multivariadas normais. Essa situação é frequentemente chamada de problema multivariado de Behrens-Fisher. O resultado exige que \(n_1 >p\) e \(n_2 >p\). A abordagem depende de uma aproximação para a distribuição da estatística

\[ \begin{align} T^2 &= \left(\overline{\mathbf{X}}_1 - \overline{\mathbf{X}}_2-(\boldsymbol{\mu}_1 - \boldsymbol{\mu}_2)\right)^{\prime} \left( \dfrac{1}{n_1} \mathbf{S}_1 + \dfrac{1}{n_2} \mathbf{S}_2 \right)^{-1} \left(\overline{\mathbf{X}}_1 - \overline{\mathbf{X}}_2-(\boldsymbol{\mu}_1 - \boldsymbol{\mu}_2)\right)\\ T^2 &\underset{a}{\sim}T^2_{p,\nu} \end{align} \tag{6-27} \]

que é idêntica à estatística de amostra grande no Resultado 6.4. No entanto, em vez de usar a aproximação qui-quadrado para obter o valor crítico para testar \(H_0\), a aproximação recomendada para amostras menores (veja [15] e [19]) é dada por

\[ T^2_{p,\nu} = \dfrac{\nu p}{\nu-p+1}F_{p,\nu-p+1}\tag{6-28} \]

em que o número de graus de liberdade \(\nu\) de \(T^2\) é estimado a partir das matrizes de covariância amostrais usando a relação:

\[ \hat{\nu}=\dfrac{p(1+p)}{ \sum_{i=1}^{2}{\dfrac{1}{n_i}\left( \text{tr}\left(\left(\dfrac{1}{n_i}\mathbf{S}_i\left( \dfrac{1}{n_1}\mathbf{S}_1 + \dfrac{1}{n_2}\mathbf{S}_2 \right)^{-1}\right)^2\right) + \left(\text{tr}\left(\dfrac{1}{n_i}\mathbf{S}_i\left( \dfrac{1}{n_1}\mathbf{S}_1 + \dfrac{1}{n_2}\mathbf{S}_2 \right)^{-1}\right)\right)^2\right)}} \tag{6-29} \]

em que \(\min(n_1, n_2) \le \nu \le n_1+ n_2\).

Esta aproximação reduz-se à solução usual de Welch para o problema de Behrens-Fisher (heterocedasticidade) no caso univariado (\(p = 1\)).

Para populações normais, a aproximação para a distribuição de \(T^2\) dada por (6-28) e (6-29) geralmente fornece resultados razoáveis.

Exemplo 6.6: A distribuição aproximada de \(T^2\) se \(\mathbf{\Sigma_1} \neq \mathbf{\Sigma_2}\)

Embora os tamanhos das amostras sejam bastante grandes para os dados de consumo elétrico no Exemplo 6.4, usamos esses dados e os cálculos do Exemplo 6.5 para ilustrar os cálculos que levam à distribuição aproximada de \(T^2\) quando as matrizes de covariância da população são diferentes.

Primeiro, calculamos:

\[ \dfrac{1}{n_1} \mathbf{s}_1 = \dfrac{1}{45} \begin{bmatrix} 13825.2 & 23823.4 \\ 23823.4 & 73107.4 \\ \end{bmatrix} = \begin{bmatrix} 307.227 & 529.409 \\ 529.409 & 1624.609 \\ \end{bmatrix} \]

e

\[ \dfrac{1}{n_2} \mathbf{s}_2 = \dfrac{1}{55} \begin{bmatrix} 8632.0 & 19616.7 \\ 19616.7 & 55964.5 \\ \end{bmatrix} = \begin{bmatrix} 156.945 & 356.667 \\ 356.667 & 1017.536 \\ \end{bmatrix} \]

E usando um resultado do Exemplo 6.5,

\[ \left(\dfrac{1}{n_1} \mathbf{s}_1 + \dfrac{1}{n_2} \mathbf{s}_2\right)^{-1} = 10^{-4} \begin{bmatrix} 59.874 & -20.080 \\ -20.080 & 10.519 \\ \end{bmatrix} \]

suppressMessages(suppressWarnings(
  invisible(Sys.setlocale("LC_ALL", "pt_BR.UTF-8"))))
centroidif <- c(204.4 - 130.0, 
                556.6 - 355.0)
s1 <- matrix(c(13825.2, 23823.4, 
               23823.4, 73107.4), 
             nrow=2, byrow=TRUE)
s2 <- matrix(c(8632.0, 19616.7, 
               19616.7, 55964.5), 
             nrow=2, byrow=TRUE)
p <- length(centroidif)
p
[1] 2
n1 <- 45
n2 <- 55
alfa <- 0.05
compute_nu_hat <- function(s1, s2, n1, n2, p) {
  common_part <- (1/n1)*s1 + (1/n2)*s2
  sum_term <- function(n, s) {
    A <- (1/n)*s %*% solve(common_part)
    tr_A <- sum(diag(A))
    return(tr_A^2 + (sum(diag(A %*% A))) )
  }
  sum_val <- (1/n1)*sum_term(n1, s1) + (1/n2)*sum_term(n2, s2)
  nu_hat <- (p*(1+p)) / sum_val
  return(nu_hat)
}
nu_hat <- compute_nu_hat(s1, s2, n1, n2, p)
T2crit <- (nu_hat*p/(nu_hat-p+1))*qf(1-alfa, p, nu_hat-p+1)
print(T2crit, 3)
[1] 6.31
H0 <- rep(0, p)
T2 <- as.numeric(t(centroidif-H0)%*%solve((1/n1)*s1 + (1/n2)*s2)
                 %*%(centroidif-H0))
print(T2, 4)
[1] 15.66
T2 > T2crit
[1] TRUE
F <- T2/(nu_hat*p/(nu_hat-p+1))
pv <- 1-pf(F, p, nu_hat-p+1)
cat("\nF(",p,", ",nu_hat-p+1,") = ", round(F,2),", p = ", round(pv,5), "\n", sep="")

F(2, 76.59217) = 7.73, p = 0.00088
c <- sqrt(T2crit)
car::ellipse(center=centroidif,
             shape=(1/n1)*s1 + (1/n2)*s2,
             radius=c,
             fill=TRUE,
             fill.alpha=0.1,
             grid=FALSE,
             col="black",
             add=FALSE,
             xlab=expression(mu[11] - mu[21]), 
             ylab=expression(mu[12] - mu[22]),
             xlim=c(-5,130),
             ylim=c(-5,330),
             main="Região elíptica de confiança de 95% (Welch)\n on- vs. off-peak")
abline(v=0,h=0,lty=2)
points(H0[1], H0[2], pch=9, col="black")
text(H0[1], H0[2], pos=3, expression(H[0])) 

a.hat_abs <- abs(solve((1/n1)*s1 + (1/n2)*s2)%*%centroidif)
colnames(a.hat_abs) <- "Importância"
rownames(a.hat_abs) <- c("on-peak", "off-peak")
print(proportions(a.hat_abs), digits=3)
         Importância
on-peak        0.394
off-peak       0.606

Teste \(T^2\) de Hotelling robusto à heterocedasticidade multivariada

Os testes \(T^2\) de Johansen (1980) e Yao (1965) são robustos à heterocedasticidade multivariada.

Teste \(T^2\) de Johansen

suppressMessages(suppressWarnings(
  invisible(Sys.setlocale("LC_ALL", "pt_BR.UTF-8"))
))
Dados <- datasets::iris
lst <- split(Dados[, 1:5], iris$Species)
lst <- lapply(lst, function(df) head(df, 6))
Dados <- do.call(rbind, lst)
vervir <- subset(Dados, Species != "setosa")
vervir$Species <- droplevels(vervir$Species)
rownames(vervir) <- NULL
print(summary(vervir))
  Sepal.Length    Sepal.Width     Petal.Length    Petal.Width          Species 
 Min.   :5.500   Min.   :2.300   Min.   :4.000   Min.   :1.300   versicolor:6  
 1st Qu.:6.175   1st Qu.:2.800   1st Qu.:4.575   1st Qu.:1.475   virginica :6  
 Median :6.450   Median :3.000   Median :5.000   Median :1.650                 
 Mean   :6.467   Mean   :2.942   Mean   :5.183   Mean   :1.758                 
 3rd Qu.:6.925   3rd Qu.:3.125   3rd Qu.:5.825   3rd Qu.:2.100                 
 Max.   :7.600   Max.   :3.300   Max.   :6.600   Max.   :2.500                 
result <- MVN::mvn(data=vervir, 
                   subset="Species",
                   univariate_test="SW")
print(result$multivariate_normality)
       Group          Test Statistic p.value      MVN
1 versicolor Henze-Zirkler     0.658   0.203 ✓ Normal
2  virginica Henze-Zirkler     0.599   0.379 ✓ Normal
print(result$univariate_normality)
       Group         Test     Variable Statistic p.value    Normality
1 versicolor Shapiro-Wilk Sepal.Length     0.907   0.414     ✓ Normal
2 versicolor Shapiro-Wilk  Sepal.Width     0.858   0.182     ✓ Normal
3 versicolor Shapiro-Wilk Petal.Length     0.914   0.462     ✓ Normal
4 versicolor Shapiro-Wilk  Petal.Width     0.775   0.035 ✗ Not normal
5  virginica Shapiro-Wilk Sepal.Length     0.942   0.673     ✓ Normal
6  virginica Shapiro-Wilk  Sepal.Width     0.909   0.433     ✓ Normal
7  virginica Shapiro-Wilk Petal.Length     0.971   0.901     ✓ Normal
8  virginica Shapiro-Wilk  Petal.Width     0.952   0.753     ✓ Normal
res <- heplots::boxM(Y=vervir[-5],
                     group=vervir$Species)
print(res)

    Box's M-test for Homogeneity of Covariance Matrices

data:  vervir[-5]
Chi-Sq (approx.) = 11.43, df = 10, p-value = 0.325
plot(res)

versicolor <- as.matrix(subset(x=Dados, 
                               subset=Species=="versicolor", 
                               select=Sepal.Length:Petal.Width))
virginica <- as.matrix(subset(x=Dados, 
                              subset=Species=="virginica", 
                              select=Sepal.Length:Petal.Width))

print(SHT::mean2.1980Johansen(versicolor, virginica))

    Two-sample Test for Multivariate Means by Johansen (1980)

data:  versicolor and virginica
T2 = 113.37, p-value = 0.0005876
alternative hypothesis: true means are different.
print(SHT::mean2.1965Yao(versicolor, virginica))

    Two-sample Test for Multivariate Means by Yao (1965).

data:  versicolor and virginica
T2 = 113.37, p-value = 0.002617
alternative hypothesis: true means are different.
print(SHT::mean2.1931Hotelling(versicolor, virginica))

    Hotelling's T-squared Test for Independent Samples with Equal
    Covariance Assumption.

data:  versicolor and virginica
T2 = 113.37, p-value = 0.0006393
alternative hypothesis: true means are different.
# Na saída, T.2 é F
print(DescTools::HotellingsT2Test(cbind(Sepal.Length,
                                        Sepal.Width,
                                        Petal.Length,
                                        Petal.Width)~Species, 
                                  test="f",
                                  data=vervir))

    Hotelling's two sample T2-test

data:  cbind(Sepal.Length, Sepal.Width, Petal.Length, Petal.Width) by Species
T.2 = 19.839, df1 = 4, df2 = 7, p-value = 0.0006393
alternative hypothesis: true location difference is not equal to c(0,0,0,0)

Teste \(T^2\) de Welch

suppressMessages(suppressWarnings(
  invisible(Sys.setlocale("LC_ALL", "pt_BR.UTF-8"))
))

Dados <- datasets::iris
lst <- split(Dados[, 1:5], iris$Species)
lst <- lapply(lst, function(df) head(df, 6))
Dados <- do.call(rbind, lst)
vervir <- subset(Dados, Species != "setosa")
vervir$Species <- droplevels(vervir$Species)
rownames(vervir) <- NULL
print(summary(vervir))
  Sepal.Length    Sepal.Width     Petal.Length    Petal.Width          Species 
 Min.   :5.500   Min.   :2.300   Min.   :4.000   Min.   :1.300   versicolor:6  
 1st Qu.:6.175   1st Qu.:2.800   1st Qu.:4.575   1st Qu.:1.475   virginica :6  
 Median :6.450   Median :3.000   Median :5.000   Median :1.650                 
 Mean   :6.467   Mean   :2.942   Mean   :5.183   Mean   :1.758                 
 3rd Qu.:6.925   3rd Qu.:3.125   3rd Qu.:5.825   3rd Qu.:2.100                 
 Max.   :7.600   Max.   :3.300   Max.   :6.600   Max.   :2.500                 
result <- MVN::mvn(data=vervir, 
                   subset="Species",
                   univariate_test="SW")
print(result$multivariate_normality)
       Group          Test Statistic p.value      MVN
1 versicolor Henze-Zirkler     0.658   0.203 ✓ Normal
2  virginica Henze-Zirkler     0.599   0.379 ✓ Normal
print(result$univariate_normality)
       Group         Test     Variable Statistic p.value    Normality
1 versicolor Shapiro-Wilk Sepal.Length     0.907   0.414     ✓ Normal
2 versicolor Shapiro-Wilk  Sepal.Width     0.858   0.182     ✓ Normal
3 versicolor Shapiro-Wilk Petal.Length     0.914   0.462     ✓ Normal
4 versicolor Shapiro-Wilk  Petal.Width     0.775   0.035 ✗ Not normal
5  virginica Shapiro-Wilk Sepal.Length     0.942   0.673     ✓ Normal
6  virginica Shapiro-Wilk  Sepal.Width     0.909   0.433     ✓ Normal
7  virginica Shapiro-Wilk Petal.Length     0.971   0.901     ✓ Normal
8  virginica Shapiro-Wilk  Petal.Width     0.952   0.753     ✓ Normal
res <- heplots::boxM(Y=vervir[-5],
                     group=vervir$Species)
print(res)

    Box's M-test for Homogeneity of Covariance Matrices

data:  vervir[-5]
Chi-Sq (approx.) = 11.43, df = 10, p-value = 0.325
plot(res)

versicolor <- as.matrix(subset(x=Dados, 
                               subset=Species=="versicolor", 
                               select=Sepal.Length:Petal.Width))
virginica <- as.matrix(subset(x=Dados, 
                              subset=Species=="virginica", 
                              select=Sepal.Length:Petal.Width))

# T^2 de Welch
centroidif <- colMeans(versicolor) - colMeans(virginica)
s1 <- cov(versicolor)
s2 <- cov(virginica)
p <- length(centroidif)
n1 <- nrow(versicolor)
n2 <- nrow(virginica)
alfa <- 0.05

compute_nu_hat <- function(s1, s2, n1, n2, p) {
  common_part <- (1/n1)*s1 + (1/n2)*s2
  sum_term <- function(n, s) {
    A <- (1/n)*s %*% solve(common_part)
    tr_A <- sum(diag(A))
    return(tr_A^2 + (sum(diag(A %*% A))) )
  }
  sum_val <- (1/n1)*sum_term(n1, s1) + (1/n2)*sum_term(n2, s2)
  nu_hat <- (p*(1+p)) / sum_val
  return(nu_hat)
}

# Significância estatística
nu_hat <- compute_nu_hat(s1, s2, n1, n2, p)
T2crit <- (nu_hat*p/(nu_hat-p+1))*qf(1-alfa, p, nu_hat-p+1)
print(T2crit, 3)
[1] 21.7
H0 <- rep(0, p)
T2 <- as.numeric(t(centroidif-H0)%*%solve((1/n1)*s1 + (1/n2)*s2)
                 %*%(centroidif-H0))
print(T2, 4)
[1] 113.4
T2 > T2crit
[1] TRUE
F <- T2/(nu_hat*p/(nu_hat-p+1))
pv <- formatC(1-pf(F, p, nu_hat-p+1), 
              format="e", digits=2)
cat("\nF(",p,", ",round(nu_hat-p+1,2),") = ", round(F,2),", p = ", pv, "\n", sep="")

F(4, 7.73) = 20.42, p = 3.51e-04
cat("\nT^2(",p,", ",round(nu_hat,2),") = ", round(T2,2),", p = ", pv, "\n", sep="")

T^2(4, 10.73) = 113.37, p = 3.51e-04
print(SHT::mean2.1980Johansen(versicolor, virginica))

    Two-sample Test for Multivariate Means by Johansen (1980)

data:  versicolor and virginica
T2 = 113.37, p-value = 0.0005876
alternative hypothesis: true means are different.
print(SHT::mean2.1965Yao(versicolor, virginica))

    Two-sample Test for Multivariate Means by Yao (1965).

data:  versicolor and virginica
T2 = 113.37, p-value = 0.002617
alternative hypothesis: true means are different.
print(SHT::mean2.1931Hotelling(versicolor, virginica))

    Hotelling's T-squared Test for Independent Samples with Equal
    Covariance Assumption.

data:  versicolor and virginica
T2 = 113.37, p-value = 0.0006393
alternative hypothesis: true means are different.
# Na saída, T.2 é F
print(DescTools::HotellingsT2Test(cbind(Sepal.Length,
                                        Sepal.Width,
                                        Petal.Length,
                                        Petal.Width)~Species, 
                                  test="f",
                                  data=vervir))

    Hotelling's two sample T2-test

data:  cbind(Sepal.Length, Sepal.Width, Petal.Length, Petal.Width) by Species
T.2 = 19.839, df1 = 4, df2 = 7, p-value = 0.0006393
alternative hypothesis: true location difference is not equal to c(0,0,0,0)
# Importância da VD
a.hat_abs <- abs(solve((1/n1)*s1 + (1/n2)*s2)%*%centroidif)
colnames(a.hat_abs) <- "Importância"
rownames(a.hat_abs) <- c("Sepal.Length",
                         "Sepal.Width",
                         "Petal.Length",
                         "Petal.Width")
print(proportions(a.hat_abs), digits=3)
             Importância
Sepal.Length       0.155
Sepal.Width        0.214
Petal.Length       0.360
Petal.Width        0.271

Comparando Várias Médias Populacionais Multivariadas (MANOVA unifatorial independente)

  • \(p\ge2,\; q=1,\; g\ge2\)

Frequentemente, é necessário comparar mais do que duas populações. Amostras aleatórias coletadas de cada uma das \(g\) populações (condições experimentais independentes) são organizadas como:

\[ \begin{align} \text{População } 1: \mathbf{X}_{11}, \mathbf{X}_{12}, \ldots, \mathbf{X}_{1n_1}\\ \text{População } 2: \mathbf{X}_{21}, \mathbf{X}_{22}, \ldots, \mathbf{X}_{2n_2}\\ \vdots\\ \text{População } g: \mathbf{X}_{g1}, \mathbf{X}_{g2}, \ldots, \mathbf{X}_{gn_g} \end{align} \tag{6-31} \]

MANOVA unifatorial independente (one-way MANOVA) é usado primeiramente para investigar se os vetores de média populacional são os mesmos e, se não forem, quais componentes do vetores de média diferem significantemente.

Suposições sobre a Estrutura dos Dados para MANOVA unifatorial independente:

  1. \(\mathbf{X}_{\ell 1}, \mathbf{X}_{\ell 2}, \ldots, \mathbf{X}_{\ell n_\ell}\) é uma amostra aleatória de tamanho \(n_\ell\) de uma população com média \(\boldsymbol{\mu}_\ell\) para \(\ell = 1, 2, \ldots, g\), i.e, \(\{\mathbf{X}_{\ell}\}_{i=1}^{n_{\ell}} \sim \text{IID}(\boldsymbol{\mu }_{\ell}, \mathbf{\Sigma}_{\ell})\). As amostras aleatórias de diferentes populações são independentes.
  2. Todas as populações têm uma matriz de covariância comum (homocedasticidade multivariada) \(\mathbf{\Sigma}_{\mathcal{1}}=\mathbf{\Sigma}_{\mathcal{2}}=\cdots=\mathbf{\Sigma}_{\ell}=\mathbf{\Sigma}\).
  3. Cada população é multivariada normal, i.e., \(\{\mathbf{X}_{\ell}\}_{i=1}^{n_{\ell}} \sim \mathcal{N}_p\text{IID}(\boldsymbol{\mu}_{\ell}, \mathbf{\Sigma}_{\ell})\), \(\ell = 1, 2, \ldots, g\).

A condição 3 pode ser relaxada recorrendo ao teorema do limite central (Resultado 4.13) se: \[ \sum_{\ell=1}^{g}{n_\ell} -g \ge 30 \\ \ell = 1, 2, \ldots, g \]

Resumo da ANOVA unifatorial independente de Fisher

  • \(p=1,\; q=1,\; g\ge2\)

Na situação univariada, as suposições são de que \(\left\{X_{\ell i}\right\}_{i=1}^{n_\ell} \sim \mathcal{N}\text{IID}\left(\mu_{\ell},\sigma^2\right)\), \(\ell = 1, 2, \ldots, g\), e que as \(g\) amostras aleatórias \(\left\{\left\{X_{\ell i}\right\}_{i=1}^{n_\ell}\right\}_{\ell =1}^{g}\) são independentes.

Embora a hipótese nula de igualdade de médias possa ser formulada como \(\mu_1 = \mu_2 = \cdots = \mu_g\), é costumeiro considerar \(\mu_\ell\) como a soma de um componente de média global, como \(\mu\), e um componente devido à população específica. Por exemplo, podemos escrever \(\mu_{\ell} = \mu + (\mu_{\ell} - \mu)\) ou \(\mu_{\ell} = \mu + \tau_{\ell}\), em que \(\tau_{\ell} = \mu_{\ell} - \mu\).

As populações geralmente correspondem a diferentes conjuntos de condições experimentais independentes e, portanto, é conveniente investigar os desvios \(\tau_{\ell}\) associados à \(\ell\)-ésima população (tratamento).

A reparametrização

\[ \mu_{\ell} = \mu + \tau_{\ell} \]

em que:

  • \(\mu_{\ell}\): média da \(\ell\)-ésima população
  • \(\mu\): média sem o efeito do fator (média global)
  • \(\tau_{\ell}\): efeito fixo do tratamento da \(\ell\)-ésima população

leva a uma reformulação da hipótese de igualdade das médias. A hipótese nula torna-se

\[ H_0: \tau_1 = \tau_2 = \cdots = \tau_g = 0 \]

A resposta \(X_{\ell j} \sim \mathcal{N}\left(\mu + \tau_{\ell} \sigma^2\right)\), pode ser expressa da seguinte forma forma

\[ X_{\ell j} = \mu + \tau_{\ell} + \varepsilon_{\ell j} \]

em que:

  • \(\mu\): média global
  • \(\tau_{\ell}\): efeito fixo do tratamento
  • \(\varepsilon_{\ell j}\): resíduo ou termo de erro aleatório

em que os \(\varepsilon_{\ell j} \sim \mathcal{N}\text{IID}\left(0,\sigma^2\right)\), \(j = 1, 2, \ldots, n_{\ell}\) e \(\ell = 1, 2, \ldots, g\) são independentes. Para definir de forma única os parâmetros do modelo e suas estimativas de mínimos quadrados, é costumeiro impor a restrição \(\sum_{\ell =1}^g n_\ell \tau_{\ell} = 0\).

Motivado pela decomposição anterior, a análise de variância é baseada em uma decomposição análoga das observações,

\[ x_{\ell j} = \bar{x} + (\bar{x}_{\ell} - \bar{x}) + (x_{\ell j} - \bar{x}_{\ell}) \]

em que:

  • \(x_{\ell j}\): observação
  • \(\hat{\mu}=\bar{x}\): estimativa da média global
  • \(\hat{\tau}_{\ell}=\bar{x}_{\ell} - \bar{x}\): estimativa do efeito fixo do tratamento \(\ell\)
  • \(\hat{\varepsilon}_{\ell j}=x_{\ell j} - \bar{x}_{\ell}\): estimativa do termo de erro ou resíduo

Exemplo 6.7: Decomposição da soma dos quadrados para ANOVA univariada

  • \(p=1,\; q=1,\; g=3:\; n_1=3,\; n_2=2,\; n_3=3\)

O número de UE é \(n_1+n_2+n_3=8\).

Considere as seguintes amostras independentes:

População 1: 9, 6, 9

População 2: 0, 2

População 3: 3, 1, 2

Por exemplo, dado que

\[ \bar{x}_3 = \dfrac{3 + 1 + 2}{3} = 2 \quad \text{e} \quad \bar{x} = \dfrac{9 + 6 + 9 + 0 + 2 + 3 + 1 + 2}{8} = 4 \]

encontramos que

\[ \begin{align} 3 &= x_{31} \\ &= \bar{x} + (\bar{x}_3 - \bar{x}) + (x_{31} - \bar{x}_3) \\ &= 4 + (2 - 4) + (3 - 2) \\ 3&= 4 + (-2) + 1 \end{align} \]

Repetindo esta operação para cada observação, obtemos a seguinte igualdade matricial:

\[ \left[ \begin{array}{rrr} 9 & 6 & 9\\0 & 2 & \\3 & 1 & 2 \end{array} \right] = \left[ \begin{array}{rrr} 4 & 4 & 4\\4 & 4 & \\4 & 4 & 4 \end{array} \right] + \left[ \begin{array}{rrr} 4 & 4 & 4\\-3 & -3 & \\-2 & -2 & -2 \end{array}\right] + \left[ \begin{array}{rrr} 1 & -2 & 1\\-1 & 1 & \\1 & -1 & 0 \end{array} \right] \]

\[ \begin{align} x_{\ell j} &= \bar{x} + (\bar{x}_{\ell} - \bar{x}) + (x_{\ell j} - \bar{x}_{\ell})\\ x_{\ell j} &= \hat{\mu}+\hat{\tau}_{\ell}+\hat{\varepsilon}_{\ell j} \end{align} \]

observação = média global + efeito de tratamento + resíduo

A questão da igualdade das médias é respondida avaliando se a contribuição do vetor de tratamento é grande em relação aos resíduos.

Nossas estimativas \(\hat{\tau}_{\ell}=\bar{x}_{\ell} - \bar{x}\) sempre satisfazem \(\sum_{\ell =1}^g n_\ell \hat{\tau}_{\ell} = 0\).

Sob \(H_0\), cada \(\hat{\tau}_{\ell}\) é uma estimativa nula.

Se a contribuição do tratamento for grande, \(H_0\) deve ser rejeitada.

O tamanho de um vetor é quantificado transformando as linhas do vetor em um único vetor e calculando seu comprimento ao quadrado. Esta quantidade é chamada de soma dos quadrados (SS: Sum of Squares).

Para as observações, construímos o vetor \(\mathbf{y}^{\prime} = [9\; 6\; 9\; 0\; 2\; 3\; 1\; 2]\).

Seu comprimento ao quadrado é:

\[ \text{SS}_{\text{obs}} = 9^2 + 6^2 + 9^2 + 0^2 + 2^2 + 3^2 + 1^2 + 2^2 = 216 \]

Similarmente,

\[ \begin{align} \text{SS}_{\text{mean}} &= 4^2 + 4^2 + 4^2 + 4^2 + 4^2 + 4^2 + 4^2 + 4^2 = 8(4^2) = 128\\\\ \text{SS}_{\text{trt}} &= 4^2 + 4^2 + 4^2 + (-3)^2 + (-3)^2 + (-2)^2 + (-2)^2 + (-2)^2 \\ \text{SS}_{\text{trt}} &= 3(4^2) + 2(-3)^2 + 3(-2)^2 = 78 \end{align} \]

e a soma dos quadrados residual é

\[ \text{SS}_{\text{res}} = 1^2 + (-2)^2 + 1^2 + (-1)^2 + 1^2 + 1^2 + (-1)^2 + 0^2 = 10 \]

As somas dos quadrados satisfazem a mesma decomposição, (6-34), que as observações. Portanto,

\[ \text{SS}_{\text{obs}} = \text{SS}_{\text{mean}} + \text{SS}_{\text{trt}} + \text{SS}_{\text{res}} \]

ou

\[ 216 = 128 + 78 + 10 \]

A divisão em somas de quadrados aloca a variabilidade nas amostras combinadas em componentes de média, tratamento e residual (erro).

Uma análise de variância procede comparando os tamanhos relativos de \(\text{SS}_{\text{trt}}\) e \(\text{SS}_{\text{res}}\).

Se \(H_0\) for verdadeira, as variâncias calculadas a partir de \(\text{SS}_{\text{trt}}\) e \(\text{SS}_{\text{res}}\) devem ser aproximadamente iguais:

\[ \text{SS}_{\text{trt}} \underset{H_0}{\approx}\text{SS}_{\text{res}} \]

\[\Diamond\]

A decomposição da soma dos quadrados ilustrada numericamente no Exemplo 6.7 é tão básica que o equivalente algébrico será agora desenvolvido.

Subtraindo \(\bar{x}\) de ambos os lados de (6-34) e elevando ao quadrado, obtemos:

\[ (x_{\ell j} - \bar{x})^2 = ( \bar{x}_{\ell} - \bar{x})^2 + (x_{\ell j} - \bar{x}_{\ell})^2 + 2( \bar{x}_{\ell} - \bar{x})(x_{\ell j} - \bar{x}_{\ell}) \]

Podemos somar ambos os lados sobre \(j\), notando que \(\sum_{i=1}^{n_\ell}{(x_{\ell j} - \bar{x}_{\ell})} = 0\), e obtemos:

\[ \sum_{j=1}^{n_{\ell}} (x_{\ell j} - \bar{x})^2 = n_{\ell}(\bar{x}_{\ell} - \bar{x})^2 + \sum_{j=1}^{n_{\ell}} (x_{\ell j} - \bar{x}_{\ell})^2 \]

Em seguida, somando ambos os lados sobre \(\ell\), obtemos:

\[ \begin{align} \sum_{\ell =1}^{g} \sum_{j=1}^{n_{\ell}} (x_{\ell j} - \bar{x})^2 &= \sum_{\ell =1}^{g} n_{\ell}(\bar{x}_{\ell} - \bar{x})^2 + \sum_{\ell =1}^{g} \sum_{j=1}^{n_{\ell}} (x_{\ell j} - \bar{x}_{\ell})^2 \\ \text{SS}_{\text{tot}}&=\text{SS}_{\text{trt}}+\text{SS}_{\text{res}} \end{align} \tag{6-35} \]

Em que:

  • \(\text{SS}_{\text{tot}}\) é a soma dos quadrados total corrigida.
  • \(\text{SS}_{\text{trt}}\) é a soma dos quadrados entre (between) as condições.
  • \(\text{SS}_{\text{res}}\) é a soma dos quadrados dentro (within) das condições.

ou

\[ \begin{align} \sum_{\ell =1}^{g} \sum_{j=1}^{n_{\ell}} x_{\ell j}^2 &= \bar{x}^2 \sum_{\ell=1}^{g}{n_\ell} + \sum_{\ell =1}^{g} n_{\ell}(\bar{x}_{\ell} - \bar{x})^2 + \sum_{\ell =1}^{g} \sum_{j=1}^{n_{\ell}} (x_{\ell j} - \bar{x}_{\ell})^2 \\ \text{SS}_{\text{obs}}&=\text{SS}_{\text{mean}}+\text{SS}_{\text{trt}}+\text{SS}_{\text{res}} \end{align} \tag{6-36} \]

Em que:

  • \(\text{SS}_{\text{obs}}\) é a soma dos quadrados das observações,
  • \(\text{SS}_{\text{mean}}\) é a soma dos quadrados das médias,
  • \(\text{SS}_{\text{trt}}\) é a soma dos quadrados dos tratamentos e
  • \(\text{SS}_{\text{res}}\) é a soma dos quadrados dos resíduos.

Ao estabelecer (6-36), verificamos que as matrizes representando a média, os efeitos do tratamento e os resíduos são ortogonais. Ou seja, essas matrizes, consideradas como vetores, são perpendiculares independentemente do vetor de observação

\[ \mathbf{y}^{\prime} = [x_{11}, \ldots, x_{1n_1}, x_{21}, \ldots, x_{2n_2},x_{g1}, \ldots, x_{gn_g}] \]

mean <- rep(4, 8)
trt <- c(4, 4, 4, -3, -3, -2, -2, -2)
res <- c(1, -2, 1, 1, 1, 1, -1, 0)
crossprod(mean, trt)
     [,1]
[1,]    0
crossprod(mean, res)
     [,1]
[1,]    8
crossprod(trt, res)
     [,1]
[1,]   -6

Consequentemente, poderíamos obter \(\text{SS}_{\text{res}}\) por subtração, sem ter que calcular os resíduos individuais, porque

\[ \text{SS}_{\text{res}} = \text{SS}_{\text{obs}} - \text{SS}_{\text{mean}} - \text{SS}_{\text{trt}} \]

No entanto, isso é uma economia falsa porque os gráficos dos resíduos fornecem verificações das suposições do modelo.

As representações vetoriais das matrizes envolvidas na decomposição (6-34) também têm interpretações geométricas que fornecem os graus de liberdade. Para um conjunto arbitrário de observações, o vetor de observação \(\mathbf{y}\) pode estar em qualquer lugar em \(n = \sum_{\ell =1}^{g}{n_\ell}\) dimensões; o vetor médio \(\bar{x}\mathbf{1} = [\bar{x}, \ldots, \bar{x}]^{\prime}\) deve estar ao longo da linha equiangular de \(\mathbf{1}\), e o vetor de efeito de tratamento

reside no hiperplano de combinações lineares dos \(g\) vetores \(\mathbf{u}_1, \mathbf{u}_2, \ldots, \mathbf{u}_g\). Como \(\mathbf{1} = \mathbf{u}_1 + \mathbf{u}_2 + \cdots + \mathbf{u}_g\), o vetor médio também reside neste hiperplano e é sempre perpendicular ao vetor de tratamento. (Consulte o Exercício 6.10). Assim, o vetor médio tem a liberdade de residir em qualquer lugar ao longo da linha equiangular unidimensional, e o vetor de tratamento tem a liberdade de residir em qualquer lugar nas outras \(g - 1\) dimensões. O vetor de resíduo, \(\hat{\boldsymbol{\varepsilon}} = \mathbf{y} - \bar{x}\mathbf{1} - ((\bar{x}_i - \bar{x})\mathbf{u}_j + \cdots + (\bar{x}_g - \bar{x})\mathbf{u}_g)\), é perpendicular a ambos, o vetor de média e o vetor de efeito de tratamento, e tem a liberdade de residir em qualquer lugar no subespaço de dimensão \(n - (g -1) - 1 = n - g\), que é perpendicular ao seu hiperplano.

Em resumo, atribuímos 1 grau de liberdade para \(\text{SS}_{\text{mean}}\), \(g - 1\) graus de liberdade para \(\text{SS}_{\text{trt}}\), e \(n - g = \sum_{\ell =1}^{g}{n_\ell} - g\) graus de liberdade para \(\text{SS}_{\text{res}}\). O número total de graus de liberdade é \(\sum_{\ell =1}^{g}{n_\ell}\). Alternativamente, recorrendo à teoria da distribuição univariada, descobrimos que estes são os graus de liberdade para as distribuições qui-quadrado associadas com as respectivas somas dos quadrados. Os cálculos das somas dos quadrados e os graus de liberdade associados são convenientemente resumidos por uma tabela ANOVA.

Fonte de variação Soma dos Quadrados (SS) Graus de Liberdade (df)
Tratamentos \(\text{SS}_{\text{trt}} = \sum_{\ell =1}^{g} n_{\ell}(\bar{x}_{\ell} - \bar{x})^2\) \(g - 1\)
Resíduo \(\text{SS}_{\text{res}} = \sum_{\ell =1}^{g} \sum_{j=1}^{n_{\ell}} (x_{\ell j} - \bar{x}_{\ell})^2\) \(\sum_{\ell =1}^{g}{n_\ell} - g\)
Total \(\text{SS}_{\text{tot}} = \sum_{\ell =1}^{g} \sum_{j=1}^{n_{\ell}} (x_{\ell j} - \bar{x})^2\) \(\sum_{\ell =1}^{g}{n_\ell}-1\)

O teste F usual rejeita \(H_0: \tau_1 = \tau_2 = \cdots = \tau_g = 0\) no nível \(\alpha\) se

\[ F=\dfrac{\dfrac{\text{SS}_{\text{trt}}}{g-1}}{\dfrac{\text{SS}_{\text{res}}}{\sum_{\ell =1}^{g}{n_\ell} - g}} > F_{g-1, \;\sum_{\ell =1}^{g}{n_\ell} - g}(1-\alpha) \]

Isso é equivalente a rejeitar \(H_0\) para grandes valores de \(\dfrac{\text{SS}_{\text{trt}}}{\text{SS}_{\text{res}}}\) ou para grandes valores de \(1 + \dfrac{\text{SS}_{\text{trt}}}{\text{SS}_{\text{res}}}\).

A estatística apropriada para uma generalização multivariada rejeita \(H_0\) para pequenos valores do recíproco

\[ \dfrac{1}{1 + \dfrac{\text{SS}_{\text{trt}}}{\text{SS}_{\text{res}}}} = \dfrac{\text{SS}_{\text{res}}}{\text{SS}_{\text{res}} + \text{SS}_{\text{trt}}} \tag{6-37} \]

Exemplo 6.8: Uma tabela ANOVA univariada e teste F para efeitos de tratamento

  • \(p=1,\; q=1,\; g=3:\; n_1=3,\; n_2=2,\; n_3=3\)

O número de UE é \(n_1+n_2+n_3=8\).

Usando as informações do Exemplo 6.7, temos a seguinte tabela ANOVA:

Fonte de Variação Soma dos Quadrados Graus de Liberdade
Tratamentos \(\text{SS}_\text{trt} = 78\) \(g - 1 = 3 - 1 = 2\)
Resíduo \(\text{SS}_\text{res} = 10\) \(n - g = (3 + 2 + 3) - 3 = 5\)
Total \(\text{SS}_\text{tot} = 88\) \(\sum_{\ell =1}^{g}{n_\ell}-1=7\)

Consequentemente,

\[ F=\dfrac{\dfrac{\text{SS}_\text{trt}}{g - 1}}{\dfrac{\text{SS}_\text{res}}{n - g}} \sim F_{g-1,\,n-g} \]

\[ F=\dfrac{\dfrac{\text{SS}_\text{trt}}{g - 1}}{\dfrac{\text{SS}_\text{res}}{n - g}} = \dfrac{\dfrac{78}{2}}{\dfrac{10}{5}}=19.5 \]

Como \(F = 19.5 > F_{2,5}(0.99) = 13.27\), rejeitamos \(H_0: \tau_1 = \tau_2 = \tau_3 = 0\) (sem efeito populacional de tratamento) no nível de significância de 1%.

Por que \(F=(\text{SS}_{\text{trt}}/(g - 1))/(\text{SS}_\text{res}/(n - g)) \sim F_{g-1,n-g}\)?

A resposta é Teorema de Cochran.

O Teorema de Cochran é uma ferramenta fundamental na análise de variância (ANOVA). O teorema fornece a distribuição de somas de quadrados de certos tipos de combinações lineares de variáveis aleatórias normais independentes. Este teorema é frequentemente utilizado em estatísticas para testar hipóteses sobre os parâmetros de populações.

O artigo seminal relacionado ao Teorema de Cochran é:

  • Cochran, WG (1934) The distribution of quadratic forms in a normal system, with applications to the analysis of covariance. Mathematical Proceedings of the Cambridge Philosophical Society 30: 178-91. doi:10.1017/S0305004100016595.

Outros artigos e referências são:


suppressMessages(suppressWarnings(
  invisible(Sys.setlocale("LC_ALL", "pt_BR.UTF-8"))))
n1 <- 3
n2 <- 2
n3 <- 3
n <- n1 + n2 + n3
Grupo <- factor(c(rep("1", n1), 
                  rep("2", n2), 
                  rep("3", n3)))
y <- c(9, 6, 9, 0, 2, 3, 1, 2)
x <- data.frame(Grupo, y)
print(x)
  Grupo y
1     1 9
2     1 6
3     1 9
4     2 0
5     2 2
6     3 3
7     3 1
8     3 2
# Solução crossprod
# Soma dos Quadrados Total 
SS_tot <- crossprod(y - mean(y))
SS_tot
     [,1]
[1,]   88
var(y)*(n-1)
[1] 88
# Soma dos Quadrados do Modelo
x_bar_g <- rep(aggregate(y~Grupo, 
                         FUN="mean", 
                         data=x)$y, 
               times=c(n1,n2,n3))
x_bar_g
[1] 8 8 8 1 1 2 2 2
SS_trt <- crossprod(x_bar_g - mean(y))

# Soma dos Quadrados dos Resíduos
SS_res <- SS_tot - SS_trt

# Grupos
g <- length(unique(Grupo))
n <- length(y)

# Graus de liberdade
df_trt <- g - 1  # tratamentos
df_res <- n - g  # erro
df_tot <- n - 1  # total

# Médias dos Quadrados
MS_trt <- SS_trt / df_trt
MS_res <- SS_res / df_res

# Estatística F
F_val <- MS_trt / MS_res

# Valor p
p_val <- formatC(1 - pf(F_val, df_trt, df_res), 
                 format="e", digits=2)

# Tabela ANOVA
cat("\nAnova Table (Type II tests)\n")

Anova Table (Type II tests)
cat("Response: y")
Response: y
anova_table <- data.frame(Source = c("Grupo", "Residuals", "Total"),
                          df = c(df_trt, df_res, df_tot),
                          "Sum Sq" = c(SS_trt, SS_res, SS_tot),
                          "Mean Sq" = c(MS_trt, MS_res, ""),
                          "F value" = c(F_val, "", ""),
                          "p-value" = c(p_val, "", ""),
                          stringsAsFactors = FALSE,
                          check.names = FALSE)
print(anova_table, row.names=FALSE)
    Source df Sum Sq Mean Sq F value  p-value
     Grupo  2     78      39    19.5 4.35e-03
 Residuals  5     10       2                 
     Total  7     88                         
# Solução model.matrix, HIJ e OLS
# Kutner et al., 2005, p. 204
# Criar a matriz de design
X <- model.matrix(~Grupo, 
                  data=x)
X
  (Intercept) Grupo2 Grupo3
1           1      0      0
2           1      0      0
3           1      0      0
4           1      1      0
5           1      1      0
6           1      0      1
7           1      0      1
8           1      0      1
attr(,"assign")
[1] 0 1 1
attr(,"contrasts")
attr(,"contrasts")$Grupo
[1] "contr.treatment"
I <- diag(1, n)
I
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
[1,]    1    0    0    0    0    0    0    0
[2,]    0    1    0    0    0    0    0    0
[3,]    0    0    1    0    0    0    0    0
[4,]    0    0    0    1    0    0    0    0
[5,]    0    0    0    0    1    0    0    0
[6,]    0    0    0    0    0    1    0    0
[7,]    0    0    0    0    0    0    1    0
[8,]    0    0    0    0    0    0    0    1
J <- matrix(rep(1,n^2), nrow=n, byrow=TRUE)
J
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
[1,]    1    1    1    1    1    1    1    1
[2,]    1    1    1    1    1    1    1    1
[3,]    1    1    1    1    1    1    1    1
[4,]    1    1    1    1    1    1    1    1
[5,]    1    1    1    1    1    1    1    1
[6,]    1    1    1    1    1    1    1    1
[7,]    1    1    1    1    1    1    1    1
[8,]    1    1    1    1    1    1    1    1
H <- X%*%solve(t(X)%*%X)%*%t(X) # OLS
print(round(H, 2))
     1    2    3   4   5    6    7    8
1 0.33 0.33 0.33 0.0 0.0 0.00 0.00 0.00
2 0.33 0.33 0.33 0.0 0.0 0.00 0.00 0.00
3 0.33 0.33 0.33 0.0 0.0 0.00 0.00 0.00
4 0.00 0.00 0.00 0.5 0.5 0.00 0.00 0.00
5 0.00 0.00 0.00 0.5 0.5 0.00 0.00 0.00
6 0.00 0.00 0.00 0.0 0.0 0.33 0.33 0.33
7 0.00 0.00 0.00 0.0 0.0 0.33 0.33 0.33
8 0.00 0.00 0.00 0.0 0.0 0.33 0.33 0.33
SS_trt <- t(y)%*%(H-J/n)%*%y
SS_res <- t(y)%*%(I-H)%*%y
SS_tot <- t(y)%*%(I-J/n)%*%y

df_trt <- sum(diag(H-J/n))
df_res <- sum(diag(I-H))
df_tot <- sum(diag(I-J/n))

# Médias dos Quadrados
MS_trt <- SS_trt / df_trt
MS_res <- SS_res / df_res

# Estatística F
F_val <- MS_trt / MS_res

# Valor p
p_val <- formatC(1 - pf(F_val, df_trt, df_res), 
                 format="e", digits=2)

# Tabela ANOVA
cat("\nAnova Table (Type II tests)\n")

Anova Table (Type II tests)
cat("Response: y\n")
Response: y
anova_table <- data.frame(Source = c("Grupo", "Residuals", "Total"),
                          df = c(df_trt, df_res, df_tot),
                          "Sum Sq" = c(SS_trt, SS_res, SS_tot),
                          "Mean Sq" = c(MS_trt, MS_res, ""),
                          "F value" = c(F_val, "", ""),
                          "p-value" = c(p_val, "", ""),
                          stringsAsFactors = FALSE,
                          check.names = FALSE)
print(anova_table, row.names=FALSE)
    Source df Sum Sq Mean Sq F value  p-value
     Grupo  2     78      39    19.5 4.35e-03
 Residuals  5     10       2                 
     Total  7     88                         
# Solução model.matrix e OLS
# https://genomicsclass.github.io/book/pages/expressing_design_formula.html
n1 <- 3
n2 <- 2
n3 <- 3
Grupo <- factor(c(rep("1", n1), rep("2", n2), rep("3", n3)))
y <- c(9, 6, 9, 0, 2, 3, 1, 2)
x <- data.frame(Grupo, y)

# Criar a matriz de design
X <- model.matrix(~Grupo, 
                  data=x)

# Computar as somas de quadrados
coeff <- solve(t(X) %*% X) %*% t(X) %*% y # OLS
cat("\nCoefficients:\n")

Coefficients:
colnames(coeff) <- c("Estimate")
print(coeff)
            Estimate
(Intercept)        8
Grupo2            -7
Grupo3            -6
fit <- summary(lm(y~Grupo, data=x))
print(coefficients(fit), digits=2)
            Estimate Std. Error t value Pr(>|t|)
(Intercept)        8       0.82     9.8  0.00019
Grupo2            -7       1.29    -5.4  0.00289
Grupo3            -6       1.15    -5.2  0.00348
y_hat <- X%*%coeff
SS_trt <- sum((y_hat - mean(y))^2)
SS_res <- sum((y - y_hat)^2)
SS_tot <- sum((y - mean(y))^2)
R2 <- 1-SS_res/SS_tot
cat("R^2 = eta^2 omnibus = ", round(R2,2), sep="")
R^2 = eta^2 omnibus = 0.89
# Grupos
g <- length(unique(Grupo))
n <- length(y)

# Graus de liberdade
df_trt <- g - 1  # tratamentos
df_res <- n - g  # erro
df_tot <- n - 1

# Médias das somas de quadrados
MS_trt <- SS_trt / df_trt
MS_res <- SS_res / df_res

# Estatística F
F_value <- MS_trt / MS_res

# Valor p
p_value <- formatC(1 - pf(F_value, df_trt, df_res), 
                   format="e", digits=2)

# Tabela ANOVA
cat("\nAnova Table (Type II tests)")

Anova Table (Type II tests)
cat("\nResponse: y\n")

Response: y
anova_table <- data.frame(Source = c("Grupo", "Residuals", "Total"),
                          df = c(df_trt, df_res, df_tot),
                          "Sum Sq" = c(SS_trt, SS_res, SS_tot),
                          "Mean Sq" = c(MS_trt, MS_res, ""),
                          "F value" = c(F_val, "", ""),
                          "p-value" = c(p_val, "", ""),
                          stringsAsFactors = FALSE,
                          check.names = FALSE)
print(anova_table, row.names=FALSE)
    Source df Sum Sq Mean Sq F value  p-value
     Grupo  2     78      39    19.5 4.35e-03
 Residuals  5     10       2                 
     Total  7     88                         
# Solução GLM
fit <- lm(y ~ Grupo,
          data=x)

print(anv <- anova(fit))
Analysis of Variance Table

Response: y
          Df Sum Sq Mean Sq F value   Pr(>F)   
Grupo      2     78      39    19.5 0.004353 **
Residuals  5     10       2                    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
str(anv)
Classes 'anova' and 'data.frame':   2 obs. of  5 variables:
 $ Df     : int  2 5
 $ Sum Sq : num  78 10
 $ Mean Sq: num  39 2
 $ F value: num  19.5 NA
 $ Pr(>F) : num  0.00435 NA
 - attr(*, "heading")= chr [1:2] "Analysis of Variance Table\n" "Response: y"
anv_df <- data.frame(broom::tidy(anv))
print(anv_df)
       term df sumsq meansq statistic     p.value
1     Grupo  2    78     39      19.5 0.004353047
2 Residuals  5    10      2        NA          NA
str(anv_df)
'data.frame':   2 obs. of  6 variables:
 $ term     : chr  "Grupo" "Residuals"
 $ df       : int  2 5
 $ sumsq    : num  78 10
 $ meansq   : num  39 2
 $ statistic: num  19.5 NA
 $ p.value  : num  0.00435 NA
print(Anv <- car::Anova(fit,
                        type="II")) # default
Anova Table (Type II tests)

Response: y
          Sum Sq Df F value   Pr(>F)   
Grupo         78  2    19.5 0.004353 **
Residuals     10  5                    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
print(car::Anova(fit,
                 type="III"))
Anova Table (Type III tests)

Response: y
            Sum Sq Df F value    Pr(>F)    
(Intercept)    192  1    96.0 0.0001885 ***
Grupo           78  2    19.5 0.0043530 ** 
Residuals       10  5                      
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
str(Anv)
Classes 'anova' and 'data.frame':   2 obs. of  4 variables:
 $ Sum Sq : num  78 10
 $ Df     : num  2 5
 $ F value: num  19.5 NA
 $ Pr(>F) : num  0.00435 NA
 - attr(*, "heading")= chr [1:2] "Anova Table (Type II tests)\n" "Response: y"
Anv_df <- data.frame(broom::tidy(Anv))
print(Anv_df)
       term sumsq df statistic     p.value
1     Grupo    78  2      19.5 0.004353047
2 Residuals    10  5        NA          NA
str(Anv_df)
'data.frame':   2 obs. of  5 variables:
 $ term     : chr  "Grupo" "Residuals"
 $ sumsq    : num  78 10
 $ df       : num  2 5
 $ statistic: num  19.5 NA
 $ p.value  : num  0.00435 NA
print(reg <- summary(fit))

Call:
lm(formula = y ~ Grupo, data = x)

Residuals:
 1  2  3  4  5  6  7  8 
 1 -2  1 -1  1  1 -1  0 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)   8.0000     0.8165   9.798 0.000189 ***
Grupo2       -7.0000     1.2910  -5.422 0.002890 ** 
Grupo3       -6.0000     1.1547  -5.196 0.003478 ** 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 1.414 on 5 degrees of freedom
Multiple R-squared:  0.8864,    Adjusted R-squared:  0.8409 
F-statistic:  19.5 on 2 and 5 DF,  p-value: 0.004353
str(reg)
List of 11
 $ call         : language lm(formula = y ~ Grupo, data = x)
 $ terms        :Classes 'terms', 'formula'  language y ~ Grupo
  .. ..- attr(*, "variables")= language list(y, Grupo)
  .. ..- attr(*, "factors")= int [1:2, 1] 0 1
  .. .. ..- attr(*, "dimnames")=List of 2
  .. .. .. ..$ : chr [1:2] "y" "Grupo"
  .. .. .. ..$ : chr "Grupo"
  .. ..- attr(*, "term.labels")= chr "Grupo"
  .. ..- attr(*, "order")= int 1
  .. ..- attr(*, "intercept")= int 1
  .. ..- attr(*, "response")= int 1
  .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv> 
  .. ..- attr(*, "predvars")= language list(y, Grupo)
  .. ..- attr(*, "dataClasses")= Named chr [1:2] "numeric" "factor"
  .. .. ..- attr(*, "names")= chr [1:2] "y" "Grupo"
 $ residuals    : Named num [1:8] 1 -2 1 -1 1 ...
  ..- attr(*, "names")= chr [1:8] "1" "2" "3" "4" ...
 $ coefficients : num [1:3, 1:4] 8 -7 -6 0.816 1.291 ...
  ..- attr(*, "dimnames")=List of 2
  .. ..$ : chr [1:3] "(Intercept)" "Grupo2" "Grupo3"
  .. ..$ : chr [1:4] "Estimate" "Std. Error" "t value" "Pr(>|t|)"
 $ aliased      : Named logi [1:3] FALSE FALSE FALSE
  ..- attr(*, "names")= chr [1:3] "(Intercept)" "Grupo2" "Grupo3"
 $ sigma        : num 1.41
 $ df           : int [1:3] 3 5 3
 $ r.squared    : num 0.886
 $ adj.r.squared: num 0.841
 $ fstatistic   : Named num [1:3] 19.5 2 5
  ..- attr(*, "names")= chr [1:3] "value" "numdf" "dendf"
 $ cov.unscaled : num [1:3, 1:3] 0.333 -0.333 -0.333 -0.333 0.833 ...
  ..- attr(*, "dimnames")=List of 2
  .. ..$ : chr [1:3] "(Intercept)" "Grupo2" "Grupo3"
  .. ..$ : chr [1:3] "(Intercept)" "Grupo2" "Grupo3"
 - attr(*, "class")= chr "summary.lm"
reg_df <- data.frame(broom::tidy(reg))
print(reg_df)
         term estimate std.error statistic      p.value
1 (Intercept)        8 0.8164966  9.797959 0.0001885113
2      Grupo2       -7 1.2909944 -5.422177 0.0028900202
3      Grupo3       -6 1.1547005 -5.196152 0.0034781651
str(reg_df)
'data.frame':   3 obs. of  5 variables:
 $ term     : chr  "(Intercept)" "Grupo2" "Grupo3"
 $ estimate : num  8 -7 -6
 $ std.error: num  0.816 1.291 1.155
 $ statistic: num  9.8 -5.42 -5.2
 $ p.value  : num  0.000189 0.00289 0.003478

\[\Diamond\]

Modelo MANOVA (Análise de Variância Multivariada) para Comparar \(g\) Vetores de Média Populacionais

  • \(p\ge2,\; q=1,\; g\ge2\)

\[ \begin{align} \mathbf{X}_{\ell j} &= \boldsymbol{\mu} + \boldsymbol{\tau}_\ell + \boldsymbol{\varepsilon}_{\ell j}\\\\ j &= 1, 2, \ldots, n_\ell \\ \ell &= 1, 2, \ldots, g \end{align} \tag{6-38} \]

em que os \(\boldsymbol{\varepsilon}_{\ell j}\sim\mathcal{N}_p\text{IID}(\mathbf{0},\mathbf{\sigma^2\mathbf{I}})\).

Aqui, o vetor de parâmetros \(\boldsymbol{\mu}\) é a média global (nível), e \(\boldsymbol{\tau}_\ell\) representa o efeito de tratamento \(\ell\) com

\[ \sum_{\ell = 1}^{g} n_\ell \boldsymbol{\tau}_\ell = \mathbf{0} \]

De acordo com o modelo em (6-38), cada componente do vetor de observação satisfaz o modelo univariado (6-33). Os erros para os componentes de \(\mathbf{X}_{\ell j}\) estão correlacionados, mas a matriz de covariância \(\mathbf{\Sigma}\) é a mesma para todas as populações.

Um vetor de observações pode ser decomposto conforme sugerido pelo modelo. Assim,

observação = média geral + efeito tratamento + resíduo

\[ \begin{align} \mathbf{X}_{\ell j} &= \boldsymbol{\mu} + \boldsymbol{\tau}_\ell + \mathbf{e}_{\ell j}\\ &= \hat{\boldsymbol{\mu}} + \hat{\boldsymbol{\tau}}_\ell + \hat{\mathbf{e}}_{\ell j}\\ &= \hat{\boldsymbol{\mu}} + (\hat{\boldsymbol{\mu}}_\ell - \hat{\boldsymbol{\mu}}) + \hat{\mathbf{e}}_{\ell j}\\ \mathbf{X}_{\ell j} &= \overline{\mathbf{X}} + (\overline{\mathbf{X}}_\ell - \overline{\mathbf{X}}) + (\mathbf{X}_{\ell j} - \overline{\mathbf{X}}_\ell) \end{align} \tag{6-39} \]

A decomposição em (6-39) leva ao análogo multivariado da divisão univariada da soma dos quadrados em (6-35).

Primeiro, notamos que o produto

\[ (\mathbf{x}_{\ell j} - \bar{\mathbf{x}})(\mathbf{x}_{\ell j} - \bar{\mathbf{x}})^{\prime} \]

pode ser expressa como

\[ \begin{align} (\mathbf{x}_{\ell j} - \bar{\mathbf{x}})(\mathbf{x}_{\ell j} - \bar{\mathbf{x}})^{\prime}&=((\mathbf{x}_{\ell j} - \bar{\mathbf{x}}_\ell)+(\bar{\mathbf{x}}_{\ell} - \bar{\mathbf{x}}))((\mathbf{x}_{\ell j} - \bar{\mathbf{x}}_\ell)+(\bar{\mathbf{x}}_{\ell} - \bar{\mathbf{x}}))^{\prime}\\ (\mathbf{x}_{\ell j} - \bar{\mathbf{x}})(\mathbf{x}_{\ell j} - \bar{\mathbf{x}})^{\prime}&=(\mathbf{x}_{\ell j} - \bar{\mathbf{x}}_\ell)(\mathbf{x}_{\ell j} - \bar{\mathbf{x}}_\ell)^{\prime}+(\mathbf{x}_{\ell j} - \bar{\mathbf{x}}_\ell)(\bar{\mathbf{x}}_{\ell} - \bar{\mathbf{x}})^{\prime}+\\ &\;\quad(\bar{\mathbf{x}}_{\ell} - \bar{\mathbf{x}})(\mathbf{x}_{\ell j} - \bar{\mathbf{x}}_\ell)^{\prime}+(\bar{\mathbf{x}}_{\ell} - \bar{\mathbf{x}})(\bar{\mathbf{x}}_{\ell} - \bar{\mathbf{x}})^{\prime} \end{align} \]

A soma sobre \(j\) das duas expressões intermediárias é a matriz nula, porque

\[ \sum_{j=1}^{n_\ell} (\mathbf{x}_{\ell j} - \bar{\mathbf{x}}_\ell)=\mathbf{0} \]

Assim, somando o produto cruzado sobre \(j\) e \(\ell\) obtemos:

Total = Entre (Between) + Dentro (Within)

\[ \begin{align} \sum_{\ell=1}^{g} \sum_{j=1}^{n_\ell} (\mathbf{x}_{\ell j} - \bar{\mathbf{x}})(\mathbf{x}_{\ell j} - \bar{\mathbf{x}})^{\prime} &= \sum_{\ell=1}^{g} n_\ell (\bar{\mathbf{x}}_{\ell} - \bar{\mathbf{x}})(\bar{\mathbf{x}}_{\ell} - \bar{\mathbf{x}})^{\prime}+\\ &\quad\sum_{\ell=1}^{g} \sum_{j=1}^{n_\ell} (\mathbf{x}_{\ell j} - \bar{\mathbf{x}}_\ell)(\mathbf{x}_{\ell j} - \bar{\mathbf{x}}_\ell)^{\prime}\\ \mathbf{T}&=\mathbf{B}+\mathbf{W} \end{align} \tag{6-40} \]

A matriz de somas de quadrados e produtos cruzados dentro (Within) pode ser expressa como:

\[ \begin{align} \mathbf{W} &= \sum_{\ell=1}^{g} \sum_{j=1}^{n_\ell} (\mathbf{x}_{\ell j} - \bar{\mathbf{x}}_\ell)(\mathbf{x}_{\ell j} - \bar{\mathbf{x}}_\ell)^{\prime}\\ \mathbf{W} &= \sum_{\ell=1}^{g}{(n_\ell-1) \mathbf{S}_\ell} \end{align} \tag{6-41} \]

em que \(\mathbf{S}_\ell\) é a matriz de covariância amostral para a \(\ell\)-ésima condição independente. Esta matriz é uma generalização da matriz agrupada \((n_1 + n_2 - 2)\mathbf{S}_{\text{comb}}\) encontrada no caso de duas condições. Ela desempenha um papel dominante no teste para a presença de efeitos de tratamento.

Análogo ao resultado univariado, a hipótese de não haver efeitos populacionais de tratamento

\[ \begin{cases} H_0:\;\boldsymbol{\tau}_1=\boldsymbol{\tau}_2=\cdots=\boldsymbol{\tau}_g=\mathbf{0} \\ H_1:\; \exists\, j \in \{1,\dots,g\}\ \;|\; \boldsymbol{\tau}_j \neq \mathbf{0} \end{cases}\\ \alpha=5\% \]

é testada considerando os tamanhos relativos das somas de quadrados de tratamento e residuais e produtos cruzados. Equivalentemente, podemos considerar os tamanhos relativos das somas de quadrados residuais e totais (corrigidos) e produtos cruzados.

Formalmente, resumimos os cálculos que levam à estatística de teste em uma tabela MANOVA.

Tabela MANOVA para Comparação de Vetores de Média Populacionais

Fonte de variação Matriz de soma de quadrados e produtos cruzados (SSP) Graus de liberdade (df)
Tratamento \(\mathbf{B} = \sum_{\ell=1}^{g} n_\ell (\bar{\mathbf{x}}_{\ell} - \bar{\mathbf{x}})(\bar{\mathbf{x}}_{\ell} - \bar{\mathbf{x}})^{\prime}\) \(g - 1\)
Resíduo \(\mathbf{W} = \sum_{\ell=1}^{g} \sum_{j=1}^{n_\ell} (\mathbf{x}_{\ell j} - \bar{\mathbf{x}}_\ell)(\mathbf{x}_{\ell j} - \bar{\mathbf{x}}_\ell)^{\prime}\) \(\sum_{\ell=1}^{g}n_\ell - g\)
Total \(\mathbf{T}=\sum_{\ell=1}^{g} \sum_{j=1}^{n_\ell} (\mathbf{x}_{\ell j} - \bar{\mathbf{x}})(\mathbf{x}_{\ell j} - \bar{\mathbf{x}})^{\prime}\) \(\sum_{\ell=1}^{g}n_\ell - 1\)

Esta tabela tem exatamente a mesma forma, componente por componente, que a tabela ANOVA unifatorial independente de Fisher, exceto que os quadrados de escalares são substituídos por seus contrapartes vetoriais. Por exemplo, \((\bar{x}_\ell - \bar{x})^2\) torna-se \((\bar{\mathbf{x}}_{\ell} - \bar{\mathbf{x}})(\bar{\mathbf{x}}_{\ell} - \bar{\mathbf{x}})^{\prime}\). Os graus de liberdade correspondem à geometria univariada e também a alguma teoria de distribuição multivariada envolvendo densidade de Wishart. (Veja [1].)

Um teste da hipótese nula multivariada:

\[ H_0:\;\boldsymbol{\tau}_1=\boldsymbol{\tau}_2=\cdots=\boldsymbol{\tau}_g=\mathbf{0} \]

envolve variâncias generalizadas.

Rejeitamos \(H_0\) se a razão das variâncias generalizadas, \(\Lambda^{*}\), for muito pequena:

\[ \Lambda^{*}=\dfrac{|\mathbf{W}|}{|\mathbf{W} + \mathbf{B}|} \tag{6-42} \]

O valor \(\Lambda^{*}\), proposto originalmente por Wilks (veja [25]), corresponde à forma equivalente (6-37) do teste F de \(H_0\): sem efeitos de tratamento no caso univariado.

Lambda de Wilks tem a virtude de ser conveniente e relacionado ao critério da razão de verossimilhança. A distribuição exata de \(\Lambda^{*}\) pode ser derivada para os casos especiais listados na Tabela 6.3. Para outros casos e tamanhos de amostras grandes, uma modificação de \(\Lambda^{*}\) devido a Bartlett (veja [4]) pode ser usada para testar \(H_0\).

Lambda de Wilks também pode ser expresso como uma função dos autovalores \(\lambda_1, \lambda_2, \dots, \lambda_r\) de \(\mathbf{W}^{-1}\mathbf{B}\) como:

\[ \Lambda^* = \prod_{i=1}^{r} \dfrac{1}{1 + \lambda_i} \]

em que \(r = \min(p, g - 1)\), sendo \(p=\text{rank}(\mathbf{B})\). Outras estatísticas para verificar a igualdade de várias médias multivariadas, como a estatística de Pillai, a estatística de Lawley-Hotelling e a estatística da maior raiz de Roy também podem ser escritas como funções particulares dos autovalores de \(\mathbf{W}^{-1}\mathbf{B}\). Para amostras grandes, todas essas estatísticas são, essencialmente, equivalentes. (Veja a discussão adicional na página 336).

Tabela 6.3 Distribuição de Lambda de Wilks, \(\Lambda^*\)

Número variáveis Número grupos Distribuição amostral com multinormalidade
\(p = 1\) \(g \ge 2\) \(\dfrac{\sum{n_\ell}-g}{g-1}\dfrac{1-\Lambda^*}{\Lambda^*}\sim F_{g-1,\;\sum{n_\ell}-g}\)
\(p = 2\) \(g \ge 2\) \(\dfrac{\sum{n_\ell}-g-1}{g-1}\dfrac{1-\sqrt{\Lambda^*}}{\sqrt{\Lambda^*}}\sim F_{2(g-1),\;2\left(\sum{n_\ell}-g-1\right)}\)
\(p \ge 1\) \(g = 2\) \(\dfrac{\sum{n_\ell}-p-1}{p}\dfrac{1-\Lambda^*}{\Lambda^*}\sim F_{p,\;\sum{n_\ell}-p-1}\)
\(p \ge 1\) \(g = 3\) \(\dfrac{\sum{n_\ell}-p-2}{p}\dfrac{1-\sqrt{\Lambda^*}}{\sqrt{\Lambda^*}}\sim F_{2p,\;2\left(\sum{n_\ell}-p-2\right)}\)

Bartlett (veja [4]) mostrou que, se \(H_0\) é verdadeira e \(\sum{n_\ell}=n \ge 30\),

\[ -\left(n - 1 - \dfrac{p + g}{2}\right) \ln (\Lambda^{\ast}) \underset{a}{\sim} \chi^2_{p(g-1)} \]

Consequentemente, rejeitamos \(H_0\) no nível de significância \(\alpha\) se

\[ -\left(n - 1 - \dfrac{p + g}{2}\right) \ln (\Lambda^{\ast}) > \chi^2_{p(g-1)}(1-\alpha) \]

Exemplo 6.9: Uma tabela MANOVA e o lambda de Wilks para testar a igualdade de três vetores médios

  • \(p=2,\; q=1,\; g=3:\; n_1=3,\; n_2=2,\; n_3=3\)

O número de UE é \(n_1+n_2+n_3=8\).

Suponha que uma variável adicional seja observada juntamente com a variável introduzida no Exemplo 6.7. Os tamanhos de amostra são \(n_1 = 3\), \(n_2 = 2\) e \(n_3 = 3\). Organizando os pares de observações \(\mathbf{x}_{\ell j}\) em linhas, obtemos:

\[ \boldsymbol{x}= \begin{bmatrix} \begin{bmatrix}9\\3\end{bmatrix} &\begin{bmatrix}6\\2\end{bmatrix} &\begin{bmatrix}9\\7\end{bmatrix}\\ \begin{bmatrix}0\\4\end{bmatrix} &\begin{bmatrix}2\\0\end{bmatrix} \\ \begin{bmatrix}3\\8\end{bmatrix} &\begin{bmatrix}1\\9\end{bmatrix} &\begin{bmatrix}2\\7\end{bmatrix} \end{bmatrix} \]

Então:

\[ \bar{\mathbf{x}}_1=\begin{bmatrix}8\\4\end{bmatrix}\quad \bar{\mathbf{x}}_2=\begin{bmatrix}1\\2\end{bmatrix}\quad \bar{\mathbf{x}}_3=\begin{bmatrix}2\\8\end{bmatrix}\\ \bar{\mathbf{x}}=\begin{bmatrix}4\\5\end{bmatrix} \]

suppressMessages(suppressWarnings(
  invisible(Sys.setlocale("LC_ALL", "pt_BR.UTF-8"))))
n1 <- 3; n2 <- 2; n3 <- 3

p <- 2
Grupo <- factor(c(rep("1", n1), 
                  rep("2", n2), 
                  rep("3", n3)))
y <- matrix(c(9, 3,  6, 2,  9, 7, 
              0, 4,  2, 0, 
              3, 8,  1, 9,  2, 7), 
            ncol=p, byrow=TRUE)
x <- data.frame(Grupo, y)
print(x)
  Grupo X1 X2
1     1  9  3
2     1  6  2
3     1  9  7
4     2  0  4
5     2  2  0
6     3  3  8
7     3  1  9
8     3  2  7
y <- as.data.frame(y)
y_split <- split(y, Grupo)
x_bar_k <- tapply(y, 
                  Grupo, 
                  FUN="colMeans")
print(x_bar_k)
$`1`
V1 V2 
 8  4 

$`2`
V1 V2 
 1  2 

$`3`
V1 V2 
 2  8 
x_bar <- colMeans(y)
print(x_bar)
V1 V2 
 4  5 
n_k <- as.integer(table(Grupo))
g <- nlevels(Grupo)
p <- ncol(y)

B <- matrix(0, ncol = p, nrow = p)
for (k in 1:g) {
  d <- x_bar_k[[k]] - x_bar
  B <- B + n_k[k] * tcrossprod(d)
}
B
     [,1] [,2]
[1,]   78  -12
[2,]  -12   48
W <- matrix(0, ncol = p, nrow = p) 
for (k in 1:g) {
  for (i in 1:nrow(y_split[[k]])) {
    d <- as.numeric(y_split[[k]][i, ]) - x_bar_k[[k]]
    W <- W + tcrossprod(d)
  }
}
W
     [,1] [,2]
[1,]   10    1
[2,]    1   24
# B = Σ_k n_k (x_bar_k - x̄)x_bar_kk - x̄)'
B <- Reduce(`+`, Map(function(nk, mk) {
  d <- as.numeric(mk - x_bar)
  tcrossprod(d) * nk
}, n_k, x_bar_k))

# W = Σ_k Σ_{i∈k} (y_i - x_bar_k)(y_i - x_bar_k)'
W <- Reduce(`+`, Map(function(Gk, mk) {
  R <- sweep(as.matrix(Gk), 2, as.numeric(mk), "-")
  t(R) %*% R
}, y_split, x_bar_k))

B; W
     [,1] [,2]
[1,]   78  -12
[2,]  -12   48
   V1 V2
V1 10  1
V2  1 24
Lambda <- det(W)/det(W+B)
print(Lambda, 3)
[1] 0.0385
n <- sum(n_k)
g <- nlevels(Grupo)
# O livro usou linha 2 da tabela 6.3, mas poderia usar linha 4!
F <- ((1-sqrt(Lambda))/sqrt(Lambda))*(n-g-1)/(g-1) 
print(F, 3)
[1] 8.2
alfa <- 0.01
df1 <- 2*(g-1)
df1
[1] 4
df2 <- 2*(n-g-1)
df2
[1] 8
Fcrit <- qf(1-alfa, df1, df2)
print(Fcrit, 3)
[1] 7.01
F > Fcrit
[1] TRUE
pv <- formatC(1 - pf(F, df1, df2), 
              format="e", digits=2)
cat("\nF(0.99; ", df1, ", ", df2, ") = ", 
  round(Fcrit,2), ", F = ",  round(F,2), 
  ", p = ", pv, "\n", sep="")

F(0.99; 4, 8) = 7.01, F = 8.2, p = 6.23e-03
# Com dados brutos
rrcov::Wilks.test(x=x[-1], 
                  grouping=x[1])

    One-way MANOVA (Bartlett Chi2)

data:  x
Wilks' Lambda = 0.038455, Chi2-Value = 14.662, DF = 4.000, p-value =
0.005456
sample estimates:
  X1 X2
1  8  4
2  1  2
3  2  8
# rrcov::Wilks.test(x=iris[,1:4],grouping=iris[,5],method="mcd",nrep=1e3)
rrcov::Wilks.test(Grupo~., 
                  data=x)

    One-way MANOVA (Bartlett Chi2)

data:  x
Wilks' Lambda = 0.038455, Chi2-Value = 14.662, DF = 4.000, p-value =
0.005456
sample estimates:
  X1 X2
1  8  4
2  1  2
3  2  8
fit <- lm(cbind(X1,X2) ~ Grupo, 
          data=x, 
          na.action="na.omit")
print(car::Anova(fit, test="Wilks"),  digits=3)

Type II MANOVA Tests: Wilks test statistic
      Df test stat approx F num Df den Df Pr(>F)   
Grupo  2    0.0385      8.2      4      8 0.0062 **
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
alfa <- 0.05
print(effectsize::eta_squared(fit,
                              partial=TRUE,
                              ci = 1-alfa/2,
                              alternative = "two.sided"), 
      digits=4)
For one-way between subjects designs, partial eta squared is equivalent
  to eta squared. Returning eta squared.
For one-way between subjects designs, partial eta squared is equivalent
  to eta squared. Returning eta squared.
# Effect Size for ANOVA (Type I)

Response | Parameter |   Eta2 |         97.5% CI
------------------------------------------------
X1       |     Grupo | 0.8864 | [0.2209, 0.9609]
X2       |     Grupo | 0.6667 | [0.0000, 0.8845]
sm <- summary(fit)
print(sm, digits=3)
Response X1 :

Call:
lm(formula = X1 ~ Grupo, data = x, na.action = "na.omit")

Residuals:
 1  2  3  4  5  6  7  8 
 1 -2  1 -1  1  1 -1  0 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)    8.000      0.816    9.80  0.00019 ***
Grupo2        -7.000      1.291   -5.42  0.00289 ** 
Grupo3        -6.000      1.155   -5.20  0.00348 ** 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 1.41 on 5 degrees of freedom
Multiple R-squared:  0.886, Adjusted R-squared:  0.841 
F-statistic: 19.5 on 2 and 5 DF,  p-value: 0.00435


Response X2 :

Call:
lm(formula = X2 ~ Grupo, data = x, na.action = "na.omit")

Residuals:
        1         2         3         4         5         6         7         8 
-1.00e+00 -2.00e+00  3.00e+00  2.00e+00 -2.00e+00  5.55e-17  1.00e+00 -1.00e+00 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)  
(Intercept)     4.00       1.26    3.16    0.025 *
Grupo2         -2.00       2.00   -1.00    0.363  
Grupo3          4.00       1.79    2.24    0.076 .
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 2.19 on 5 degrees of freedom
Multiple R-squared:  0.667, Adjusted R-squared:  0.533 
F-statistic:    5 on 2 and 5 DF,  p-value: 0.0642
print(smm <- summary(car::Anova(fit), 
                     univariate=FALSE, 
                     multivariate=TRUE), digits=4) 

Type II MANOVA Tests:

Sum of squares and products for error:
   X1 X2
X1 10  1
X2  1 24

------------------------------------------
 
Term: Grupo 

Sum of squares and products for the hypothesis:
    X1  X2
X1  78 -12
X2 -12  48

Multivariate Tests: Grupo
                 Df test stat approx F num Df den Df  Pr(>F)   
Pillai            2     1.541    8.388      4     10 0.00310 **
Wilks             2     0.038    8.199      4      8 0.00623 **
Hotelling-Lawley  2     9.941    7.456      4      6 0.01643 * 
Roy               2     8.076   20.191      2      5 0.00403 **
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
print(smm$SSPE, digits=4)
   X1 X2
X1 10  1
X2  1 24
print(smm$multivariate.tests$`sex:region`, digits=4)
NULL
print(smm$multivariate.tests$sex, digits=4)
NULL
print(smm$multivariate.tests$region, digits=4)
NULL
print(summary.aov(fit), digits=4)
 Response X1 :
            Df Sum Sq Mean Sq F value  Pr(>F)   
Grupo        2     78      39    19.5 0.00435 **
Residuals    5     10       2                   
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

 Response X2 :
            Df Sum Sq Mean Sq F value Pr(>F)  
Grupo        2     48    24.0       5 0.0642 .
Residuals    5     24     4.8                 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
print(summary(car::Anova(fit), 
              univariate=TRUE, 
              multivariate=FALSE,
              p.adjust.method=TRUE), digits=2)

 Type II Sums of Squares
          df X1 X2
Grupo      2 78 48
residuals  5 10 24

 F-tests
        X1 X2
Grupo 19.5  5

 p-values
      X1       X2      
Grupo 0.004353 0.064150

 p-values adjusted (by term) for simultaneous inference by holm method
      X1        X2       
Grupo 0.0087061 0.0641500

\[\Diamond\]

Exemplo 6.10: Uma análise multivariada dos dados de asilos de idosos em Wisconsin

  • \(p=4,\; q=1,\; g=3:\; n_1=271,\; n_2=138,\; n_3=107\)

O número de UE é \(n_1+n_2+n_3=516\).

O Departamento de Saúde e Serviços Sociais de Wisconsin reembolsa os asilos de idosos no estado pelos serviços prestados. O departamento desenvolve um conjunto de fórmulas para taxas para cada instituição, com base em fatores como nível de atendimento, salário médio e salário médio no estado.

Os asilos de idosos podem ser classificados com base na propriedade (particular, organização sem fins lucrativos e governo) e certificação (instalação de enfermagem especializada, instalação de cuidados intermediários ou uma combinação dos dois).

Um dos objetivos de um estudo recente foi investigar os efeitos da propriedade ou certificação (ou ambos) nos custos. Quatro custos, calculados com base no paciente por dia e medidos em horas por dia do paciente, foram selecionados para análise: \(X_1\) = custo da mão-de-obra de enfermagem, \(X_2\) = custo da mão-de-obra dietética, \(X_3\) = custo da mão-de-obra de operação e manutenção da planta, e \(X_4\) = custo da mão-de-obra de limpeza e lavanderia. Um total de \(n = 516\) observações em cada uma das \(p = 4\) variáveis de custo foi inicialmente separado de acordo com a propriedade.

\[ n_1 = 271, \quad n_2 = 138, \quad n_3 = 107 \]

\[ \bar{\mathbf{x}}_1 = \begin{bmatrix} 2.066 \\ 0.480 \\ 0.082 \\ 0.360 \\ \end{bmatrix} \quad \bar{\mathbf{x}}_2 = \begin{bmatrix} 2.167 \\ 0.596 \\ 0.124 \\ 0.418 \\ \end{bmatrix} \quad \bar{\mathbf{x}}_3 = \begin{bmatrix} 2.273 \\ 0.521 \\ 0.125 \\ 0.383 \\ \end{bmatrix} \]

Média geral ponderada:

\[ \bar{\mathbf{x}} = \dfrac{n_1 \bar{\mathbf{x}}_1 + n_2 \bar{\mathbf{x}}_2 + n_3 \bar{\mathbf{x}}_3}{n} \]

O cálculo de \(\mathbf{B}\) necessita apenas dos dados brutos, mas dos tamanhos e médias dos grupos.

A matriz \(B\) é a matriz de somas de quadrados e produtos cruzados entre os grupos (tratamentos) e é calculada como:

\[ \begin{align} \mathbf{B} &= n_1 (\bar{\mathbf{x}}_1 - \bar{\mathbf{x}})(\bar{\mathbf{x}}_1 - \bar{\mathbf{x}})^{\prime} + n_2 (\bar{\mathbf{x}}_2 - \bar{\mathbf{x}})(\bar{\mathbf{x}}_2 - \bar{\mathbf{x}})^{\prime} + n_3 (\bar{\mathbf{x}}_3 - \bar{\mathbf{x}})(\bar{\mathbf{x}}_3 - \bar{\mathbf{x}})^{\prime}\\ \mathbf{B} &= \begin{bmatrix} 3.4688 & 1.0986 & 0.8107 & 0.5860 \\ 1.0986 & 1.2307 & 0.4500 & 0.6157 \\ 0.8107 & 0.4500 & 0.2318 & 0.2311 \\ 0.5860 & 0.6157 & 0.2311 & 0.3086 \\ \end{bmatrix} \end{align} \]

Como as \(\mathbf{s}_\ell\) parecem ser razoavelmente compatíveis, elas foram agrupadas [veja (6-41)] para obter:

\[ \mathbf{W} = (n_1 - 1)\mathbf{s}_1 + (n_2 - 1)\mathbf{s}_2 + (n_3 - 1)\mathbf{s}_3 \]

\[ \begin{align} \mathbf{s}_1 &= \begin{bmatrix} 0.291 & -0.001 & 0.002 & 0.010 \\ -0.001 & 0.011 & 0.000 & 0.003 \\ 0.002 & 0.000 & 0.001 & 0.000 \\ 0.010 & 0.003 & 0.000 & 0.010 \\ \end{bmatrix} \\ \mathbf{s}_2 &= \begin{bmatrix} 0.561 & 0.011 & 0.001 & 0.037 \\ 0.011 & 0.025 & 0.004 & 0.007 \\ 0.001 & 0.004 & 0.005 & 0.002 \\ 0.037 & 0.007 & 0.002 & 0.019 \\ \end{bmatrix} \\ \mathbf{s}_3 &= \begin{bmatrix} 0.261 & 0.030 & 0.003 & 0.018 \\ 0.030 & 0.017 & -0.000 & 0.006 \\ 0.003 & -0.000 & 0.004 & 0.001 \\ 0.018 & 0.006 & 0.001 & 0.013 \\ \end{bmatrix} \end{align} \]

\[ \mathbf{W} = \begin{bmatrix} 183.093 & 4.417 & 0.995 & 9.677 \\ 4.417 & 8.197 & 0.548 & 2.405 \\ 0.995 & 0.548 & 1.379 & 0.380 \\ 9.677 & 2.405 & 0.380 & 6.681 \\ \end{bmatrix} \]

Para testar \(H_0: \boldsymbol{\tau}_1 = \boldsymbol{\tau}_2 = \boldsymbol{\tau}_3=\mathbf{0}\) (sem efeitos de propriedade ou, equivalentemente, sem diferença nos custos médios entre os três tipos de proprietários - privado, sem fins lucrativos e governo), podemos usar o resultado na Tabela 6.3 para \(g = 3\). Então, \(\Lambda^{*}=0.76\).

No entanto, um teste de teoria normal de \(H_0: \mathbf{\Sigma}_1 = \mathbf{\Sigma}_2 = \mathbf{\Sigma}_3\) rejeitaria \(H_0\) em qualquer nível de significância razoável devido aos grandes tamanhos de amostra (veja o Exemplo 6.12).

É informativo comparar os resultados com base no teste “exato” com aqueles obtidos usando o procedimento de grande amostra resumido em (6-43) e (6-44). Para o exemplo atual, \(n - p - g = 516 - 4 - 3 = 509 \ge 30\), e \(H_0\) pode ser testado no nível \(\alpha = 0.01\) comparando

\[ X^2=-\left(n - 1 - \dfrac{p + g}{2}\right)\ln\left(\Lambda^{\ast}\right) = -511.5 \ln(0.7714) = 138.52 \]

com \(\chi^2_{p(g-1)}(1-\alpha) = \chi^2_8(0.99) = 20.09\). Como \(138.52 > 20.09\), rejeitamos \(H_0\) no nível de 1%.

suppressMessages(suppressWarnings(
  invisible(Sys.setlocale("LC_ALL", "pt_BR.UTF-8"))))
n1 <- 271
n2 <- 138
n3 <- 107
n <- n1 + n2 + n3
x_bar_1 <- c(2.066, 0.480, 0.082, 0.360)
x_bar_2 <- c(2.167, 0.596, 0.124, 0.418)
x_bar_3 <- c(2.273, 0.521, 0.125, 0.383)
x_bar <- (n1*x_bar_1+n2*x_bar_2+n3*x_bar_3)/n
print(x_bar, 2)
[1] 2.14 0.52 0.10 0.38
s1 <- matrix(c( 0.291, -0.001, 0.002, 0.010,
               -0.001,  0.011, 0.000, 0.003,
                0.002,  0.000, 0.001, 0.000,
                0.010,  0.003, 0.000, 0.010), nrow=4, byrow=TRUE)
s2 <- matrix(c(0.561, 0.011, 0.001, 0.037,
               0.011, 0.025, 0.004, 0.007,
               0.001, 0.004, 0.005, 0.002,
               0.037, 0.007, 0.002, 0.019), nrow=4, byrow=TRUE)
s3 <- matrix(c(0.261,  0.030,  0.003, 0.018,
               0.030,  0.017, -0.000, 0.006,
               0.003, -0.000,  0.004, 0.001,
               0.018,  0.006,  0.001, 0.013), nrow=4, byrow=TRUE)

B <- n1*tcrossprod(x_bar_1 - x_bar) +
     n2*tcrossprod(x_bar_2 - x_bar) +
     n3*tcrossprod(x_bar_3 - x_bar)
print(B, 2)
     [,1] [,2] [,3] [,4]
[1,] 3.47 1.10 0.81 0.59
[2,] 1.10 1.23 0.45 0.62
[3,] 0.81 0.45 0.23 0.23
[4,] 0.59 0.62 0.23 0.31
W <- (n1-1)*s1 + (n2-1)*s2 + (n3-1)*s3
print(W, 2)
      [,1] [,2] [,3] [,4]
[1,] 183.1 4.42 1.00 9.68
[2,]   4.4 8.20 0.55 2.41
[3,]   1.0 0.55 1.38 0.38
[4,]   9.7 2.41 0.38 6.68
p      <- length(x_bar)         
n_k    <- c(n1, n2, n3)
x_bar_k <- list(x_bar_1, x_bar_2, x_bar_3)
s_k     <- list(s1, s2, s3)

B <- matrix(0, p, p)
for (k in seq_along(n_k)) {
    d <- as.numeric(x_bar_k[[k]] - x_bar)     
    d <- matrix(d, ncol = 1)                  
    B <- B + n_k[k] * tcrossprod(d)           
}
print(B, 2)
     [,1] [,2] [,3] [,4]
[1,] 3.47 1.10 0.81 0.59
[2,] 1.10 1.23 0.45 0.62
[3,] 0.81 0.45 0.23 0.23
[4,] 0.59 0.62 0.23 0.31
W <- matrix(0, p, p)
for (k in seq_along(n_k)) {
    W <- W + (n_k[k] - 1) * s_k[[k]]
}
print(W, 2)
      [,1] [,2] [,3] [,4]
[1,] 183.1 4.42 1.00 9.68
[2,]   4.4 8.20 0.55 2.41
[3,]   1.0 0.55 1.38 0.38
[4,]   9.7 2.41 0.38 6.68
Lambda <- det(W)/det(W+B)
print(Lambda, 2)
[1] 0.76
p <- length(x_bar)
F <- ((1-sqrt(Lambda))/sqrt(Lambda))*(n-p-2)/p
print(F, 4)
[1] 18.49
alfa <- 0.01
df1 <- 2*p
df1
[1] 8
df2 <- 2*(n-p-2)
df2
[1] 1020
Fcrit <- qf(1-alfa, df1, df2)
print(Fcrit, 3)
[1] 2.53
F > Fcrit
[1] TRUE
p_value <- formatC(1 - pf(F, df1, df2), 
                   format="e", digits=2)
p_value
[1] "0.00e+00"
cat("\nF(0.99; ", df1, ", ", df2, ") = ", 
    round(Fcrit,2), ", F = ",  round(F,2), 
    ", p = ", p_value, "\n", sep="")

F(0.99; 8, 1020) = 2.53, F = 18.49, p = 0.00e+00
X2crit <- qchisq(1-alfa, df1)/df1
print(X2crit, 3)
[1] 2.51
cat("\nTCL: F(0.99; ", df1, ", ", df2, ") = ", 
    round(X2crit,2), ", F = ",  round(F,2), 
    ", p = ", p_value, "\n", sep="")

TCL: F(0.99; 8, 1020) = 2.51, F = 18.49, p = 0.00e+00
# (6-44)
g <- 3
X2 <- -(n-1-(p+g)/2)*log(Lambda)
print(X2, 4)
[1] 138.5
df <- p*(g-1)
X2crit <- qchisq(1-alfa, df)
print(X2crit, 3)
[1] 20.1
X2 > X2crit
[1] TRUE
p_value <- formatC(1 - pchisq(X2, df), 
                   format="e", digits=2)
p_value
[1] "0.00e+00"
cat("\nTCL (lambda de Wilks): X^2(0.99; ", df, ") = ", 
    round(X2crit,2), ", X2 = ",  round(X2,2), 
    ", p = ", p_value, "\n", sep="")

TCL (lambda de Wilks): X^2(0.99; 8) = 20.09, X2 = 138.52, p = 0.00e+00

\[\Diamond\]

Intervalos de Confiança Simultâneos para Efeitos de Tratamento

Quando a hipótese de efeitos de tratamento iguais é rejeitada, os efeitos que levaram à rejeição da hipótese são de interesse. Para comparações aos pares, a abordagem de Bonferroni (veja a Seção 5.4) pode ser usada para construir intervalos de confiança simultâneos para os componentes das diferenças \(\boldsymbol{\tau}_k - \boldsymbol{\tau}_\ell\) (ou \(\boldsymbol{\mu}_k - \boldsymbol{\mu}_\ell\)). Esses intervalos são mais curtos do que os obtidos para todos os contrastes e requerem valores críticos apenas para a estatística t univariada.

Seja \(\tau_{ki}\) o i-ésimo componente de \(\boldsymbol{\tau}_k\). Uma vez que \(\boldsymbol{\tau}_k\) é estimado por \(\hat{\boldsymbol{\tau}}_k = \bar{\mathbf{x}}_k - \bar{\mathbf{x}}\),

\[ \hat{\tau}_{ki} = \bar{x}_{ki} - \bar{x}_{i} \]

em que \(\hat{\tau}_{ki} - \hat{\tau}_{\ell i} = \bar{x}_{ki}-\bar{x}_{\ell i}\) é a diferença entre duas médias amostrais independentes. O intervalo de confiança t é válido com um \(\alpha\) apropriadamente modificado. Observe que:

\[ \mathbb{V}\left(\hat{\tau}_{ki} - \hat{\tau}_{\ell i} \right) = \mathbb{V}\left(\overline{X}_{ki} - \overline{X}_{\ell i} \right) = \left(\dfrac{1}{n_k}+\dfrac{1}{n_\ell}\right)\sigma_{ii} \]

Como sugerido por (6-41), \(\mathbb{V}\left(\overline{X}_{ki} - \overline{X}_{\ell i} \right)\) é estimado dividindo-se o elemento correspondente de \(\mathbf{W}\) por seus graus de liberdade. Ou seja,

\[ \widehat{\mathbb{V}}\left(\overline{X}_{ki} - \overline{X}_{\ell i} \right)=\left(\dfrac{1}{n_k}+\dfrac{1}{n_\ell}\right)\dfrac{w_{ii}}{n-g} \]

em que \(w_{ii}\) é o i-ésimo elemento diagonal de \(\mathbf{W}\) e \(n = \sum_{\ell = 1}^{g}{n_\ell}\).

Ainda resta distribuir a probabilidade do erro do tipo I global entre as diversos intervalos de confiança. A relação (5-28) ainda se aplica.

Existem \(p\) variáveis e \(\frac{g(g - 1)}{2}\) diferenças aos pares, então cada intervalo t empregará o valor crítico \(t_{n-g}(\frac{\alpha}{2m})\), em que

\[ m =p\binom{g}{2}=p\dfrac{g(g - 1)}{2} \tag{6-46} \]

é o número de intervalos de confiança simultâneos.

Resultado 6.5. Seja \(n = \sum_{\ell = 1}^{g}{n_\ell}\). Para o modelo em (6-38), com confiança de pelo menos \((1-\alpha)\),

\[ \text{IC}^{1-\alpha}\left(\tau_{kl} - \tau_{\ell i}\right)=\left[ \bar{x}_{ki} - \bar{x}_{\ell i} \pm t_{n-g}\left(\dfrac{1-\alpha}{pg(g-1)}\right) \sqrt{\left(\dfrac{1}{n_k} + \dfrac{1}{n_\ell}\right)\dfrac{w_{ii}}{n-g}}\right] \]

para todos os componentes \(i = 1, 2, \dots, p\) e todas as diferenças \(\ell < k = 1, 2, \dots, g\). Aqui \(w_{ii}\) é o i-ésimo elemento diagonal de \(\mathbf{W}\).

Ilustraremos a construção de intervalo de confiança simultâneos para as diferenças aos pares nas médias de tratamento usando os dados de asilos de enfermagem introduzidos no Exemplo 6.10.

Exemplo 6.11: Intervalos simultâneos para diferenças de tratamento - asilos de enfermagem

Vimos no Exemplo 6.10 que os custos médios para asilos de enfermagem diferem, dependendo do tipo de propriedade. Podemos usar o Resultado 6.5 para estimar as magnitudes das diferenças. Uma comparação da variável \(X_3\), custos de operação e mão de obra de manutenção, entre asilos de enfermagem de propriedade privada e asilos de enfermagem de propriedade do governo pode ser feita estimando \(\tau_{13} - \tau_{33}\). Usando (6-39) e as informações no Exemplo 6.10, temos:

\[ \hat{\boldsymbol{\tau}}_1 = \bar{\mathbf{x}}_1 - \bar{\mathbf{x}} = \begin{bmatrix} -0.070 \\ -0.039 \\ -0.020 \\ -0.020 \end{bmatrix} \]

\[ \hat{\boldsymbol{\tau}}_3 = \bar{\mathbf{x}}_3 - \bar{\mathbf{x}} = \begin{bmatrix} 0.137 \\ 0.002 \\ 0.023 \\ 0.003 \end{bmatrix} \]

\[ \mathbf{W} = \begin{bmatrix} 183.093 & 4.417 & 0.995 & 9.677 \\ 4.417 & 8.197 & 0.548 & 2.405 \\ 0.995 & 0.548 & 1.379 & 0.380 \\ 9.677 & 2.405 & 0.380 & 6.681 \\ \end{bmatrix} \]

Consequentemente,

\[ \hat{\tau}_{13} -\hat{\tau}_{33} = -0.020 - 0.023 = -0.043 \]

e \(n = 271 + 138 + 107 = 516\), de forma que

\[ \sqrt{\left(\dfrac{1}{n_1} + \dfrac{1}{n_3}\right)\dfrac{w_{33}}{n - g}} = \sqrt{\left(\dfrac{1}{271} + \dfrac{1}{107}\right)\dfrac{1.484}{516 - 3}} = 0.00614 \]

Uma vez que \(p = 4\) e \(g= 3\), para intervalos de confiança simultâneos de 95%, exigimos que \(t_{513}(0.05/4(3)2) \approx 2.87\). (Consulte o Apêndice, Tabela 1.) O intervalo de confiança simultâneo de 95% é

\[ \begin{align} \text{IC}^{1-0.00208} \left(\tau_{13} - \tau_{33}\right)&= \left[\hat{\tau}_{13} - \hat{\tau}_{33} \pm t_{513}(1-0.00208)\sqrt{\left(\dfrac{1}{n_1} + \dfrac{1}{n_3}\right)\dfrac{n}{n - g}}\right]\\ \text{IC}^{1-0.00208} \left(\tau_{13} - \tau_{33}\right)&= [-0.061, -0.025] \end{align} \]

Concluímos que o custo médio de manutenção e mão de obra para asilos de enfermagem de propriedade do governo é maior em .025 a .061 hora por dia por paciente do que para asilos de enfermagem de propriedade privada. Com a mesma confiança de 95%, podemos dizer que

\[ \text{IC}^{1-0.00208}\left(\tau_{13} - \tau_{23}\right)=[-.058, -.026] \]

e

\[ \text{IC}^{1-0.00208}\left(\tau_{23} - \tau_{33}\right)=[-.021, .019) \]

Assim, existe uma diferença neste custo entre asilos de enfermagem privados e sem fins lucrativos, mas não se observa diferença entre asilos de enfermagem sem fins lucrativos e de propriedade do governo.

suppressMessages(suppressWarnings(
  invisible(Sys.setlocale("LC_ALL", "pt_BR.UTF-8"))))
# Dados
x_bar_1 <- c(-0.070, -0.039, -0.020, -0.020)
x_bar_3 <- c(0.137, 0.002, 0.023, 0.003)
W <- matrix(c(183.093, 4.417, 0.995, 9.677,
              4.417, 8.197, 0.548, 2.405,
              0.995, 0.548, 1.379, 0.380,
              9.677, 2.405, 0.380, 6.681), 
            nrow=4, byrow=TRUE)
w33 <- W[3,3]

n1 <- 271
n2 <- 138
n3 <- 107
n <- n1 + n2 + n3
g <- 3
p <- length(x_bar_1)

# Cálculos
tau_13 <- x_bar_1[3]
tau_33 <- x_bar_3[3]
tau_13_minus_tau_33 <- tau_13 - tau_33

error_term <- sqrt((1/n1 + 1/n3) * w33 / (n - g))
m <- p*g*(g-1)/2
m
[1] 12
alfa <- 0.05
t_value <- qt(1-alfa/(2*m), n-g)
print(t_value, 3)
[1] 2.88
confidence_interval <- c(tau_13_minus_tau_33 - t_value * error_term, 
                         tau_13_minus_tau_33 + t_value * error_term)

# Resultados
cat("IC", round(1-alfa/(2*m),4)*100, "% (tau_13 - tau_33) = [", 
    round(confidence_interval[1], 3), ", ", round(confidence_interval[2], 3), "]", sep="")
IC99.79% (tau_13 - tau_33) = [-0.06, -0.026]

\[\Diamond\]

Testando a Igualdade das Matrizes de Covariância

Uma das suposições feitas ao comparar dois ou mais vetores médios multivariados é que as matrizes de covariância das potenciais diferentes populações são as mesmas (homocedasticidade multivariada). (Esta suposição aparecerá novamente no Capítulo 11 quando discutirmos discriminação e classificação.) Antes de agrupar a variação entre amostras para formar uma matriz de covariância agrupada ao comparar vetores de média, pode ser útil testar a igualdade das matrizes de covariância da população. Um teste comumente empregado para matrizes de covariância iguais é o teste M de Box ([8], [9]).

Com \(g\) populações, as hipótese nula e alternativa são:

\[ \begin{cases} H_0: \mathbf{\Sigma}_1 = \mathbf{\Sigma}_2 = \cdots = \mathbf{\Sigma}_g = \mathbf{\Sigma}\\ H_1:\; \exists\; i \neq j \;|\; \mathbf{\Sigma}_i \neq \mathbf{\Sigma}_j \end{cases}\\ \alpha=5\% \tag{6-47} \]

em que \(\mathbf{\Sigma}_\ell\) é a matriz de covariância para a \(\ell\)-ésima população, \(\ell = 1, 2, \cdots, g\), e \(\mathbf{\Sigma}\) é a matriz de covariância comum presumida. A hipótese alternativa é que pelo menos duas das matrizes de covariância não são iguais.

Assumindo populações multinormais, uma estatística de razão de verossimilhança para testar (6-47) é dada por (veja [1])

\[ \Lambda=\prod_{\ell = 1}^{g}{\left(\dfrac{|\mathbf{S}_\ell|}{|\mathbf{S}_\text{comb}|}\right)^{\frac{n_\ell -1}{2}}} \tag{6-48} \]

Aqui \(n_\ell\) é o tamanho da amostra para o \(\ell\)-ésimo grupo, \(\mathbf{S}_\ell\) é a matriz de covariância amostral do \(\ell\)-ésimo grupo e \(\mathbf{S}_{\text{comb}}\) é a matriz de covariância da amostra combinada dada por

\[ \mathbf{S}_{\text{comb}} = \dfrac{1}{\sum_{\ell =1}^{g}{(n_\ell -1)}} \sum_{\ell =1}^{g}{(n_\ell -1)\mathbf{S}_\ell} \tag{6-49} \]

O teste M de Box é baseado em sua aproximação \(\chi^2\) para a distribuição amostral de \(-2 \ln \Lambda\) (veja Resultado 5.2).

Definindo \(-2 \ln \Lambda = M\) (estatística M de Box), temos:

\[ M = \sum_{\ell =1}^{g} {(n_\ell - 1)} \ln \left(|\mathbf{S}_{\text{comb}}|\right) - \sum_{\ell =1}^{g} {(n_\ell - 1) \ln \left(|\mathbf{S}_\ell|\right)} \tag{6-50} \]

Se a hipótese nula for verdadeira, não se espera que as matrizes de covariância amostral individuais difiram muito e, consequentemente, não difiram muito da matriz de covariância combinada. Nesse caso, a razão dos determinantes em (6-48) estará próxima de 1, \(\Lambda\) estará próximo de 1 e a estatística M de Box será pequena. Se a hipótese nula for falsa, as matrizes de covariância amostral podem diferir mais e as diferenças em seus determinantes serão mais pronunciadas. Neste caso, \(\Lambda\) será pequeno e M será relativamente grande. Para ilustrar, observe que o determinante da matriz de covariância combinada, \(|\mathbf{S}_{\text{comb}}|\), estará em algum lugar próximo ao “meio” dos determinantes \(|\mathbf{S}_\ell|\) das matrizes de covariância do grupo individual. À medida que essas quantidades se tornam mais distintas, o produto das razões em (6-44) se aproxima de 0. De fato, à medida que os \(|\mathbf{S}_\ell|\) aumentam em dispersão, \(|\mathbf{S}_{(1)}|/|\mathbf{S}_{\text{comb}}|\) reduz o produto proporcionalmente mais do que \(|\mathbf{S}_{(g)}|/|\mathbf{S}_{\text{comb}}|\) o aumenta, em que \(|\mathbf{S}_{(1)}|\) e \(|\mathbf{S}_{(g)}|\) são os valores determinantes mínimo e máximo, respectivamente.

Teste M de Box para Igualdade de Matrizes de Covariância

Seja

\[ u=\left(\sum_{\ell = 1}^{g}{\dfrac{1}{n_\ell - 1}}-\dfrac{1}{\sum_{\ell = 1}^{g}{n_\ell - 1}}\right)\dfrac{2p^2+3p-1}{6(p+1)(g-1)} \tag{6-51} \]

em que \(p\) é o número de variáveis e \(g\) é o número de grupos.

Então

\[ C = (1-u)M \underset{a}{\sim}\chi^2_{p(p + 1)(g - 1)/2} \tag{6-52} \]

No nível de significância \(\alpha\), rejeitar \(H_0\) se \(C > \chi^2_{p(p + 1)(g - 1)/2}(1-\alpha)\).

A aproximação de M de Box funciona bem se cada \(n_\ell - p - g>20\) e se \(p \le 5\) e \(g \le 5\). Em situações em que essas condições não se mantêm, Box ([7],[8]) forneceu uma aproximação \(F\) mais precisa para a distribuição amostral de M de Box.

Exemplo 6.12: Testando a igualdade das matrizes de covariância - asilos de enfermagem

Introduzimos os dados de asilos de enfermagem de Wisconsin no Exemplo 6.10. Naquele exemplo, as matrizes de covariância amostral para \(p = 4\) variáveis de custo associadas com \(g = 3\) grupos de asilos de enfermagem são exibidas. Supondo dados multinormais, testamos a hipótese \(H_0: \mathbf{\Sigma}_1 = \mathbf{\Sigma}_2=\mathbf{\Sigma}_3=\mathbf{\Sigma}\).

Usando as informações do Exemplo 6.10, temos \(n_1 = 271\), \(n_2 = 138\), \(n_3 = 107\) e \(|\mathbf{s}_1| = 2.783 \times 10^{-8}\), \(|\mathbf{s}_2| = 89.539 \times 10^{-8}\), \(|\mathbf{s}_3| = 14.579 \times 10^{-8}\), e \(|\mathbf{s}_{\text{pooled}}| = 17.398 \times 10^{-8}\). Tomando os logaritmos naturais dos determinantes, obtemos:

\[ \ln (|\mathbf{s}_1|) = -17.397, \quad \ln (|\mathbf{s}_2|) = -13.926, \quad \ln (|\mathbf{s}_3|) = -15.741\\ \ln (|\mathbf{s}_{\text{comb}}|) = -15.564 \]

Calculamos

\[ \begin{align} u &= 0.0133\\ M &= (270 + 137 + 106)(-15.564) - (270(-17.397) + 137(-13.926) + 106(-15.741)) \\ M&= 244.15 \end{align} \]

e

\[ C = (1 - 0.0133) \times 244.15 = 240.76 \]

Com \(C=240.76\) e \(\nu = 4(4 + 1)(3 - 1)/2 = 20\) graus de liberdade, fica claro que \(H_0\) é rejeitado em qualquer nível razoável de significância. Concluímos que as matrizes de covariância das variáveis de custo associadas com as três populações de asilos de enfermagem não são as mesmas (heterocedasticidade multivariada).

suppressMessages(suppressWarnings(
  invisible(Sys.setlocale("LC_ALL", "pt_BR.UTF-8"))))
# Definindo as matrizes e tamanhos das amostras
n1 <- 271
n2 <- 138
n3 <- 107
n <- n1+n2+n3

s1 <- matrix(c(0.291, -0.001, 0.002, 0.010,
               -0.001, 0.011, 0.000, 0.003,
               0.002, 0.000, 0.001, 0.000,
               0.010, 0.003, 0.000, 0.010), nrow=4, byrow=TRUE)

s2 <- matrix(c(0.561, 0.011, 0.001, 0.037,
               0.011, 0.025, 0.004, 0.007,
               0.001, 0.004, 0.005, 0.002,
               0.037, 0.007, 0.002, 0.019), nrow=4, byrow=TRUE)

s3 <- matrix(c(0.261, 0.030, 0.003, 0.018,
               0.030, 0.017, -0.000, 0.006,
               0.003, -0.000, 0.004, 0.001,
               0.018, 0.006, 0.001, 0.013), nrow=4, byrow=TRUE)

# Definindo p e g
p <- 4
g <- 3

# Calculando a matriz de covariância combinada
s_pooled <- ((n1 - 1)*s1 + (n2 - 1)*s2 + (n3 - 1)*s3) / (n - g)

# Calculando M
u <- (1/(n1-1)+1/(n2-1)+1/(n3-1)-1/(n - g))*
     (2*p^2 + 3*p + 1) / (6*(p + 1)*(g - 1))
print(u, 2)
[1] 0.014
M <- (n-g)*log(det(s_pooled)) - 
     ((n1-1)*log(det(s1)) + (n2-1)*log(det(s2)) + (n3-1)*log(det(s3)))
print(M, 4)
[1] 244.1
# Calculando C
C <- (1 - u)*M
print(C, 4)
[1] 240.8
alfa <- 0.05
df <- p*(p+1)*(g-1)/2
X2crit <- qchisq(1-alfa, df)
C > X2crit
[1] TRUE
pv <- formatC(1 - pchisq(C, df), 
              format="e", digits=2)
cat("X^2(95%; ", df, ") = ", round(X2crit,2), 
    ", X^2 = ", round(C,2), ", p = ", pv, sep="")
X^2(95%; 20) = 31.41, X^2 = 240.76, p = 0.00e+00

\[\Diamond\]

O teste M de Box é rotineiramente calculado em muitos pacotes de computação estatística que realizam MANOVA e outros procedimentos que requerem matrizes de covariância iguais. É conhecido que o teste M é sensível a algumas formas de não-normalidade. De forma mais ampla, na presença de não-normalidade, testes de teoria normal em covariâncias são influenciados pela curtose das populações originais (veja [16]). No entanto, com amostras suficientemente grandes, os testes MANOVA de médias ou efeitos de tratamento são bastante robustos à não-normalidade e também funciona o teorema central do limite que permite distribuições multivariadas distintas e eventualmente heterocedásticas nos \(g\) grupos. Assim, o teste M pode rejeitar \(H_0\) em alguns casos de não-normalidade, onde não é prejudicial para os testes MANOVA. Além disso, com tamanhos de amostra iguais (balanceamento perfeito), algumas diferenças nas matrizes de covariância têm pouco efeito nos testes MANOVA. Em resumo, podemos decidir continuar com os testes MANOVA usuais, mesmo que o teste M leve à rejeição de \(H_0\).

Teste Post Hoc da MANOVA Unifatorial Independente

Conforme Grice & Iwasaki (2007), a maneira incorreta de fazer o teste post hoc é realizar uma ANOVA para cada medida.

“Resumo: Muitos pesquisadores realizam uma Análise Multivariada de Variância (MANOVA) em seus dados, mas não reconhecem plenamente a natureza verdadeiramente multivariada de seus efeitos. O erro mais comum é seguir a MANOVA com análises univariadas das variáveis dependentes. Uma das causas desse erro é a falta de materiais pedagógicos claros para identificar e testar os efeitos multivariados obtidos na análise. Este artigo revisa as diferenças fundamentais entre MANOVA e ANOVA univariada e apresenta um conjunto coerente de métodos para explorar a natureza multivariada de um conjunto de dados. Um exemplo completo, com dados reais, é fornecido, incluindo estimativas de tamanho de efeito e intervalos de confiança. Também é apresentada uma seção de resultados de exemplo, redigida segundo o estilo técnico da American Psychological Association. Diversas questões relativas aos métodos atuais também são discutidas.”

Dados <- iris
fit <- lm(cbind(Sepal.Length, Sepal.Width, 
                Petal.Length, Petal.Width) ~ Species,
          data=Dados)
print(car::Anova(fit))

Type II MANOVA Tests: Pillai test statistic
        Df test stat approx F num Df den Df    Pr(>F)    
Species  2    1.1919   53.466      8    290 < 2.2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
print(summary.aov(fit))
 Response Sepal.Length :
             Df Sum Sq Mean Sq F value    Pr(>F)    
Species       2 63.212  31.606  119.26 < 2.2e-16 ***
Residuals   147 38.956   0.265                      
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

 Response Sepal.Width :
             Df Sum Sq Mean Sq F value    Pr(>F)    
Species       2 11.345  5.6725   49.16 < 2.2e-16 ***
Residuals   147 16.962  0.1154                      
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

 Response Petal.Length :
             Df Sum Sq Mean Sq F value    Pr(>F)    
Species       2 437.10 218.551  1180.2 < 2.2e-16 ***
Residuals   147  27.22   0.185                      
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

 Response Petal.Width :
             Df Sum Sq Mean Sq F value    Pr(>F)    
Species       2 80.413  40.207  960.01 < 2.2e-16 ***
Residuals   147  6.157   0.042                      
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Teste MANOVA omnibus

Implementado em demo_MANOVA_iris.R:

Warning in readLines("demo_MANOVA_iris.R"): linha final incompleta encontrada
em 'demo_MANOVA_iris.R'
suppressMessages(suppressWarnings(
  invisible(Sys.setlocale("LC_ALL", "pt_BR.UTF-8"))))
Dados <- datasets::iris
print(summary(Dados, digits =2))

result <- try(MVN::mvn(data = Dados,
                       subset="Species",
                       univariate_test="SW"))
print(result$multivariate_normality)
print(result$univariate_normality)

print(res <- heplots::boxM(Dados[-5], Dados[,"Species"]))
plot(res, main="Iris")

alfa <- 0.05
fit_lm <- lm(data=Dados,
             cbind(Sepal.Length, 
                   Sepal.Width,
                   Petal.Length,
                   Petal.Width) ~ Species)
print(anv_lm <- car::Anova(fit_lm,
                           univariate=FALSE, 
                           multivariate=TRUE,
                           test="Pillai"), 
      digits=3)
eta2 <- effectsize::eta_squared(anv_lm,
                                partial=TRUE,
                                generalized=FALSE,
                                ci=1-alfa,
                                alternative="two.sided",
                                verbose=TRUE)
eta2$interpret <- effectsize::interpret_eta_squared(eta2$Eta2)
print(eta2, digits=2)

g <- nlevels(Dados$Species)
alfaBonf <- alfa/g

# p = 2, g = 3
setosa <- subset(x=Dados, 
                 subset=Species=="setosa", 
                 select=c(Sepal.Length, Sepal.Width))
n <- nrow(setosa)
p <- ncol(setosa)
centroide <- colMeans(setosa)
s <- cov(setosa)
T2crit <- ((n-1)*p/(n-p))*qf(p=1-alfaBonf, df1=p, df2=n-p)
c <- sqrt(T2crit/n)
car::ellipse(center=centroide,
             shape=s,
             radius=c,
             fill=TRUE,
             fill.alpha=0.05,
             col="black",
             add=FALSE,
             lwd=1,
             grid=FALSE,
             xlim=c(4.5,7),
             ylim=c(2.5,3.7),
             xlab=expression(mu[SL]), 
             ylab=expression(mu[SW]), 
             main="Região elíptica de confiança de 95% Bonferroni")
text(centroide[1],centroide[2], pos=2, expression(bar(x)[setosa]), col="black")

versicolor <- subset(x=Dados, 
                     subset=Species=="versicolor", 
                     select=c(Sepal.Length, Sepal.Width))
n <- nrow(versicolor)
p <- ncol(versicolor)
centroide <- colMeans(versicolor)
s <- cov(versicolor)
T2crit <- ((n-1)*p/(n-p))*qf(p=1-alfaBonf, df1=p, df2=n-p)
c <- sqrt(T2crit/n)
car::ellipse(center=centroide,
             shape=s,
             radius=c,
             fill=TRUE,
             fill.alpha=0.05,
             col="black",
             lwd=1,
             add=TRUE)
text(centroide[1],centroide[2], pos=2, expression(bar(x)[versicolor]), col="black")

virginica <- subset(x=Dados, 
                    subset=Species=="virginica", 
                    select=c(Sepal.Length, Sepal.Width))
n <- nrow(virginica)
p <- ncol(virginica)
centroide <- colMeans(virginica)
s <- cov(virginica)
T2crit <- ((n-1)*p/(n-p))*qf(p=1-alfaBonf, df1=p, df2=n-p)
c <- sqrt(T2crit/n)
car::ellipse(center=centroide,
             shape=s,
             radius=c,
             fill=TRUE,
             fill.alpha=0.05,
             col="black",
             lwd=1,
             add=TRUE)
text(centroide[1],centroide[2], pos=2, expression(bar(x)[virginica]), col="black")

# p = 3, g = 3
setosa <- subset(x=Dados, 
                 subset=Species=="setosa", 
                 select=c(Sepal.Length, Sepal.Width, Petal.Length))
n <- nrow(setosa)
p <- ncol(setosa)
centroide <- colMeans(setosa)
s <- cov(setosa)
T2crit <- ((n-1)*p/(n-p))*qf(p=1-alfaBonf, df1=p, df2=n-p)
c <- sqrt(T2crit/n)
rgl::aspect3d(1,1,1)
c <- sqrt(T2crit/n)
rgl::plot3d(rgl::ellipse3d(x=s, 
                           centre=centroide,
                           level=1-alfaBonf,
                           t=c),
            aspect=TRUE,
            xlab=expression(mu[SL]),
            ylab=expression(mu[SW]),
            zlab=expression(mu[PL]),
            col="lightgray", 
            box=FALSE,
            alpha=0.3, 
            add=FALSE)
rgl::points3d(centroide, size=5, color="black")
rgl::text3d(centroide, texts="setosa", adj=1.2, cex=1)

versicolor <- subset(x=Dados, 
                     subset=Species=="versicolor", 
                     select=c(Sepal.Length, Sepal.Width, Petal.Length))
n <- nrow(versicolor)
p <- ncol(versicolor)
centroide <- colMeans(versicolor)
s <- cov(versicolor)
T2crit <- ((n-1)*p/(n-p))*qf(p=1-alfaBonf, df1=p, df2=n-p)
c <- sqrt(T2crit/n)
rgl::aspect3d(1,1,1)
c <- sqrt(T2crit/n)
rgl::plot3d(rgl::ellipse3d(x=s, 
                           centre=centroide,
                           level=1-alfaBonf,
                           t=c),
            aspect=TRUE,
            xlab=expression(mu[SL]),
            ylab=expression(mu[SW]),
            zlab=expression(mu[PL]),
            col="lightgray", 
            box=FALSE,
            alpha=0.3, 
            add=TRUE)
rgl::points3d(centroide, size=5, color="black")
rgl::text3d(centroide, texts="versicolor", adj=1.2, cex=1)

virginica <- subset(x=Dados, 
                    subset=Species=="virginica", 
                    select=c(Sepal.Length, Sepal.Width, Petal.Length))
n <- nrow(virginica)
p <- ncol(virginica)
centroide <- colMeans(virginica)
s <- cov(virginica)
T2crit <- ((n-1)*p/(n-p))*qf(p=1-alfaBonf, df1=p, df2=n-p)
c <- sqrt(T2crit/n)
rgl::aspect3d(1,1,1)
c <- sqrt(T2crit/n)
rgl::plot3d(rgl::ellipse3d(x=s, 
                           centre=centroide,
                           level=1-alfaBonf,
                           t=c),
            aspect=TRUE,
            xlab=expression(mu[SL]),
            ylab=expression(mu[SW]),
            zlab=expression(mu[PL]),
            col="lightgray", 
            box=FALSE,
            alpha=0.3, 
            add=TRUE)
rgl::points3d(centroide, size=5, color="black")
rgl::text3d(centroide, texts="virginica", adj=1.2, cex=1)
rgl::rglwidget()
  Sepal.Length  Sepal.Width   Petal.Length  Petal.Width        Species  
 Min.   :4.3   Min.   :2.0   Min.   :1.0   Min.   :0.1   setosa    :50  
 1st Qu.:5.1   1st Qu.:2.8   1st Qu.:1.6   1st Qu.:0.3   versicolor:50  
 Median :5.8   Median :3.0   Median :4.3   Median :1.3   virginica :50  
 Mean   :5.8   Mean   :3.1   Mean   :3.8   Mean   :1.2                  
 3rd Qu.:6.4   3rd Qu.:3.3   3rd Qu.:5.1   3rd Qu.:1.8                  
 Max.   :7.9   Max.   :4.4   Max.   :6.9   Max.   :2.5                  
       Group          Test Statistic p.value          MVN
1     setosa Henze-Zirkler     0.949   0.050 ✗ Not normal
2 versicolor Henze-Zirkler     0.839   0.226     ✓ Normal
3  virginica Henze-Zirkler     0.757   0.497     ✓ Normal
        Group         Test     Variable Statistic p.value    Normality
1      setosa Shapiro-Wilk Sepal.Length     0.978    0.46     ✓ Normal
2      setosa Shapiro-Wilk  Sepal.Width     0.972   0.272     ✓ Normal
3      setosa Shapiro-Wilk Petal.Length     0.955   0.055     ✓ Normal
4      setosa Shapiro-Wilk  Petal.Width     0.800  <0.001 ✗ Not normal
5  versicolor Shapiro-Wilk Sepal.Length     0.978   0.465     ✓ Normal
6  versicolor Shapiro-Wilk  Sepal.Width     0.974   0.338     ✓ Normal
7  versicolor Shapiro-Wilk Petal.Length     0.966   0.158     ✓ Normal
8  versicolor Shapiro-Wilk  Petal.Width     0.948   0.027 ✗ Not normal
9   virginica Shapiro-Wilk Sepal.Length     0.971   0.258     ✓ Normal
10  virginica Shapiro-Wilk  Sepal.Width     0.967   0.181     ✓ Normal
11  virginica Shapiro-Wilk Petal.Length     0.962    0.11     ✓ Normal
12  virginica Shapiro-Wilk  Petal.Width     0.960   0.087     ✓ Normal

    Box's M-test for Homogeneity of Covariance Matrices

data:  Dados[-5]
Chi-Sq (approx.) = 140.94, df = 20, p-value < 2.2e-16


Type II MANOVA Tests: Pillai test statistic
        Df test stat approx F num Df den Df Pr(>F)    
Species  2      1.19     53.5      8    290 <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Effect Size for ANOVA (Type II)

Parameter | Eta2 (partial) |       95% CI | interpret
-----------------------------------------------------
Species   |           0.60 | [0.52, 0.65] |     large

Pelo teste de Pillai, rejeita-se \(H_0\).

Os supostos testes post hoc estão implementados aqui por ilustração, exibindo a saída por duas formas diferentes (para o leitor escolher sua preferida), mas (como já dissemos acima) são testes inadequados porque desprezam as correlações entre as medidas.

Teste MANOVA post hoc

A forma adequada de fazer o teste post hoc é comparar as condições independentes (grupos) dois a dois mas considerando conjuntamente todas as medidas usadas para o teste omnibus. Implementado em demo_MANOVA_iris_posthoc.R:

Warning in readLines("demo_MANOVA_iris_posthoc.R"): linha final incompleta
encontrada em 'demo_MANOVA_iris_posthoc.R'
# Teste post hoc
alpha <- 0.05
# setosa & versicolor
Dados1 <- subset(iris, Species!="virginica")
fit <- lm(cbind(Sepal.Length, Sepal.Width, 
                Petal.Length, Petal.Width) ~ Species, 
          data=Dados1)
print(anv <- car::Anova(fit, 
                        test="Pillai"), 
      digits=3)
eta2 <- effectsize::eta_squared(anv,
                                partial=TRUE,
                                generalized=FALSE,
                                ci=1-alpha,
                                alternative="two.sided",
                                verbose=TRUE)
eta2$interpret <- effectsize::interpret_eta_squared(eta2$Eta2)
print(eta2, digits=2)

# setosa & virginica
Dados2 <- subset(iris, Species!="versicolor")
fit <- lm(cbind(Sepal.Length, Sepal.Width, 
                Petal.Length, Petal.Width) ~ Species, 
          data=Dados2)
print(anv <- car::Anova(fit, 
                        test="Pillai"), 
      digits=3)
eta2 <- effectsize::eta_squared(anv,
                                partial=TRUE,
                                generalized=FALSE,
                                ci=1-alpha,
                                alternative="two.sided",
                                verbose=TRUE)
eta2$interpret <- effectsize::interpret_eta_squared(eta2$Eta2)
print(eta2, digits=2)

# versicolor & virginica
Dados3 <- subset(iris, Species!="setosa")
fit <- lm(cbind(Sepal.Length, Sepal.Width, 
                Petal.Length, Petal.Width) ~ Species, 
          data=Dados3)
print(anv <- car::Anova(fit, 
                        test="Pillai"), 
      digits=3)
eta2 <- effectsize::eta_squared(anv,
                                partial=TRUE,
                                generalized=FALSE,
                                ci=1-alpha,
                                alternative="two.sided",
                                verbose=TRUE)
eta2$interpret <- effectsize::interpret_eta_squared(eta2$Eta2)
print(eta2, digits=2)

Type II MANOVA Tests: Pillai test statistic
        Df test stat approx F num Df den Df Pr(>F)    
Species  1     0.963      625      4     95 <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Effect Size for ANOVA (Type II)

Parameter | Eta2 (partial) |       95% CI | interpret
-----------------------------------------------------
Species   |           0.96 | [0.95, 0.97] |     large

Type II MANOVA Tests: Pillai test statistic
        Df test stat approx F num Df den Df Pr(>F)    
Species  1      0.98     1183      4     95 <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Effect Size for ANOVA (Type II)

Parameter | Eta2 (partial) |       95% CI | interpret
-----------------------------------------------------
Species   |           0.98 | [0.97, 0.98] |     large

Type II MANOVA Tests: Pillai test statistic
        Df test stat approx F num Df den Df Pr(>F)    
Species  1     0.784     86.1      4     95 <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Effect Size for ANOVA (Type II)

Parameter | Eta2 (partial) |       95% CI | interpret
-----------------------------------------------------
Species   |           0.78 | [0.71, 0.83] |     large

Utilizando correção de Bonferroni para o nível de significância de 5% (i.e., \(\alpha \approx 0.0167\)), conclui-se que os tamanhos totais das três espécies são diferentes.

Podemos imaginar como indicador o produto do comprimento e largura das pétalas e sépalas (que são uma aproximação das respectivas áreas) para colocar as flores das três espécies em ordem de tamanho:

Análise de Variância Multivariada Bifatorial Independente

Após nossa abordagem à MANOVA unifatorial independente, revisaremos brevemente a análise para um modelo univariado independente de efeitos fixos de dois fatores e, em seguida, generalizaremos simplesmente para o caso multivariado por analogia.

Exemplo de GLM univariado multifatorial independente sem interação em Silveira, Tempski, Mayer, Enns, Peleias, Martins & Siqueira (2025)

Título: Comparação entre amostras aleatórias e de conveniência em levantamento multicêntrico para avaliar a qualidade de vida de estudantes de medicina.

Resumo: A avaliação da saúde mental e física de estudantes de medicina é dificultada pela obtenção de amostras aleatórias e pelas limitações de amostras de conveniência. Conduzimos um estudo multicêntrico para avaliar o ambiente educacional, a qualidade de vida e a competência emocional de estudantes de medicina. Entre 2011 e 2012, um total de 1.350 estudantes selecionados aleatoriamente de 22 escolas e 1.201 estudantes voluntários de 50 escolas em todo o Brasil completaram todos os questionários (WHOQOL-BREF, VERAS-Q, IRI, RS-14, BDI, PSQI, ESS, IDATE, MBI e DREEM). Monitoramento, apoio a pesquisadores locais e estratégias de feedback personalizado foram aplicados para assegurar a participação dos estudantes aleatorizados, alcançando taxa de resposta de 81,8%. A plataforma também ficou disponível aos voluntários. A análise estatística examinou o efeito dessas duas estratégias de recrutamento por meio de modelos lineares gerais, controlando por sexo, idade, massa corporal, ano do curso, atividade física e equivalentes metabólicos (METs), tipo de escola, população da cidade e localização. Adotou-se nível de significância de 5% e tamanhos de efeito estimados pelo eta-quadrado de Cohen, ambos com correção de Bonferroni nas variáveis de interesse. O grupo de voluntários apresentou mais mulheres, menos alunos dos anos finais do curso e maior proporção de estudantes de escolas privadas e de cidades maiores. Essas variáveis explicaram em grande parte as diferenças estatisticamente significantes e os tamanhos de efeito observados entre os grupos aleatorizado e voluntário. Em conclusão, embora tenham sido identificadas lições e estratégias motivacionais úteis, o esforço considerável necessário para obter alta adesão via busca ativa pode não se justificar, pois os resultados entre amostras aleatórias e de voluntários mostraram diferenças mínimas nas respostas aos questionários. Nossos achados sugerem que estudos futuros considerem estratégias motivacionais mais leves para reduzir a carga das equipes de pesquisa. Dados e scripts em R para replicar a análise estatística estão disponíveis no Harvard Dataverse em https://doi.org/10.7910/DVN/YECV8E.

Modelo Univariado de Efeitos Fixos de Dois Fatores com Interação

  • \(p=1,\; q=1,\; g=2,\; b=2,\; n_{\ell k}\ge2\)

Supomos que as medições são registradas em vários níveis de dois fatores. Em alguns casos, essas condições experimentais representam níveis de um único tratamento organizado em vários blocos. O delineamento experimental particular empregado não nos preocupará neste livro. (Consulte [10] e [17] para discussões sobre delineamento experimental.) No entanto, assumiremos que observações em diferentes combinações de condições experimentais são independentes entre si.

Vamos considerar que os dois conjuntos de condições experimentais sejam os níveis, por exemplo, do fator 1 e do fator 2, respectivamente. Suponha que haja \(g \ge 2\) níveis do fator 1 e \(b \ge 2\) níveis do fator 2, e que \(n \ge 2\) observações independentes possam ser observadas em cada uma das combinações de níveis (tratamentos) \(gb\).

O uso do termo fator para indicar uma condição experimental é conveniente. Os fatores discutidos aqui não devem ser confundidos com os fatores não observáveis considerados no Capítulo 9 no contexto da análise de fatores.

Denotando a r-ésima observação no nível \(\ell\) do fator 1 e nível \(k\) do fator 2 por \(X_{\ell kr}\), especificamos o modelo univariado de dois sentidos como:

\[ X_{\ell kr} = \mu + \tau_\ell + \beta_k + \gamma_{\ell k} + \varepsilon_{\ell kr} \tag{6-54} \]

Em que:

  • \(\ell = 1, 2, \ldots, g\)
  • \(k = 1, 2, \ldots, b\)
  • \(r = 1, 2, \ldots, n\)

Sendo que:

\[ \sum_{\ell=1}^{g} \tau_\ell = \sum_{k=1}^{b} \beta_k = \sum_{\ell=1}^{g} \gamma_{\ell k} = \sum_{k=1}^{b} \gamma_{\ell k} = 0 \]

Os \(\{\varepsilon_{\ell kr}\}_{\ell=1,k=1,r=1}^{g,b,n}\sim\mathcal{N}\text{IID}(0, \sigma^2)\). Aqui, \(\mu\) representa um nível geral, \(\tau_\ell\) representa o efeito fixo do fator 1, \(\beta_k\) representa o efeito fixo do fator 2, e \(\gamma_{\ell k}\) é a interação entre o fator 1 e o fator 2. A resposta esperada no \(\ell\)-ésimo nível do fator 1 e do \(k\)-ésimo nível do fator 2 é, portanto:

\[ \mathbb{E}\left(X_{\ell kr}\right) = \mu + \tau_\ell + \beta_k + \gamma_{\ell k} \]

Em que:

  • \(\mathbb{E}(X_{\ell kr})\): resposta média
  • \(\mu\): média global (nível geral)
  • \(\tau_\ell\): efeito fixo do fator 1
  • \(\beta_k\): efeito fixo do fator 2
  • \(\gamma_{\ell k}\): efeito fixo de interação fator1:fator2

para \(\ell = 1, 2, \ldots, g\) e \(k = 1, 2, \ldots, b\).

A presença da interação, \(\gamma_{\ell k}\), implica que os efeitos dos fatores não são aditivos e a interpretação dos resultados dos resultados torna-se mais complexa.

Figura 6.3 Perfis de médias (a) com interação e (b) sem interação.

Figura 6.3 Perfis de médias (a) com interação e (b) sem interação.

As Figuras 6.3(a) e (b) mostram as respostas esperadas em função dos níveis dos fatores com e sem interação, respectivamente. A ausência de interação significa \(\gamma_{\ell k} = 0\) para todos \(\ell\) e \(k\).

De forma análoga a (6-55), cada observação pode ser decomposta como

\[ \begin{align} X_{\ell kr} &= \mu+\tau_{\ell}+\beta_k+\gamma_{\ell k}+\varepsilon_{\ell kr}\\ &= \mu+\tau_{\ell}+\beta_k+\left(\left(\tau\beta\right)_{\ell k}-\left(\mu+\tau_{\ell}+\beta_k\right)\right)+\varepsilon_{\ell kr}\\ &= \hat{\mu}+\hat{\tau}_{\ell}+\hat{\beta}_k+\left(\widehat{\left(\tau\beta\right)}_{\ell k}-\left( \hat{\mu}+\hat{\tau}_{\ell}+\hat{\beta}_k\right)\right)+\hat{\varepsilon}_{\ell kr}\\ &= \overline{X} + (\overline{X}_{\ell} - \overline{X}) + (\overline{X}_{k} - \overline{X}) + \\ &\quad(\overline{X}_{\ell k} - (\overline{X}+(\overline{X}_{\ell}- \overline{X}) + (\overline{X}_{k} - \overline{X}))) + \\ &\quad(X_{\ell kr} - \overline{X}_{\ell k}) \\ X_{\ell kr} &= \overline{X} + (\overline{X}_{\ell} - \overline{X}) + (\overline{X}_{k} - \overline{X}) + \\ &\quad(\overline{X}_{\ell k} - \overline{X}_{\ell} - \overline{X}_{k}+ \overline{X}) + \\ &\quad(X_{\ell kr} - \overline{X}_{\ell k}) \end{align} \tag{6-56} \]

em que \(\overline{X}\) é a média geral, \(\overline{X}_{\ell}\) é a média para o nível \(\ell\) do fator 1, \(\overline{X}_k\) é a média para o nível \(k\) do fator 2, e \(X_{\ell k}\) é a média para o nível \(\ell\) do fator 1 e o nível \(k\) do fator 2. Ao quadrar e somar os desvios \((X_{\ell kr} - \overline{X})\), obtemos:

\[ \begin{align} \sum_{\ell=1}^{g} \sum_{k=1}^{b} \sum_{r=1}^{n} \left(X_{\ell kr} - \overline{X}\right)^2 &= b n \sum_{\ell=1}^{g} \left(\overline{X}_{\ell} - \overline{X}\right)^2 + g n \sum_{k=1}^{b} \left(\overline{X}_k - \overline{X}\right)^2 +\\ & \quad n \sum_{\ell=1}^{g} \sum_{k=1}^{b} \left(\overline{X}_{\ell k} - \overline{X}_{\ell} - \overline{X}_k + \overline{X}\right)^2 +\\ & \quad\sum_{\ell=1}^{g} \sum_{k=1}^{b} \sum_{r=1}^{n} \left(X_{\ell kr}- \overline{X}_{\ell k}\right)^2 \end{align} \tag{6-57} \]

Em que:

\[ \begin{align} \overline{X}_{\ell k} &= \dfrac{1}{n} \sum_{r=1}^{n} X_{\ell kr} \\ \overline{X}_{\ell} &= \dfrac{1}{nb} \sum_{k=1}^{b} \sum_{r=1}^{n} X_{\ell kr} \\ \overline{X}_k &= \dfrac{1}{ng} \sum_{\ell=1}^{g} \sum_{r=1}^{n} X_{\ell kr} \\ \overline{X} &= \dfrac{1}{gnb} \sum_{\ell=1}^{g} \sum_{k=1}^{b} \sum_{r=1}^{n} X_{\ell kr} \end{align} \]

ou

\[ \text{SS}_{\text{tot}} = \text{SS}_{\text{fat1}} + \text{SS}_{\text{fat2}} + \text{SS}_{\text{int}} + \text{SS}_{\text{res}} \]

Os graus de liberdade correspondentes associados às somas de quadrados na decomposição em (6-57) são:

\[ gbn - 1 = (g - 1) + (b - 1) + (g - 1) (b - 1) + gb(n - 1) \]

Temos que \(\{X_{\ell kr}\}_{\ell=1,k=1,r=1}^{g,b,n}\sim\mathcal{N}\text{IID}(\mu+\tau_{\ell}+\beta_k+\gamma_{\ell k}, \sigma^2)\).

A tabela ANOVA assume a seguinte forma:

Tabela de ANOVA para Modelo Univariado de Dois Fatores com Interação:

Fonte de Variação Graus de Liberdade (df) Soma de Quadrados (SS) Quadrado Médio (MS) F
Fator 1 \(g - 1\) \(\text{SS}_{\text{fat1}}\) \(\dfrac{\text{SS}_{\text{fat1}}}{g-1}\) \(\dfrac{\text{MS}_{\text{fat1}}}{\text{MS}_{\text{res}}}\)
Fator 2 \(b - 1\) \(\text{SS}_{\text{fat2}}\) \(\dfrac{\text{SS}_{\text{fat2}}}{b-1}\) \(\dfrac{\text{MS}_{\text{fat2}}}{\text{MS}_{\text{res}}}\)
Interação \((g - 1)(b - 1)\) \(\text{SS}_{\text{int}}\) \(\dfrac{\text{SS}_{\text{int}}} {(g-1)(b-1)}\) \(\dfrac{\text{MS}_{\text{int}}}{\text{MS}_{\text{res}}}\)
Resíduo \(gb(n - 1)\) \(\text{SS}_{\text{res}}\) \(\dfrac{\text{SS}_{\text{res}}}{gb(n-1)}\) -
Total \(gbn - 1\) \(\text{SS}_{\text{tot}}\) - -

A tabela ANOVA necessita que \(n\ge2\), i.e., que o número de réplicas seja pelo menos igual a dois em todas as combinações dos níveis dos dois fatores (tratamentos), pois \(\frac{\text{SS}_{\text{res}}}{gb(n - 1)}\) faz parte do denominador das estatísticas de teste F.

Se \(g=b\), i.e., delineamento perfeitamente balanceado no número de níveis dos dois fatores, e um efeito não é significante, então sua exclusão do modelo não altera os resultados da tabela ANOVA.

Pelo teorema de Cochran, as razões F dos quadrados médios, \(\frac{\text{SS}_{\text{fat1}}}{g - 1}\), \(\frac{\text{SS}_{\text{fat2}}}{b - 1}\), e \(\frac{\text{SS}_{\text{int}}}{(g - 1)(b - 1)}\) em relação ao quadrado médio, \(\frac{\text{SS}_{\text{res}}}{gb(n - 1)}\), podem ser usadas para testar hierarquicamente os efeitos do fator 1, fator 2, e a interação fator1:fator2, respectivamente. (Veja [11] para uma discussão sobre análise de variância univariada bifatorial independente).

A hipótese nula omnibus é:

\[ \begin{cases} H_{0}^{\text{omnibus}}&: \tau_1=\cdots=\tau_g=\beta_1=\cdots=\beta_b=\gamma_{11}=\cdots=\gamma_{gb}=0\\ H_{1}^{\text{omnibus}}&:\text{algum efeito populacional é diferente de zero} \end{cases} \]

Se \(H_{0}^{\text{omnibus}}\) é rejeitada, testar o efeito de interação:

\[ H_{0}^{\text{interação}}: \gamma_{11}=\cdots=\gamma_{gb}=0 \]

Se \(H_{0}^{\text{interação}}\) não é rejeitada, testar os efeitos principais:

\[ H_{0}^{\text{Fator 1}}: \tau_1=\cdots=\tau_g=0\\ H_{0}^{\text{Fator 2}}: \beta_1=\cdots=\beta_b=0 \]

Se \(H_{0}^{\text{interação}}\) é rejeitada, testar os efeitos principais simples.

Figura 1. Árvore de Decisão para conduzir análises post-hoc após uma ANOVA de dois ou três fatores. Howell & Lacroix, 2012

Figura 1. Árvore de Decisão para conduzir análises post-hoc após uma ANOVA de dois ou três fatores. Howell & Lacroix, 2012

  • Howell, GT & Lacroix, GL (2012) Decomposing interactions using GLM in combination with the COMPARE, LMATRIX and MMATRIX subcommands in SPSS. Tutorials in Quantitative Methods for Psychology 8(1): 1-22.

“Primeiramente, numa ANOVA univariada bifatorial independente, teste a presença do efeito de interação. Se o efeito de interação for significante, então o teste de efeitos principais simples deve ser considerado.”

Woodward & Bonett, 1991, p. 256

Fig. 1. Estratégia de teste de hipóteses para delineamento de três fatores (Keppel, 1973, p. 293). Woodward & Bonett, 1991

Fig. 1. Estratégia de teste de hipóteses para delineamento de três fatores (Keppel, 1973, p. 293). Woodward & Bonett, 1991

FIG. 2. Estratégia de teste de hipótese para delineamento de três fatores (adaptado de Milliken & Johnson, 1984, p. 198 - veja p. 114 para uma aplicação de análise de estrutura de tratamento de duas vias). Woodward & Bonett, 1991

FIG. 2. Estratégia de teste de hipótese para delineamento de três fatores (adaptado de Milliken & Johnson, 1984, p. 198 - veja p. 114 para uma aplicação de análise de estrutura de tratamento de duas vias). Woodward & Bonett, 1991

  • Woodward, JA & Bonett, DG (1991) Simple main effects in factorial designs. Journal of Applied Statistics 18(2): 255-64, DOI: 10.1080/02664769100000019
    Tabela 1. Representações univariada e multivariada do GLM (Modelo Linear General). Chartier & Faulkner, 2008

    Tabela 1. Representações univariada e multivariada do GLM (Modelo Linear General). Chartier & Faulkner, 2008

Uma forma de definir com mais precisão o número de variáveis dependentes (DV) é \(pq\), sendo \(p\) o número de medidas (measures) e \(q\) o número de condições experimentais dependentes. Se \(pq=1\), o modelo é univariado. Se \(pq\ge2\), o modelo é multivariado.

Observe que Correlação Canônica não tem VD-VE, pois não é um modelo de regressão. A confusão da classificação começa ao misturar variável manifesta com variável latente. Variável latente pode ser nominal, ordinal ou intervalar (continuous). Note que a ausência de Regressão Multivariada em GLM multivariado. Note também que há a confusão e ausência de modelos para medidas repetidas. Há GLM duplamente multivariado que não consta na Tabela 1.

Figura 1. Diagramas de Venn para a) dois preditores intervalares em regressão, b) análise de variância unifatorial (trocar C por &alpha;), c) ANOVA bifatorial e d) medidas repetidas (ANCOVA pré-pós?). Chartier & Faulkner, 2008

Figura 1. Diagramas de Venn para a) dois preditores intervalares em regressão, b) análise de variância unifatorial (trocar C por α), c) ANOVA bifatorial e d) medidas repetidas (ANCOVA pré-pós?). Chartier & Faulkner, 2008

  • Chartier, S & Faulkner, A (2008) General Linear Models: An integrated approach to statistics. Tutorial in Quantitative Methods for Psychology 4(2): 65‐78.

Exemplo: Estudo dos Efeitos da Vitamina C no Desenvolvimento Dentário de Porquinhos-da-Índia: Comparação entre Fontes Biológicas e Químicas

porquinho-da-índia

porquinho-da-índia

Uma preocupação durante a Segunda Guerra Mundial era o fornecimento de vitamina C aos soldados e, nesse amplo contexto, os efeitos do ácido ascórbico e do suco de laranja foram estudados em animais. Um desses estudos foi realizado por Crampton (1947).

Sessenta porquinhos-da-índia (com 28 dias de idade) receberam um suplemento dietético de vitamina C em uma de três doses (0.5, 1 ou 2 mg/dia) administradas de uma de duas maneiras (como ácido ascórbico ou em suco de laranja). Havia dez porquinhos-da-índia, cinco machos e cinco fêmeas, em cada combinação de dose e método de administração. Após 42 dias na dieta, os porquinhos-da-índia foram sacrificados; os incisivos foram removidos e seccionados para obter medidas do comprimento dos odontoblastos — células que são importantes para o desenvolvimento dos dentes. Poderia haver múltiplas medições (odontoblastos) por animal, então os comprimentos foram médios para fornecer um único valor para cada animal. O resultado de interesse é o comprimento médio dos odontoblastos incisivos; isso foi medido em micrômetros. O interesse é como a dose e o método de administração influenciam o resultado.

Crampton (1947, p. 495)

Crampton (1947, p. 495)

Você pode estar se perguntando o que um estudo de células em porquinhos-da-índia tem a ver com o fornecimento de vitamina C aos humanos. Os pesquisadores haviam estabelecido que o crescimento dos odontoblastos em porquinhos-da-índia era sensível à ingestão de vitamina C e, portanto, medir os odontoblastos poderia fornecer uma maneira de medir de forma confiável a absorção de vitamina C. Havia um debate sobre se as fontes ‘biológicas’ (por exemplo, suco de laranja) de vitamina C eram melhores do que as formas ‘químicas’ (por exemplo, ácido ascórbico), e isso foi explorado em um modelo animal.

ANOVA unifatorial independente de Fisher com o fator tipo de suplemento resulta na não significância deste fator (\(p=0.060\)) com \(\alpha=5\%\). Os resultados a seguir mostram que há o efeito de interação entre tipo de suplemento e dose (\(p=0.022\)) com \(\alpha=5\%\). Há efeitos simples de tipo de suplemento e dose. Então, suco de laranja tem efeito maior do que ácido ascórbico. As três doses têm efeitos progressivamente maiores.

suppressMessages(suppressWarnings(
  invisible(Sys.setlocale("LC_ALL", "pt_BR.UTF-8"))))
# The Effect of Vitamin C on Tooth Growth in Guinea Pigs
# len: numeric  Tooth length
# supp: factor  Supplement type (VC or OJ).
#   dose:   numeric Dose in milligrams/day
Dados <- datasets::ToothGrowth
Dados$supp <- factor(Dados$supp,
                     levels=c("VC", "OJ"))
print(head(Dados))
   len supp dose
1  4.2   VC  0.5
2 11.5   VC  0.5
3  7.3   VC  0.5
4  5.8   VC  0.5
5  6.4   VC  0.5
6 10.0   VC  0.5
print(tail(Dados))
    len supp dose
55 24.8   OJ    2
56 30.9   OJ    2
57 26.4   OJ    2
58 27.3   OJ    2
59 29.4   OJ    2
60 23.0   OJ    2
# print(skimr::skim_without_charts(Dados))
Dados$dose <- factor(Dados$dose)
print(ftable(Dados$supp, Dados$dose))
    0.5  1  2
             
VC   10 10 10
OJ   10 10 10
print(summary(Dados))
      len        supp     dose   
 Min.   : 4.20   VC:30   0.5:20  
 1st Qu.:13.07   OJ:30   1  :20  
 Median :19.25           2  :20  
 Mean   :18.81                   
 3rd Qu.:25.27                   
 Max.   :33.90                   
boxplot(len~dose*supp,
        data=Dados)

alfa <- 0.05 
g1 <- nlevels(Dados$supp)
alfaBonf.supp <- alfa/g1
g2 <- nlevels(Dados$dose)
alfaBonf.dose <- alfa/g2
gplots::plotmeans(len~supp,
                  connect=FALSE,
                  col="black",
                  barcol="black",
                  p=1-alfaBonf.supp,
                  main="Porquinho-da-Índia",
                  data=Dados)
Registered S3 method overwritten by 'gplots':
  method         from     
  reorder.factor DescTools

gplots::plotmeans(len~dose,
                  connect=FALSE,
                  col="black",
                  barcol="black",
                  p=1-alfaBonf.dose,
                  main="Porquinho-da-Índia",
                  data=Dados)

fit <- lm(len~supp,
          data=Dados)
print(summary(fit))

Call:
lm(formula = len ~ supp, data = Dados)

Residuals:
     Min       1Q   Median       3Q      Max 
-12.7633  -5.7633   0.4367   5.5867  16.9367 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)   16.963      1.366  12.418   <2e-16 ***
suppOJ         3.700      1.932   1.915   0.0604 .  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 7.482 on 58 degrees of freedom
Multiple R-squared:  0.05948,   Adjusted R-squared:  0.04327 
F-statistic: 3.668 on 1 and 58 DF,  p-value: 0.06039
print(car::Anova(fit))
Anova Table (Type II tests)

Response: len
          Sum Sq Df F value  Pr(>F)  
supp       205.4  1  3.6683 0.06039 .
Residuals 3246.9 58                  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
fit <- lm(len~dose,
          data=Dados)
print(summary(fit))

Call:
lm(formula = len ~ dose, data = Dados)

Residuals:
    Min      1Q  Median      3Q     Max 
-7.6000 -3.2350 -0.6025  3.3250 10.8950 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)  10.6050     0.9486  11.180 5.39e-16 ***
dose1         9.1300     1.3415   6.806 6.70e-09 ***
dose2        15.4950     1.3415  11.551  < 2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 4.242 on 57 degrees of freedom
Multiple R-squared:  0.7029,    Adjusted R-squared:  0.6924 
F-statistic: 67.42 on 2 and 57 DF,  p-value: 9.533e-16
print(car::Anova(fit))
Anova Table (Type II tests)

Response: len
          Sum Sq Df F value    Pr(>F)    
dose      2426.4  2  67.416 9.533e-16 ***
Residuals 1025.8 57                      
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
fit <- lm(len~supp+dose,
          data=Dados)
print(summary(fit))

Call:
lm(formula = len ~ supp + dose, data = Dados)

Residuals:
   Min     1Q Median     3Q    Max 
-7.085 -2.751 -0.800  2.446  9.650 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)   8.7550     0.9883   8.859 3.05e-12 ***
suppOJ        3.7000     0.9883   3.744 0.000429 ***
dose1         9.1300     1.2104   7.543 4.38e-10 ***
dose2        15.4950     1.2104  12.802  < 2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 3.828 on 56 degrees of freedom
Multiple R-squared:  0.7623,    Adjusted R-squared:  0.7496 
F-statistic: 59.88 on 3 and 56 DF,  p-value: < 2.2e-16
print(car::Anova(fit))
Anova Table (Type II tests)

Response: len
           Sum Sq Df F value    Pr(>F)    
supp       205.35  1  14.017 0.0004293 ***
dose      2426.43  2  82.811 < 2.2e-16 ***
Residuals  820.43 56                      
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
alfaBonf <- alfa/(g1*g2)
gplots::plotmeans(len~interaction(dose,supp),
                  connect=FALSE,
                  col="black",
                  barcol="black",
                  p=1-alfaBonf,
                  main="Porquinho-da-Índia",
                  data=Dados)

fiti <- lm(len~supp*dose,
           data=Dados)
print(summary(fiti))

Call:
lm(formula = len ~ supp * dose, data = Dados)

Residuals:
   Min     1Q Median     3Q    Max 
 -8.20  -2.72  -0.27   2.65   8.27 

Coefficients:
             Estimate Std. Error t value Pr(>|t|)    
(Intercept)     7.980      1.148   6.949 4.98e-09 ***
suppOJ          5.250      1.624   3.233  0.00209 ** 
dose1           8.790      1.624   5.413 1.46e-06 ***
dose2          18.160      1.624  11.182 1.13e-15 ***
suppOJ:dose1    0.680      2.297   0.296  0.76831    
suppOJ:dose2   -5.330      2.297  -2.321  0.02411 *  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 3.631 on 54 degrees of freedom
Multiple R-squared:  0.7937,    Adjusted R-squared:  0.7746 
F-statistic: 41.56 on 5 and 54 DF,  p-value: < 2.2e-16
print(car::Anova(fiti))
Anova Table (Type II tests)

Response: len
           Sum Sq Df F value    Pr(>F)    
supp       205.35  1  15.572 0.0002312 ***
dose      2426.43  2  92.000 < 2.2e-16 ***
supp:dose  108.32  2   4.107 0.0218603 *  
Residuals  712.11 54                      
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Solução Somas de Quadrados
X_bar <- mean(Dados$len)
print(X_bar, 3)
[1] 18.8
X_bar_l <- aggregate(len~supp,
                     data=Dados,
                     FUN="mean")
print(X_bar_l)
  supp      len
1   VC 16.96333
2   OJ 20.66333
X_bar_k <- aggregate(len~dose,
                     data=Dados,
                     FUN="mean")
print(X_bar_k)
  dose    len
1  0.5 10.605
2    1 19.735
3    2 26.100
X_bar_lk <- aggregate(len~dose*supp,
                      data=Dados,
                      FUN="mean")
print(X_bar_lk)
  dose supp   len
1  0.5   VC  7.98
2    1   VC 16.77
3    2   VC 26.14
4  0.5   OJ 13.23
5    1   OJ 22.70
6    2   OJ 26.06
# Somas de Quadrados
g <- nlevels(Dados$supp)
b <- nlevels(Dados$dose)
n <- nrow(Dados) / (g*b)
p <- 1
SS_total <- sum((Dados$len - X_bar)^2)
SS_A <- b * n * sum((X_bar_l$len - X_bar)^2)
SS_B <- g * n * sum((X_bar_k$len - X_bar)^2)
SS_error <- sum((Dados$len - rep(X_bar_lk$len, times=rep(n,g*b)))^2)
SS_AB <- SS_total - SS_A - SS_B - SS_error

# Graus de Liberdade
df_A <- g - 1
df_B <- b - 1
df_AB <- (g - 1)*(b - 1)
df_error <- g*b*(n - 1)

# Quadrado Médio
MS_A <- SS_A / df_A
MS_B <- SS_B / df_B
MS_AB <- SS_AB / df_AB
MS_error <- SS_error / df_error

# Estatística F
F_A <- MS_A / MS_error
F_B <- MS_B / MS_error
F_AB <- MS_AB / MS_error

# Valor-p (usando a distribuição F)

p_value_A <- formatC(1-pf(F_A, df_A, df_error), 
                     format="e", digits=2)
p_value_B <- formatC(1-pf(F_B, df_B, df_error), 
                     format="e", digits=2)
p_value_AB <- formatC(1-pf(F_AB, df_AB, df_error), 
                      format="e", digits=2)

# Tabela ANOVA
anova_table <- data.frame(
  Source = c("Factor A", "Factor B", "Interaction AB", "Error", "Total"),
  SS = c(SS_A, SS_B, SS_AB, SS_error, SS_total),
  df = c(df_A, df_B, df_AB, df_error, g*b*n - 1),
  MS = c(MS_A, MS_B, MS_AB, MS_error, NA),
  "F value" = c(F_A, F_B, F_AB, NA, NA),
  "p value" = c(p_value_A, p_value_B, p_value_AB, NA, NA),
  stringsAsFactors = FALSE,
  check.names = FALSE
)
print(anova_table, digits=3, row.names=FALSE)
         Source   SS df     MS F value  p value
       Factor A  205  1  205.3   15.57 2.31e-04
       Factor B 2426  2 1213.2   92.00 0.00e+00
 Interaction AB  108  2   54.2    4.11 2.19e-02
          Error  712 54   13.2      NA     <NA>
          Total 3452 59     NA      NA     <NA>
# Solução model.matrix e OLS 
# https://www.maths.usyd.edu.au/u/UG/SM/STAT3022/r/current/Lecture/lecture18_2020JC.html#17
fit <- lm(len~supp*dose,
          data=Dados)
print(anova(fit))
Analysis of Variance Table

Response: len
          Df  Sum Sq Mean Sq F value    Pr(>F)    
supp       1  205.35  205.35  15.572 0.0002312 ***
dose       2 2426.43 1213.22  92.000 < 2.2e-16 ***
supp:dose  2  108.32   54.16   4.107 0.0218603 *  
Residuals 54  712.11   13.19                      
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
print(anv <- car::Anova(fit))
Anova Table (Type II tests)

Response: len
           Sum Sq Df F value    Pr(>F)    
supp       205.35  1  15.572 0.0002312 ***
dose      2426.43  2  92.000 < 2.2e-16 ***
supp:dose  108.32  2   4.107 0.0218603 *  
Residuals  712.11 54                      
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
y <- Dados$len
X0 <- model.matrix(~ 1, data=Dados)
XA <- model.matrix(~ -1 + supp, data=Dados)
XB <- model.matrix(~ -1 + dose, data=Dados)
XAB <- model.matrix(~ -1 + supp:dose, data=Dados)
PV0 <- X0 %*% solve(t(X0) %*% X0) %*% t(X0)
PWA <- XA %*% solve(t(XA) %*% XA) %*% t(XA) - PV0
PWB <- XB %*% solve(t(XB) %*% XB) %*% t(XB) - PV0
PVAB <- XAB %*% solve(t(XAB) %*% XAB) %*% t(XAB)
PWAB <- PVAB - PWA - PWB - PV0
PRes <- diag(nrow(Dados)) - PVAB
SSA <- t(y) %*% PWA %*% y
SSB <- t(y) %*% PWB %*% y
SSAB <- t(y) %*% PWAB %*% y
SSE <- t(y) %*% PRes %*% y
dfA <- sum(diag(PWA)) 
dfB <- sum(diag(PWB)) 
dfAB <- sum(diag(PWAB)) 
dfE <- sum(diag(PRes))
dfT <- dfA+dfB+dfAB+dfE
SST <- SSA+SSB+SSAB+SSE
R2A <- SSA/SST
R2B <- SSB/SST
R2AB <- SSAB/SST
R2E <- SSE/SST
R2 <- 1 - SSE/SST
eta2partialA <- R2A/(R2A+1-R2)
eta2partialB <- R2B/(R2B+1-R2)
eta2partialAB <- R2AB/(R2AB+1-R2)
FA <- (SSA/dfA)/(SSE/dfE)
pA <- formatC(1-pf(FA, dfA, dfE), 
                     format="e", digits=2)
FB <- (SSB/dfB)/(SSE/dfE)
pB <- formatC(1-pf(FB, dfB, dfE), 
              format="e", digits=2)
FAB <- (SSAB/dfAB)/(SSE/dfE)
pAB <- formatC(1-pf(FAB, dfAB, dfE), 
              format="e", digits=2)

R2 <- 1 - SSE/SST
df1 <- dfT-dfE
df2 <- dfE
F_omnibus <- (R2/df1)/((1-R2)/df2) # Pestana & Gageiro, 2005, p. 77
pv <- 1-pf(F_omnibus, df1, df2)
if(pv<2.2e-16) p_omnibus <- "< 2.2e-16"
if(pv>2.2e-16) p_omnibus <- paste0("< ", formatC(pv, format="e", digits=2))
Fcrit <- qf(1-alfa, df1, df2)
cat("Omnibus F(",df1, ",", df2, ") = ", round(Fcrit,2), 
    ", F = ", round(F_omnibus,2), 
    ", p = ", p_omnibus, "\nR^2 = eta^2 = ", round(R2,4), sep="")
Omnibus F(5,54) = 2.39, F = 41.56, p = < 2.2e-16
R^2 = eta^2 = 0.7937
ANOVA2wtable <- data.frame("Source"=c("supp", "dose", "supp:dose", "Error", "Total"),
                           # "df"=c(qr(PWA)$rank, qr(PWB)$rank, qr(PWAB)$rank, qr(PRes)$rank),
                           "df"=c(dfA, dfB, dfAB, dfE, dfT),
                           "SS"=c(SSA, SSB, SSAB, SSE, SST),
                           "F value"=c(FA, FB, FAB, NA, NA),
                           "p value"=c(pA, pB, pAB, NA, NA),
                           "R^2"=c(R2A, R2B, R2AB, R2E, NA),
                           "eta^2 partial"=c(eta2partialA, eta2partialB, eta2partialAB, NA, NA),
                           stringsAsFactors = FALSE,
                           check.names = FALSE)
print(ANOVA2wtable, digits=2, row.names=FALSE)
    Source df   SS F value  p value   R^2 eta^2 partial
      supp  1  205    15.6 2.31e-04 0.059          0.22
      dose  2 2426    92.0 0.00e+00 0.703          0.77
 supp:dose  2  108     4.1 2.19e-02 0.031          0.13
     Error 54  712      NA     <NA> 0.206            NA
     Total 59 3452      NA     <NA>    NA            NA
eta2 <- effectsize::eta_squared(anv,
                                partial=TRUE,
                                generalized=FALSE,
                                ci=1-alfa/3,
                                alternative="two.sided",
                                verbose=TRUE)
eta2$interpret <- effectsize::interpret_eta_squared(eta2$Eta2)
print(eta2, digits=4)
# Effect Size for ANOVA (Type II)

Parameter | Eta2 (partial) |      98.3333% CI | interpret
---------------------------------------------------------
supp      |         0.2238 | [0.0337, 0.4383] |     large
dose      |         0.7731 | [0.6299, 0.8496] |     large
supp:dose |         0.1320 | [0.0000, 0.3346] |    medium
eta2 <- effectsize::eta_squared(anv,
                                partial=FALSE,
                                generalized=FALSE,
                                ci=1-alfa/3,
                                alternative="two.sided",
                                verbose=TRUE)
eta2$interpret <- effectsize::interpret_eta_squared(eta2$Eta2)
print(eta2, digits=4)
# Effect Size for ANOVA (Type II)

Parameter |   Eta2 |      98.3333% CI | interpret
-------------------------------------------------
supp      | 0.0595 | [0.0000, 0.2525] |     small
dose      | 0.7029 | [0.5236, 0.8020] |     large
supp:dose | 0.0314 | [0.0000, 0.1848] |     small
# Regressão Linear Múltipla de two-way ANOVA
fit <- lm(len~supp*dose,
          data=Dados)
print(car::Anova(fit))
Anova Table (Type II tests)

Response: len
           Sum Sq Df F value    Pr(>F)    
supp       205.35  1  15.572 0.0002312 ***
dose      2426.43  2  92.000 < 2.2e-16 ***
supp:dose  108.32  2   4.107 0.0218603 *  
Residuals  712.11 54                      
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
print(summary(fit))

Call:
lm(formula = len ~ supp * dose, data = Dados)

Residuals:
   Min     1Q Median     3Q    Max 
 -8.20  -2.72  -0.27   2.65   8.27 

Coefficients:
             Estimate Std. Error t value Pr(>|t|)    
(Intercept)     7.980      1.148   6.949 4.98e-09 ***
suppOJ          5.250      1.624   3.233  0.00209 ** 
dose1           8.790      1.624   5.413 1.46e-06 ***
dose2          18.160      1.624  11.182 1.13e-15 ***
suppOJ:dose1    0.680      2.297   0.296  0.76831    
suppOJ:dose2   -5.330      2.297  -2.321  0.02411 *  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 3.631 on 54 degrees of freedom
Multiple R-squared:  0.7937,    Adjusted R-squared:  0.7746 
F-statistic: 41.56 on 5 and 54 DF,  p-value: < 2.2e-16
y <- Dados$len
X <- model.matrix(len~supp*dose, data=Dados)
coeff <- solve(t(X) %*% X) %*% t(X) %*% y # OLS
cat("\nCoefficients:\n")

Coefficients:
colnames(coeff) <- c("Estimate")
print(coeff)
             Estimate
(Intercept)      7.98
suppOJ           5.25
dose1            8.79
dose2           18.16
suppOJ:dose1     0.68
suppOJ:dose2    -5.33
y_hat <- X%*%coeff
SS_trt <- sum((y_hat - mean(y))^2)
SS_trt
[1] 2740.103
SS_error <- sum((y - y_hat)^2)
SS_error
[1] 712.106
SS_total <- sum((y - mean(y))^2)
SS_total
[1] 3452.209
R2 <- 1-SS_error/SS_total
cat("R^2 = eta^2 omnibus = ", round(R2,2), sep="")
R^2 = eta^2 omnibus = 0.79
df1 <- dim(X)[2] - 1
N <- dim(X)[1]
df2 <- N-df1-1
F_omnibus <- (R2/df1)/((1-R2)/df2) # Pestana & Gageiro, 2005, p. 77
pv <- 1-pf(F_omnibus, df1, df2)
if(pv<2.2e-16) p_omnibus <- "< 2.2e-16"
if(pv>2.2e-16) p_omnibus <- paste0("< ", formatC(pv, format="e", digits=2))
Fcrit <- qf(1-alfa, df1, df2)
cat("Omnibus F(",df1, ",", df2, ") = ", round(Fcrit,2), 
    ", F = ", round(F_omnibus,2), 
    ", p ", p_omnibus, "\nR^2 = eta^2 = ", round(R2,2), sep="")
Omnibus F(5,54) = 2.39, F = 41.56, p < 2.2e-16
R^2 = eta^2 = 0.79
# print(sjPlot::tab_model(fit,
#                         p.adjust="holm",
#                         encoding="Windows-1252",
#                         title="Effect of Vitamin C on Tooth Growth in Guinea Pigs: holm",
#                         show.reflvl=TRUE,
#                         show.ngroups=TRUE,
#                         show.stat=TRUE,
#                         show.df=TRUE,
#                         show.se=TRUE,
#                         digits=4,
#                         digits.p=4,
#                         digits.rsq=6,
#                         digits.re=6))

# Solução GLM
fit <- lm(len~supp,
          data=Dados)
print(anova(fit))
Analysis of Variance Table

Response: len
          Df Sum Sq Mean Sq F value  Pr(>F)  
supp       1  205.4  205.35  3.6683 0.06039 .
Residuals 58 3246.9   55.98                  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
fit <- lm(len~supp+dose,
          data=Dados)
print(anova(fit))
Analysis of Variance Table

Response: len
          Df  Sum Sq Mean Sq F value    Pr(>F)    
supp       1  205.35  205.35  14.017 0.0004293 ***
dose       2 2426.43 1213.22  82.811 < 2.2e-16 ***
Residuals 56  820.43   14.65                      
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
fit <- lm(len~supp*dose,
          data=Dados)
print(anova(fit))
Analysis of Variance Table

Response: len
          Df  Sum Sq Mean Sq F value    Pr(>F)    
supp       1  205.35  205.35  15.572 0.0002312 ***
dose       2 2426.43 1213.22  92.000 < 2.2e-16 ***
supp:dose  2  108.32   54.16   4.107 0.0218603 *  
Residuals 54  712.11   13.19                      
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
print(anv <- car::Anova(fit))
Anova Table (Type II tests)

Response: len
           Sum Sq Df F value    Pr(>F)    
supp       205.35  1  15.572 0.0002312 ***
dose      2426.43  2  92.000 < 2.2e-16 ***
supp:dose  108.32  2   4.107 0.0218603 *  
Residuals  712.11 54                      
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
eta2 <- effectsize::eta_squared(anv,
                                partial=TRUE,
                                generalized=FALSE,
                                ci=1-alfa/3,
                                alternative="two.sided",
                                verbose=TRUE)
eta2$interpret <- effectsize::interpret_eta_squared(eta2$Eta2)
print(eta2, digits=4)
# Effect Size for ANOVA (Type II)

Parameter | Eta2 (partial) |      98.3333% CI | interpret
---------------------------------------------------------
supp      |         0.2238 | [0.0337, 0.4383] |     large
dose      |         0.7731 | [0.6299, 0.8496] |     large
supp:dose |         0.1320 | [0.0000, 0.3346] |    medium
eta2 <- effectsize::eta_squared(anv,
                                partial=FALSE,
                                generalized=FALSE,
                                ci=1-alfa/3,
                                alternative="two.sided",
                                verbose=TRUE)
eta2$interpret <- effectsize::interpret_eta_squared(eta2$Eta2)
print(eta2, digits=4)
# Effect Size for ANOVA (Type II)

Parameter |   Eta2 |      98.3333% CI | interpret
-------------------------------------------------
supp      | 0.0595 | [0.0000, 0.2525] |     small
dose      | 0.7029 | [0.5236, 0.8020] |     large
supp:dose | 0.0314 | [0.0000, 0.1848] |     small
o.par <- par()
alfaBonf_int <- alfa/(g1*g2)
fit.means <- phia::interactionMeans(fit)
plot(fit.means, 
     errorbar=paste0("ci",
                     round((1-alfaBonf)*100,4)),
     abbrev.levels=FALSE)
par(o.par)
Warning in par(o.par): parâmetro gráfico "cin" não pode ser especificado
Warning in par(o.par): parâmetro gráfico "cra" não pode ser especificado
Warning in par(o.par): parâmetro gráfico "csi" não pode ser especificado
Warning in par(o.par): parâmetro gráfico "cxy" não pode ser especificado
Warning in par(o.par): parâmetro gráfico "din" não pode ser especificado

Warning in par(o.par): parâmetro gráfico "page" não pode ser especificado
# alfaBonf_int <- alfa/(length(unique(Dados$supp))*
#                       length((unique(Dados$dose))))
# plot(effects::effect(c("supp", "dose"), fit, 
#                      confidence.level=1-alfaBonf_int), 
#      multiline=TRUE, ci.style="bars")
# alfaBonf_fat1 <- alfa/(length(unique(Dados$supp)))
# plot(effects::effect(c("supp"), fit, confidence.level=1-alfaBonf_fat1), 
#      ci.style="bars")
# alfaBonf_fat2 <- alfa/(length(unique(Dados$dose)))
# plot(effects::effect(c("dose"), fit, confidence.level=1-alfaBonf_fat2), 
#      ci.style="bars")

cat("supp simple main effect test in the presence of interaction with dose \n")
supp simple main effect test in the presence of interaction with dose 
print(phia::testInteractions(fit,
                             fixed="dose",
                             across="supp",
                             adjustment="holm"))
F Test: 
P-value adjustment method: holm
          Value    SE Df Sum of Sq       F   Pr(>F)   
0.5       -5.25 1.624  1    137.81 10.4505 0.004185 **
  1       -5.93 1.624  1    175.82 13.3330 0.001769 **
  2        0.08 1.624  1      0.03  0.0024 0.960893   
Residuals             54    712.11                    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
cat("\nPost hoc test: supp|supp:dose (there is no simple main effect)\n")

Post hoc test: supp|supp:dose (there is no simple main effect)
emm <- emmeans::emmeans(object=fit, 
                        specs=pairwise~supp|supp:dose, 
                        alpha=alfa,
                        adjust="holm")
print(emm)
$emmeans
dose = 0.5:
 supp emmean   SE df lower.CL upper.CL
 VC     7.98 1.15 54     5.68     10.3
 OJ    13.23 1.15 54    10.93     15.5

dose = 1:
 supp emmean   SE df lower.CL upper.CL
 VC    16.77 1.15 54    14.47     19.1
 OJ    22.70 1.15 54    20.40     25.0

dose = 2:
 supp emmean   SE df lower.CL upper.CL
 VC    26.14 1.15 54    23.84     28.4
 OJ    26.06 1.15 54    23.76     28.4

Confidence level used: 0.95 

$contrasts
dose = 0.5:
 contrast estimate   SE df t.ratio p.value
 VC - OJ     -5.25 1.62 54  -3.233  0.0021

dose = 1:
 contrast estimate   SE df t.ratio p.value
 VC - OJ     -5.93 1.62 54  -3.651  0.0006

dose = 2:
 contrast estimate   SE df t.ratio p.value
 VC - OJ      0.08 1.62 54   0.049  0.9609
print(plot(emm$emmeans, 
     colors="black")+ 
       ggplot2::theme_bw())

print(plot(emm$contrasts, 
     colors="black")+ 
       ggplot2::theme_bw())

print(multcomp::cld(object=emm$emmeans,
                    adjust="holm",
                    Letters=letters,
                    level=1-alfa,
                    alpha=alfa))
dose = 0.5:
 supp emmean   SE df lower.CL upper.CL .group
 VC     7.98 1.15 54     5.33     10.6  a    
 OJ    13.23 1.15 54    10.58     15.9   b   

dose = 1:
 supp emmean   SE df lower.CL upper.CL .group
 VC    16.77 1.15 54    14.12     19.4  a    
 OJ    22.70 1.15 54    20.05     25.3   b   

dose = 2:
 supp emmean   SE df lower.CL upper.CL .group
 OJ    26.06 1.15 54    23.41     28.7  a    
 VC    26.14 1.15 54    23.49     28.8  a    

Confidence level used: 0.95 
Conf-level adjustment: bonferroni method for 2 estimates 
significance level used: alpha = 0.05 
NOTE: If two or more means share the same grouping symbol,
      then we cannot show them to be different.
      But we also did not show them to be the same. 
cat("dose simple main effect test in the presence of interaction with supp \n")
dose simple main effect test in the presence of interaction with supp 
print(phia::testInteractions(fit,
                             fixed="supp",
                             across="dose",
                             adjustment="holm"))
F Test: 
P-value adjustment method: holm
           dose1 dose2   SE1   SE2 Df Sum of Sq      F    Pr(>F)    
VC        -18.16 -9.37 1.624 1.624  2   1649.49 62.541 1.751e-14 ***
OJ        -12.83 -3.36 1.624 1.624  2    885.26 33.565 3.363e-10 ***
Residuals                          54    712.11                     
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
cat("\nPost hoc test: dose (there is simple main effect)\n")

Post hoc test: dose (there is simple main effect)
emm <- emmeans::emmeans(object=fit, 
                        specs=pairwise~dose,  
                        alpha=alfa,
                        adjust="holm")
NOTE: Results may be misleading due to involvement in interactions
print(emm)
$emmeans
 dose emmean    SE df lower.CL upper.CL
 0.5    10.6 0.812 54     8.98     12.2
 1      19.7 0.812 54    18.11     21.4
 2      26.1 0.812 54    24.47     27.7

Results are averaged over the levels of: supp 
Confidence level used: 0.95 

$contrasts
 contrast        estimate   SE df t.ratio p.value
 dose0.5 - dose1    -9.13 1.15 54  -7.951  <.0001
 dose0.5 - dose2   -15.49 1.15 54 -13.493  <.0001
 dose1 - dose2      -6.37 1.15 54  -5.543  <.0001

Results are averaged over the levels of: supp 
P value adjustment: holm method for 3 tests 
print(plot(emm$emmeans, 
     colors="black")+ 
       ggplot2::theme_bw())

print(plot(emm$contrasts, 
     colors="black")+ 
       ggplot2::theme_bw())

print(multcomp::cld(object=emm$emmeans,
                    adjust="holm",
                    Letters=letters,
                    level=1-alfa,
                    alpha=alfa))
 dose emmean    SE df lower.CL upper.CL .group
 0.5    10.6 0.812 54      8.6     12.6  a    
 1      19.7 0.812 54     17.7     21.7   b   
 2      26.1 0.812 54     24.1     28.1    c  

Results are averaged over the levels of: supp 
Confidence level used: 0.95 
Conf-level adjustment: bonferroni method for 3 estimates 
P value adjustment: holm method for 3 tests 
significance level used: alpha = 0.05 
NOTE: If two or more means share the same grouping symbol,
      then we cannot show them to be different.
      But we also did not show them to be the same. 
cat("\nPost hoc test: supp:dose\n")

Post hoc test: supp:dose
emm <- emmeans::emmeans(object=fit, 
                        specs=pairwise~supp:dose,
                        alpha=alfa,
                        adjust="holm")
print(emm)
$emmeans
 supp dose emmean   SE df lower.CL upper.CL
 VC   0.5    7.98 1.15 54     5.68     10.3
 OJ   0.5   13.23 1.15 54    10.93     15.5
 VC   1     16.77 1.15 54    14.47     19.1
 OJ   1     22.70 1.15 54    20.40     25.0
 VC   2     26.14 1.15 54    23.84     28.4
 OJ   2     26.06 1.15 54    23.76     28.4

Confidence level used: 0.95 

$contrasts
 contrast                estimate   SE df t.ratio p.value
 VC dose0.5 - OJ dose0.5    -5.25 1.62 54  -3.233  0.0105
 VC dose0.5 - VC dose1      -8.79 1.62 54  -5.413  <.0001
 VC dose0.5 - OJ dose1     -14.72 1.62 54  -9.064  <.0001
 VC dose0.5 - VC dose2     -18.16 1.62 54 -11.182  <.0001
 VC dose0.5 - OJ dose2     -18.08 1.62 54 -11.133  <.0001
 OJ dose0.5 - VC dose1      -3.54 1.62 54  -2.180  0.1346
 OJ dose0.5 - OJ dose1      -9.47 1.62 54  -5.831  <.0001
 OJ dose0.5 - VC dose2     -12.91 1.62 54  -7.949  <.0001
 OJ dose0.5 - OJ dose2     -12.83 1.62 54  -7.900  <.0001
 VC dose1 - OJ dose1        -5.93 1.62 54  -3.651  0.0035
 VC dose1 - VC dose2        -9.37 1.62 54  -5.770  <.0001
 VC dose1 - OJ dose2        -9.29 1.62 54  -5.720  <.0001
 OJ dose1 - VC dose2        -3.44 1.62 54  -2.118  0.1346
 OJ dose1 - OJ dose2        -3.36 1.62 54  -2.069  0.1346
 VC dose2 - OJ dose2         0.08 1.62 54   0.049  0.9609

P value adjustment: holm method for 15 tests 
print(plot(emm$emmeans, 
     colors="black")+ 
       ggplot2::theme_bw())

print(plot(emm$contrasts, 
     colors="black")+ 
       ggplot2::theme_bw())

print(multcomp::cld(object=emm$emmeans,
                    adjust="holm",
                    Letters=letters,
                    level=1-alfa,
                    alpha=alfa))
 supp dose emmean   SE df lower.CL upper.CL .group
 VC   0.5    7.98 1.15 54     4.83     11.1  a    
 OJ   0.5   13.23 1.15 54    10.08     16.4   b   
 VC   1     16.77 1.15 54    13.62     19.9   b   
 OJ   1     22.70 1.15 54    19.55     25.8    c  
 OJ   2     26.06 1.15 54    22.91     29.2    c  
 VC   2     26.14 1.15 54    22.99     29.3    c  

Confidence level used: 0.95 
Conf-level adjustment: bonferroni method for 6 estimates 
P value adjustment: holm method for 15 tests 
significance level used: alpha = 0.05 
NOTE: If two or more means share the same grouping symbol,
      then we cannot show them to be different.
      But we also did not show them to be the same. 

Exemplo de GLM misto multifatorial com interação em Takayanagi, Siqueira, Silveira & Valentova (2024)

Título: O que Diferentes Pessoas Buscam em um Parceiro? Efeitos do Sexo, da Orientação Sexual e das Estratégias de Acasalamento nas Preferências de Parceiro

A artigo apresenta uma aplicação de GLMM (modelo linear misto geral) com fatores entre e intraparticipantes.

Os dados e código R estão disponíveis em OSF Home.

Resumo: As preferências de parceiro são um diferencial importante na formação de relacionamentos e na aptidão evolutiva, variando de acordo com fatores individuais, ecológicos e sociais. Neste estudo, avaliamos a variação na preferência por inteligência, bondade, atratividade física, saúde e nível socioeconômico entre indivíduos de diferentes sexos e orientações sexuais em uma amostra brasileira. Analisamos as pontuações de preferência de 778 homens e mulheres heterossexuais, bissexuais e homossexuais em três tarefas de orçamento de parceiro (baixo vs. médio vs. alto orçamento) e sua associação com sociosexualidade, estilos de apego, homogamia e disposição para engajar-se em relacionamentos de curto e longo prazo. Os resultados indicaram uma ordem global de preferência por traços, com a inteligência em primeiro lugar, seguida por bondade, atratividade física, saúde e, por último, status socioeconômico. Diferenças típicas de sexo foram observadas principalmente no grupo heterossexual, e combinações específicas de sexo e orientação sexual estiveram associadas a variações na preferência por atratividade física, bondade e status socioeconômico. Também encontramos associações únicas de outras variáveis com preferências de parceiro e com a disposição para engajar-se em relacionamentos de curto ou longo prazo. Ao explorar as preferências de parceiro de indivíduos não heterossexuais de um país latino-americano, um grupo sub-representado na pesquisa em psicologia evolucionista, nossos resultados ajudam a compreender os fatores universais e específicos que orientam as preferências de parceiro e o comportamento sexual humano.

Análises Estatísticas: Os dados foram analisados no software R, versão 4.2.1 (Core Team, 2022). Computamos modelos lineares mistos gerais (GLMM) utilizando a função lmer do pacote lmerTest (Kuznetsova et al., 2017).

Na análise principal, utilizamos um GLMM para avaliar como o nível de preferência por cada traço variou em função das características individuais. Usamos a pontuação de preferência pelo traço como variável dependente; o identificador do participante como efeito aleatório; traço do parceiro, sexo e orientação sexual como variáveis fixas nominais; e tamanho do orçamento, sociosexualidade, apego ansioso, apego evitativo e pontuação de autoavaliação do traço como variáveis fixas intervalares. Idade, estado civil, renda mensal domiciliar per capita e nível educacional foram incluídos como variáveis de controle.

Nas análises adicionais, comparamos as pontuações de disposição para engajar-se em relacionamentos de curto e longo prazo entre condições de orçamento, sexo e orientações sexuais, utilizando uma análise de variância (ANOVA) de medidas repetidas com quatro fatores. Também usamos GLMM para explorar como características individuais e diferenças nas preferências de parceiro influenciaram a inclinação para formar relacionamentos de curto ou longo prazo com o parceiro hipotético. Usamos o nível de disposição para engajar-se em relacionamentos de curto ou longo prazo como variável dependente de cada modelo; o identificador do participante como efeito aleatório; sexo e orientação sexual como variáveis fixas nominais; e tamanho do orçamento, sociosexualidade, apego ansioso, apego evitativo e pontuações de preferência por traços como variáveis fixas intervalares. Mais uma vez, idade, estado civil, renda mensal domiciliar per capita e nível educacional foram incluídos como variáveis de controle.

Modelo de Efeitos Fixos Multivariado de Dois Fatores com Interação

Procedendo por analogia, especificamos o modelo de efeitos fixos de dois fatores para uma resposta vetorial consistindo em \(p\) componentes [veja (6-54)]

\[ \mathbf{X}_{\ell kr} = \boldsymbol{\mu} + \boldsymbol{\tau}_\ell + \boldsymbol{\beta}_k + \boldsymbol{\gamma}_{\ell k} + \boldsymbol{\varepsilon}_{\ell kr} \]

em que \(\ell=1,2,\ldots,g\), \(k = 1,2,..., b\) e \(r = 1,2,...,n\) e

\[ \sum_{\ell=1}^{g} \boldsymbol{\tau}_\ell = \sum_{k=1}^{b} \boldsymbol{\beta}_k = \sum_{\ell=1}^{g} \boldsymbol{\gamma}_{\ell k} = \sum_{k=1}^{b} \boldsymbol{\gamma}_{\ell k} = \mathbf{0} \]

Os vetores são todos da ordem \(p \times 1\), e os \(\{\boldsymbol{\varepsilon}_{\ell kr}\}_{\ell=1,k=1,r=1}^{g,b,n}\sim \mathcal{N}_p\text{IID}(\boldsymbol{0}, \boldsymbol{\sigma^2\mathbf{I}})\). Assim, as respostas consistem em \(p\) medições replicadas \(n\) vezes em cada uma das possíveis combinações de níveis dos fatores 1 e 2.

Seguindo (6-56), podemos decompor os vetores de observação \(\mathbf{X}_{\ell kr}\) como:

\[ \begin{align} \mathbf{X}_{\ell kr} &= \mathbf{\overline{X}} + \left(\mathbf{\overline{X}}_\ell - \mathbf{\overline{X}}\right) + \left(\mathbf{\overline{X}}_k - \mathbf{\overline{X}}\right)+ \\ &\quad \left(\mathbf{\overline{X}}_{\ell k} - \mathbf{\overline{X}}_\ell - \mathbf{\overline{X}}_k + \mathbf{\overline{X}}\right) + \left(\mathbf{X}_{\ell kr} - \mathbf{\overline{X}}_{\ell k}\right) \end{align} \tag{6-60} \]

em que \(\mathbf{\overline{X}}\) é a média geral dos vetores de observação, \(\mathbf{\overline{X}}_\ell\) é a média dos vetores de observação no \(\ell\)-ésimo nível do fator 1, \(\mathbf{\overline{X}}_k\) é a média dos vetores de observação no \(k\)-ésimo nível do fator 2, e \(\mathbf{\overline{X}}_{\ell k}\) é a média dos vetores de observação no \(\ell\)-ésimo nível do fator 1 e no \(k\)-ésimo nível do fator 2.

Generalizações diretas de (6-57) e (6-58) fornecem as decomposições da soma dos quadrados e produtos cruzados e graus de liberdade:

\[ \begin{align} \sum_{\ell=1}^{g} \sum_{k=1}^{b} \sum_{r=1}^{n} \left(\mathbf{X}_{\ell kr} - \mathbf{\overline{X}}\right)\left(\mathbf{X}_{\ell kr} - \mathbf{\overline{X}}\right)^{\prime} &= b n \sum_{\ell=1}^{g} \left(\mathbf{\overline{X}}_\ell - \mathbf{\overline{X}}\right)\left(\mathbf{\overline{X}}_\ell - \mathbf{\overline{X}}\right)^{\prime}+ \\ &\quad g n \sum_{k=1}^{b} \left(\mathbf{\overline{X}}_k - \mathbf{\overline{X}}\right)\left(\mathbf{\overline{X}}_k - \mathbf{\overline{X}}\right)^{\prime}+\\ &\quad n \sum_{\ell=1}^{g} \sum_{k=1}^{b} \left(\mathbf{\overline{X}}_{\ell k} - \mathbf{\overline{X}}_\ell - \mathbf{\overline{X}}_k + \mathbf{\overline{X}}\right)\left(\mathbf{\overline{X}}_{\ell k} - \mathbf{\overline{X}}_\ell - \mathbf{\overline{X}}_k + \mathbf{\overline{X}}\right)^{\prime}+ \\ &\quad \sum_{\ell=1}^{g} \sum_{k=1}^{b} \sum_{r=1}^{n} \left(\mathbf{X}_{\ell kr} - \mathbf{\overline{X}}_{\ell k}\right)\left(\mathbf{X}_{\ell kr} - \mathbf{\overline{X}}_{\ell k}\right)^{\prime} \end{align} \tag{6-61} \]

Os graus de liberdade correspondentes são:

\[ gbn - 1 = (g - 1) + (b - 1) + (g - 1)(b - 1) + gb(n - 1) \tag{6-62} \]

Mais uma vez, a generalização da análise univariada para a análise multivariada consiste simplesmente em substituir um escalar, como \((x_\ell - \bar{x})^2\), pela matriz correspondente \((\mathbf{X}_\ell - \mathbf{\overline{X}})(\mathbf{X}_\ell - \mathbf{\overline{X}})^{\prime}\).

Traduzindo e adaptando para a notação solicitada:

Tabela MANOVA

Fonte de Variação Matriz de Soma de Quadrados e Produtos Cruzados (SSP) Graus de Liberdade (df)
Fator 1 \(\text{SSP}_{\text{fat1}} = \sum_{\ell=1}^{g} bn (\mathbf{\overline{X}}_{\ell} - \mathbf{\overline{X}})(\mathbf{\overline{X}}_{\ell} - \mathbf{\overline{X}})^{\prime}\) \(g - 1\)
Fator 2 \(\text{SSP}_{\text{fat2}} = \sum_{k=1}^{b} gn (\mathbf{\overline{X}}_k - \mathbf{\overline{X}})(\mathbf{\overline{X}}_k - \mathbf{\overline{X}})^{\prime}\) \(b - 1\)
Interação \(\text{SSP}_{\text{int}} = \sum_{\ell=1}^{g} \sum_{k=1}^{b} n (\mathbf{\overline{X}}_{\ell k} - \mathbf{\overline{X}}_{\ell} - \mathbf{\overline{X}}_k + \mathbf{\overline{X}})(\mathbf{\overline{X}}_{\ell k} - \mathbf{\overline{X}}_{\ell} - \mathbf{\overline{X}}_k + \mathbf{\overline{X}})^{\prime}\) \((g - 1)(b - 1)\)
Resíduo \(\text{SSP}_{\text{res}} = \sum_{\ell=1}^{g} \sum_{k=1}^{b} \sum_{r=1}^{n} (\mathbf{X}_{\ell kr} - \mathbf{\overline{X}}_{\ell k})(\mathbf{X}_{\ell kr} - \mathbf{\overline{X}}_{\ell k})^{\prime}\) \(gb(n - 1)\)
Total \(\text{SSP}_{\text{tot}} = \sum_{\ell=1}^{g} \sum_{k=1}^{b} \sum_{r=1}^{n} (\mathbf{X}_{\ell kr} - \mathbf{\overline{X}})(\mathbf{X}_{\ell kr} - \mathbf{\overline{X}})^{\prime}\) \(gbn - 1\)

O teste de razão de verossimilhanças de (sem efeito de interação):

\[ \begin{cases} H_0: \boldsymbol{\gamma}_{11} = \boldsymbol{\gamma}_{12} = \cdots = \boldsymbol{\gamma}_{gb} = \mathbf{0} \\ H_1: \text{Pelo menos um }\boldsymbol{\gamma}_{\ell k} \ne \mathbf{0} \end{cases}\\ \alpha=5\% \tag{6-63} \]

É conduzido rejeitando \(H_0\) para pequenos valores da razão:

\[ \Lambda^{\ast}_\text{int} = \dfrac{|\text{SSP}_\text{res}|}{|\text{SSP}_\text{res} + \text{SSP}_\text{int}|} \tag{6-64} \]

O procedimento de teste de razão de verossimilhanças (LR) requer que \(p \leq gb(n - 1)\), para que o \(\text{SSP}_{\text{res}}\) seja definida positiva (com probabilidade 1).

Para amostra grande, \(gb(n-1) -p\ge30\), o lambda de Wilks, \(\Lambda^*\), pode ser referido a um percentil de qui-quadrado.

Usando o multiplicador de Bartlett (veja [6]) para melhorar a aproximação qui-quadrada, rejeitamos \(H_0: \boldsymbol{\gamma}_{11} = \boldsymbol{\gamma}_{12} = \cdots = \boldsymbol{\gamma}_{gb} = \mathbf{0}\) no nível \(\alpha\) se:

\[ X^2 = -\left(gb(n-1)-\dfrac{p+1-(g-1)(b-1)}{2}\right)\ln(\Lambda^*) > \chi^2_{(g-1)(b-1)p}(1-\alpha) \tag{6-65} \]

Aquelas respostas sem interação podem ser interpretadas em termos de efeitos aditivos dos fatores 1 e 2, desde que esses últimos efeitos existam. Em qualquer caso, gráficos de interação semelhantes à Figura 6.3, mas com médias de amostra de tratamento substituindo os valores esperados, esclarecem melhor as magnitudes relativas dos efeitos principais e de interação.

No modelo multivariado, testamos os efeitos principais dos fatores 1 e 2 da seguinte maneira. Primeiro, considere as hipóteses \(H_{\mathbf{0}}: \boldsymbol{\tau}_1 = \boldsymbol{\tau}_2 = \cdots = \boldsymbol{\tau}_g = \mathbf{0}\) e \(H_1:\) pelo menos um \(\boldsymbol{\tau}_\ell \ne\mathbf{0}\). Essas hipóteses nula e alternativa especificam que não há efeito do fator 1 e há algum efeito do fator 1, respectivamente. Seja

\[ \Lambda^{\ast}_\text{fat1} = \dfrac{|\text{SSP}_\text{res}|}{|\text{SSP}_\text{res} + \text{SSP}_\text{fat1}|} \tag{6-66} \]

de modo que valores pequenos de \(\Lambda^*\) são consistentes com \(H_1\). Para amostra grande, \(g(n-1)-p\ge30\), e usando a correção de Bartlett, o teste de razão de verossimilhanças é o seguinte:

Rejeite \(H_{\mathbf{0}}: \boldsymbol{\tau}_1 = \boldsymbol{\tau}_2 =\cdots= \boldsymbol{\tau}_g = \mathbf{0}\) (sem efeito do fator 1) no nível \(\alpha\) se

\[ X^2 = -\left(gb(n-1)-\dfrac{p+1-(g-1)}{2}\right)\ln(\Lambda^*) > \chi^2_{(g-1)p}(1-\alpha) \tag{6-67} \]

De maneira semelhante, o efeito do fator 2 é testado considerando \(H_{\mathbf{0}}: \boldsymbol{\beta}_1 = \boldsymbol{\beta}_2 = \cdots = \boldsymbol{\beta}_b = \mathbf{0}\) e \(H_1\) onde pelo menos um \(\boldsymbol{\beta}_k \ne\mathbf{0}\). Valores pequenos de

\[ \Lambda^{\ast}_\text{fat2} =\dfrac{|\text{SSP}_\text{res}|}{|\text{SSP}_\text{res} + \text{SSP}_\text{fat2}|} \tag{6-68} \]

são consistentes com \(H_1\). Novamente, para amostra grande, \(b(n-1)-p\ge30\), e usando a correção de Bartlett:

Rejeite \(H_{\mathbf{0}}: \boldsymbol{\beta}_1 = \boldsymbol{\beta}_2 = \cdots = \boldsymbol{\beta}_b = \mathbf{0}\) (sem efeito do fator 2) no nível \(\alpha\) se

\[ X^2 = -\left(gb(n-1)-\dfrac{p+1-(b-1)}{2}\right)\ln(\Lambda^*) > \chi^2_{(b-1)p}(1-\alpha) \tag{6-69} \]

Comentário. Consideramos o modelo multivariado de dois fatores com replicações. Ou seja, o modelo permite \(n\ge2\) replicações das respostas em cada combinação de níveis de fatores. Isso nos permite examinar a interação dos fatores. Se apenas um vetor de observação estiver disponível em pelo menos uma combinação de níveis de fatores, o modelo de dois fatores não permite a possibilidade de um termo de interação geral \(\gamma_{\ell k}\). A tabela MANOVA correspondente inclui apenas o fator 1, o fator 2 e as fontes residuais de variação como componentes da variação total. (Veja o Exercício 6.13).

Exemplo 6.13: Uma análise multivariada de variância de dois fatores de dados de filme plástico

As condições ótimas para extrudir filme plástico foram examinadas usando uma técnica chamada Operação Evolutiva. (Veja [9].)

No decorrer do estudo que foi realizado, três respostas

  • \(X_1\) = resistência ao rasgo
  • \(X_2\) = brilho
  • \(X_3\) = opacidade

foram medidas em dois níveis dos fatores, taxa de extrusão\(\ast\) e quantidade de um aditivo.

\(\ast\): Extrudir é um processo utilizado na produção de objetos com perfil contínuo e homogêneo. Durante a extrusão, um material é empurrado ou puxado através de um molde (conhecido como matriz) que possui um orifício com o perfil desejado, resultando em um produto com a forma desse orifício. Um exemplo comum de extrusão é a produção de massas alimentícias, onde a massa é pressionada através de uma matriz para formar diferentes formatos, como espaguete ou macarrão. Em contextos industriais, a extrusão é amplamente utilizada na produção de itens como tubos, hastes, fios e filmes plásticos. O processo pode ser usado com uma variedade de materiais, incluindo plásticos, metais e cerâmicas.

As medições foram repetidas \(n = 5\) vezes em cada combinação dos níveis de fatores. Os dados são exibidos na Tabela 6.4.

O valor p omnibus é obtido por meio de GLM usando lm.

porquinho-da-índia

porquinho-da-índia

Para testar a interação, calculamos

\[ \Lambda^{\ast}_\text{int}=\dfrac{|\text{SSP}_\text{res}|}{|\text{SSP}_\text{res}+\text{SSP}_\text{int}|}=\dfrac{275.7098}{354.7906}=0.7771 \]

Para \((g - l)(b - 1) = 1\),

\[ F=\left(\dfrac{1-\Lambda^{\ast}_\text{int}}{\Lambda^{\ast}_\text{int}}\right)\dfrac{(gb(n-1)-p+1)/2}{(|(g-1)(b-1)-p|+1)/2} \]

possui uma distribuição F exata com graus de liberdade \(\nu_1 = |(g - l)(b - 1) - p| + 1\) e \(\nu_2=gb(n - 1) - p + 1\). (Veja [1]).

Para o nosso exemplo:

\[ F = \dfrac{1 - 0.7771}{0.7771} \dfrac{(2(2)(4)-3+1)/2}{(|1(1)-3|+1)/2} \]

Uma vez que \(F = 1.34 < F_{3,14}(0.95) = 3.34\), não rejeitamos a hipótese \(H_0: \boldsymbol{\gamma}_{11} = \boldsymbol{\gamma}_{12} = \boldsymbol{\gamma}_{21} = \boldsymbol{\gamma}_{22} = \mathbf{0}\) (sem efeitos de interação).

Observe que a estatística qui-quadrado aproximada para este teste é \(- [2(2)(4) \times (3 + 1 - 2(1))/2] \ln(0.7771) = 3.66\), a partir de (6-65). Uma vez que \(\chi^2(0.95) = 7.81\), chegaríamos à mesma conclusão que foi fornecida pelo teste F exato.

Para testar os efeitos dos fatores 1 e 2 (veja página 317), calculamos:

\[ \Lambda^{\ast}_\text{fat1} = \dfrac{{|\text{SSP}_{\text{res}}|}}{|\text{SSP}_{\text{res}} + \text{SSP}_{\text{fat1}}|} = \dfrac{{275.7098}}{722.0212} = 0.3819 \]

e

\[ \Lambda^{\ast}_\text{fat2} = \dfrac{{|\text{SSP}_{\text{res}}|}}{|\text{SSP}_{\text{res}} + \text{SSP}_{\text{fat2}}|} = \dfrac{{275.7098}}{527.1347} = 0.5230 \]

Para ambos \(g - 1 = 1\) e \(b - 1 = 1\),

\[ F_1 = \left(\dfrac{1 - \Lambda^{\ast}_\text{fat1}}{\Lambda^{\ast}_\text{fat1}}\right) \dfrac{(gb(n-1) - p + 1)/2}{(|(g-1)(b-1) - p| + 1)/2} \]

e

\[ F_2 = \left(\dfrac{1 - \Lambda^{\ast}_\text{fat2}}{\Lambda^{\ast}_\text{fat2}}\right) \dfrac{(gb(n-1) - p + 1)/2}{(|(g-1)(b-1) - p| + 1)/2} \]

possuem distribuições F exatas com graus de liberdade \(\nu_1 = |(g - 1)(b - 1) - p| + 1\) e \(\nu_2 = gb(n - 1) - p + 1\), respectivamente. (Veja [1]).

No nosso caso,

\[ F_1 = \dfrac{1 - 0.3819}{0.3819} \dfrac{(2(2)(4) - 3 + 1)/2}{(|(2 - 1)(2 - 1) - 3| + 1)/2} = 7.55 \]

e

\[ F_2 = \dfrac{1 - 0.5230}{0.5230} \dfrac{(2(2)(4) - 3 + 1)/2}{(|(2 - 1)(2 - 1) - 3| + 1)/2} = 4.26 \]

De antes, \(F_{3,14}(0.95) = 3.34\). Temos \(F_1 = 7.55 > F_{3,14}(0.95) = 3.34\), e portanto, rejeitamos \(H_0: \boldsymbol{\tau}_1 = \boldsymbol{\tau}_2 = \mathbf{0}\) (sem efeitos do fator 1) no nível de 5%. Similarmente, \(F_2 = 4.26 > F_{3,14}(0.95) = 3.34\), e rejeitamos \(H_0: \boldsymbol{\beta}_1 = \boldsymbol{\beta}_2 = \mathbf{0}\) (sem efeitos do fator 2) no nível de 5%. Concluímos que tanto a mudança na taxa de extrusão quanto a quantidade de aditivo afetam as respostas, e eles o fazem de maneira aditiva. Outra solução é usar a correção de Bonferroni ou de Kimball (Sidak) para testar os dois efeitos principais.

A natureza dos efeitos dos fatores 1 e 2 nas respostas é explorada no Exercício 6.15. Nesse exercício, intervalos de confiança simultâneos para contrastes nos componentes de \(\boldsymbol{\tau}_\ell\) e \(\boldsymbol{\beta}_k\) são considerados.

suppressMessages(suppressWarnings(
  invisible(Sys.setlocale("LC_ALL", "pt_BR.UTF-8"))
))

x <- read.table("JW6Data/T6-4.dat", quote="\"", comment.char="")
alfa <- 0.05 
names(x) <- c("F1", "F2", "X1", "X2", "X3")
x$F1 <- factor(x$F1)
x$F2 <- factor(x$F2)

# --- descritivas rápidas
print(psych::describeBy(X1+X2+X3 ~ F1+F2, 
                        mat=1, digits=2, data=x))
    item group1 group2 vars n mean   sd median trimmed  mad min  max range
X11    1      0      0    1 5 6.30 0.31    6.5    6.30 0.00 5.8  6.5   0.7
X12    2      1      0    1 5 6.88 0.26    6.8    6.88 0.30 6.6  7.2   0.6
X13    3      0      1    1 5 6.68 0.46    6.9    6.68 0.44 6.1  7.2   1.1
X14    4      1      1    1 5 7.28 0.26    7.2    7.28 0.30 7.0  7.6   0.6
X21    5      0      0    2 5 9.56 0.25    9.6    9.56 0.15 9.2  9.9   0.7
X22    6      1      0    2 5 8.72 0.45    8.5    8.72 0.30 8.3  9.3   1.0
X23    7      0      1    2 5 9.58 0.37    9.5    9.58 0.59 9.1 10.0   0.9
X24    8      1      1    2 5 9.40 0.50    9.2    9.40 0.59 8.8 10.1   1.3
X31    9      0      0    3 5 3.74 2.05    4.1    3.74 1.63 0.8  6.4   5.6
X32   10      1      0    3 5 3.14 0.99    3.4    3.14 0.89 1.6  4.1   2.5
X33   11      0      1    3 5 3.84 1.88    3.9    3.84 2.67 1.9  5.7   3.8
X34   12      1      1    3 5 5.02 2.74    5.2    5.02 3.71 1.9  8.4   6.5
     skew kurtosis   se
X11 -0.70    -1.51 0.14
X12  0.17    -2.11 0.12
X13 -0.18    -2.06 0.21
X14  0.17    -2.11 0.12
X21 -0.09    -1.48 0.11
X22  0.29    -2.13 0.20
X23 -0.04    -1.98 0.17
X24  0.21    -1.83 0.23
X31 -0.15    -1.58 0.92
X32 -0.52    -1.60 0.44
X33 -0.02    -2.20 0.84
X34  0.02    -2.06 1.23
# --- formato longo (tidyr) para boxplot
Dados.long <- tidyr::pivot_longer(
  x, cols = c(X1, X2, X3),
  names_to = "variavel", values_to = "valor"
)

# --- boxplot por célula F1:F2, facet por variável
p_box <- ggplot2::ggplot(
  Dados.long,
  ggplot2::aes(x = interaction(F1, F2, sep=":"),
               y = valor,
               fill = interaction(F1, F2, sep=":"))
) +
  ggplot2::geom_boxplot() +
  ggplot2::facet_wrap(~ variavel, scales = "free_y") +
  ggplot2::labs(x = "F1:F2", y = "", fill = "F1:F2") +
  ggplot2::theme_bw() + 
  ggplot2::theme(panel.grid = 
                   ggplot2::element_blank())
print(p_box)

# --- pairs plots (corrigindo estética)
print(
  GGally::ggpairs(
    data = x,
    mapping = ggplot2::aes(
      alpha=0.3,
      color = interaction(F1, F2, sep=":")
    )
  ) + 
    ggplot2::theme_bw() + 
    ggplot2::theme(panel.grid = 
                     ggplot2::element_blank())
)
Registered S3 method overwritten by 'GGally':
  method from   
  +.gg   ggplot2
`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

# --- ICs por célula (Bonferroni por célula F1×F2)
g1 <- nlevels(x$F1) 
g2 <- nlevels(x$F2)
alfaBonf <- alfa/(g1*g2)

## 0) Nível de confiança (usa 1-alfaBonf se existir)
conf.level <- 1 - alfaBonf 

## 1) Longo (a partir de x)
Dados.long <- tidyr::pivot_longer(
  x,
  cols = c(X1, X2, X3),
  names_to = "variavel",
  values_to = "valor"
)
Dados.long$variavel <- factor(Dados.long$variavel, levels = c("X1","X2","X3"))
Dados.long$F1 <- factor(Dados.long$F1, levels = levels(x$F1))
Dados.long$F2 <- factor(Dados.long$F2, levels = levels(x$F2))

## 2) Resumo por (variavel, F1, F2)
sumfun <- function(z) c(N = length(z), mean = mean(z, na.rm=TRUE), sd = sd(z, na.rm=TRUE))
res <- aggregate(valor ~ variavel + F1 + F2, data = Dados.long, FUN = sumfun, na.action = na.omit)

ic <- res
ic$N    <- ic$valor[, "N"]
ic$mean <- ic$valor[, "mean"]
ic$sd   <- ic$valor[, "sd"]
ic$valor <- NULL

## 3) IC de t
ic$se   <- ic$sd / sqrt(pmax(ic$N, 1))
tcrit   <- qt((1 + conf.level)/2, df = pmax(ic$N - 1, 1))
ic$ci   <- tcrit * ic$se
ic$ymin <- ic$mean - ic$ci
ic$ymax <- ic$mean + ic$ci

## 4) Limpeza para evitar facets vazios
ic <- ic[complete.cases(ic[, c("variavel","F1","F2","mean","ci")]), ]
stopifnot(nrow(ic) > 0)   # garante que há dados

## 5) Gráfico
pd <- ggplot2::position_dodge(0.9)
grf <- ggplot2::ggplot(ic,
                       ggplot2::aes(x = F1, y = mean, 
                                    colour = F2)) +
  ggplot2::geom_errorbar(ggplot2::aes(ymin = ymin, 
                                      ymax = ymax),
                         position = pd, 
                         width = 0.1) +
  ggplot2::geom_point(shape = 21, 
                      size = 3, 
                      fill = "white",
                      position = pd) +
  ggplot2::facet_wrap(~ variavel, scales = "free_y") +
  ggplot2::labs(x = "F1", 
                y = "IC",
                colour = "F2",
                title = sprintf("F1 × F2: IC95 Bonferroni")) +
  ggplot2::theme_bw() + 
  ggplot2::theme(panel.grid = 
                   ggplot2::element_blank())

print(grf)

fit <- lm(cbind(X1,X2,X3)~F1*F2, 
          data=x)
print(anv <- car::Anova(fit, test="Wilks"), digits=3)

Type II MANOVA Tests: Wilks test statistic
      Df test stat approx F num Df den Df Pr(>F)   
F1     1     0.382     7.55      3     14  0.003 **
F2     1     0.523     4.26      3     14  0.025 * 
F1:F2  1     0.777     1.34      3     14  0.302   
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
eta2 <- effectsize::eta_squared(anv,
                                partial=TRUE,
                                generalized=FALSE,
                                ci=1-alfa/3,
                                alternative="two.sided",
                                verbose=TRUE)
eta2$interpret <- effectsize::interpret_eta_squared(eta2$Eta2)
print(eta2, digits=4)
# Effect Size for ANOVA (Type II)

Parameter | Eta2 (partial) |      98.3333% CI | interpret
---------------------------------------------------------
F1        |         0.6181 | [0.0654, 0.8129] |     large
F2        |         0.4770 | [0.0000, 0.7350] |     large
F1:F2     |         0.2229 | [0.0000, 0.5584] |     large
# valor p omnibus necessita de regressão multivariada múltipla

# Função para calcular a matriz SSP para o Fator 1
SSP_fat1 <- function(data) {
  g <- nlevels(data$F1)
  b <- nlevels(data$F2)
  n <- nrow(data) / (g * b)
  p <- ncol(data[, grep("X",colnames(data))])
  
  ssp_matrix <- matrix(0, p, p)
  
  for (i in unique(data$F1)) {
    current_subset <- subset(data, F1 == i)
    mean_diff <- colMeans(current_subset[, grep("X",colnames(data))]) - 
      colMeans(data[, grep("X",colnames(data))])
    ssp_matrix <- ssp_matrix + b * n * (matrix(mean_diff) %*% t(matrix(mean_diff)))
  }
  
  return(ssp_matrix)
}

# Função para calcular a matriz SSP para o Fator 2
SSP_fat2 <- function(data) {
  g <- nlevels(data$F1)
  b <- nlevels(data$F2)
  n <- nrow(data) / (g * b)
  p <- ncol(data[, grep("X",colnames(data))])
  
  ssp_matrix <- matrix(0, p, p)
  
  for (i in unique(data$F2)) {
    current_subset <- subset(data, F2 == i)
    mean_diff <- colMeans(current_subset[, grep("X",colnames(data))]) - 
      colMeans(data[, grep("X",colnames(data))])
    ssp_matrix <- ssp_matrix + g * n * (matrix(mean_diff) %*% t(matrix(mean_diff)))
  }
  
  return(ssp_matrix)
}

# Função para calcular a matriz SSP de Interação
SSP_int <- function(data) {
  g <- nlevels(data$F1)
  b <- nlevels(data$F2)
  n <- nrow(data) / (g * b)
  p <- ncol(data[, grep("X",colnames(data))])
  
  ssp_matrix <- matrix(0, p, p)
  
  for (i in unique(data$F1)) {
    for (j in unique(data$F2)) {
      current_subset <- subset(data, F1 == i & F2 == j)
      mean_diff <- colMeans(current_subset[, grep("X",colnames(data))]) - 
        colMeans(subset(data, F1 == i)[, grep("X",colnames(data))]) - 
        colMeans(subset(data, F2 == j)[, grep("X",colnames(data))]) + 
        colMeans(data[, grep("X",colnames(data))])
      ssp_matrix <- ssp_matrix + n * (matrix(mean_diff) %*% t(matrix(mean_diff)))
    }
  }
  
  return(ssp_matrix)
}

# Função para calcular a matriz SSP Residual
SSP_res <- function(data) {
  g <- nlevels(data$F1)
  b <- nlevels(data$F2)
  n <- nrow(data) / (g * b)
  p <- ncol(data[, grep("X",colnames(data))])
  
  ssp_matrix <- matrix(0, p, p)
  
  for (i in unique(data$F1)) {
    for (j in unique(data$F2)) {
      current_subset <- subset(data, F1 == i & F2 == j)
      mean_diff <- t(as.matrix(current_subset[, grep("X",colnames(data))] - 
                                 matrix(rep(colMeans(current_subset[, grep("X",colnames(data))]), each=nrow(current_subset)), ncol=p)))
      ssp_matrix <- ssp_matrix + (mean_diff %*% t(mean_diff))
    }
  }
  
  return(ssp_matrix)
}

# Agora, vamos calcular cada matriz SSP e reproduzir a tabela
ssp_fat1 <- SSP_fat1(x)
ssp_fat2 <- SSP_fat2(x)
ssp_int <- SSP_int(x)
ssp_res <- SSP_res(x)
ssp_tot <- ssp_fat1 + ssp_fat2 + ssp_int + ssp_res

cat("SSP for Factor 1:\n")
SSP for Factor 1:
print(ssp_fat1, 2)
      [,1]  [,2]  [,3]
[1,]  1.74 -1.50  0.86
[2,] -1.50  1.30 -0.74
[3,]  0.86 -0.74  0.42
cat("\nSSP for Factor 2:\n")

SSP for Factor 2:
print(ssp_fat2, 2)
     [,1] [,2] [,3]
[1,] 0.76 0.68  1.9
[2,] 0.68 0.61  1.7
[3,] 1.93 1.73  4.9
cat("\nSSP for Interaction:\n")

SSP for Interaction:
print(ssp_int, 2)
       [,1]  [,2]  [,3]
[1,] 0.0005 0.017 0.045
[2,] 0.0165 0.545 1.469
[3,] 0.0445 1.469 3.961
cat("\nSSP for Residual:\n")

SSP for Residual:
print(ssp_res, 2)
      X1    X2    X3
X1  1.76  0.02 -3.07
X2  0.02  2.63 -0.55
X3 -3.07 -0.55 64.92
cat("\nSSP for Total:\n") 

SSP for Total:
print(ssp_tot, 2)
      X1    X2    X3
X1  4.27 -0.79 -0.24
X2 -0.79  5.09  1.91
X3 -0.24  1.91 74.21
# Teste de razão de verossimilhança por qui-quadrado aproximado
g <- length(unique(x$F1))
b <- length(unique(x$F2))
n <- nrow(x) / (g*b)
p <- 3
df_fat1 <- (g - 1)*p
df_fat2 <- (b - 1)*p
df_int <- (g - 1) * (b - 1)*p
Lambda_star_int <- det(ssp_res) / det(ssp_int + ssp_res)
X2_int <- -(g*b*(n-1) - (p+1-(g-1)*(b-1))/2) * log(Lambda_star_int)
print(Lambda_star_int, 2)
[1] 0.78
print(X2_int, 3)
[1] 3.66
print(X2Crit_int <- qchisq(1-alfa, df_int), 3)
[1] 7.81
print(p_int <- 1-pchisq(X2_int, df_int), 3)
[1] 0.301
Lambda_star_fat1 <- det(ssp_res) / det(ssp_fat1 + ssp_res)
X2_fat1 <- -(g*b*(n-1) - (p+1-(g-1))/2) * log(Lambda_star_fat1)
print(Lambda_star_fat1,2)
[1] 0.38
print(X2_fat1,4)
[1] 13.96
print(X2Crit_fat1 <- qchisq(1-alfa, df_fat1),3)
[1] 7.81
print(p_fat1 <- 1-pchisq(X2_fat1, df_fat1),2)
[1] 0.003
Lambda_star_fat2 <- det(ssp_res) / det(ssp_fat2 + ssp_res)
X2_fat2 <- -(g*b*(n-1) - (p+1-(b-1))/2) * log(Lambda_star_fat2)
print(Lambda_star_fat2,2)
[1] 0.52
print(X2_fat2,4) 
[1] 9.398
print(X2Crit_fat2 <- qchisq(1-alfa, df_fat2),4)
[1] 7.815
print(p_fat2 <- 1-pchisq(X2_fat2, df_fat2),2)
[1] 0.024
# Formatando a saída para se assemelhar à função car::Anova
output <- data.frame(
  "Wilks Lambda" = c(Lambda_star_fat1, Lambda_star_fat2, Lambda_star_int),
  "Approx X2" = c(X2_fat1, X2_fat2, X2_int),
  "df" = c(df_fat1, df_fat2, df_int),
  "p" = c(p_fat1, p_fat2, p_int),
  stringsAsFactors = FALSE,
  check.names = FALSE)

rownames(output) <- c("Fator 1", "Fator 2", "Interação")
cat("Teste de razão de verossimilhanças por qui-quadrado aproximado\n")
Teste de razão de verossimilhanças por qui-quadrado aproximado
print(output, digits=3)
          Wilks Lambda Approx X2 df       p
Fator 1          0.382     13.96  3 0.00296
Fator 2          0.523      9.40  3 0.02445
Interação        0.777      3.66  3 0.30101
print(anv <- car::Anova(fit, test="Wilks"), digits=3)

Type II MANOVA Tests: Wilks test statistic
      Df test stat approx F num Df den Df Pr(>F)   
F1     1     0.382     7.55      3     14  0.003 **
F2     1     0.523     4.26      3     14  0.025 * 
F1:F2  1     0.777     1.34      3     14  0.302   
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

\(T^2\) de Hotelling generalizada

A distribuição \(T^2\) de Hotelling de Modelo Linear Geral (GLM) multivariado indepedendente em arquivo wide ou GLM multivariado relacionado em arquivo long ou GLM duplamente multivariado (ou “misto” (sem efeito aleatório!)) em arquivo long é necessária para a determinação do valor p omnibus.

  • \(n\): número total de unidades experimentais (UE) do estudo; número de linhas do arquivo wide

  • \(g_i\): número de condições experimentais independentes ou níveis de fator fixo entre participantes \(i=1,2,\ldots,m\)

  • \(n_i\): número de unidades experimentais de condição independente (nível) do fator fixo entre participantes \(i=1,2,\ldots,g_i\)

  • \(p\): número de medidas (measures) intervalares

  • \(q_i\): número de condições experimentais dependentes do fator fixo intra participantes \(i=1,2,\ldots,h\)

  • \(p \prod_{i=1}^{h}{q_i}\): número de variáveis dependentes ou de desfecho (outcome) em arquivo wide; número de colunas com variáveis intervalares observadas em arquivo wide ou número de linhas em arquivo long

GLM multivariado unifatorial relacionado

Para Modelo Linear Geral (GLM) multivariado unifatorial relacionado com \(q \ge2\) condições dependentes, a distribuição \(T^2\) de Hotelling para o teste omnibus é (equivalente ao teste do efeito do fator):

\[ \begin{align} T^2_{k_1,\,k_2}&=k_2\dfrac{k_1}{k_2-k_1+1}F_{k_1,\,k_2-k_1+1} \\ T^2_{df_A,\,k_2}&=k_2\dfrac{df_A}{df_E}F_{df_A,\,df_E} \\ T^2_{p(q-1),\,n-1}&=(n-1)\dfrac{p(q-1)}{n-p(q-1)}F_{p(q-1),\,n-p(q-1)} \end{align} \] Os números de graus de liberdade do numerador e denominador da F são, respectivamente,

\[ df_A=k_1=p(q-1) \]

e

\[ \begin{align} df_E&=k_2-k_1+1\\ &=k_2-df_A+1\\ df_E&=n-1-p(q-1)+1\\ df_E&=n-p(q-1) \end{align} \]

Sendo que \(k_2=n-g=n-1\).

GLM multivariado unifatorial independente

Para Modelo Linear Geral (GLM) multivariado unifatorial independente com \(g\ge2\) grupos, a distribuição \(T^2\) de Hotelling para o teste omnibus é (equivalente ao teste do efeito do fator):

\[ \begin{align} T^2_{k_1,\,k_2}&=k_2\dfrac{k_1}{k_2-k_1+1}F_{k_1,\,k_2-k_1+1} \\ T^2_{df_A,\,k_2}&=k_2\dfrac{df_A}{df_E}F_{df_A,\,df_E} \\ T^2_{p(g-1),\,n-g}&=(n-g)\dfrac{p(g-1)}{n-g-p(g-1)+1}F_{p(g-1),\,n-g-p(g-1)+1} \end{align} \] Os números de graus de liberdade do numerador e denominador da F são, respectivamente,

\[ df_A=k_1=p(g-1) \]

e

\[ \begin{align} df_E&=k_2-k_1+1\\ &=k_2-df_A+1\\ df_E&=n-g-p(g-1)+1 \end{align} \]

Sendo que \(k_2=(n-1)-(g-1)=n-g\).

\(df_A\) quantifica a complexidade do modelo (GLM multivariado) e \(df_E\) quantifica o tamanho de amostra efetivo, sendo que \(n\) é o tamanho de amostra nominal.

Se \(df_E \ge 30\), pode-se recorrer ao Teorema Central do Limite, dispensando-se a suposição de multinormalidade para a validade do teste de hipótese nula omnibus.

Se \(df_E < 30\), pode-se recorrer ao argumento de que a distribuição multinormal em cada condição independente é uma condição suficiente para a validade do teste de hipótese nula omnibus. Nenhum teste estatístico de normalidade multivariada ou univariada é prova de normalidade, sendo possível apenas desprovar a normalidade por meio de teste estatístico. Dessa forma, mesmo em situação de amostra pequena, o teste omnibus pode ser válido.

A aproximação do quantil 95% de \(T^2\) por \(\chi^2\) com tolerância de 5% de diferença relativa ocorre para \(df_E \geq 200\) e \(df_A\le6\).

GLM multivariado bifatorial independente com interação

Para Modelo Linear Geral (GLM) multivariado bifatorial independente com interação (full model) há o método de aproximação-F de Rao para o Lambda de Wilks (Rao, 1951; Boik, 1988; Pham-Gia, 2008). Conforme Boik (1988), o método de Rao é adequado para DM-GLM. Portanto, a aplicação para GLM multivariado independente bifatorial é uma adaptação. Nesse artigo, o método a seguir é aplicável para testar o efeito de interação. Pela simplicidade, sugere-se o uso do teste de razão de verossimilhanças (LRT) com correção de Bartlett (fórmulas 6-65, 6-67 e 6-69).

Compute apenas \(\mathrm{SSP}_E\) e \(\mathrm{SSP}_\tau\), sendo que \(\tau\in{A,B,AB,O}\) é o efeito de interesse.

Daí, \(\Lambda_{\tau}=\det(\mathrm{SSP}_E)/\det(\mathrm{SSP}_E+\mathrm{SSP}_\tau)\) e aplique Rao–F ou Bartlett–χ² com as fórmulas abaixo.

  1. Notação
  • \(p\): número de medidas
  • \(g_1, g_2 \ge 2\): níveis de \(F_1\) e \(F_2\)
  • \(n\): número de unidades experimentais
  • Número de graus de liberdade do efeito em teste:
    • \(h_A=g_1-1\)
    • \(h_B=g_2-1\)
    • \(h_{AB}=(g_1-1)(g_2-1)\)
    • \(h_O=h_A+h_B+h_{AB}=g_1g_2-1\)
    • \(v=n-1-h_O=n-g_1g_2\)
  1. Matrizes SSP
  • \(\mathrm{SSP}_E\) (\(p\times p\)): matriz SSP do erro do modelo completo
  • \(\mathrm{SSP}_A,\ \mathrm{SSP}_B,\ \mathrm{SSP}_{AB}\): SSP do efeito (A, B, AB) obtida pela hipótese linear do termo correspondente
  • Omnibus: \(\mathrm{SSP}_O=\mathrm{SSP}_A+\mathrm{SSP}_B+\mathrm{SSP}_{AB}\).
  1. Lambda de Wilks

\[ \Lambda_\tau=\frac{\det\left(\mathrm{SSP}_E\right)}{\det\left(\mathrm{SSP}_E+\mathrm{SSP}_\tau\right)}\in(0,1] \]

  1. Rao–F (Wilks \(\to F\))

Com \(h_\tau\) do efeito \(\tau\):

\[ t=\sqrt{\frac{p^{2}+h_\tau^{2}-5}{(ph_\tau)^{2}-4}}\quad(\text{se não finito, }t=1),\qquad w=v-\frac{p-h_\tau+1}{2} \] \[ \mathrm{df}_1=ph_\tau,\qquad \mathrm{df}_2=wt+1-\frac{\mathrm{df}_1}{2} \] \[ F_{\tau}={\left(\Lambda_\tau^{-t}-1\right)}\frac{\mathrm{df}_2}{\mathrm{df}_1}, \qquad \text{valor-}p=P\left(F_{\mathrm{df}_1,\mathrm{df}_2}\ge F_{\tau}\right) \]

car::Anova: Df \(=h_\tau\); num Df \(=ph_\tau\); den Df \(=\mathrm{df}_2\); test stat \(=\Lambda_\tau\); approx F \(=F^{\text{Rao}}_{\tau}\).

  1. Bartlett–χ² (Wilks \(\to \chi^{2}\))

\[ X_\tau^{2}=-\left(n-g_1g_2-\frac{p-h_\tau+1}{2}\right)\ln\left(\Lambda_\tau\right) \underset{a}{\sim}\ \chi^{2}_{ph_\tau} \] \[ \text{valor-}p=P\left(\chi^{2}_{ph_\tau}\ge X_\tau^{2}\right) \]

  1. Relação útil (checagem, \(v=n-g_1g_2\) grande)

\[ \frac{h_\tau}{n-g_1g_2-p+1}F_{\tau}\ \approx\ \Lambda_\tau^{-1}-1 \]

suppressMessages(suppressWarnings(
  invisible(Sys.setlocale("LC_ALL", "pt_BR.UTF-8"))))
Dados <- read.table("JW6Data/T6-4.dat", quote="\"", comment.char="") 
alfa <- 0.05 
names(Dados) <- c("F1", "F2", "X1", "X2", "X3") 
Dados$F1 <- factor(Dados$F1) 
Dados$F2 <- factor(Dados$F2)

# Fit MANOVA diretamente nos três desfechos
fit <- lm(cbind(X1, X2, X3) ~ F1*F2, data = Dados)
mf  <- model.frame(fit)
Y   <- model.response(mf)                 # n×p
X   <- model.matrix(fit)                  # n×q
XtX <- crossprod(X)
B   <- solve(XtX, crossprod(X, Y))
E   <- crossprod(residuals(fit))          # SSP_E (p×p)

assign_vec  <- attr(X, "assign")
term_labels <- attr(terms(fit), "term.labels")
get_cols <- function(lbl) which(assign_vec == which(term_labels == lbl))
cols_A  <- get_cols("F1")
cols_B  <- get_cols("F2")
cols_AB <- get_cols("F1:F2")

mk_H <- function(cols){
  g <- length(cols)
  C <- matrix(0, nrow=g, ncol=ncol(X))
  C[cbind(seq_len(g), cols)] <- 1
  Mid <- C %*% solve(XtX) %*% t(C)
  t(C %*% B) %*% solve(Mid) %*% (C %*% B)   # SSP_H (p×p)
}

H_A  <- mk_H(cols_A)
H_B  <- mk_H(cols_B)
H_AB <- mk_H(cols_AB)

logdet <- function(M){ d <- determinant(M, logarithm=TRUE); as.numeric(d$modulus) }
Lambda <- function(H) exp(logdet(E) - logdet(E + H))

lam_A  <- Lambda(H_A)
lam_B  <- Lambda(H_B)
lam_AB <- Lambda(H_AB)
H_O   <- H_A + H_B + H_AB          
lam_O <- Lambda(H_O)

# Df do efeito omnibus
p  <- ncol(Y)
g1 <- nlevels(Dados$F1); g2 <- nlevels(Dados$F2)
n  <- nrow(Dados); v <- n - g1*g2
hA <- g1-1; hB <- g2-1; hAB <- (g1-1)*(g2-1); hO <- g1*g2 - 1

# Rao–Wilks (padrão MANOVA)
rao_one <- function(lam, h){
  t  <- sqrt((p^2*h^2 - 4)/(p^2 + h^2 - 5)); if (!is.finite(t)) t <- 1
  w  <- v - (p - h + 1)/2
  df1 <- p*h
  df2 <- w*t + 1 - df1/2
  F   <- ((1 - lam^(1/t)) / (lam^(1/t))) * (df2/df1)
  pv  <- pf(F, df1=df1, df2=df2, lower.tail=FALSE)
  c(Df=h, `test stat`=lam, `approx F`=F, `num Df`=df1, `den Df`=df2, `Pr(>F)`=pv)
}

tab_Rao <- rbind(
  `F1`   = rao_one(lam_A,  hA),
  `F2`   = rao_one(lam_B,  hB),
  `F1:F2`= rao_one(lam_AB, hAB),
  `F1*F2`= rao_one(lam_O, hO)
)
tab_Rao <- as.data.frame(tab_Rao, check.names=FALSE)

cat("Type II MANOVA Tests: Wilks test statistic — Rao–Wilks\n")
Type II MANOVA Tests: Wilks test statistic — Rao–Wilks
print(tab_Rao, digits=3)
      Df test stat approx F num Df den Df Pr(>F)
F1     1     0.463     5.42      3   14.0 0.0110
F2     1     0.813     1.07      3   14.0 0.3931
F1:F2  1     0.777     1.34      3   14.0 0.3018
F1*F2  3     0.320     2.27      9   34.2 0.0406
# Bartlett (χ²) para Wilks
bartlett_one <- function(lam, h){
  cfac <- v - (p - h + 1)/2             # fator de Bartlett
  X2   <- - cfac * log(lam)             # estatística χ^2
  df   <- p * h
  pv   <- pchisq(X2, df=df, lower.tail=FALSE)
  c(Df=h, `test stat`=lam, `approx chi^2`=X2, `df(chi^2)`=df, `Pr(>chi^2)`=pv)
}

tab_Bart <- rbind(
  `F1`   = bartlett_one(lam_A,  hA),
  `F2`   = bartlett_one(lam_B,  hB),
  `F1:F2`= bartlett_one(lam_AB, hAB),
  `F1*F2`= bartlett_one(lam_O, hO)
)
tab_Bart <- as.data.frame(tab_Bart, check.names=FALSE)

cat("\nType II MANOVA Tests: Wilks test statistic — Bartlett (chi^2)\n")

Type II MANOVA Tests: Wilks test statistic — Bartlett (chi^2)
print(tab_Bart, digits=3)
      Df test stat approx chi^2 df(chi^2) Pr(>chi^2)
F1     1     0.463        11.17         3     0.0108
F2     1     0.813         3.00         3     0.3924
F1:F2  1     0.777         3.66         3     0.3010
F1*F2  3     0.320        17.67         9     0.0392
print(car::Anova(fit, test="Wilks"), digits=4)

Type II MANOVA Tests: Wilks test statistic
      Df test stat approx F num Df den Df  Pr(>F)   
F1     1    0.3819    7.554      3     14 0.00303 **
F2     1    0.5230    4.256      3     14 0.02475 * 
F1:F2  1    0.7771    1.339      3     14 0.30178   
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

GLM multivariado duplamente multivariado ou misto

Para GLM multivariado duplamente multivariado ou misto (sem efeito aleatório) (Doubly Multivariate General Linear Model (DM-GLM) (com medidas repetidas) ou Mixed MANOVA Model) com efeito de interação, sendo que \(g\ge2\) e \(q\ge2\) são condições independentes e dependentes, respectivamente, a distribuição \(T^2\) de Hotelling para o teste do efeito de interação é desconhecida.

  • Livros sobre DM-GLM
    • Muller, KE & Stewart, PW (2006) Linear model theory: Univariate, multivariate, and mixed models. NJ: Wiley.
      • Chapter 17: Tests for Generalizations of Multivariate Linear Models: 17.2 DOUBLY MULTIVARIATE MODELS (Superficial!)
  • Artigos sobre DM-GLM:
    • Pham-Gia, T (2008) Exact distribution of the generalized Wilks’s statistic and applications. Journal of Multivariate Analysis 99(8): 1698-716.
    • Boik, RJ (1988) The mixed model for multivariate repeated measures: Validity conditions and an approximate test. Psychometrika 53(4): 469–86. https://doi.org/10.1007/BF02294401
    • Opheim, T & Roy, A (2021) Doubly multivariate linear models with block exchangeable distributed errors and site-dependent covariates. Journal of Applied Statistics 49(14): 3659–76. https://doi.org/10.1080/02664763.2021.1959529
    • Krzyśko, M et al. (2014) Analysis of multivariate repeated measures data using a MANOVA model and principal components. Biometrical Letters 51(2): 85–96. https://doi.org/10.2478/bile-2014-0008
    • Friendly, M. (2010). HE plots for repeated measures designs. Journal of Statistical Software, 37(4), 1–40. https://doi.org/10.18637/jss.v037.i04

Exemplo: MANOVA.RM::multRM

library(MANOVA.RM)
Dados <- MANOVA.RM::EEG
eeg <- tidyr::spread(EEG, feature, resp)
print(head(eeg), digits=2)
  sex age diagnosis   region  id brainrate complexity
1   M   0        AD  central  65      -1.1      -1.26
2   M   0        AD  central 155      -2.0      -2.87
3   M   0        AD  frontal  65      -1.3      -2.56
4   M   0        AD  frontal 155      -1.6      -0.78
5   M   0        AD temporal  65      -1.1      -1.25
6   M   0        AD temporal 155      -2.1      -2.89
print(tail(eeg), digits=2)
    sex age diagnosis   region  id brainrate complexity
475   W   1       SCC temporal 123      0.87      0.056
476   W   1       SCC temporal 131      0.32      0.698
477   W   1       SCC temporal 132      1.21      1.073
478   W   1       SCC temporal 133     -0.26      0.265
479   W   1       SCC temporal 135     -0.69      0.343
480   W   1       SCC temporal 147     -1.17      0.740
B <- 1e4
fitRM <- MANOVA.RM::multRM(cbind(brainrate, complexity) ~ sex * region,
                         data=eeg,
                         subject="id",
                         within="region",
                         iter=B)
print(summary(fitRM))
Call: 
cbind(brainrate, complexity) ~ sex * region
A multivariate repeated measures analysis with  1 within-subject factor(s) ( region )and  1 between-subject factor(s). 

Descriptive:
  sex   region   n brainrate  complexity
1   M  central  59    -0.254      -0.302
2   M  frontal  59    -0.335      -0.399
3   M temporal  59    -0.294      -0.386
4   W  central 101     0.149       0.176
5   W  frontal 101     0.195       0.233
6   W temporal 101     0.172       0.226

Wald-Type Statistic (WTS):
           Test statistic df  p-value
sex        "12.45"        "2" "0.002"
region     "0.192"        "4" "0.996"
sex:region "2.79"         "4" "0.593"

modified ANOVA-Type Statistic (MATS):
           Test statistic
sex                54.203
region              0.048
sex:region          0.703

p-values resampling:
           paramBS (WTS) paramBS (MATS)
sex        "0.003"       "0.001"       
region     "0.996"       "0.988"       
sex:region "0.609"       "0.432"       
           paramBS (WTS) paramBS (MATS)
sex        "0.003"       "0.001"       
region     "0.996"       "0.988"       
sex:region "0.609"       "0.432"       
fit <- lm(cbind(brainrate, complexity) ~ sex * region + id,
                data=eeg)
print(car::Anova(fit),  digits=3)
Warning in cbind(x$df, tests, pf(tests[ok, 2], tests[ok, 3], tests[ok, 4], :
number of rows of result is not a multiple of vector length (arg 3)

Type II MANOVA Tests: Pillai test statistic
           Df test stat approx F num Df den Df  Pr(>F)    
sex         1    0.0791    20.27      2    472 3.6e-09 ***
region      2    0.0000     0.00      4    946 1.1e-06 ***
id          1    0.0564    14.10      2    472    0.96    
sex:region  2    0.0014     0.17      4    946 3.6e-09 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
alfa <- 0.05
print(effectsize::eta_squared(fit,
                              partial=TRUE,
                              ci = 1-alfa/8,
                              alternative = "two.sided"), 
      digits=4)
# Effect Size for ANOVA (Type I)

Response   |  Parameter | Eta2 (partial) |       99.375% CI
-----------------------------------------------------------
brainrate  |        sex |         0.0523 | [0.0114, 0.1160]
brainrate  |     region |     1.4160e-31 | [0.0000, 0.0000]
brainrate  |         id |         0.0270 | [0.0016, 0.0791]
brainrate  | sex:region |         0.0007 | [0.0000, 0.0174]
complexity |        sex |         0.0773 | [0.0252, 0.1485]
complexity |     region |     6.2436e-31 | [0.0000, 0.0000]
complexity |         id |     5.3705e-06 | [0.0000, 0.0000]
complexity | sex:region |         0.0012 | [0.0000, 0.0205]
sm <- summary(fit)
print(sm, digits=3)
Response brainrate :

Call:
lm(formula = brainrate ~ sex * region + id, data = eeg)

Residuals:
   Min     1Q Median     3Q    Max 
-3.512 -0.582  0.039  0.726  3.735 

Coefficients:
                     Estimate Std. Error t value Pr(>|t|)    
(Intercept)          0.012068   0.145542    0.08  0.93395    
sexW                 0.422168   0.158162    2.67  0.00786 ** 
regionfrontal       -0.080174   0.177614   -0.45  0.65191    
regiontemporal      -0.039491   0.177614   -0.22  0.82415    
id                  -0.003460   0.000955   -3.62  0.00032 ***
sexW:regionfrontal   0.127008   0.223551    0.57  0.57021    
sexW:regiontemporal  0.062559   0.223551    0.28  0.77972    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.965 on 473 degrees of freedom
Multiple R-squared:  0.0772,    Adjusted R-squared:  0.0655 
F-statistic: 6.59 on 6 and 473 DF,  p-value: 1.05e-06


Response complexity :

Call:
lm(formula = complexity ~ sex * region + id, data = eeg)

Residuals:
   Min     1Q Median     3Q    Max 
-8.306 -0.289  0.202  0.559  2.178 

Coefficients:
                     Estimate Std. Error t value Pr(>|t|)   
(Intercept)         -3.06e-01   1.45e-01   -2.10   0.0361 * 
sexW                 4.78e-01   1.58e-01    3.02   0.0026 **
regionfrontal       -9.67e-02   1.78e-01   -0.54   0.5862   
regiontemporal      -8.44e-02   1.78e-01   -0.48   0.6346   
id                   4.81e-05   9.54e-04    0.05   0.9598   
sexW:regionfrontal   1.53e-01   2.23e-01    0.69   0.4933   
sexW:regiontemporal  1.34e-01   2.23e-01    0.60   0.5498   
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.964 on 473 degrees of freedom
Multiple R-squared:  0.0783,    Adjusted R-squared:  0.0666 
F-statistic: 6.69 on 6 and 473 DF,  p-value: 8.17e-07
print(smm <- summary(car::Anova(fit), 
                     univariate=FALSE, 
                     multivariate=TRUE), digits=4) 

Type II MANOVA Tests:

Sum of squares and products for error:
           brainrate complexity
brainrate      440.2      319.1
complexity     319.1      439.7

------------------------------------------
 
Term: sex 

Sum of squares and products for the hypothesis:
           brainrate complexity
brainrate      26.23      31.01
complexity     31.01      36.65

Multivariate Tests: sex
                 Df test stat approx F num Df den Df   Pr(>F)    
Pillai            1    0.0791    20.27      2    472 3.57e-09 ***
Wilks             1    0.9209    20.27      2    472 3.57e-09 ***
Hotelling-Lawley  1    0.0859    20.27      2    472 3.57e-09 ***
Roy               1    0.0859    20.27      2    472 3.57e-09 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

------------------------------------------
 
Term: region 

Sum of squares and products for the hypothesis:
           brainrate complexity
brainrate  -1.11e-16 -1.665e-16
complexity  0.00e+00 -1.110e-16

Multivariate Tests: region
                 Df test stat   approx F num Df den Df Pr(>F)
Pillai            2         0 -5.742e-17      4    946      1
Wilks             2         1  0.000e+00      4    944      1
Hotelling-Lawley  2         0 -5.718e-17      4    942      1
Roy               2         0 -5.742e-17      2    473      1

------------------------------------------
 
Term: id 

Sum of squares and products for the hypothesis:
           brainrate complexity
brainrate    12.2205  -0.169870
complexity   -0.1699   0.002361

Multivariate Tests: id
                 Df test stat approx F num Df den Df   Pr(>F)    
Pillai            1    0.0564     14.1      2    472 1.12e-06 ***
Wilks             1    0.9436     14.1      2    472 1.12e-06 ***
Hotelling-Lawley  1    0.0598     14.1      2    472 1.12e-06 ***
Roy               1    0.0598     14.1      2    472 1.12e-06 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

------------------------------------------
 
Term: sex:region 

Sum of squares and products for the hypothesis:
           brainrate complexity
brainrate     0.3004     0.3609
complexity    0.3609     0.5180

Multivariate Tests: sex:region
                 Df test stat approx F num Df den Df Pr(>F)
Pillai            2    0.0014   0.1672      4    946  0.955
Wilks             2    0.9986   0.1669      4    944  0.955
Hotelling-Lawley  2    0.0014   0.1666      4    942  0.955
Roy               2    0.0012   0.2792      2    473  0.756
print(smm$SSPE, digits=4)
           brainrate complexity
brainrate      440.2      319.1
complexity     319.1      439.7
print(smm$multivariate.tests$`sex:region`, digits=4)

Sum of squares and products for the hypothesis:
           brainrate complexity
brainrate     0.3004     0.3609
complexity    0.3609     0.5180

Sum of squares and products for error:
           brainrate complexity
brainrate      440.2      319.1
complexity     319.1      439.7

Multivariate Tests: sex:region
                 Df test stat approx F num Df den Df Pr(>F)
Pillai            2    0.0014   0.1672      4    946  0.955
Wilks             2    0.9986   0.1669      4    944  0.955
Hotelling-Lawley  2    0.0014   0.1666      4    942  0.955
Roy               2    0.0012   0.2792      2    473  0.756
print(smm$multivariate.tests$sex, digits=4)

Sum of squares and products for the hypothesis:
           brainrate complexity
brainrate      26.23      31.01
complexity     31.01      36.65

Sum of squares and products for error:
           brainrate complexity
brainrate      440.2      319.1
complexity     319.1      439.7

Multivariate Tests: sex
                 Df test stat approx F num Df den Df   Pr(>F)    
Pillai            1    0.0791    20.27      2    472 3.57e-09 ***
Wilks             1    0.9209    20.27      2    472 3.57e-09 ***
Hotelling-Lawley  1    0.0859    20.27      2    472 3.57e-09 ***
Roy               1    0.0859    20.27      2    472 3.57e-09 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
print(smm$multivariate.tests$region, digits=4)

Sum of squares and products for the hypothesis:
           brainrate complexity
brainrate  -1.11e-16 -1.665e-16
complexity  0.00e+00 -1.110e-16

Sum of squares and products for error:
           brainrate complexity
brainrate      440.2      319.1
complexity     319.1      439.7

Multivariate Tests: region
                 Df test stat   approx F num Df den Df Pr(>F)
Pillai            2         0 -5.742e-17      4    946      1
Wilks             2         1  0.000e+00      4    944      1
Hotelling-Lawley  2         0 -5.718e-17      4    942      1
Roy               2         0 -5.742e-17      2    473      1
print(summary.aov(fit), digits=4)
 Response brainrate :
             Df Sum Sq Mean Sq F value   Pr(>F)    
sex           1   24.3  24.291  26.101 4.71e-07 ***
region        2    0.0   0.000   0.000 1.000000    
id            1   12.2  12.220  13.131 0.000322 ***
sex:region    2    0.3   0.150   0.161 0.850997    
Residuals   473  440.2   0.931                     
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

 Response complexity :
             Df Sum Sq Mean Sq F value   Pr(>F)    
sex           1   36.8   36.81  39.599 7.12e-10 ***
region        2    0.0    0.00   0.000    1.000    
id            1    0.0    0.00   0.003    0.960    
sex:region    2    0.5    0.26   0.279    0.757    
Residuals   473  439.7    0.93                     
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
print(summary(car::Anova(fit), 
              univariate=TRUE, 
              multivariate=FALSE,
              p.adjust.method=TRUE), digits=2)

 Type II Sums of Squares
            df   brainrate  complexity
sex          1  2.6233e+01  3.6653e+01
region       2 -1.1102e-16 -1.1102e-16
id           1  1.2220e+01  2.3613e-03
sex:region   2  3.0041e-01  5.1796e-01
residuals  473  4.4019e+02  4.3967e+02

 F-tests
           brainrate complexity
sex            28.19      19.72
region          0.00       0.00
id             13.13       0.00
sex:region      0.32       0.28

 p-values
           brainrate  complexity
sex        1.6960e-07 5.9682e-09
region     1.00000000 1.00000000
id         0.00032184 0.99873069
sex:region 0.57019736 0.75695628

 p-values adjusted (by term) for simultaneous inference by holm method
           brainrate  complexity
sex        1.6960e-07 1.1936e-08
region     1.00000000 1.00000000
id         0.00064369 0.99873069
sex:region 1.00000000 1.00000000

Exemplo: carData::OBrienKaiser

# a multivariate linear model for repeated-measures data
## See ?OBrienKaiser for a description of the data set used in this example.

phase <- factor(rep(c("pretest", "posttest", "followup"), c(5, 5, 5)),
                levels=c("pretest", "posttest", "followup"))
hour <- ordered(rep(1:5, 3))
idata <- data.frame(phase, hour)
idata
# A tibble: 15 × 2
   phase    hour 
   <fct>    <ord>
 1 pretest  1    
 2 pretest  2    
 3 pretest  3    
 4 pretest  4    
 5 pretest  5    
 6 posttest 1    
 7 posttest 2    
 8 posttest 3    
 9 posttest 4    
10 posttest 5    
11 followup 1    
12 followup 2    
13 followup 3    
14 followup 4    
15 followup 5    
mod.ok <- lm(cbind(pre.1, pre.2, pre.3, pre.4, pre.5,
                   post.1, post.2, post.3, post.4, post.5,
                   fup.1, fup.2, fup.3, fup.4, fup.5) ~  treatment*gender,
             data=carData::OBrienKaiser)
(av.ok <- car::Anova(mod.ok, idata=idata, idesign=~phase*hour))

Type II Repeated Measures MANOVA Tests: Pillai test statistic
                            Df test stat approx F num Df den Df    Pr(>F)    
(Intercept)                  1   0.96954   318.34      1     10 6.532e-09 ***
treatment                    2   0.48092     4.63      2     10 0.0376868 *  
gender                       1   0.20356     2.56      1     10 0.1409735    
treatment:gender             2   0.36350     2.86      2     10 0.1044692    
phase                        1   0.85052    25.61      2      9 0.0001930 ***
treatment:phase              2   0.68518     2.61      4     20 0.0667354 .  
gender:phase                 1   0.04314     0.20      2      9 0.8199968    
treatment:gender:phase       2   0.31060     0.92      4     20 0.4721498    
hour                         1   0.93468    25.04      4      7 0.0003043 ***
treatment:hour               2   0.30144     0.35      8     16 0.9295212    
gender:hour                  1   0.29274     0.72      4      7 0.6023742    
treatment:gender:hour        2   0.57022     0.80      8     16 0.6131884    
phase:hour                   1   0.54958     0.46      8      3 0.8324517    
treatment:phase:hour         2   0.66367     0.25     16      8 0.9914415    
gender:phase:hour            1   0.69505     0.85      8      3 0.6202076    
treatment:gender:phase:hour  2   0.79277     0.33     16      8 0.9723693    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
summary(av.ok, multivariate=FALSE)

Univariate Type II Repeated-Measures ANOVA Assuming Sphericity

                            Sum Sq num Df Error SS den Df  F value    Pr(>F)
(Intercept)                 7260.0      1  228.056     10 318.3435 6.532e-09
treatment                    211.3      2  228.056     10   4.6323  0.037687
gender                        58.3      1  228.056     10   2.5558  0.140974
treatment:gender             130.2      2  228.056     10   2.8555  0.104469
phase                        167.5      2   80.278     20  20.8651 1.274e-05
treatment:phase               78.7      4   80.278     20   4.8997  0.006426
gender:phase                   1.7      2   80.278     20   0.2078  0.814130
treatment:gender:phase        10.2      4   80.278     20   0.6366  0.642369
hour                         106.3      4   62.500     40  17.0067 3.191e-08
treatment:hour                 1.2      8   62.500     40   0.0929  0.999257
gender:hour                    2.6      4   62.500     40   0.4094  0.800772
treatment:gender:hour          7.8      8   62.500     40   0.6204  0.755484
phase:hour                    11.1      8   96.167     80   1.1525  0.338317
treatment:phase:hour           6.3     16   96.167     80   0.3256  0.992814
gender:phase:hour              6.6      8   96.167     80   0.6900  0.699124
treatment:gender:phase:hour   14.2     16   96.167     80   0.7359  0.749562
                               
(Intercept)                 ***
treatment                   *  
gender                         
treatment:gender               
phase                       ***
treatment:phase             ** 
gender:phase                   
treatment:gender:phase         
hour                        ***
treatment:hour                 
gender:hour                    
treatment:gender:hour          
phase:hour                     
treatment:phase:hour           
gender:phase:hour              
treatment:gender:phase:hour    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1


Mauchly Tests for Sphericity

                            Test statistic p-value
phase                              0.74927 0.27282
treatment:phase                    0.74927 0.27282
gender:phase                       0.74927 0.27282
treatment:gender:phase             0.74927 0.27282
hour                               0.06607 0.00760
treatment:hour                     0.06607 0.00760
gender:hour                        0.06607 0.00760
treatment:gender:hour              0.06607 0.00760
phase:hour                         0.00478 0.44939
treatment:phase:hour               0.00478 0.44939
gender:phase:hour                  0.00478 0.44939
treatment:gender:phase:hour        0.00478 0.44939


Greenhouse-Geisser and Huynh-Feldt Corrections
 for Departure from Sphericity

                             GG eps Pr(>F[GG])    
phase                       0.79953  7.323e-05 ***
treatment:phase             0.79953    0.01223 *  
gender:phase                0.79953    0.76616    
treatment:gender:phase      0.79953    0.61162    
hour                        0.46028  8.741e-05 ***
treatment:hour              0.46028    0.97879    
gender:hour                 0.46028    0.65346    
treatment:gender:hour       0.46028    0.64136    
phase:hour                  0.44950    0.34573    
treatment:phase:hour        0.44950    0.94019    
gender:phase:hour           0.44950    0.58903    
treatment:gender:phase:hour 0.44950    0.64634    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

                               HF eps   Pr(>F[HF])
phase                       0.9278594 2.387543e-05
treatment:phase             0.9278594 8.089765e-03
gender:phase                0.9278594 7.984495e-01
treatment:gender:phase      0.9278594 6.319975e-01
hour                        0.5592802 2.014357e-05
treatment:hour              0.5592802 9.887716e-01
gender:hour                 0.5592802 6.911521e-01
treatment:gender:hour       0.5592802 6.692976e-01
phase:hour                  0.7330608 3.440460e-01
treatment:phase:hour        0.7330608 9.804731e-01
gender:phase:hour           0.7330608 6.552382e-01
treatment:gender:phase:hour 0.7330608 7.080122e-01
## A "doubly multivariate" design with two  distinct repeated-measures variables
## (example courtesy of Michael Friendly)
## See ?WeightLoss for a description of the dataset.

imatrix <- matrix(c(
  1,0,-1, 1, 0, 0,
  1,0, 0,-2, 0, 0,
  1,0, 1, 1, 0, 0,
  0,1, 0, 0,-1, 1,
  0,1, 0, 0, 0,-2,
  0,1, 0, 0, 1, 1), 6, 6, byrow=TRUE)
colnames(imatrix) <- c("WL", "SE", "WL.L", "WL.Q", "SE.L", "SE.Q")
rownames(imatrix) <- colnames(carData::WeightLoss)[-1]
(imatrix <- list(measure=imatrix[,1:2], month=imatrix[,3:6]))
$measure
    WL SE
wl1  1  0
wl2  1  0
wl3  1  0
se1  0  1
se2  0  1
se3  0  1

$month
    WL.L WL.Q SE.L SE.Q
wl1   -1    1    0    0
wl2    0   -2    0    0
wl3    1    1    0    0
se1    0    0   -1    1
se2    0    0    0   -2
se3    0    0    1    1
(wl.mod<-lm(cbind(wl1, wl2, wl3, se1, se2, se3)~group, data=carData::WeightLoss))

Call:
lm(formula = cbind(wl1, wl2, wl3, se1, se2, se3) ~ group, data = carData::WeightLoss)

Coefficients:
             wl1       wl2       wl3       se1       se2       se3     
(Intercept)   5.34444   4.45000   2.17778  14.92778  13.79444  16.28333
group1        0.42222   0.55833   0.04722   0.08889  -0.26944   0.60000
group2        0.43333   1.09167  -0.02500   0.18333  -0.22500   0.71667
car::Anova(wl.mod, imatrix=imatrix, test="Roy")

Type II Repeated Measures MANOVA Tests: Roy test statistic
              Df test stat approx F num Df den Df    Pr(>F)    
measure        1    86.203  1293.04      2     30 < 2.2e-16 ***
group:measure  2     0.356     5.52      2     31  0.008906 ** 
month          1     9.407    65.85      4     28 7.807e-14 ***
group:month    2     1.772    12.84      4     29 3.909e-06 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Análise de Perfil

A análise de perfil refere-se a situações nas quais um conjunto de \(p\) tratamentos (testes, itens etc.) é administrado a dois ou mais grupos de unidades experimentais. Assume-se que as respostas para os diferentes grupos são independentes entre si. Normalmente, poderíamos nos perguntar: os vetores de média da população são os mesmos? Na análise de perfil, a questão da igualdade dos vetores de média é dividida em algumas possibilidades específicas.

Figura 6.4 O perfil populacional para p = 4.

Figura 6.4 O perfil populacional para p = 4.

Considere as médias populacionais \(\boldsymbol{\mu}_1 = [\mu_{11}\; \mu_{12}\; \mu_{13}\; \mu_{14}]^{\prime}\) representando as respostas médias a quatro tratamentos para o primeiro grupo. Um gráfico dessas médias, conectado por linhas retas, é mostrado na Figura 6.4. Este gráfico de linhas quebradas é o perfil para a população 1. Perfis podem ser construídos para cada população (grupo). Concentraremos a discussão em dois grupos.

Seja \(\boldsymbol{\mu}_1 = [\mu_{11}\; \mu_{12}\; \cdots, \;\mu_{1p}]^{\prime}\) e \(\boldsymbol{\mu}_2 = [\mu_{21}\; \mu_{22}\;\cdots\; \mu_{2p}]^{\prime}\) serem as respostas médias para os \(p\) tratamentos para as populações 1 e 2, respectivamente. A hipótese nula \(H_0: \boldsymbol{\mu}_1 = \boldsymbol{\mu}_2\) implica que os tratamentos têm o mesmo efeito nas duas populações. Em termos dos perfis da população, podemos formular a questão da igualdade de uma forma passo a passo.

  1. Os perfis são paralelos?

Equivalentemente:

\[ H_{0}^1: \mu_{1i} - \mu_{1(i-1)} = \mu_{2i} - \mu_{2(i-1)}\\ i = 2, 3, \ldots, p \]

  1. Supondo que os perfis sejam paralelos, os perfis são coincidentes?

Equivalentemente:

\[ H_{0}^2: \mu_{1i} = \mu_{2i}\\ i = 1, 2, \ldots, p \]

A questão “Supondo que os perfis sejam paralelos, os perfis são lineares?” é considerada no Exercício 6.12. A hipótese nula de perfis lineares paralelos pode ser escrita como:

\[ H_{0}: (\mu_{1i} + \mu_{2i}) - \left(\mu_{1(i-1)} + \mu_{2(i-1)}\right)= \left(\mu_{1(i-1)} + \mu_{2(i-1)}\right) - \left(\mu_{1(i-2)} + \mu_{2(i-2)}\right)\\ i = 3,\ldots, p \]

Embora essa hipótese possa ser de interesse em uma situação particular, na prática, a questão de saber se dois perfis paralelos são os mesmos (coincidentes), seja qual for sua natureza, geralmente é de maior interesse.

  1. Supondo que os perfis sejam coincidentes, os perfis são nivelados? Ou seja, todas as médias são iguais à mesma constante?

Equivalentemente:

\[ H_{0}^3: \mu_{11} = \mu_{12} = \cdots = \mu_{1p} = \mu_{21} = \mu_{22} = \cdots = \mu_{2p} \]

Observação: O teste de paralelismo não exige que os itens intervalares tenha a mesma unidade de medida e que os itens ordinais tenha o mesmo número de níveis. No entanto, os testes de linearidade com ou sem inclinação exigem os itens intervalares tenha a mesma unidade de medida e que os itens ordinais tenha o mesmo número de níveis.

A hipótese nula na etapa 1 pode ser escrita como

\[ H_{0}^1: \mathbf{C}\boldsymbol{\mu}_1 = \mathbf{C}\boldsymbol{\mu}_2 \]

Em que \(\mathbf{C}\) é a matriz de contraste:

\[ \underset{(p-1) \times p}{\mathbf{C}} = \begin{bmatrix} -1 & 1 & 0 & 0 & \cdots & 0 & 0 \\ 0 & -1 & 1 & 0 & \cdots & 0 & 0 \\ \vdots & \vdots & \vdots & \vdots & \ddots & \vdots & \vdots \\ 0 & 0 & 0 & 0 & \cdots & -1 & 1 \\ \end{bmatrix} \tag{6-72} \]

Para condicões independentes de tamanhos \(n_1\) e \(n_2\) das duas populações, a hipótese nula pode ser testada construindo as observações transformadas:

\[ \mathbf{C}\mathbf{X}_{1i} \quad i=1,2,\ldots,n_1 \]

e

\[ \mathbf{C}\mathbf{X}_{2j} \quad j=1,2,\ldots,n_2 \]

Estes têm vetores de média \(\mathbf{C}\overline{\mathbf{X}}_1\sim\mathcal{N}_{p-1}\left(\mathbf{C}\boldsymbol{\mu}_1, \mathbf{C}\boldsymbol{\Sigma}\mathbf{C}^{\prime}\right)\) e \(\mathbf{C}\overline{\mathbf{X}}_2\sim\mathcal{N}_{p-1}\left(\mathbf{C}\boldsymbol{\mu}_2, \mathbf{C}\boldsymbol{\Sigma}\mathbf{C}^{\prime}\right)\), respectivamente, e matriz de covariância agrupada \(\mathbf{C}\mathbf{S}_{\text{comb}}\mathbf{C}^{\prime}\).

Uma aplicação do Resultado 6.2 fornece um teste para perfis paralelos.

Teste de Perfis Paralelos para Duas Populações Normais

Rejeite \(H_{0}^1: \mathbf{C}\boldsymbol{\mu}_1 = \mathbf{C}\boldsymbol{\mu}_2\) (perfis paralelos) no nível \(\alpha\) se:

\[ T^2 = \left(\mathbf{C}\left(\bar{\mathbf{x}}_1 - \bar{\mathbf{x}}_2\right)\right)^{\prime}\left(\left(\dfrac{1}{{n_1}} + \dfrac{1}{{n_2}}\right)\mathbf{C}\mathbf{s}_{\text{comb}}\mathbf{C}^{\prime}\right)^{-1}\mathbf{C}\left(\bar{\mathbf{x}}_1 - \bar{\mathbf{x}}_2\right) >c^2 \tag{6-73} \]

em que

\[ c^2= \dfrac{{(n_1 + n_2 - 2)(p - 1)}}{{n_1 + n_2 - p}}F_{p-1, n_1+n_2-p}(1-\alpha)=T^2_{p-1, n_1+n_2-2}(1-\alpha) \]

Quando os perfis são paralelos, o primeiro está acima do segundo (\(\mu_{1i} > \mu_{2i}\) para todo \(i\)) ou vice-versa. Sob esta condição, os perfis serão coincidentes apenas se as alturas totais \(\sum_{i=1}^{p}{\mu_{1i}}= \mathbf{1}^{\prime}\boldsymbol{\mu}_1\) e \(\sum_{i=1}^{p}{\mu_{2i}} = \mathbf{1}^{\prime}\boldsymbol{\mu}_2\) forem iguais. Portanto, a hipótese nula na etapa 2 pode ser escrita na forma equivalente:

\[ H_{0}^2: \mathbf{1}^{\prime}\boldsymbol{\mu}_1 = \mathbf{1}^{\prime}\boldsymbol{\mu}_2 \]

Podemos então testar \(H_{0}^2\) com a usual estatística t com base nas observações univariadas \(\mathbf{1}^{\prime}\mathbf{x}_{1i}\), \(i = 1, 2, \ldots, n_1\) e \(\mathbf{1}^{\prime}\mathbf{x}_{2j}\), \(j = 1, 2, \ldots, n_2\).

Teste para Perfis Coincidentes se os Perfis São Paralelos

Para duas populações normais, rejeite \(H_{0}^2: \boldsymbol{1}^{\prime}\boldsymbol{\mu}_1 = \boldsymbol{1}^{\prime}\boldsymbol{\mu}_2\) (perfis coincidentes) no nível \(\alpha\) se:

\[ T^2 = \boldsymbol{1}^{\prime}(\bar{\mathbf{x}}_1 - \bar{\mathbf{x}}_2)\left(\left(\dfrac{1}{{n_1}} + \dfrac{1}{{n_2}}\right)\boldsymbol{1}^{\prime}\mathbf{s}_{\text{comb}}\boldsymbol{1}\right)\boldsymbol{1}^{\prime}(\bar{\mathbf{x}}_1 - \bar{\mathbf{x}}_2)>c^2 \tag{6-74} \]

\[ c^2=F_{1,n_1+n_2-2}(1-\alpha)=T^2_{1, n_1+n_2-2}(1-\alpha)=t^{2}_{n_1+n_2-2}\left(1-\frac{\alpha}{2}\right) \]

Para perfis coincidentes, \(\mathbf{x}_{11}, \mathbf{x}_{12}, \ldots, \mathbf{x}_{1n_1}\) e \(\mathbf{x}_{21}, \mathbf{x}_{22}, \ldots, \mathbf{x}_{2n_2}\) são todas observações da mesma população normal. O próximo passo é verificar se todas as variáveis têm a mesma média, de modo que o perfil comum seja nivelado.

Quando \(H_{0}^1\) e \(H_{0}^2\) são não rejeitáveis, o vetor de média comum é estimado, usando todas as observações \(n_{1} + n_{2}\), por:

\[ \bar{\mathbf{x}} = \dfrac{{n_1 \bar{\mathbf{x}}_1 + n_2 \bar{\mathbf{x}}_2}}{{n_1 + n_2}} \]

Se o perfil comum é nivelado, então \(\mu_1 = \mu_2 = \cdots = \mu_p\), e a hipótese nula na etapa 3 pode ser escrita como:

\[ H_{0}^3: \mathbf{C}\boldsymbol{\mu} = \mathbf{0} \]

em que \(\mathbf{C}\) é dado por (6-72). Consequentemente, temos o seguinte teste.

Teste para Perfis Nivelados Se os Perfis São Coincidentes

Para duas populações normais, rejeite \(H_{0}^3: \mathbf{C}\boldsymbol{\mu} = \mathbf{0}\) (perfis nivelados) no nível \(\alpha\) se:

\[ T^2 = (n_1 + n_2)\,\left(\mathbf{C}\bar{\mathbf{x}}\right)^{\prime}\left(\mathbf{C}\mathbf{s}\mathbf{C}^{\prime}\right)^{-1}\mathbf{C}\bar{\mathbf{x}} > c^2 \tag{6-75} \]

em que \(\mathbf{s}\) é a matriz de covariância amostral baseada em todas as observações \(n_1 + n_2\), e:

\[ c^2 = \dfrac{{(n_1 + n_2 - 2)(p - 1)}}{{n_1 + n_2 - p}}F_{p-1, n_1+n_2-p+1}(1-\alpha)=T^2_{p-1, n_1+n_2-1}(1-\alpha) \]

Exemplo 6.14: Uma análise de perfil de dados sobre amor e casamento

Como parte de um estudo mais amplo sobre amor e casamento, E. Hatfield, um sociólogo, entrevistou homens e mulheres recém-casados. Eles foram convidados a responder às seguintes perguntas:

  1. Qual é o nível de amor apaixonado que você sente pelo seu parceiro(a)?
  2. Qual é o nível de amor apaixonado que o seu parceiro(a) sente por você?
  3. Qual é o nível de amor companheiro que você sente pelo seu parceiro(a)?
  4. Qual é o nível de amor companheiro que o seu parceiro(a) sente por você?

Os níveis dos quatro itens Likert de cinco pontos são:

  1. Nada
  2. Pouco
  3. Algum
  4. Muito
  5. Enorme
suppressMessages(suppressWarnings(
  invisible(Sys.setlocale("LC_ALL", "pt_BR.UTF-8"))))
# profileR::spouse
x <- read.table("JW6Data/T6-14.dat", quote="\"", comment.char="")
alfa <- 0.05
names(x) <- c("X1", "X2", "X3", "X4", "Grupo")
x$Grupo <- factor(x$Grupo)
print(car::some(x))
   X1 X2 X3 X4   Grupo
1   2  3  5  5 Husband
10  4  4  3  3 Husband
11  4  4  5  5 Husband
20  4  4  4  4 Husband
23  3  4  5  5 Husband
24  5  3  5  5 Husband
38  3  4  5  5    Wife
48  4  5  4  4    Wife
50  5  3  4  4    Wife
58  3  4  4  4    Wife
print(xtabs(~Grupo, data=x))
Grupo
Husband    Wife 
     30      30 
print(psych::describeBy(x=x[-5],
                  group=x$Grupo,
                  mat=1,
                  digits=2,
                  data=x))
    item  group1 vars  n mean   sd median trimmed  mad min max range  skew
X11    1 Husband    1 30 3.90 0.76    4.0    3.92 0.00   2   5     3 -0.30
X12    2    Wife    1 30 3.83 0.70    4.0    3.83 0.00   2   5     3 -0.37
X21    3 Husband    2 30 3.97 0.76    4.0    3.96 1.48   3   5     2  0.05
X22    4    Wife    2 30 4.10 0.66    4.0    4.12 0.00   3   5     2 -0.10
X31    5 Husband    3 30 4.33 0.66    4.0    4.42 1.48   3   5     2 -0.44
X32    6    Wife    3 30 4.63 0.49    5.0    4.67 0.00   4   5     1 -0.53
X41    7 Husband    4 30 4.40 0.67    4.5    4.50 0.74   3   5     2 -0.63
X42    8    Wife    4 30 4.53 0.51    5.0    4.54 0.00   4   5     1 -0.13
    kurtosis   se
X11    -0.35 0.14
X12     0.09 0.13
X21    -1.35 0.14
X22    -0.82 0.12
X31    -0.86 0.12
X32    -1.78 0.09
X41    -0.78 0.12
X42    -2.05 0.09
fit <- lm(cbind(X1,X2,X3,X4)~Grupo, 
          data=x)
print(anv <- car::Anova(fit), digits=3)

Type II MANOVA Tests: Pillai test statistic
      Df test stat approx F num Df den Df Pr(>F)  
Grupo  1     0.136     2.16      4     55  0.086 .
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
eta2 <- effectsize::eta_squared(anv,
                                partial=TRUE,
                                generalized=FALSE,
                                ci=1-alfa,
                                alternative="two.sided",
                                verbose=TRUE)
eta2$interpret <- effectsize::interpret_eta_squared(eta2$Eta2)
print(eta2, digits=4)
# Effect Size for ANOVA (Type II)

Parameter | Eta2 (partial) |           95% CI | interpret
---------------------------------------------------------
Grupo     |         0.1355 | [0.0000, 0.2739] |    medium
# Profile Analysis
# Results of F-tests for testing parallel, coincidential, and level profiles across two groups
mod <- profileR::pbg(data=x[,1:4], 
                     group=x[,5], 
                     original.names=TRUE, 
                     profile.plot=TRUE)

print(mod, digits=3) # prints average scores in the profile across two groups

Data Summary:
    Husband     Wife
X1 3.900000 3.833333
X2 3.966667 4.100000
X3 4.333333 4.633333
X4 4.400000 4.533333
summary(mod, digits=3) # prints the results of three profile by group hypothesis tests
Call:
profileR::pbg(data = x[, 1:4], group = x[, 5], original.names = TRUE, 
    profile.plot = TRUE)

Hypothesis Tests:
$`Ho: Profiles are parallel`
  Multivariate.Test Statistic Approx.F num.df den.df    p.value
1             Wilks 0.8785726 2.579917      3     56 0.06255945
2            Pillai 0.1214274 2.579917      3     56 0.06255945
3  Hotelling-Lawley 0.1382099 2.579917      3     56 0.06255945
4               Roy 0.1382099 2.579917      3     56 0.06255945

$`Ho: Profiles have equal levels`
            Df Sum Sq Mean Sq F value Pr(>F)
group        1  0.234  0.2344   1.533  0.221
Residuals   58  8.869  0.1529               

$`Ho: Profiles are flat`
        F df1 df2      p-value
1 8.18807   3  56 0.0001310162
# Hypothesis 1 - Ratios of the means of the variables over the hypothesized mean are equal to 1.
print(profileR::paos(x[x$Grupo=="Husband",1:4], 
                     scale=TRUE), 
      digits=3)

Profile Analysis for One Sample with Hotelling's T-Square:

                                              T-Squared      F df1 df2  p-value
Ho: Ratios of the means over Mu0=1               2391.4 535.99   4  26 0.000000
Ho: All of the ratios are equal to each other      27.3   8.48   3  27 0.000395
# Hypothesis 2 - All of the ratios are equal to each other.
print(profileR::paos(x[x$Grupo=="Wife",1:4], 
                     scale=TRUE), 
      digits=3)

Profile Analysis for One Sample with Hotelling's T-Square:

                                              T-Squared   F df1 df2  p-value
Ho: Ratios of the means over Mu0=1                 2940 659   4  26 0.00e+00
Ho: All of the ratios are equal to each other       348 108   3  27 3.77e-15

\[\Diamond\]

Quando o tamanho da amostra é pequeno, uma análise de perfil dependerá da suposição de normalidade. Essa suposição pode ser verificada usando métodos discutidos no Capítulo 4, com as observações originais ou as observações de contraste.

A análise de perfis para várias populações procede de maneira muito semelhante àquela para duas populações. Na verdade, as medidas gerais de comparação são análogas àquelas recém-discutidas. (Veja [13], [18]).

Delineamento de Medidas Repetidas e Curva de Crescimento

Como mencionamos anteriormente, o termo “medidas repetidas” refere-se a situações em que a mesma característica é observada, em diferentes momentos ou locais, na mesma unidade experimental.

  1. As observações em uma unidade experimental podem corresponder a diferentes tratamentos, como no Exemplo 6.2, em que o tempo entre batimentos cardíacos foi medido sob as combinações de tratamentos 2 × 2 aplicadas a cada cão. Os tratamentos precisam ser comparados quando as respostas na mesma unidade experimental estão correlacionadas.

  2. Um único tratamento pode ser aplicado a cada unidade experimental e uma única característica observada ao longo de um período de tempo. Por exemplo, poderíamos medir a massa corporal total de um filhote ao nascer e depois uma vez por mês. É a curva traçada por um cão típico que precisa ser modelada. Neste contexto, nos referimos à curva como uma curva de crescimento. Quando algumas unidades experimentais recebem um tratamento e outros outro tratamento, as curvas de crescimento para os tratamentos precisam ser comparadas.

Para ilustrar o modelo de curva de crescimento introduzido por Potthoff e Roy (1964), consideramos as medições de cálcio do osso ulna dominante em mulheres idosas. Além de uma leitura inicial, a Tabela 6.5 fornece leituras após um ano, dois anos e três anos para o grupo controle. Leituras obtidas por absorptiometria de fóton do mesmo participante estão correlacionadas, mas aquelas de diferentes participantes devem ser independentes. O modelo assume que a mesma matriz de covariância \(\mathbf{\Sigma}\) se aplica a cada sujeito. Ao contrário das abordagens univariadas, este modelo não requer que as quatro medidas sejam homocedásticas. Um perfil, construído a partir das quatro médias amostrais (\(x_1\), \(x_2\), \(x_3\), \(x_4\)), resume o crescimento que aqui é uma perda de cálcio ao longo do tempo. O padrão de crescimento pode ser adequadamente representado por um polinômio no tempo?

suppressMessages(suppressWarnings(
  invisible(Sys.setlocale("LC_ALL", "pt_BR.UTF-8"))))
source("summarySEwithin2.R")
alfa <- 0.05
xc <- read.table("JW6Data/T6-5.dat", quote="\"", comment.char="")
xc <- data.frame(ID = 1:15, xc)
names(xc) <- c("ID", "0", "1", "2", "3")
xc$Grupo <- "Contr"
xt <- read.table("JW6Data/T6-6.dat", quote="\"", comment.char="")
xt <- data.frame(ID = 16:31, xt)
names(xt) <- c("ID", "0", "1", "2", "3")
xt$Grupo <- "Trat"
x_wide <- rbind(xc, xt)
x_wide$Grupo <- factor(x_wide$Grupo)
x_wide$ID <- factor(x_wide$ID)
print(car::some(x_wide))
   ID    0    1    2    3 Grupo
4   4 70.6 76.1 72.1 65.3 Contr
10 10 82.3 86.9 79.4 77.4 Contr
15 15 72.3 74.6 75.3 66.1 Contr
17 17 65.3 66.9 67.0 60.6  Trat
18 18 81.2 79.5 84.5 75.2  Trat
22 22 76.5 79.9 80.4 71.6  Trat
25 25 77.2 74.0 77.8 67.9  Trat
26 26 67.3 70.7 68.9 65.9  Trat
27 27 50.3 51.4 53.6 48.0  Trat
31 31 57.3 56.0 64.7 53.0  Trat
print(xtabs(~Grupo, data=x_wide))
Grupo
Contr  Trat 
   15    16 
x_long <- data.frame(tidyr::pivot_longer(
  x_wide,
  cols = c("0", "1", "2", "3"),
  names_to = "Year",
  values_to = "Ca"
))
x_long$Year <- factor(x_long$Year)

print(tapply(x_long[c(-1,-2)], x_long$Grupo, FUN=summary, digits=3))
$Contr
 Year         Ca      
 0:15   Min.   :49.0  
 1:15   1st Qu.:65.9  
 2:15   Median :70.7  
 3:15   Mean   :70.7  
        3rd Qu.:76.5  
        Max.   :87.3  

$Trat
 Year         Ca      
 0:16   Min.   :48.0  
 1:16   1st Qu.:63.2  
 2:16   Median :70.3  
 3:16   Mean   :68.9  
        3rd Qu.:76.5  
        Max.   :86.2  
print(car::some(x_long))
    ID Grupo Year   Ca
9    3 Contr    0 76.7
18   5 Contr    1 55.1
19   5 Contr    2 57.2
20   5 Contr    3 49.0
33   9 Contr    0 85.3
34   9 Contr    1 84.4
51  13 Contr    2 67.0
63  16  Trat    2 86.2
100 25  Trat    3 67.9
109 28  Trat    0 57.7
print(ftable(x_long$Grupo, x_long$ID, x_long$Year))
          0 1 2 3
                 
Contr 1   1 1 1 1
      2   1 1 1 1
      3   1 1 1 1
      4   1 1 1 1
      5   1 1 1 1
      6   1 1 1 1
      7   1 1 1 1
      8   1 1 1 1
      9   1 1 1 1
      10  1 1 1 1
      11  1 1 1 1
      12  1 1 1 1
      13  1 1 1 1
      14  1 1 1 1
      15  1 1 1 1
      16  0 0 0 0
      17  0 0 0 0
      18  0 0 0 0
      19  0 0 0 0
      20  0 0 0 0
      21  0 0 0 0
      22  0 0 0 0
      23  0 0 0 0
      24  0 0 0 0
      25  0 0 0 0
      26  0 0 0 0
      27  0 0 0 0
      28  0 0 0 0
      29  0 0 0 0
      30  0 0 0 0
      31  0 0 0 0
Trat  1   0 0 0 0
      2   0 0 0 0
      3   0 0 0 0
      4   0 0 0 0
      5   0 0 0 0
      6   0 0 0 0
      7   0 0 0 0
      8   0 0 0 0
      9   0 0 0 0
      10  0 0 0 0
      11  0 0 0 0
      12  0 0 0 0
      13  0 0 0 0
      14  0 0 0 0
      15  0 0 0 0
      16  1 1 1 1
      17  1 1 1 1
      18  1 1 1 1
      19  1 1 1 1
      20  1 1 1 1
      21  1 1 1 1
      22  1 1 1 1
      23  1 1 1 1
      24  1 1 1 1
      25  1 1 1 1
      26  1 1 1 1
      27  1 1 1 1
      28  1 1 1 1
      29  1 1 1 1
      30  1 1 1 1
      31  1 1 1 1
print(xtabs(~Year+ID+Grupo, data=x_long))
, , Grupo = Contr

    ID
Year 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28
   0 1 1 1 1 1 1 1 1 1  1  1  1  1  1  1  0  0  0  0  0  0  0  0  0  0  0  0  0
   1 1 1 1 1 1 1 1 1 1  1  1  1  1  1  1  0  0  0  0  0  0  0  0  0  0  0  0  0
   2 1 1 1 1 1 1 1 1 1  1  1  1  1  1  1  0  0  0  0  0  0  0  0  0  0  0  0  0
   3 1 1 1 1 1 1 1 1 1  1  1  1  1  1  1  0  0  0  0  0  0  0  0  0  0  0  0  0
    ID
Year 29 30 31
   0  0  0  0
   1  0  0  0
   2  0  0  0
   3  0  0  0

, , Grupo = Trat

    ID
Year 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28
   0 0 0 0 0 0 0 0 0 0  0  0  0  0  0  0  1  1  1  1  1  1  1  1  1  1  1  1  1
   1 0 0 0 0 0 0 0 0 0  0  0  0  0  0  0  1  1  1  1  1  1  1  1  1  1  1  1  1
   2 0 0 0 0 0 0 0 0 0  0  0  0  0  0  0  1  1  1  1  1  1  1  1  1  1  1  1  1
   3 0 0 0 0 0 0 0 0 0  0  0  0  0  0  0  1  1  1  1  1  1  1  1  1  1  1  1  1
    ID
Year 29 30 31
   0  1  1  1
   1  1  1  1
   2  1  1  1
   3  1  1  1
boxplot(Ca ~ Year*Grupo, data=x_long)

q <- nlevels(x_long$Year)
g <- nlevels(x_long$Grupo)
alfaBonf <- alfa/(q*g)
ic <- summarySEwithin2(x_long, 
                       measurevar="Ca", 
                       withinvars="Year",
                       betweenvars="Grupo",
                       idvar="ID", 
                       na.rm=TRUE, 
                       conf.interval=1-alfaBonf)
print(ic, digits=3)
  Grupo Year   Ca n_obs.x CaNormed   sd n_obs.y    se   ci
1 Contr    0 72.4      15     71.4 2.55      15 0.657 2.11
2 Contr    1 73.3      15     72.4 2.57      15 0.663 2.13
3 Contr    2 72.5      15     71.5 3.02      15 0.779 2.50
4 Contr    3 64.8      15     63.8 3.38      15 0.873 2.81
5  Trat    0 69.3      16     70.2 1.58      16 0.396 1.26
6  Trat    1 70.7      16     71.5 1.90      16 0.475 1.51
7  Trat    2 71.2      16     72.1 2.06      16 0.515 1.64
8  Trat    3 64.5      16     65.4 1.78      16 0.444 1.41
pd <- ggplot2::position_dodge(0.9)
grf <- ggplot2::ggplot(ic, 
                       ggplot2::aes(x=Year, 
                                    y=Ca,
                                    color=Grupo)) +
  ggplot2::geom_errorbar(position = pd, 
                         width = 0.1,
                         ggplot2::aes(ymin=Ca-ci, 
                                      ymax=Ca+ci)) +
  ggplot2::geom_point(shape=21, 
                      size=3, 
                      fill="white",
                      position = pd) +
  ggplot2::ylab("Ca") +
  ggplot2::ggtitle("Medições de Cálcio na Ulna Dominante\nWithin-subject CI95 Bonferroni") +
  ggplot2::theme_bw() + 
  ggplot2::theme(panel.grid = 
                   ggplot2::element_blank())
print(grf)

# Profile Analysis
# Results of F-tests for testing parallel, coincidential, and level profiles across two groups
mod <- profileR::pbg(data=x_wide[,2:5], 
                     group=x_wide[,6], 
                     original.names=TRUE, 
                     profile.plot=TRUE)

print(mod, digits=3) # prints average scores in the profile across two groups

Data Summary:
     Contr     Trat
0 72.38000 69.28750
1 73.29333 70.65625
2 72.47333 71.18125
3 64.78667 64.53125
summary(mod, digits=3) # prints the results of three profile by group hypothesis tests
Call:
profileR::pbg(data = x_wide[, 2:5], group = x_wide[, 6], original.names = TRUE, 
    profile.plot = TRUE)

Hypothesis Tests:
$`Ho: Profiles are parallel`
  Multivariate.Test Statistic Approx.F num.df den.df   p.value
1             Wilks 0.8433309 1.671968      3     27 0.1965042
2            Pillai 0.1566691 1.671968      3     27 0.1965042
3  Hotelling-Lawley 0.1857742 1.671968      3     27 0.1965042
4               Roy 0.1857742 1.671968      3     27 0.1965042

$`Ho: Profiles have equal levels`
            Df Sum Sq Mean Sq F value Pr(>F)
group        1   25.6   25.62    0.31  0.582
Residuals   29 2398.1   82.69               

$`Ho: Profiles are flat`
         F df1 df2      p-value
1 50.60026   3  27 3.257707e-11
cat("\nGLMM")

GLMM
modelo <- lmerTest::lmer(Ca ~ Grupo + Year + (as.numeric(Year)|ID), 
                         data=x_long)
cat("\nRegression")

Regression
print(summary(modelo, correl=FALSE))
Linear mixed model fit by REML. t-tests use Satterthwaite's method [
lmerModLmerTest]
Formula: Ca ~ Grupo + Year + (as.numeric(Year) | ID)
   Data: x_long

REML criterion at convergence: 679.3

Scaled residuals: 
     Min       1Q   Median       3Q      Max 
-2.29930 -0.45525 -0.03677  0.40955  2.86328 

Random effects:
 Groups   Name             Variance Std.Dev. Corr 
 ID       (Intercept)      107.45   10.3660       
          as.numeric(Year)   0.59    0.7681  -0.71
 Residual                    5.06    2.2495       
Number of obs: 124, groups:  ID, 31

Fixed effects:
            Estimate Std. Error      df t value Pr(>|t|)    
(Intercept)  70.3927     2.4082 33.3549  29.230  < 2e-16 ***
GrupoTrat     0.7579     3.0735 29.0003   0.247   0.8070    
Year1         1.1484     0.5878 78.1289   1.954   0.0543 .  
Year2         1.0226     0.6345 78.5336   1.612   0.1111    
Year3        -6.1290     0.7055 34.2751  -8.687 3.52e-10 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
cat("\nANOVA\n")

ANOVA
print(anv <- car::Anova(modelo,
                        test.statistic="F"))
Analysis of Deviance Table (Type II Wald F tests with Kenward-Roger df)

Response: Ca
            F Df Df.res Pr(>F)    
Grupo  0.0569  1  29.00 0.8132    
Year  59.8518  3  63.23 <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
print(anova(modelo, ddf = "Kenward-Roger"), digits=5) # necessita do pbkrtest instalado
Type III Analysis of Variance Table with Kenward-Roger's method
      Sum Sq Mean Sq NumDF DenDF F value Pr(>F)    
Grupo   0.29   0.288     1 29.00  0.0569 0.8132    
Year  920.75 306.918     3 63.23 59.8518 <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
print(anova(modelo, ddf = "Satterthwaite"), digits=5)
Type III Analysis of Variance Table with Satterthwaite's method
      Sum Sq Mean Sq NumDF  DenDF F value Pr(>F)    
Grupo   0.31   0.308     1 29.000  0.0608  0.807    
Year  920.75 306.918     3 61.957 60.6544 <2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
cat("\nGLM")

GLM
modeloGLM <- lm(Ca ~ Grupo + Year + ID, 
                data=x_long)
print(car::Anova(modeloGLM), digits=4)
Note: model has aliased coefficients
      sums of squares computed by model comparison
Anova Table (Type II tests)

Response: Ca
          Sum Sq Df F value Pr(>F)    
Grupo             0                   
Year        1116  3   61.58 <2e-16 ***
ID          9592 29   54.73 <2e-16 ***
Residuals    544 90                   
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
print(anova(modeloGLM), digits=4)
Analysis of Variance Table

Response: Ca
          Df Sum Sq Mean Sq F value   Pr(>F)    
Grupo      1    102   102.5   16.96 8.46e-05 ***
Year       3   1116   372.1   61.58  < 2e-16 ***
ID        29   9592   330.8   54.73  < 2e-16 ***
Residuals 90    544     6.0                     
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
cat("\nEffect size analysis")

Effect size analysis
eta2 <- effectsize::eta_squared(anv,
                                partial=TRUE,
                                generalized=FALSE,
                                ci=1-alfa,
                                alternative="two.sided",
                                verbose=TRUE)
eta2$interpret <- effectsize::interpret_eta_squared(eta2$Eta2)
print(eta2, digits=4)
# Effect Size for ANOVA (Type II)

Parameter | Eta2 (partial) |           95% CI |  interpret
----------------------------------------------------------
Grupo     |         0.0020 | [0.0000, 0.1239] | very small
Year      |         0.7396 | [0.6238, 0.8089] |      large
cat("\nPost hoc tests")

Post hoc tests
cat("Teste post hoc: Pairwise")
Teste post hoc: Pairwise
emm <- emmeans::emmeans(modelo, 
                        specs=pairwise~Year|Grupo, 
                        adjust="holm",
                        level=1-alfa,
                        lmer.df="satterthwaite",
                        lmerTest.limit=nrow(x_long))
print(summary(emm$emmeans))
Grupo = Contr:
 Year emmean   SE   df lower.CL upper.CL
 0      70.4 2.41 33.4     65.5     75.3
 1      71.5 2.34 32.7     66.8     76.3
 2      71.4 2.28 31.5     66.8     76.1
 3      64.3 2.23 29.9     59.7     68.8

Grupo = Trat:
 Year emmean   SE   df lower.CL upper.CL
 0      71.2 2.34 33.2     66.4     75.9
 1      72.3 2.28 32.7     67.7     76.9
 2      72.2 2.22 31.6     67.7     76.7
 3      65.0 2.16 29.9     60.6     69.4

Degrees-of-freedom method: satterthwaite 
Confidence level used: 0.95 
print(summary(emm$contrasts, infer=TRUE))
Grupo = Contr:
 contrast      estimate    SE   df lower.CL upper.CL t.ratio p.value
 Year0 - Year1   -1.148 0.588 78.1    -2.74    0.443  -1.954  0.1629
 Year0 - Year2   -1.023 0.634 78.5    -2.74    0.695  -1.612  0.2221
 Year0 - Year3    6.129 0.706 34.3     4.15    8.105   8.687  <.0001
 Year1 - Year2    0.126 0.588 78.1    -1.47    1.717   0.214  0.8311
 Year1 - Year3    7.277 0.634 78.5     5.56    8.995  11.470  <.0001
 Year2 - Year3    7.152 0.588 78.1     5.56    8.743  12.167  <.0001

Grupo = Trat:
 contrast      estimate    SE   df lower.CL upper.CL t.ratio p.value
 Year0 - Year1   -1.148 0.588 78.1    -2.74    0.443  -1.954  0.1629
 Year0 - Year2   -1.023 0.634 78.5    -2.74    0.695  -1.612  0.2221
 Year0 - Year3    6.129 0.706 34.3     4.15    8.105   8.687  <.0001
 Year1 - Year2    0.126 0.588 78.1    -1.47    1.717   0.214  0.8311
 Year1 - Year3    7.277 0.634 78.5     5.56    8.995  11.470  <.0001
 Year2 - Year3    7.152 0.588 78.1     5.56    8.743  12.167  <.0001

Degrees-of-freedom method: satterthwaite 
Confidence level used: 0.95 
Conf-level adjustment: bonferroni method for 6 estimates 
P value adjustment: holm method for 6 tests 
print(plot(emm$emmeans, 
           colors="black") + ggplot2::theme_bw())

print(plot(emm$contrasts, 
           colors="black") + ggplot2::theme_bw())

print(multcomp::cld(object=emm$emmeans,
                    level=1-alfa,
                    adjust="holm",
                    Letters=letters,
                    alpha=alfa))
Grupo = Contr:
 Year emmean   SE   df lower.CL upper.CL .group
 3      64.3 2.23 29.9     58.3     70.2  a    
 0      70.4 2.41 33.4     64.0     76.8   b   
 2      71.4 2.28 31.5     65.4     77.5   b   
 1      71.5 2.34 32.7     65.3     77.7   b   

Grupo = Trat:
 Year emmean   SE   df lower.CL upper.CL .group
 3      65.0 2.16 29.9     59.3     70.8  a    
 0      71.2 2.34 33.2     65.0     77.3   b   
 2      72.2 2.22 31.6     66.3     78.0   b   
 1      72.3 2.28 32.7     66.3     78.3   b   

Degrees-of-freedom method: satterthwaite 
Confidence level used: 0.95 
Conf-level adjustment: bonferroni method for 4 estimates 
P value adjustment: holm method for 6 tests 
significance level used: alpha = 0.05 
NOTE: If two or more means share the same grouping symbol,
      then we cannot show them to be different.
      But we also did not show them to be the same. 
cat("Teste post hoc: Dunnett")
Teste post hoc: Dunnett
EMM.contrast <- emmeans::contrast(object = emm, 
                                  by="Grupo",
                                  method = "trt.vs.ctrl", 
                                  ref = "Year0",
                                  adjust="holm",
                                  level=1-alfa)
print(EMM.contrast)
Grupo = Contr:
 contrast      estimate    SE   df t.ratio p.value
 Year1 - Year0     1.15 0.588 78.1   1.954  0.1086
 Year2 - Year0     1.02 0.634 78.5   1.612  0.1111
 Year3 - Year0    -6.13 0.706 34.3  -8.687  <.0001

Grupo = Trat:
 contrast      estimate    SE   df t.ratio p.value
 Year1 - Year0     1.15 0.588 78.1   1.954  0.1086
 Year2 - Year0     1.02 0.634 78.5   1.612  0.1111
 Year3 - Year0    -6.13 0.706 34.3  -8.687  <.0001

Degrees-of-freedom method: satterthwaite 
P value adjustment: holm method for 3 tests 
print(plot(EMM.contrast,
           colors="black") + ggplot2::theme_bw())

cat("Teste post hoc: Consecutivo")
Teste post hoc: Consecutivo
EMM.contrast <- emmeans::contrast(object = emm, 
                                  by="Grupo",
                                  method = "consec",
                                  adjust="holm",
                                  level=1-alfa)
print(EMM.contrast)
Grupo = Contr:
 contrast      estimate    SE   df t.ratio p.value
 Year1 - Year0    1.148 0.588 78.1   1.954  0.1086
 Year2 - Year1   -0.126 0.588 78.1  -0.214  0.8311
 Year3 - Year2   -7.152 0.588 78.1 -12.167  <.0001

Grupo = Trat:
 contrast      estimate    SE   df t.ratio p.value
 Year1 - Year0    1.148 0.588 78.1   1.954  0.1086
 Year2 - Year1   -0.126 0.588 78.1  -0.214  0.8311
 Year3 - Year2   -7.152 0.588 78.1 -12.167  <.0001

Degrees-of-freedom method: satterthwaite 
P value adjustment: holm method for 3 tests 
print(plot(EMM.contrast,
           colors="black") + ggplot2::theme_bw())

cat("Teste post hoc: curvas polinomiais de graus 1, 2 e 3")
Teste post hoc: curvas polinomiais de graus 1, 2 e 3
EMM.contrast <- emmeans::contrast(object = emm, 
                                  by="Grupo",
                                  method = "poly",
                                  adjust="holm",
                                  level=1-alfa)
print(EMM.contrast)
Grupo = Contr:
 contrast  estimate    SE df t.ratio p.value
 linear      -18.51 2.270 30  -8.144  <.0001
 quadratic    -8.30 0.808 60 -10.272  <.0001
 cubic        -5.75 1.810 60  -3.183  0.0023

Grupo = Trat:
 contrast  estimate    SE df t.ratio p.value
 linear      -18.51 2.270 30  -8.144  <.0001
 quadratic    -8.30 0.808 60 -10.272  <.0001
 cubic        -5.75 1.810 60  -3.183  0.0023

Degrees-of-freedom method: satterthwaite 
P value adjustment: holm method for 3 tests 
print(plot(EMM.contrast,
           colors="black") + ggplot2::theme_bw())

Questões

6.1, 6.5, 6.8, 6.12, 6.13, 6.14, 6.15, 6.17, 6.18, 6.20, 6.22, 6.28, 6.31, 6.39, 6.41


Aplicativos

Análise estatística multivariada em R e Python na internet

Bibliografia

  • Livro-texto:
    • JOHNSON, RA & WICHERN, DW (2007) Applied multivariate statistical analysis. 6th ed. NJ: Prentice Hall.
    • JOHNSON, RA & WICHERN, DW (2007) Applied multivariate statistical analysis: Solutions Manual. 6th ed. NJ: Prentice Hall.
    • JOHNSON, RA & WICHERN, DW (2002) Applied multivariate statistical analysis. 5th ed. NJ: Prentice Hall.
  • ANDERSON, TW (2003) An introduction to multivariate statistical analysis. 3rd ed. NY: Wiley.
  • EVERITT, BS & HOTHORN, T (2011) An introduction to applied multivariate analysis with R. USA: Springer.
  • FLURY, B (1997) A first course in multivariate statistics. NY: Springer-Verlag.
  • HARDLE, W & SIMAR, L (2015) Applied multivariate statistical analysis. 4th ed. NY: Springer-Verlag.
  • JAMES, G; WITTEN, D; HASTIE, T; & TIBSHIRANI, R (2021) An Introduction to statistical learning with applications in R. 2nd ed. USA: Springer.
  • MARDIA, KV, KENT, JT & BIBBY, JM (2003) Multivariate analysis. UK: Academic.
  • MORRISON, DF (1990) Multivariate statistical methods. 3rd ed. NY: McGraw-Hill.
  • MULLER, KE & STEWART, PW (2006) Linear model theory: Univariate, multivariate, and mixed models. NJ: Wiley.
  • RAO, CR (1951) An asymptotic expansion of the distribution of Wilks’ criterion. Bulletin of the International Statistical Institute 33(2): 177–80.
  • REIS, E (2001) Estatística multivariada aplicada. 2a ed. Lisboa: Sílabo.
  • REIS, SF (1988) Morfometria e Estatística Multivariada em Biologia Evolutiva. Revista Brasileira de Zoologia 5(4): 571-80.
  • RENCHER, AC & CHRISTENSEN, WF (2012) Methods of multivariate analysis. 3rd ed. NJ: Wiley.
  • SAVILLE, DJ & WOOD, GR (1996) Statistical methods: a geometric primer.USA: Lawrence Erlbaum.
  • SOUZA, J (1997) Estatística econômica e social. RJ: Campus.
  • SRIVASTAVA, MS & CARTER, EM (1983) An Introduction to applied multivariate Statistics. North Holland.
  • SRIVASTAVA, MS (2006) Methods of multivariate statistics. NY: Wiley.
  • WICKENS, TD (1995) The geometry of multivariate Statistics. USA: Lawrence Erlbaum.


Bibliografia adicional

  • Soch, J et al. (2020) The Book of Statistical Proofs: https://statproofbook.github.io/

  • Artes, R & Barroso, LP (2023) Métodos multivariados de análise estatística. SP: Blucher/ABE.

  • Batschelet, E (1978) Introdução à matemática para biocientistas. Tradução da 2ª ed. São Paulo: EDUSP e Rio de Janeiro: Interciência.

  • Batschelet, E (1979) Introduction to mathematics for life scientists. 3rd ed. NY: Springer.

  • Bickel, PJ & Doksum, KA (2001) Mathematical Statistics: Basic Ideas and Selected Topics, Volume I. USA: CRC.

  • Bilodeau, M & Brenner, D (1999) Theory of Multivariate Statistics. USA: Springer. (T^2 de Hotelling)

  • Boik, RJ (1988) The mixed model for multivariate repeated measures: Validity conditions and an approximate test. Psychometrika 53(4): 469–86. https://doi.org/10.1007/BF02294401

  • Chartier, S & Faulkner, A (2008) General Linear Models: An integrated approach to statistics. Tutorial in Quantitative Methods for Psychology 4(2): 65‐78.

  • Crampton, EW (1947) O crescimento do odontoblasto dos dentes incisivos como critério de ingestão de vitamina C do porquinho-da-índia. The Journal of Nutrition 33(5): 491–504.

  • Denis, DJ (2021) Applied Univariate, Bivariate, and Multivariate Statistics Using Python: A Beginners Guide to Advanced Data Analysis. NJ: Wiley.

  • Friendly, M (2010) HE plots for repeated measures designs. Journal of Statistical Software, 37(4), 1–40. https://doi.org/10.18637/jss.v037.i04

  • Genz, A (1992) Numerical Computation of Multivariate Normal Probabilities. Journal of Computational and Graphical Statistics 1(2): 141–149. https://doi.org/10.2307/1390838

  • Gokpınar, E et al. (?) A Computational Approach Test for the Equality of Two Multivariate Normal Mean Vectors under Heterogeneity of Covariance Matrices: https://www.ine.pt/revstat/pdf/AComputationalApproachTest.pdf

  • Grice, JW & Iwasaki, M (2007) A truly multivariate approach to MANOVA. Applied Multivariate Research 12(30): 199-226.

  • Hardle, W & Hlavka, Z (2007) Multivariate Statistics - Exercises and Solutions. USA: Springer.

  • Hotelling, H (1931), The generalization of Student’s ratio. Annals of Mathematical Statistics 2(3): 360-378.

  • Hotelling, H (1951) A generalized T test and measure of multivariate dispersion. Proceedings of the Second Berkeley Symposium on Mathematical Statistics and Probability, 23–41. University of California Press.

  • Johansen, S (1980) The Welch-James approximation to the distribution of the residual sum of squares in a weighted linear regression. Biometrika 67(1). doi:10.1093/biomet/67.1.85.

  • Kassambara, A (2017) Practical guide to cluster analysis in R: Unsupervised machine learning. STHDA: http://www.sthda.com.

  • Kollo, T & von Rosen, D (2005) Advanced Multivariate Statistics with Matrices. USA: Springer.

  • Kutner, MH; Nachtsheim, CJ; Neter, J & Li, W (2005) Applied linear statistical model. 5th ed. NY: McGraw-Hill/Irwin.

  • Loesch, C & Hoeltgebaum, M (2012) Métodos estatísticos multivariados. SP: Saraiva.

  • Mair, P (2018) Modern psychometrics with R. USA: Springer.

  • Manly, BFJ & Alberto, JAN (2017) Multivariate Statistical Methods: A Primer using R. 4th ed. USA: CRC.

  • Matloff, N (2020) Probability and Statistics for Data Science: Math + R + Data. USA: CRC.

  • Melo, J. M. & & Ferreira, D. F. (2017) PROPOSTA DE UM TESTE DE NORMALIDADE MULTIVARIADA EXATO BASEADO EM UMA TRANSFORMAÇÃO t DE STUDENT. Brazilian Journal of Biometrics, 35(2): 242–65. https://biometria.ufla.br/index.php/BBJ/article/view/55

  • McColl, JH (2004) Multivariate probability. UK: Arnold.

  • Mirman, D (2014) Growth Curve Analysis and Visualization Using R. USA: CRC.

  • Pessoa, DGC (2008) Exemplos do livro de Johnson e Wichern.

  • Pham-Gia, T (2008) Exact distribution of the generalized Wilks’s statistic and applications. Journal of Multivariate Analysis 99(8): 1698-716.

  • Rawlings, JO et al. (1998) Applied Regression Analysis: A Research Tool. USA: Springer. T^2 de Hotelling

  • Schumacker, RE (2016) Using R With Multivariate Statistics. USA: SAGE.

  • Silveira PSP, Tempski PZ, Mayer FB, Enns SC, Peleias M, Martins MdA, Siqueira JO (2025) Comparison between random and convenience samples in a multicenter survey to evaluate medical students’ quality of life. PLoS One 20(10): e0332850. https://doi.org/10.1371/journal.pone.0332850

  • Smith, CE & Cribbie, R (2014) Factorial ANOVA with unbalanced data: A fresh look at the types of sums of squares. Journal of Data Science 12(2): 385–404.

  • Siqueira, JO (2012) Fundamentos de métodos quantitativos: aplicados em Administração, Economia, Contabilidade e Atuária usando WolframAlpha e SCILAB. São Paulo: Saraiva. Soluções dos exercícios em https://www.researchgate.net/publication/326533772_Fundamentos_de_metodos_quantitativos_-_Solucoes.

  • Takayanagi, JFGB, Siqueira, JO, Silveira, PSP, Valentova, JV (2024) What Do Different People Look for in a Partner? Effects of Sex, Sexual Orientation, and Mating Strategies on Partner Preferences. Arch Sex Behav 53, 981–1000 (2024). https://doi.org/10.1007/s10508-023-02767-4. Dados e código R: https://osf.io/pc6rn/?view%2520only=38097a82dd274d34bbddc8dcc2258bb9

  • Tay, A (2018) OLS using Matrix Algebra. http://www.mysmu.edu/faculty/anthonytay/MFE/OLS_using_Matrix_Algebra.pdf

  • Teichroew, D (1964) An introduction to management science: deterministic models. NJ: Wiley.

  • Timm, NH (2002) Applied Multivariate Analysis. USA: Springer. T2 de Hotelling.

  • Wilks, SS (1932) Certain generalizations in the analysis of variance. Biometrika 24(3/4): 471-494. https://doi.org/10.1093/biomet/24.3-4.471

  • Zhang, J (2012) “An Approximate Hotelling T2-Test for Heteroscedastic One-Way MANOVA,” Open Journal of Statistics, 2(1): 1-11. doi: 10.4236/ojs.2012.21001. https://www.scirp.org/journal/paperinformation.aspx?paperid=17138

  • Zelterman, D (2015) Applied Multivariate Statistics with R. USA: Springer.