Análise

Resultados

Dados

dadz <- dad[c(-2:-3,-9:-10,-13)] 
dadz %>% kable

id	pto	dist	sys	dia	freq.c	elevm	incl	cad
P1	1	0	133	79	78	31.5	0.0	72
P1	2	300	174	86	110	55.5	24.1	76
P1	3	600	149	79	105	85.5	-8.6	96
P1	4	900	137	78	93	70.5	-18.7	106
P1	5	1200	128	71	91	44.0	-26.0	106
P1	6	1500	138	78	93	23.5	-17.6	62
P1	7	1800	127	81	91	28.0	5.0	40
P1	8	2100	152	74	102	26.0	3.1	90
P1	9	2400	132	79	93	24.5	-4.0	82
P1	10	2700	137	79	95	26.5	11.0	84
P1	11	3000	136	70	115	28.0	-0.9	94
P1	12	3300	124	79	99	24.0	-0.3	28
P1	13	3600	123	78	96	22.0	1.7	90
P1	14	3900	131	83	98	21.0	-4.5	92
P1	15	4200	132	73	91	21.0	4.2	94
P1	16	4500	148	86	89	31.5	-10.0	100
P1	17	4800	129	81	90	22.5	-1.2	72
P1	18	5100	130	86	101	20.0	8.6	78
P1	19	5400	126	84	87	16.5	1.9	72
P1	20	5700	150	69	87	17.5	1.0	32
P2	1	0	100	68	75	31.5	0.0	72
P2	2	300	123	81	123	55.5	24.1	76
P2	3	600	69	43	72	85.5	-8.6	96
P2	4	900	105	75	113	70.5	-18.7	106
P2	5	1200	105	76	104	44.0	-26.0	106
P2	6	1500	101	65	121	23.5	-17.6	62
P2	7	1800	107	73	114	28.0	5.0	40
P2	8	2100	108	64	135	26.0	3.1	90
P2	9	2400	94	61	118	24.5	-4.0	82
P2	10	2700	99	67	111	26.5	11.0	84
P2	11	3000	113	72	131	28.0	-0.9	94
P2	12	3300	63	40	103	24.0	-0.3	28
P2	13	3600	99	66	124	22.0	1.7	90
P2	14	3900	102	66	123	21.0	-4.5	92
P2	15	4200	108	76	109	21.0	4.2	94
P2	16	4500	114	76	110	31.5	-10.0	100
P2	17	4800	103	71	123	22.5	-1.2	72
P2	18	5100	100	66	127	20.0	8.6	78
P2	19	5400	74	60	112	16.5	1.9	72
P2	20	5700	97	74	120	17.5	1.0	32
P3	1	0	147	96	112	31.5	0.0	72
P3	2	300	148	92	146	55.5	24.1	76
P3	3	600	151	88	137	85.5	-8.6	96
P3	4	900	133	94	116	70.5	-18.7	106
P3	5	1200	127	81	114	44.0	-26.0	106
P3	6	1500	132	90	129	23.5	-17.6	62
P3	7	1800	137	88	132	28.0	5.0	40
P3	8	2100	140	79	134	26.0	3.1	90
P3	9	2400	128	78	129	24.5	-4.0	82
P3	10	2700	130	82	132	26.5	11.0	84
P3	11	3000	147	87	134	28.0	-0.9	94
P3	12	3300	120	82	132	24.0	-0.3	28
P3	13	3600	124	81	118	22.0	1.7	90
P3	14	3900	118	81	122	21.0	-4.5	92
P3	15	4200	127	83	114	21.0	4.2	94
P3	16	4500	152	82	122	31.5	-10.0	100
P3	17	4800	127	77	114	22.5	-1.2	72
P3	18	5100	131	77	124	20.0	8.6	78
P3	19	5400	135	81	122	16.5	1.9	72
P3	20	5700	120	85	112	17.5	1.0	32
P4	1	0	122	100	91	31.5	0.0	72
P4	2	300	210	112	146	55.5	24.1	76
P4	3	600	165	137	105	85.5	-8.6	96
P4	4	900	114	87	123	70.5	-18.7	106
P4	5	1200	120	90	119	44.0	-26.0	106
P4	6	1500	119	94	136	23.5	-17.6	62
P4	7	1800	120	88	127	28.0	5.0	40
P4	8	2100	127	100	134	26.0	3.1	90
P4	9	2400	125	87	137	24.5	-4.0	82
P4	10	2700	129	79	124	26.5	11.0	84
P4	11	3000	126	101	138	28.0	-0.9	94
P4	12	3300	106	85	102	24.0	-0.3	28
P4	13	3600	115	88	131	22.0	1.7	90
P4	14	3900	119	83	132	21.0	-4.5	92
P4	15	4200	133	87	115	21.0	4.2	94
P4	16	4500	100	96	115	31.5	-10.0	100
P4	17	4800	116	84	133	22.5	-1.2	72
P4	18	5100	120	88	127	20.0	8.6	78
P4	19	5400	160	135	91	16.5	1.9	72
P4	20	5700	172	94	113	17.5	1.0	32
P5	1	0	137	89	67	31.5	0.0	72
P5	2	300	167	114	93	55.5	24.1	76
P5	3	600	143	91	101	85.5	-8.6	96
P5	4	900	125	80	100	70.5	-18.7	106
P5	5	1200	109	75	104	44.0	-26.0	106
P5	6	1500	134	88	115	23.5	-17.6	62
P5	7	1800	133	91	126	28.0	5.0	40
P5	8	2100	126	89	134	26.0	3.1	90
P5	9	2400	120	83	132	24.5	-4.0	82
P5	10	2700	122	79	129	26.5	11.0	84
P5	11	3000	142	87	134	28.0	-0.9	94
P5	12	3300	112	77	145	24.0	-0.3	28
P5	13	3600	124	80	127	22.0	1.7	90
P5	14	3900	106	72	127	21.0	-4.5	92
P5	15	4200	119	78	110	21.0	4.2	94
P5	16	4500	136	89	115	31.5	-10.0	100
P5	17	4800	115	73	116	22.5	-1.2	72
P5	18	5100	125	84	130	20.0	8.6	78
P5	19	5400	120	80	117	16.5	1.9	72
P5	20	5700	115	78	120	17.5	1.0	32
P6	1	0	165	68	28	31.5	0.0	72
P6	2	300	120	91	104	55.5	24.1	76
P6	3	600	125	84	97	85.5	-8.6	96
P6	4	900	96	62	78	70.5	-18.7	106
P6	5	1200	115	42	78	44.0	-26.0	106
P6	6	1500	121	76	100	23.5	-17.6	62
P6	7	1800	117	70	90	28.0	5.0	40
P6	8	2100	82	60	96	26.0	3.1	90
P6	9	2400	113	57	95	24.5	-4.0	82
P6	10	2700	99	49	91	26.5	11.0	84
P6	11	3000	106	65	109	28.0	-0.9	94
P6	12	3300	104	58	95	24.0	-0.3	28
P6	13	3600	103	61	78	22.0	1.7	90
P6	14	3900	95	58	99	21.0	-4.5	92
P6	15	4200	106	63	94	21.0	4.2	94
P6	16	4500	124	67	91	31.5	-10.0	100
P6	17	4800	97	60	93	22.5	-1.2	72
P6	18	5100	103	58	100	20.0	8.6	78
P6	19	5400	112	64	98	16.5	1.9	72
P6	20	5700	116	62	90	17.5	1.0	32
P7	1	0	131	78	83	31.5	0.0	72
P7	2	300	144	89	110	55.5	24.1	76
P7	3	600	133	83	109	85.5	-8.6	96
P7	4	900	131	90	102	70.5	-18.7	106
P7	5	1200	112	84	83	44.0	-26.0	106
P7	6	1500	106	75	109	23.5	-17.6	62
P7	7	1800	109	76	98	28.0	5.0	40
P7	8	2100	107	71	112	26.0	3.1	90
P7	9	2400	116	88	91	24.5	-4.0	82
P7	10	2700	137	95	70	26.5	11.0	84
P7	11	3000	119	63	121	28.0	-0.9	94
P7	12	3300	129	70	105	24.0	-0.3	28
P7	13	3600	109	68	108	22.0	1.7	90
P7	14	3900	109	69	106	21.0	-4.5	92
P7	15	4200	117	67	105	21.0	4.2	94
P7	16	4500	151	85	111	31.5	-10.0	100
P7	17	4800	124	63	105	22.5	-1.2	72
P7	18	5100	107	65	103	20.0	8.6	78
P7	19	5400	125	78	99	16.5	1.9	72
P7	20	5700	129	80	97	17.5	1.0	32
P8	1	0	120	79	95	31.5	0.0	72
P8	2	300	132	74	161	55.5	24.1	76
P8	3	600	124	81	140	85.5	-8.6	96
P8	4	900	105	79	131	70.5	-18.7	106
P8	5	1200	115	81	132	44.0	-26.0	106
P8	6	1500	113	82	146	23.5	-17.6	62
P8	7	1800	115	81	126	28.0	5.0	40
P8	8	2100	164	128	134	26.0	3.1	90
P8	9	2400	121	76	136	24.5	-4.0	82
P8	10	2700	121	77	140	26.5	11.0	84
P8	11	3000	121	76	139	28.0	-0.9	94
P8	12	3300	121	78	135	24.0	-0.3	28
P8	13	3600	125	80	146	22.0	1.7	90
P8	14	3900	120	79	139	21.0	-4.5	92
P8	15	4200	130	81	128	21.0	4.2	94
P8	16	4500	125	81	126	31.5	-10.0	100
P8	17	4800	121	83	126	22.5	-1.2	72
P8	18	5100	136	81	138	20.0	8.6	78
P8	19	5400	119	69	137	16.5	1.9	72
P8	20	5700	117	80	124	17.5	1.0	32
P9	1	0			103	31.5	0.0	72
P9	2	300			130	55.5	24.1	76
P9	3	600			93	85.5	-8.6	96
P9	4	900			120	70.5	-18.7	106
P9	5	1200			108	44.0	-26.0	106
P9	6	1500			88	23.5	-17.6	62
P9	7	1800			140	28.0	5.0	40
P9	8	2100			90	26.0	3.1	90
P9	9	2400			111	24.5	-4.0	82
P9	10	2700			140	26.5	11.0	84
P9	11	3000			140	28.0	-0.9	94
P9	12	3300			132	24.0	-0.3	28
P9	13	3600			99	22.0	1.7	90
P9	14	3900			133	21.0	-4.5	92
P9	15	4200			116	21.0	4.2	94
P9	16	4500			109	31.5	-10.0	100
P9	17	4800			123	22.5	-1.2	72
P9	18	5100			94	20.0	8.6	78
P9	19	5400			81	16.5	1.9	72
P9	20	5700			102	17.5	1.0	32

Tabela de dados

dad %>% ggboxplot(
  y = "freq.c",
  x = "dist",
  fill = cor,
  bxp.errorbar = T,
  xlab = "Distância",
  ylab = "Frequência Cardíaca") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) 

Boxplot da frequência cardíaca de todos os participantes ao longo da trilha

dad %>% ggbarplot(
  x = "dist",
  y = "freq.c",
  add = "mean_se",
  fill = cor,
  xlab = "Distância (m)",
  ylab = "Frequência Cardíaca (bpm)") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) 

Variação da frequência cardíaca de todos os participantes ao longo da trilha

Gráfico 1

dad %>% filter(nome != "Cid") %>% ggplot() +
  aes(x = sys,
      y = dia,
      #fill = nome,  
      #colour = nome
  ) + geom_point(aes(colour = id), size = 3) +
  geom_smooth(method = 'lm',
              formula = y ~ x,
              se = T) + xlab("Pressão Sistólica") + ylab("Pressão Diastólica") + 
  ggtitle("") +
  #geom_text_repel(size = 3,vjust = -.2,  show.legend=T) + 
  theme_classic2() + theme(legend.title = element_blank()) +
  stat_poly_eq(formula = y ~ x,
               aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")),
               parse = TRUE)

Coeficiente de determinação entre a pressão sistólica e diastólica, R² = 0.46

dad %>% filter(nome != "Cid") %>% ggscatter(
  x = "sys",
  y = "dia",
  col = "id",
  #size="dist",
  conf.int = F,
  cor.coef = F,
  cor.method = "spearman",
  add = "reg.line",
  cor.coeff.args = list(method = "spearman",
                        label.x.npc = "right",
                        label.y.npc = "top"), 
  xlab="Pressão Sistólica",
  ylab= "Pressão Diastólica")+
  theme_pubr(legend = "right") + 
  theme(legend.title = element_blank()) +
  stat_cor(aes(col = id), method = "spearman")

Coeficiente de correlação entre a pressão sistólica e diastólica para cada individuo

Gráfico 2

dad %>% ggboxplot(x = "id",
                  "freq.c",
                  xlab = "Participante",
                  ylab = "Frequência cardíaca",
                  fill="id",
                  bxp.errorbar = T) +
  theme_pubr(legend = "none") + 
  theme(legend.title = element_blank()) 

Variação da frequência cardíaca por participante

ANAVA

av <- aov(freq.c ~ id ,dad)
anova(av) %>% kable

	Df	Sum Sq	Mean Sq	F value	Pr(>F)
id	8	32838.11	4104.7639	19.23054	0
Residuals	171	36500.00	213.4503

Tukey dados nao transformados

 
tk <- TukeyC(av)
tk[["out"]][["Result"]] %>% kable

	Means	G1	G2	G3	G4
P8	133.95	a
P3	124.75	a	b
P4	121.95	a	b
P5	117.10		b
P2	113.40		b	c
P9	112.60		b	c
P7	101.35			c	d
P1	95.20				d
P6	90.20				d

Análise de variânca da frequência cardiáca dos participantes seguido do teste de Tukey

Kruskall

dad %>%
  group_by(id) %>%
  get_summary_stats(freq.c, type = "mean") %>% 
  arrange(desc(mean)) %>% 
  kable 

id	variable	n	mean
P8	freq.c	20	133.95
P3	freq.c	20	124.75
P4	freq.c	20	121.95
P5	freq.c	20	117.10
P2	freq.c	20	113.40
P9	freq.c	20	112.60
P7	freq.c	20	101.35
P1	freq.c	20	95.20
P6	freq.c	20	90.20

bxp <- ggboxplot(
  dad,
  x = "id",
  y = "freq.c",
  fill = "id",
  palette = "hue",
  bxp.errorbar = T, add = "jitter")

Histograma e Densidade

gghistogram(dad,
            x = "freq.c", y = "..density..", 
            xlab="Frequência Cardíaca",
            ylab="Densidade",
            fill = "steelblue", bins = 10, add_density = TRUE)

Teste de normalidade

dad %>%
  shapiro_test(freq.c) %>% kable

variable	statistic	p
freq.c	0.9736008	0.0017073

Os dados de frequência cardíaca não seguem uma distribuição normal

Teste de normalidade por individuo

dad %>%
  group_by(id) %>%
  shapiro_test(freq.c) %>% kable

id	variable	statistic	p
P1	freq.c	0.9595595	0.5350863
P2	freq.c	0.8482937	0.0049913
P3	freq.c	0.9347900	0.1908352
P4	freq.c	0.9365702	0.2063823
P5	freq.c	0.9248187	0.1227025
P6	freq.c	0.6870357	0.0000272
P7	freq.c	0.9050463	0.0513256
P8	freq.c	0.8771341	0.0157187
P9	freq.c	0.9429609	0.2725837

Os dados de frequência cardíaca seguem uma distribuição normal para alguns individuos

Teste Bartlett

res <- bartlett.test(freq.c ~ id, data = dad)
res

    Bartlett test of homogeneity of variances

data:  freq.c by id
Bartlett's K-squared = 20.728, df = 8, p-value = 0.007905

De acordo com o teste de Bartlett a 5% de significância, as variâncias não podem ser consideradas homogêneas.

Teste Levene

dad %>% levene_test(freq.c ~ factor(id))  %>% kable

df1	df2	statistic	p
8	171	1.857767	0.0696621

De acordo com o teste de Levene a 5% de significância, as variâncias não podem ser consideradas homogêneas.

QQ plot

model <- lm(freq.c ~ id, data = dad)

ggqqplot(residuals(model))

shapiro_test(residuals(model)) %>% kable()

variable	statistic	p.value
residuals(model)	0.9426287	1.3e-06

Graficamente também é possível perceber que os resíduos dos dados de frequência cardíaca não seguem uma distribuição normal

Após esses testes deve-se seguir para uma análise não paramétrica, o teste escolhido foi o de Kruskal

Kruskal-Wallis

res.kruskal <- dad %>%
  kruskal_test(freq.c ~ id) %>% add_significance()

res.kruskal %>% kable(digits = 16)

.y.	n	statistic	df	p	method	p.signif
freq.c	180	92.05515	8	2e-16	Kruskal-Wallis	****

Tamanho do efeito do teste Kruskal-Wallis

dad %>% kruskal_effsize(freq.c ~ id)  %>% kable

.y.	n	effsize	method	magnitude
freq.c	180	0.4915506	eta2[H]	large

O eta quadrado, com base na estatística H, pode ser usado como a medida do tamanho do efeito do teste de Kruskal-Wallis. É calculado da seguinte forma: eta2 [H] = (H - k + 1) / (n - k); onde H é o valor obtido no teste de Kruskal-Wallis; k é o número de grupos; n é o número total de observações (M. T. Tomczak e Tomczak 2014). A estimativa eta-quadrada assume valores de 0 a 1 e multiplicada por 100 indica a porcentagem de variância na variável dependente explicada pela variável independente. Os valores de interpretação comumente encontrados na literatura publicada são: 0,01- <0,06 (efeito pequeno), 0,06 - <0,14 (efeito moderado) e> = 0,14 (efeito grande).

Maciej Tomczak and Ewa Tomczak. The need to report effect size estimates revisited. An overview of some recommended measures of effect size. Trends in Sport Sciences. 2014; 1(21):19-25.

Densidade dos dados de Frequência Cardíaca

ggdensity(dad, x = "freq.c", rug = TRUE, fill = "lightgray", xlab = "Frequência Cardíaca", ylab="Densidade") +
  stat_central_tendency(type = "median", color = "red", linetype = "dashed") +
  labs(subtitle = get_test_label(res.kruskal, detailed = TRUE)) +   
  annotate("segment", x = 145, xend = 115, y = 0.016, yend = 0.010, colour = "red", size = 0.7, arrow = arrow()) +
  annotate("text",
           x = 145, y = 0.017, label = "mediana",
           angle = 0, size = 5, family = "Segoe UI", col = "red") 

pwc2 <- dad %>%
  dunn_test(freq.c ~ id, p.adjust.method = "bonferroni") %>%
  add_significance()

pwc2[-1][-3:-4] %>%  kable()

group1	group2	statistic	p	p.adj	p.adj.signif
P1	P2	3.4025337	0.0006676	0.0240351	*
P1	P3	5.2510110	0.0000002	0.0000054	****
P1	P4	4.7653683	0.0000019	0.0000679	****
P1	P5	4.0353867	0.0000545	0.0019624	**
P1	P6	-0.2853150	0.7754028	1.0000000	ns
P1	P7	1.2383887	0.2155720	1.0000000	ns
P1	P8	6.7246328	0.0000000	0.0000000	****
P1	P9	3.1141834	0.0018445	0.0664037	ns
P2	P3	1.8484773	0.0645333	1.0000000	ns
P2	P4	1.3628346	0.1729346	1.0000000	ns
P2	P5	0.6328531	0.5268296	1.0000000	ns
P2	P6	-3.6878487	0.0002262	0.0081417	**
P2	P7	-2.1641450	0.0304532	1.0000000	ns
P2	P8	3.3220991	0.0008934	0.0321635	*
P2	P9	-0.2883503	0.7730786	1.0000000	ns
P3	P4	-0.4856426	0.6272206	1.0000000	ns
P3	P5	-1.2156242	0.2241281	1.0000000	ns
P3	P6	-5.5363260	0.0000000	0.0000011	****
P3	P7	-4.0126222	0.0000600	0.0021617	**
P3	P8	1.4736219	0.1405834	1.0000000	ns
P3	P9	-2.1368276	0.0326120	1.0000000	ns
P4	P5	-0.7299816	0.4654014	1.0000000	ns
P4	P6	-5.0506834	0.0000004	0.0000158	****
P4	P7	-3.5269796	0.0004203	0.0151318	*
P4	P8	1.9592645	0.0500818	1.0000000	ns
P4	P9	-1.6511849	0.0987008	1.0000000	ns
P5	P6	-4.3207018	0.0000156	0.0005599	***
P5	P7	-2.7969980	0.0051580	0.1856875	ns
P5	P8	2.6892461	0.0071614	0.2578090	ns
P5	P9	-0.9212034	0.3569443	1.0000000	ns
P6	P7	1.5237038	0.1275827	1.0000000	ns
P6	P8	7.0099479	0.0000000	0.0000000	****
P6	P9	3.3994984	0.0006751	0.0243034	*
P7	P8	5.4862441	0.0000000	0.0000015	****
P7	P9	1.8757947	0.0606835	1.0000000	ns
P8	P9	-3.6104494	0.0003057	0.0110040	*

A partir do resultado do teste de Kruskal-Wallis, sabemos que há uma diferença significativa entre os grupos, mas não sabemos quais pares de grupos são diferentes. Um teste de Kruskal-Wallis significativo é geralmente seguido pelo teste de Dunn para identificar quais grupos são diferentes.

pwc2 <- pwc2 %>%
  add_xy_position(x = "id")

Boxplot dos dados de Frequência Cardíaca, seguido da significância do teste Kruskal-Wallis e a diferença entre os grupos

bxp + stat_pvalue_manual(pwc2, hide.ns = T) +
  labs(subtitle = get_test_label(res.kruskal, detailed = T),
       caption = get_pwc_label(pwc2)) + 
  theme_pubr(legend = "none") + 
  ylab("Frequência Cardíaca") +
  xlab("") +
  theme(legend.title = element_blank(),
        text = element_text(),
        axis.text.y = element_text(angle = 0,
                                   hjust = 1,
                                   colour = "black"),
        axis.text.x = element_text(angle = 0,
                                   hjust = 0.5,
                                   colour = "black"))

Gráfico 3

dad %>% ggplot() +
  aes(x = factor(dist),
      fill = id,  
      colour = id,
      group=id) + 
  geom_line(aes(y=elevm,color="Altimetria"), color="black", size = 1.5) +
  geom_line(aes(y=freq.c/2), size = 1) +
  xlab("Distância (m)") + ylab("Elevação (Altitude)") + 
  ggtitle("Elevação (Altitude) x Inclinação") +
  scale_y_continuous(sec.axis = sec_axis( ~ . * 2,
                                          name = "Frequência Cardíaca (bpm)")) +
  theme_classic() +
  theme(legend.position = "right", 
        legend.title = element_blank(),
        text = element_text(size = 10),
        axis.text.x = element_text(
          angle = 45,
          hjust = 1,
          colour = "black"))

Perfil de elevação ao longo da trilha no eixo Y e frequência cardíaca de cada participante no segundo eixo

Gráfico 4

ggscatter(subset(dad, nome != "Cid"),
          x = "sys",
          y = "dia",
          add = "reg.line",
          conf.int = TRUE,
          cor.coef = TRUE,
          cor.method = "spearman",
          xlab = "Pressão Sistólica",
          ylab = "Pressão Diastólica",
          facet.by=c("id"),
          font.label = c(5, "plain"))+
  labs(tag = "")+
  theme_pubr(legend = "none") + 
  theme(legend.title = element_blank()) 

Gráfico 5

ggscatter(subset(dad, nome != "Cid"),
          x = "sys",
          y = "dia",
          add = "reg.line",
          add.params = list(color = "blue", fill = "lightgray"), 
          col="id",
          palette = "hue",
          conf.int = TRUE,
          cor.coef = TRUE,
          cor.method = "spearman",
          xlab = "Sistólica",
          ylab = "Diastólica",
          font.label = c(5, "plain"))+
  labs(tag = "")+
  theme_pubr(legend = "none") + 
  theme(legend.title = element_blank()) 

Gráfico de correlaçao entre a pressão sistólica e diastólica dos 8 participantes, Cid - P9 não teve a pressão aferida

Gráfico 6

dadn <- dad[,c("dist","elevm","incl","cad","sys","dia","freq.c")]
names(dadn) <- c("Dist", "Elev (Alt)", "Incl", "Cad", "Sys", "Dia", "FreqC.")


dadn  %>% pairs.panels(.,
                       show.points =
                         TRUE,
                       method = "spearman",
                       gap =
                         0,
                       stars =
                         T,
                       ci =
                         T,
                       alpha =
                         0.05,
                       cex.cor =
                         1,
                       cex =
                         1.0,
                       breaks =
                         "Sturges",
                       rug =
                         FALSE,
                       density =
                         T,
                       hist.col =
                         "darkgreen",
                       factor =
                         5,
                       digits =
                         2,
                       ellipses =
                         TRUE,
                       scale =
                         FALSE,
                       smooth =
                         TRUE,
                       lm =
                         T,
                       cor =
                         T)

Foi utilizado metodo de Correlação de Spearman, já que os dados não seguem uma distribuição normal

dados.pca <- subset(dad, nome != "Cid") %>% 
  group_by(id,dist) %>%
  summarise_all("mean")

dados.pca <- dados.pca[c(
  "id",
  "dist",
  "sys",
  "dia",
  "freq.c",
  "elevm",
  "incl",
  "cad")
]

names(dados.pca) <-
  c(
    "id",
    "dist",
    "PA Sis",
    "PA Dia",
    "Freq.Card",
    "Elev",
    "Cad",
    "Incl")


fert.pca <-
  PCA(
    dados.pca[-1:-2],
    graph = F,
    scale.unit = TRUE,
    ncp = 4,
    axes = 4
  )


eig.val <- get_eigenvalue(fert.pca)
eig.val

      eigenvalue variance.percent cumulative.variance.percent
Dim.1  1.8609192        31.015320                    31.01532
Dim.2  1.6557274        27.595457                    58.61078
Dim.3  0.9683718        16.139530                    74.75031
Dim.4  0.6751202        11.252003                    86.00231
Dim.5  0.5607020         9.345034                    95.34734
Dim.6  0.2791594         4.652657                   100.00000

fviz_eig(fert.pca, addlabels=TRUE)

var <- get_pca_var(fert.pca)
var

Principal Component Analysis Results for variables
 ===================================================
  Name       Description                                    
1 "$coord"   "Coordinates for the variables"                
2 "$cor"     "Correlations between variables and dimensions"
3 "$cos2"    "Cos2 for the variables"                       
4 "$contrib" "contributions of the variables"               

$coord

$cor

$cos2

$contrib

Coordinates for the variables

Correlations between variables and dimensions

Cos2 for the variables

contributions of the variables

#  Coordenadas
head(var$coord)

               Dim.1      Dim.2       Dim.3       Dim.4
PA Sis    0.84547826  0.2174355 -0.29855409 -0.04378353
PA Dia    0.87174302  0.1919505 -0.02023082 -0.26947277
Freq.Card 0.28354025  0.2959290  0.89514625 -0.01171268
Elev      0.46923564 -0.6397165 -0.08901302  0.26054268
Cad       0.08788077  0.7470856 -0.10640891  0.64256276
Incl      0.27901541 -0.7187880  0.24144351  0.34594943

# Cos2: qualidade no mapa do fator
head(var$cos2)

               Dim.1      Dim.2        Dim.3        Dim.4
PA Sis    0.71483349 0.04727818 0.0891345436 0.0019169977
PA Dia    0.75993590 0.03684499 0.0004092862 0.0726155716
Freq.Card 0.08039507 0.08757397 0.8012868077 0.0001371868
Elev      0.22018208 0.40923719 0.0079233179 0.0678824879
Cad       0.00772303 0.55813691 0.0113228559 0.4128869000
Incl      0.07784960 0.51665620 0.0582949678 0.1196810060

# Contribuições para os componentes principais
head(var$contrib)

               Dim.1     Dim.2      Dim.3       Dim.4
PA Sis    38.4129252  2.855433  9.2045788  0.28394912
PA Dia    40.8365881  2.225305  0.0422654 10.75594790
Freq.Card  4.3201807  5.289154 82.7457827  0.02032035
Elev      11.8318993 24.716458  0.8182103 10.05487510
Cad        0.4150116 33.709468  1.1692674 61.15754359
Incl       4.1833951 31.204182  6.0198954 17.72736394

fviz_cos2(fert.pca, choice = "var", axes = 1:4)

summary(fert.pca)

Call:
PCA(X = dados.pca[-1:-2], scale.unit = TRUE, ncp = 4, graph = F,  
     axes = 4) 


Eigenvalues
                       Dim.1   Dim.2   Dim.3   Dim.4   Dim.5   Dim.6
Variance               1.861   1.656   0.968   0.675   0.561   0.279
% of var.             31.015  27.595  16.140  11.252   9.345   4.653
Cumulative % of var.  31.015  58.611  74.750  86.002  95.347 100.000

Individuals (the 10 first)
              Dist    Dim.1    ctr   cos2    Dim.2    ctr   cos2    Dim.3
1         |  1.837 | -0.091  0.003  0.002 | -0.054  0.001  0.001 | -1.817
2         |  3.833 |  2.533  2.155  0.437 |  1.279  0.618  0.111 | -1.319
3         |  3.469 |  1.920  1.238  0.306 | -2.171  1.779  0.392 | -0.749
4         |  3.198 |  1.104  0.409  0.119 | -2.803  2.965  0.768 | -0.823
5         |  2.947 | -0.086  0.003  0.001 | -2.634  2.619  0.799 | -0.555
6         |  2.129 | -0.170  0.010  0.006 | -0.317  0.038  0.022 | -1.098
7         |  2.149 | -0.387  0.050  0.032 |  1.238  0.579  0.332 | -1.513
8         |  1.802 |  0.619  0.129  0.118 |  0.205  0.016  0.013 | -0.808
9         |  1.193 | -0.032  0.000  0.001 | -0.159  0.010  0.018 | -0.925
10        |  1.675 |  0.297  0.030  0.031 |  0.608  0.139  0.132 | -1.049
             ctr   cos2  
1          2.130  0.978 |
2          1.123  0.118 |
3          0.362  0.047 |
4          0.437  0.066 |
5          0.199  0.035 |
6          0.777  0.266 |
7          1.478  0.496 |
8          0.422  0.201 |
9          0.552  0.601 |
10         0.711  0.393 |

Variables
             Dim.1    ctr   cos2    Dim.2    ctr   cos2    Dim.3    ctr   cos2
PA Sis    |  0.845 38.413  0.715 |  0.217  2.855  0.047 | -0.299  9.205  0.089
PA Dia    |  0.872 40.837  0.760 |  0.192  2.225  0.037 | -0.020  0.042  0.000
Freq.Card |  0.284  4.320  0.080 |  0.296  5.289  0.088 |  0.895 82.746  0.801
Elev      |  0.469 11.832  0.220 | -0.640 24.716  0.409 | -0.089  0.818  0.008
Cad       |  0.088  0.415  0.008 |  0.747 33.709  0.558 | -0.106  1.169  0.011
Incl      |  0.279  4.183  0.078 | -0.719 31.204  0.517 |  0.241  6.020  0.058
           
PA Sis    |
PA Dia    |
Freq.Card |
Elev      |
Cad       |
Incl      |

# Contribuições de variáveis para PC1
fviz_contrib(fert.pca, choice = "var", axes = 1)

# Contribuições de variáveis para PC2
fviz_contrib(fert.pca, choice = "var", axes = 2)

# Contribuições de variáveis para PC3
fviz_contrib(fert.pca, choice = "var", axes = 3)

# Contribuições de variáveis para PC4
fviz_contrib(fert.pca, choice = "var", axes = 4)

# contribuição total para PC1 e PC2 

fviz_contrib(fert.pca, choice = "var", axes = 1:4)

Gráfco 7

fviz_pca_biplot(
  fert.pca,
  axes = c(1,2),
  # Individuals
  geom.ind = "point",
  # Variables
  col.var = "contrib",
  gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
  #gradient.cols = c("cyan", "blue", "red"),
  legend.title = "Contribuição",
  title="Biplot da Análise de Componentes Principais",
  repel = F)

fviz_pca_biplot(
  fert.pca, 
  axes = c(1,3),
  # Individuals
  geom.ind = "point",
  # Variables
  col.var = "contrib",
  gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
  #gradient.cols = c("cyan", "blue", "red"),
  legend.title = "Contribuição",
  title="Biplot da Análise de Componentes Principais",
  repel = F)

fviz_pca_biplot(
  fert.pca, 
  axes = c(1,4),
  # Individuals
  geom.ind = "point",
  # Variables
  col.var = "contrib",
  gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
  #gradient.cols = c("cyan", "blue", "red"),
  legend.title = "Contribuição",
  title="Biplot da Análise de Componentes Principais",
  repel = F)

Os procedimentos estatísticos utilizados neste estudo foram realizados no programa R (R Core Team 2020). Pacote ‘stats’: Coeficiente de correlação de Spearman, Wilcoxon e ANAVA (R Core Team 2020). Pacote ‘ggpot2’: elementos gráficos (Wickham 2016), Pacote ‘dplyr’: manipulação de dados (Wickham et al. 2020), Pacote ‘FactoMineR’: Análise multivariada (Husson et al. 2020), Pacote ‘ggpubr’: elementos gráficos (Kassambara 2020a),Pacote ‘psych’: gráfico de correlação (Revelle 2020), Pacote ‘TukeyC’: Teste de Tukey (Jelihovschi and Allaman 2020), Pacote ‘rstatix’: Teste não paramétrico de Kruskal-Wallis (Kassambara 2020b).

Referência

Husson, Francois, Julie Josse, Sebastien Le, and Jeremy Mazet. 2020. FactoMineR: Multivariate Exploratory Data Analysis and Data Mining. https://CRAN.R-project.org/package=FactoMineR.

Jelihovschi, José Cláudio Faria Enio G., and Ivan Bezerra Allaman. 2020. Conventional Tukey Test. Ilheus, Bahia, Brasil: Universidade Estadual de Santa Cruz - UESC.

Kassambara, Alboukadel. 2020a. Ggpubr: ’Ggplot2’ Based Publication Ready Plots. https://CRAN.R-project.org/package=ggpubr.

———. 2020b. Rstatix: Pipe-Friendly Framework for Basic Statistical Tests. https://CRAN.R-project.org/package=rstatix.

R Core Team. 2020. “R: A Language and Environment for Statistical Computing.” https://www.R-project.org/.

Revelle, William. 2020. Psych: Procedures for Psychological, Psychometric, and Personality Research. https://CRAN.R-project.org/package=psych.

Wickham, Hadley. 2016. Ggplot2: Elegant Graphics for Data Analysis. Springer-Verlag New York. https://ggplot2.tidyverse.org.

Wickham, Hadley, Romain François, Lionel Henry, and Kirill Müller. 2020. Dplyr: A Grammar of Data Manipulation. https://CRAN.R-project.org/package=dplyr.