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
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
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
# 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
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
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
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")
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
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
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
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
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)
# 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
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
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
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)
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
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
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
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
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
Versão não-paramétrica do teste t de independência
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
# 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
# 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
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)
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
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
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
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)
mean(dados$Convulsões_PT)
## [1] 5.629091
mean(dados$Convulsões_S1)
## [1] 4.545455
mean(dados$Convulsões_S6)
## [1] 4.363636
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
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
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)
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
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
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)
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
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 ***
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)
stackdados <- data.frame(dados[1], stack(dados[5:6]))
names(stackdados)[names(stackdados) == "values"] <- "Convulcoes"
names(stackdados)[names(stackdados) == "ind"] <- "Periodo"
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
library(rcompanion)
wilcoxonPairedR(x = stackdados$Convulcoes, g = stackdados$Periodo)
## r
## 0.263
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)
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
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)
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
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"))
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
# 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