1 Nunca confie no valor de p

1.1 Teste 1

library(tidyverse)

set.seed(1, sample.kind = "Rounding")
dados <- data.frame(
  Sexo = factor(c(rep("H", 50), rep("M", 50))),
  Altura = c(rnorm(50, mean = 170, sd = 3), rnorm(50, mean = 169, sd = 3)))

library(ggplot2)

ggplot(dados, aes(x=as.factor(dados$Sexo), y= dados$Altura, fill = as.factor(Sexo))) +
  geom_boxplot() + labs(title = "Altura entre os gêneros", x= "Gênero", fill="Sexo")

t.test(Altura ~ Sexo, data = dados) # p-value = 0.08284, aceitamos a hipótese nula
## 
##  Welch Two Sample t-test
## 
## data:  Altura by Sexo
## t = 1.7528, df = 95.793, p-value = 0.08284
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.1258073  2.0245383
## sample estimates:
## mean in group H mean in group M 
##        170.3013        169.3520
library(effsize)

cohen.d(Altura ~ factor(Sexo), data = dados) # 0.3505534 (small)
## 
## Cohen's d
## 
## d estimate: 0.3505534 (small)
## 95 percent confidence interval:
##       lower       upper 
## -0.04937676  0.75048366

1.2 Teste 2

library(tidyverse)

set.seed(1, sample.kind = "Rounding")
dados2 <- data.frame(
  Sexo = factor(c(rep("H", 500), rep("M", 500))),
  Altura = c(rnorm(500, mean = 170, sd = 3), rnorm(500, mean = 169, sd = 3)))

library(ggplot2)

ggplot(dados2, aes(x=as.factor(dados2$Sexo), y= dados2$Altura, fill = as.factor(Sexo))) +
  geom_boxplot() + labs(title = "Altura entre os gêneros", x= "Gênero", fill="Sexo")

t.test(Altura ~ Sexo, data = dados2) # p-value = 1.185e-09, rejeitamos a hipótese nula
## 
##  Welch Two Sample t-test
## 
## data:  Altura by Sexo
## t = 6.1408, df = 996.09, p-value = 1.185e-09
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.8204427 1.5910641
## sample estimates:
## mean in group H mean in group M 
##        170.0679        168.8622
library(effsize)

cohen.d(Altura ~ factor(Sexo), data = dados2) # -0.388377 (small)
## 
## Cohen's d
## 
## d estimate: 0.388377 (small)
## 95 percent confidence interval:
##     lower     upper 
## 0.2631029 0.5136511

CONCLUSÃO

Qualquer diferença entre médias será significativa, basta ter um “n” grande suficiente.
Tamanho do efeito > Valor de p

2 Teste t para uma amostra

library(foreign) 
dados<- read.spss("C:/Users/user/Desktop/Vida acadêmica/Disciplinas/Estatística Vitor/Aula 2/Dados/Teste T.sav")
library(tibble)
dados <- as_tibble(dados)

shapiro.test(dados$Altura) # normalidade
## 
##  Shapiro-Wilk normality test
## 
## data:  dados$Altura
## W = 0.95239, p-value = 0.1958
hist(dados$Altura)

mean(dados$Altura)
## [1] 168.402
t.test(dados$Altura, mu = 168, conf.level = 0.95) # teste bicaudal (2-sided)
## 
##  One Sample t-test
## 
## data:  dados$Altura
## t = 0.19722, df = 29, p-value = 0.845
## alternative hypothesis: true mean is not equal to 168
## 95 percent confidence interval:
##  164.2331 172.5709
## sample estimates:
## mean of x 
##   168.402
t.test(dados$Altura, mu = 168, conf.level = 0.95, alternative = "less") # Menor, Unicaudal
## 
##  One Sample t-test
## 
## data:  dados$Altura
## t = 0.19722, df = 29, p-value = 0.5775
## alternative hypothesis: true mean is less than 168
## 95 percent confidence interval:
##      -Inf 171.8655
## sample estimates:
## mean of x 
##   168.402
t.test(dados$Altura, mu = 168, conf.level = 0.95, alternative = "greater") # Maior, Unicaudal
## 
##  One Sample t-test
## 
## data:  dados$Altura
## t = 0.19722, df = 29, p-value = 0.4225
## alternative hypothesis: true mean is greater than 168
## 95 percent confidence interval:
##  164.9385      Inf
## sample estimates:
## mean of x 
##   168.402

3 Teste t independente para 2 amostras

# Normalidade

shapiro.test(dados$Salário) # W = 0.97365, p-value = 0.643 Normal
## 
##  Shapiro-Wilk normality test
## 
## data:  dados$Salário
## W = 0.97365, p-value = 0.643
shapiro.test(dados$Salário[dados$Gênero == "M"]) # Normalidade p/ homens
## 
##  Shapiro-Wilk normality test
## 
## data:  dados$Salário[dados$Gênero == "M"]
## W = 0.95069, p-value = 0.5354
shapiro.test(dados$Salário[dados$Gênero == "F"]) # Normalidade p/ mulheres
## 
##  Shapiro-Wilk normality test
## 
## data:  dados$Salário[dados$Gênero == "F"]
## W = 0.95255, p-value = 0.5655

3.1 Homogeneidade de variância

library(car)
leveneTest(Salário ~ Gênero, data = dados, center = median) ## Teste de Brown-Forsythe, mais robusto que o do SPSS
## Levene's Test for Homogeneity of Variance (center = median)
##       Df F value Pr(>F)
## group  1  0.0031 0.9557
##       28
leveneTest(Salário ~ Gênero, data = dados, center = mean) # Teste original, igual ao do SPSS
## Levene's Test for Homogeneity of Variance (center = mean)
##       Df F value Pr(>F)
## group  1  0.0047  0.946
##       28

3.2 Teste t

t.test(dados$Salário ~ dados$Gênero, paired = F, conf.level = 0.95, var.eq = T) # Variâncias homogêneas
## 
##  Two Sample t-test
## 
## data:  dados$Salário by dados$Gênero
## t = 0.70535, df = 28, p-value = 0.4864
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.5394931  1.1061598
## sample estimates:
## mean in group M mean in group F 
##        3.046667        2.763333
t.test(dados$Salário ~ dados$Gênero, paired = F, conf.level = 0.95, var.eq = F) # Variâncias não homogêneas
## 
##  Welch Two Sample t-test
## 
## data:  dados$Salário by dados$Gênero
## t = 0.70535, df = 27.373, p-value = 0.4866
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.5403436  1.1070103
## sample estimates:
## mean in group M mean in group F 
##        3.046667        2.763333

3.3 Tamanho do efeito

library(effsize)

cohen.d(Salário ~ Gênero, data = dados, paired = F) # d estimate: 0.257558 (small)
## 
## Cohen's d
## 
## d estimate: 0.257558 (small)
## 95 percent confidence interval:
##      lower      upper 
## -0.4935092  1.0086253
cohen.d(Salário ~ Gênero, paired = F, hedges = TRUE, data = dados) # g estimate: 0.250597 (small)
## 
## Hedges's g
## 
## g estimate: 0.250597 (small)
## 95 percent confidence interval:
##      lower      upper 
## -0.4800109  0.9812049
boxplot(dados$Salário ~ dados$Gênero, col = c(4,2))
legend("topright", legend = c("Homens", "Mulheres"), col = c(4,2), lty = 1, cex = 0.8, lwd = 1, bty = "n")

4 Anova de uma via

4.1 Importando os dados e teste de normalidade

library(foreign) 
dados<- read.spss("C:/Users/user/Desktop/Vida acadêmica/Disciplinas/Estatística Vitor/Aula 2/Dados/Anova.sav")
library(tibble)
dados <- as_tibble(dados)

shapiro.test(dados$Pressão) #W = 0.9785, p-value = 0.7697
## 
##  Shapiro-Wilk normality test
## 
## data:  dados$Pressão
## W = 0.9785, p-value = 0.7697
shapiro.test(dados$BC) # W = 0.93549, p-value = 0.06195
## 
##  Shapiro-Wilk normality test
## 
## data:  dados$BC
## W = 0.93549, p-value = 0.06195

4.2 Homogeneidade de variância

library(car)
leveneTest(Pressão ~ Grupo, data = dados, center = median) ## Teste de Brown-Forsythe, mais robusto que o do SPSS
## Levene's Test for Homogeneity of Variance (center = median)
##       Df F value Pr(>F)
## group  2  0.5148 0.6032
##       28
leveneTest(Pressão ~ Grupo, data = dados, center = mean) # Teste original, igual ao do SPSS
## Levene's Test for Homogeneity of Variance (center = mean)
##       Df F value Pr(>F)
## group  2  0.4659 0.6323
##       28
mean(dados$Pressão[dados$Grupo == "Placebo"]) # 184.6389
## [1] 184.6389
mean(dados$Pressão[dados$Grupo == "AH Novo"]) # 168.2222
## [1] 168.2222
mean(dados$Pressão[dados$Grupo == "AH Padrão"]) # 159.4
## [1] 159.4

4.3 ANOVA

ANOVA <- aov(Pressão ~ Grupo, data = dados)
summary(ANOVA) # Z = 5.52, p.value = 0.00953 **
##             Df Sum Sq Mean Sq F value  Pr(>F)   
## Grupo        2   3631  1815.4    5.52 0.00953 **
## Residuals   28   9209   328.9                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
ANOVA$coefficients
##    (Intercept)   GrupoAH Novo GrupoAH Padrão 
##      184.63889      -16.41667      -25.23889

4.4 Post-hoc

pairwise.t.test(dados$Pressão, dados$Grupo, p.adj = "bonf") # Bonferronia
## 
##  Pairwise comparisons using t tests with pooled SD 
## 
## data:  dados$Pressão and dados$Grupo 
## 
##           Placebo AH Novo
## AH Novo   0.149   -      
## AH Padrão 0.009   0.896  
## 
## P value adjustment method: bonferroni
TukeyHSD(ANOVA) # Tukey
##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = Pressão ~ Grupo, data = dados)
## 
## $Grupo
##                         diff       lwr       upr     p adj
## AH Novo-Placebo   -16.416667 -36.20389  3.370559 0.1183449
## AH Padrão-Placebo -25.238889 -44.45245 -6.025329 0.0081666
## AH Padrão-AH Novo  -8.822222 -29.44004 11.795595 0.5469750

4.5 Tamanho do efeito

library("lsr")
etaSquared(ANOVA) # 0.2827727 efeito grande
##          eta.sq eta.sq.part
## Grupo 0.2827727   0.2827727
boxplot(dados$Pressão ~ dados$Grupo, col = c(2:4))

plot(TukeyHSD(ANOVA), las = 1)

4.6 Caso a Anova não apresente homogeneidade de variâncias

# Além do teste de Levene, podemos usar o teste de Bartlett
bartlett.test(Pressão ~ Grupo, data = dados) # Teste de Bartlett para homogeneidade de variâncias
## 
##  Bartlett test of homogeneity of variances
## 
## data:  Pressão by Grupo
## Bartlett's K-squared = 1.582, df = 2, p-value = 0.4534

4.7 Anova de Welch

oneway.test(Pressão ~ Grupo, data = dados, var.equal=FALSE) # Usamos a Anova de Welch caso não exista homogeneidade de variâncias
## 
##  One-way analysis of means (not assuming equal variances)
## 
## data:  Pressão and Grupo
## F = 4.6285, num df = 2.000, denom df = 18.325, p-value = 0.0236

4.8 Ajuste de White

library(car)
modelo <- lm(Pressão ~ Grupo, data = dados)
Anova(modelo, Type="II", white.adjust=TRUE) # Realiza uma correção para valores heterocedásticos
## Analysis of Deviance Table (Type II tests)
## 
## Response: Pressão
##           Df      F  Pr(>F)  
## Grupo      2 4.3636 0.02241 *
## Residuals 28                 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

5 Qui-Quadrado de independência

5.1 Carregando os dados

library(foreign) 
dados<- read.spss("C:/Users/user/Desktop/Vida acadêmica/Disciplinas/Estatística Vitor/Aula 2/Dados/Qui quadrado.sav")
library(tibble)
dados <- as_tibble(dados)

5.2 Verificando pré-requisito, n > 5

ki <- chisq.test(dados$Hab_Fumar, dados$Câncer, correct = T)
tabelaki <- table(dados$Hab_Fumar, dados$Câncer)
nabaixo5 <- length(which(tabelaki<5))
min(tabelaki) #6, passamos no pré-requisito
## [1] 6

5.3 Qui-quadrado

table(dados$Hab_Fumar, dados$Câncer)
##      
##       Não Sim
##   Não  23   6
##   Sim   8  33
Tabela <- table(dados$Hab_Fumar, dados$Câncer) # Criamos uma tabela
barplot(Tabela, beside = T)

chisq.test(Tabela, correct = T) # X-squared = 22.253; p-value = 2.39e-06 - rejeitamos a hip nula
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  Tabela
## X-squared = 22.253, df = 1, p-value = 2.39e-06

5.4 Estatísticas do qui-quadrado

CHI <- chisq.test(Tabela, correct = T)
attributes(CHI)
## $names
## [1] "statistic" "parameter" "p.value"   "method"    "data.name" "observed" 
## [7] "expected"  "residuals" "stdres"   
## 
## $class
## [1] "htest"
CHI$expected # Valores esperados
##      
##            Não      Sim
##   Não 12.84286 16.15714
##   Sim 18.15714 22.84286
CHI$observed # Valores observados
##      
##       Não Sim
##   Não  23   6
##   Sim   8  33
fisher.test(Tabela, conf.int = T, conf.level = 0.95) # Alternativa para o qui-quadrado - Mais adequado para amostras pequenas e tabelas 2x2; p-value = 7.207e-07; odds ratio = 14.98841
## 
##  Fisher's Exact Test for Count Data
## 
## data:  Tabela
## p-value = 7.207e-07
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
##   4.261128 62.042120
## sample estimates:
## odds ratio 
##   14.98841

5.5 Tamanho do efeito

library(lsr) # Valor exato, diferente do SPSS
cramersV(Tabela)
## [1] 0.5638228
library(DescTools) # Valor aproximado, mesmo resultado do SPSS
CramerV(Tabela, correct = F, method = "ncchisq")
## [1] 0.5930148
Phi(Tabela) # Cálculo do phi para tabelas que não são 2x2
## [1] 0.5930148

5.6 Posthoc do quiquadrado

chisq.test(dados$Hab_Fumar, dados$Câncer, correct = F)$stdres # resíduos ajustados
##                dados$Câncer
## dados$Hab_Fumar       Não       Sim
##             Não  4.961518 -4.961518
##             Sim -4.961518  4.961518
sig <- .05
sigAdj <- sig/(nrow(Tabela)*ncol(Tabela))
sigAdj
## [1] 0.0125
qnorm(sigAdj/2) # Valor maior do que |1,96|
## [1] -2.497705

6 Mann-Whitney

Versão não-paramétrica do teste t de independência

6.1 Importação e teste de normalidade

library(foreign) 
dados<- read.spss("C:/Users/user/Desktop/Vida acadêmica/Disciplinas/Estatística Vitor/Aula 2/Dados/Mann-Whitney.sav")
## re-encoding from CP1252
library(tibble)
dados <- as_tibble(dados)

shapiro.test(dados$Nota_Fis)# Dados não são normais
## 
##  Shapiro-Wilk normality test
## 
## data:  dados$Nota_Fis
## W = 0.87598, p-value = 0.0016
shapiro.test(dados$Nota_Hist) # Dados não são normais
## 
##  Shapiro-Wilk normality test
## 
## data:  dados$Nota_Hist
## W = 0.92396, p-value = 0.02666

6.2 Teste

# Mann-Whitney foi erroneamente chamado de wilcoxon rank teste no r (wilcoxon é o teste dependente)

wilcox.test(dados$Nota_Fis ~ dados$Posição_Sala, conf.int = T, exact = F) # A diferença do SPSS se dá pelo ajuste contínuo que o R faz
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  dados$Nota_Fis by dados$Posição_Sala
## W = 218, p-value = 0.0006703
## alternative hypothesis: true location shift is not equal to 0
## 95 percent confidence interval:
##  1.034972 4.065005
## sample estimates:
## difference in location 
##                2.57006
wilcox.test(dados$Nota_Hist ~ dados$Posição_Sala, conf.int = T, exact = F) 
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  dados$Nota_Hist by dados$Posição_Sala
## W = 154.5, p-value = 0.3166
## alternative hypothesis: true location shift is not equal to 0
## 95 percent confidence interval:
##  -0.6000168  3.0400173
## sample estimates:
## difference in location 
##              0.9099407
library(dplyr)
library(rstatix)
## 
## Attaching package: 'rstatix'
## The following object is masked from 'package:stats':
## 
##     filter
dados %>% group_by(Posição_Sala) %>%
  get_summary_stats(Nota_Biol, Nota_Fis, Nota_Hist, type = "median_iqr")
## # A tibble: 6 x 5
##   Posição_Sala variable      n median   iqr
##   <fct>        <chr>     <dbl>  <dbl> <dbl>
## 1 Frente       Nota_Biol    15   6.40  2.22
## 2 Frente       Nota_Fis     15   6.62  3.69
## 3 Frente       Nota_Hist    15   5.38  4.99
## 4 Fundos       Nota_Biol    17   3.80  1.44
## 5 Fundos       Nota_Fis     17   3.80  0.98
## 6 Fundos       Nota_Hist    17   4.88  2.13

6.3 Tamanho do efeito

# Tamanho do efeito - R
library(rcompanion)
wilcoxonR(x = dados$Nota_Fis, g = dados$Posição_Sala) # r = 0.605; pequeno = 0.10 - < 0.30; médio 0.30 – < 0.50; grande = >0.50 - ver livro do Cohen
##     r 
## 0.605
wilcoxonR(x = dados$Nota_Hist, g = dados$Posição_Sala) # r = 0.18
##    r 
## 0.18

7 Kruskal-Wallis

Versão não paramétrica da ANOVA

library(foreign) 
dados<- read.spss("C:/Users/user/Desktop/Vida acadêmica/Disciplinas/Estatística Vitor/Aula 2/Dados/Kruskall.sav")
## re-encoding from UTF-8
library(tibble)
dados <- as_tibble(dados)

7.1 Teste

kruskal.test(dados$Escala_dep ~ dados$Tratamento) # chi-squared = 35.205, df = 4, p-value = 4.217e-07
## 
##  Kruskal-Wallis rank sum test
## 
## data:  dados$Escala_dep by dados$Tratamento
## Kruskal-Wallis chi-squared = 35.205, df = 4, p-value = 4.217e-07

7.2 Post-Hoc

library(dunn.test) # Mesmos resultados do SPSS
library(FSA)
## ## FSA v0.8.30. See citation('FSA') if used in publication.
## ## Run fishR() for related website and fishR('IFAR') for related book.
## 
## Attaching package: 'FSA'
## The following object is masked from 'package:car':
## 
##     bootCase
dunnTest(dados$Escala_dep, dados$Tratamento, method = "bonferroni") # Post-hoc de dun com ajuste de Bonferroni
## Dunn (1964) Kruskal-Wallis multiple comparison
##   p-values adjusted with the Bonferroni method.
##                        Comparison          Z      P.unadj        P.adj
## 1               Cheerup - Effexor -0.6313566 5.278074e-01 1.000000e+00
## 2          Cheerup - No Treatment -4.4579933 8.273049e-06 8.273049e-05
## 3          Effexor - No Treatment -3.8266367 1.299060e-04 1.299060e-03
## 4               Cheerup - Placebo -3.3877669 7.046411e-04 7.046411e-03
## 5               Effexor - Placebo -2.7564104 5.843963e-03 5.843963e-02
## 6          No Treatment - Placebo  1.0702264 2.845174e-01 1.000000e+00
## 7       Cheerup - Seroxat (Paxil) -4.3040039 1.677387e-05 1.677387e-04
## 8       Effexor - Seroxat (Paxil) -3.6726473 2.400507e-04 2.400507e-03
## 9  No Treatment - Seroxat (Paxil)  0.1539894 8.776181e-01 1.000000e+00
## 10      Placebo - Seroxat (Paxil) -0.9162370 3.595426e-01 1.000000e+00
library(Hmisc) # Mais fácil de visualizar, cuidar os sinais
## Loading required package: lattice
## Loading required package: survival
## Loading required package: Formula
## 
## Attaching package: 'Hmisc'
## The following objects are masked from 'package:DescTools':
## 
##     %nin%, Label, Mean, Quantile
## The following objects are masked from 'package:dplyr':
## 
##     src, summarize
## The following objects are masked from 'package:base':
## 
##     format.pval, units
dunn.test(dados$Escala_dep, dados$Tratamento, method = "bonferroni")
##   Kruskal-Wallis rank sum test
## 
## data: x and group
## Kruskal-Wallis chi-squared = 35.2046, df = 4, p-value = 0
## 
## 
##                            Comparison of x by group                            
##                                  (Bonferroni)                                  
## Col Mean-|
## Row Mean |    Cheerup    Effexor   No Treat    Placebo
## ---------+--------------------------------------------
##  Effexor |  -0.631356
##          |     1.0000
##          |
## No Treat |  -4.457993  -3.826636
##          |    0.0000*    0.0006*
##          |
##  Placebo |  -3.387766  -2.756410   1.070226
##          |    0.0035*     0.0292     1.0000
##          |
## Seroxat  |  -4.304003  -3.672647   0.153989  -0.916236
##          |    0.0001*    0.0012*     1.0000     1.0000
## 
## alpha = 0.05
## Reject Ho if p <= alpha/2

7.3 Estatística do efeito Eta2[H]

library(rstatix)
kruskal_effsize(dados, dados$Escala_dep ~ dados$Tratamento, ci = F, conf.level = 0.95, ci.type = "perc", nboot = 1000) # 0.693 eta2[H] large
## # A tibble: 1 x 5
##   .y.                  n effsize method  magnitude
## * <chr>            <int>   <dbl> <chr>   <ord>    
## 1 dados$Escala_dep    50   0.693 eta2[H] large

Para os teste pareados, as medidas não são independentes

8 Teste t pareado

8.1 Importando os dados

library(foreign) 
dados<- read.spss("C:/Users/user/Desktop/Vida acadêmica/Disciplinas/Estatística Vitor/Aula 2/Dados/Teste T pareado.Wilcoxon.sav")
## re-encoding from CP1252
library(tibble)
dados <- as_tibble(dados)

8.2 Verificando as médias

mean(dados$Convulsões_PT)
## [1] 5.629091
mean(dados$Convulsões_S1)
## [1] 4.545455
mean(dados$Convulsões_S6)
## [1] 4.363636

8.3 Teste

t.test(dados$Convulsões_PT, dados$Convulsões_S1, paired = T)
## 
##  Paired t-test
## 
## data:  dados$Convulsões_PT and dados$Convulsões_S1
## t = 3.6762, df = 274, p-value = 0.0002848
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.5033362 1.6639366
## sample estimates:
## mean of the differences 
##                1.083636
t.test(dados$Convulsões_PT, dados$Convulsões_S6, paired = T)
## 
##  Paired t-test
## 
## data:  dados$Convulsões_PT and dados$Convulsões_S6
## t = 3.9878, df = 274, p-value = 8.561e-05
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.6407397 1.8901694
## sample estimates:
## mean of the differences 
##                1.265455

8.4 Tamanho do efeito

library(effsize)
cohen.d(dados$Convulsões_PT, dados$Convulsões_S1, paired = T) # d estimate: 0.1734133 (negligible)
## 
## Cohen's d
## 
## d estimate: 0.1734133 (negligible)
## 95 percent confidence interval:
##      lower      upper 
## 0.08005992 0.26676663
cohen.d(dados$Convulsões_PT, dados$Convulsões_S6, paired = T) # d estimate: 0.2055402 (small)
## 
## Cohen's d
## 
## d estimate: 0.2055402 (small)
## 95 percent confidence interval:
##     lower     upper 
## 0.1032324 0.3078480

9 Anova com medidas repetidas

library(foreign) 
dados<- read.spss("C:/Users/user/Desktop/Vida acadêmica/Disciplinas/Estatística Vitor/Aula 2/Dados/Anova pareada.Friedman.sav")
## re-encoding from CP1252
library(tibble)
dados <- as_tibble(dados)
library(rstatix)

9.1 Pré-processamento

id <- as.data.frame(1:30)
dados <- cbind(dados, id)
names(dados)[names(dados) == "1:30"] <- "ID"
stackdados <- data.frame(dados[5], stack(dados[1:4]))

names(stackdados)[names(stackdados) == "values"] <- "Nota"
names(stackdados)[names(stackdados) == "ind"] <- "Professor"

stackdados %>% group_by(Professor) %>% shapiro_test(Nota)
## # A tibble: 4 x 4
##   Professor  variable statistic      p
##   <fct>      <chr>        <dbl>  <dbl>
## 1 Professor1 Nota         0.932 0.0539
## 2 Professor2 Nota         0.937 0.0772
## 3 Professor3 Nota         0.936 0.0694
## 4 Professor4 Nota         0.963 0.362

9.2 Teste igual ao SPSS

library(lme4) # Saida do SPSS
## Loading required package: Matrix
## 
## Attaching package: 'Matrix'
## The following objects are masked from 'package:tidyr':
## 
##     expand, pack, unpack
## Registered S3 methods overwritten by 'lme4':
##   method                          from
##   cooks.distance.influence.merMod car 
##   influence.merMod                car 
##   dfbeta.influence.merMod         car 
##   dfbetas.influence.merMod        car
library(lmerTest)
## 
## Attaching package: 'lmerTest'
## The following object is masked from 'package:lme4':
## 
##     lmer
## The following object is masked from 'package:stats':
## 
##     step
Modelo <- lmer(Nota ~ Professor + (1|ID), data = stackdados)
anova(Modelo)
## Type III Analysis of Variance Table with Satterthwaite's method
##           Sum Sq Mean Sq NumDF DenDF F value    Pr(>F)    
## Professor 18.614  6.2047     3    87  22.337 8.154e-11 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
summary(Modelo)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: Nota ~ Professor + (1 | ID)
##    Data: stackdados
## 
## REML criterion at convergence: 303.9
## 
## Scaled residuals: 
##      Min       1Q   Median       3Q      Max 
## -2.94253 -0.44982  0.03595  0.53239  2.40469 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  ID       (Intercept) 2.9847   1.728   
##  Residual             0.2778   0.527   
## Number of obs: 120, groups:  ID, 30
## 
## Fixed effects:
##                     Estimate Std. Error      df t value Pr(>|t|)    
## (Intercept)           6.4533     0.3298 33.0400  19.569  < 2e-16 ***
## ProfessorProfessor2  -0.3533     0.1361 87.0000  -2.596  0.01106 *  
## ProfessorProfessor3  -0.3633     0.1361 87.0000  -2.670  0.00905 ** 
## ProfessorProfessor4  -1.0833     0.1361 87.0000  -7.961 5.94e-12 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) PrfsP2 PrfsP3
## PrfssrPrfs2 -0.206              
## PrfssrPrfs3 -0.206  0.500       
## PrfssrPrfs4 -0.206  0.500  0.500

9.3 Teste mais robusto

library(ez)
mod.ANOVA <- ezANOVA(data = stackdados,
                     dv = Nota,
                     wid = ID,
                     within = Professor,
                     detailed = F,
                     type = 3)
## Warning: Converting "ID" to factor for ANOVA.
mod.ANOVA
## $ANOVA
##      Effect DFn DFd        F           p p<.05        ges
## 2 Professor   3  87 22.33742 8.15365e-11     * 0.04687972
## 
## $`Mauchly's Test for Sphericity`
##      Effect         W            p p<.05
## 2 Professor 0.3596959 3.164046e-05     *
## 
## $`Sphericity Corrections`
##      Effect       GGe        p[GG] p[GG]<.05      HFe       p[HF] p[HF]<.05
## 2 Professor 0.6145519 1.828006e-07         * 0.654355 8.21071e-08         *
# F = 22.33
# p = 8.15^-11
# ges = 0.04 (tamanho de efeito)
# Esferecididade = p < 0.05 (os dados não são esféricos)

9.4 Correção de Greenhouse-Geisser

library(rstatix) # Correção de Greenhouse-Geisser para problemas com esferecidade
res.aov <- anova_test(data = stackdados, dv = Nota, wid = ID, within = Professor)
get_anova_table(res.aov)
## ANOVA Table (type III tests)
## 
##      Effect  DFn   DFd      F        p p<.05   ges
## 1 Professor 1.84 53.47 22.337 1.83e-07     * 0.047

9.5 Post Hoc

library(tidyverse)
Posthoc <- stackdados %>%
  pairwise_t_test(Nota ~ Professor, paired = TRUE, p.adjust.method = "bonferroni")
print(Posthoc)
## # A tibble: 6 x 10
##   .y.   group1  group2     n1    n2 statistic    df       p   p.adj p.adj.signif
## * <chr> <chr>   <chr>   <int> <int>     <dbl> <dbl>   <dbl>   <dbl> <chr>       
## 1 Nota  Profes~ Profes~    30    30     4.15     29 2.68e-4 2.00e-3 **          
## 2 Nota  Profes~ Profes~    30    30     3.21     29 3.00e-3 1.90e-2 *           
## 3 Nota  Profes~ Profes~    30    30     5.81     29 2.67e-6 1.60e-5 ****        
## 4 Nota  Profes~ Profes~    30    30     0.117    29 9.07e-1 1.00e+0 ns          
## 5 Nota  Profes~ Profes~    30    30     4.73     29 5.44e-5 3.26e-4 ***         
## 6 Nota  Profes~ Profes~    30    30     4.54     29 9.16e-5 5.50e-4 ***

10 Teste de Wilcoxon, Teste não-paramétrico para o teste t pareado;

10.1 Importação

library(foreign) 
dados<- read.spss("C:/Users/user/Desktop/Vida acadêmica/Disciplinas/Estatística Vitor/Aula 2/Dados/Teste T pareado.Wilcoxon.sav")
## re-encoding from CP1252
library(tibble)
dados <- as_tibble(dados)

10.2 Pré-processamento

stackdados <- data.frame(dados[1], stack(dados[5:6]))
names(stackdados)[names(stackdados) == "values"] <- "Convulcoes"
names(stackdados)[names(stackdados) == "ind"] <- "Periodo"

10.3 Teste

q <- wilcox.test(stackdados$Convulcoes ~ stackdados$Periodo, paired = T)
q
## 
##  Wilcoxon signed rank test with continuity correction
## 
## data:  stackdados$Convulcoes by stackdados$Periodo
## V = 14626, p-value = 1.308e-05
## alternative hypothesis: true location shift is not equal to 0
qnorm(q$p.value)
## [1] -4.204585

10.4 Tamanho do efeito

library(rcompanion)
wilcoxonPairedR(x = stackdados$Convulcoes, g = stackdados$Periodo)
##     r 
## 0.263

11 Teste de Friedman, Teste não-paramétrico correspondentes ao teste da ANOVA com medidas repetidas;

library(foreign) 
dados<- read.spss("C:/Users/user/Desktop/Vida acadêmica/Disciplinas/Estatística Vitor/Aula 2/Dados/Anova pareada.Friedman.sav")
## re-encoding from CP1252
library(tibble)
dados <- as_tibble(dados)

11.1 Pré-processamento

id <- as.data.frame(1:30)
dados <- cbind(dados, id)
names(dados)[names(dados) == "1:30"] <- "ID"
stackdados <- data.frame(dados[5], stack(dados[1:4]))
names(stackdados)[names(stackdados) == "values"] <- "Nota"
names(stackdados)[names(stackdados) == "ind"] <- "Professor"
stackdados$ID <- factor(stackdados$ID)
library(PMCMRplus)
friedmanTest(stackdados$Nota, stackdados$Professor, stackdados$ID)
## 
##  Friedman rank sum test
## 
## data:  y, groups and blocks
## Friedman chi-squared = 32.41, df = 3, p-value = 4.289e-07
frdAllPairsSiegelTest(stackdados$Nota, stackdados$Professor, stackdados$ID,
                      p.adjust.methods = "bonferroni") # Equivalente ao Dunn-Bonferroni, mesma saída do SPSS
## 
##  Pairwise comparisons using Siegel-Castellan all-pairs test for a two-way balanced complete block design
## data: y, groups and blocks
##            Professor1 Professor2 Professor3
## Professor2 0.0563     -          -         
## Professor3 0.0563     0.9203     -         
## Professor4 1.3e-07    0.0046     0.0040
## 
## P value adjustment method: holm
frdAllPairsNemenyiTest(stackdados$Nota, stackdados$Professor, stackdados$ID,
                       p.adjust.methods = "bonferroni")
## 
##  Pairwise comparisons using Nemenyi-Wilcoxon-Wilcox all-pairs test for a two-way balanced complete block design
## 
## data: y, groups and blocks
##            Professor1 Professor2 Professor3
## Professor2 0.0870     -          -         
## Professor3 0.1100     0.9996     -         
## Professor4 1.3e-07    0.0063     0.0045
## 
## P value adjustment method: single-step
library(rstatix)
stackdados %>% friedman_effsize(Nota ~ Professor | ID) # Tamanho do efeito
## # A tibble: 1 x 5
##   .y.       n effsize method    magnitude
## * <chr> <int>   <dbl> <chr>     <ord>    
## 1 Nota     30   0.360 Kendall W moderate
library(irr)
## Loading required package: lpSolve
kendall(t(stackdados), correct = T) # Coeficiente de concordância - credibilidade
##  Kendall's coefficient of concordance Wt
## 
##  Subjects = 3 
##    Raters = 120 
##        Wt = 0.878 
## 
##  Chisq(2) = 211 
##   p-value = 1.67e-46

12 Crohan q teste

12.1 Importação dos dados

library(foreign) 
dados<- read.spss("C:/Users/user/Desktop/Vida acadêmica/Disciplinas/Estatística Vitor/Aula 2/Dados/Crohan Q.sav")
## re-encoding from UTF-8
library(tibble)
dados <- as_tibble(dados)

12.2 Pré-processamento

id <- as.data.frame(1:60)
dados <- cbind(dados, id)
names(dados)[names(dados) == "1:60"] <- "ID"

library(reshape2)
## 
## Attaching package: 'reshape2'
## The following object is masked from 'package:tidyr':
## 
##     smiths
dados <- melt(dados, id.vars = c("ID"))

names(dados)[names(dados) == "variable"] <- "Campanha"
names(dados)[names(dados) == "value"] <- "Cliente"

# Garantir que o R não alfabetize os dados
dados$Cliente = factor(dados$Cliente,
                       levels=unique(dados$Cliente))

dados$Cliente <- as.numeric(dados$Cliente) - 1 # Quantificar a variável de resposta

12.3 Teste

Tabela = xtabs(Cliente ~ ID + Campanha, data=dados)
xtabs( ~ Cliente + Campanha, data=dados)
##        Campanha
## Cliente Sem_campanha Campanha_1 Campanha_2
##       0           40         36         25
##       1           20         24         35
library(RVAideMemoire)
## *** Package RVAideMemoire v 0.9-75 ***
## 
## Attaching package: 'RVAideMemoire'
## The following object is masked from 'package:lme4':
## 
##     dummy
## The following object is masked from 'package:FSA':
## 
##     se
## The following object is masked from 'package:dunn.test':
## 
##     dunn.test
cochran.qtest(Cliente ~ Campanha | ID, data = dados) # Q = 24.1333, df = 2, p-value = 5.748e-06
## 
##  Cochran's Q test
## 
## data:  Cliente by Campanha, block = ID 
## Q = 24.1333, df = 2, p-value = 5.748e-06
## alternative hypothesis: true difference in probabilities is not equal to 0 
## sample estimates:
## proba in group Sem_campanha   proba in group Campanha_1 
##                   0.3333333                   0.4000000 
##   proba in group Campanha_2 
##                   0.5833333 
## 
##         Pairwise comparisons using Wilcoxon sign test
## 
##            Sem_campanha Campanha_1
## Campanha_1    0.1250000          -
## Campanha_2    0.0001831   0.001465
## 
## P value adjustment method: fdr
dados$Campanha = factor(dados$Campanha,
                       levels = c("Sem_campanha", "Campanha_1",
                                  "Campanha_2"))

12.4 Post-hoc

library(rcompanion)
pairwiseMcnemar(Cliente ~ Campanha | ID,
                     data   = dados,
                     test   = "exact",
                     method = "bonferroni",
                     digits = 3) # Teste ajustado
## $Test.method
##    Test
## 1 exact
## 
## $Adustment.method
##       Method
## 1 bonferroni
## 
## $Pairwise
##                      Comparison Successes Trials  p.value p.adjust
## 1 Sem_campanha - Campanha_1 = 0         0      4    0.125 0.375000
## 2 Sem_campanha - Campanha_2 = 0         0     15  6.1e-05 0.000183
## 3   Campanha_1 - Campanha_2 = 0         0     11 0.000977 0.002930

13 Tamanho do efeito

# Q/b(k-1)

Q <- 24.1333
b <- 60
k <- 3

b <- b*(k-1)

Q/b #0.2011108
## [1] 0.2011108
# Serlin, R. C., Carr, J., and Marascuillo, L. A. (1982). A measure of association for selected nonparametric procedures. Psychological Bulletin, 92:786–790