============================================================
Script R - Manipulação e Análise de Dados Multivariados
============================================================
Pacotes necessários
library(tidyverse) # inclui ggplot2, dplyr, readr etc.
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.4.4 ✔ tibble 3.2.1
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(psych) # resumo estatístico detalhado
##
## Anexando pacote: 'psych'
##
## Os seguintes objetos são mascarados por 'package:ggplot2':
##
## %+%, alpha
library(ggpubr) # gráficos prontos (normalidade, boxplots etc.)
library(car) # qqPlot e transformações
## Carregando pacotes exigidos: carData
##
## Anexando pacote: 'car'
##
## O seguinte objeto é mascarado por 'package:psych':
##
## logit
##
## O seguinte objeto é mascarado por 'package:dplyr':
##
## recode
##
## O seguinte objeto é mascarado por 'package:purrr':
##
## some
library(reshape2) # manipulação para gráficos
##
## Anexando pacote: 'reshape2'
##
## O seguinte objeto é mascarado por 'package:tidyr':
##
## smiths
library(moments) # assimetria e curtose
library(GGally) # gráficos multivariados
## Registered S3 method overwritten by 'GGally':
## method from
## +.gg ggplot2
library(scales) # Escalonamento
##
## Anexando pacote: 'scales'
##
## Os seguintes objetos são mascarados por 'package:psych':
##
## alpha, rescale
##
## O seguinte objeto é mascarado por 'package:purrr':
##
## discard
##
## O seguinte objeto é mascarado por 'package:readr':
##
## col_factor
library(viridis) # paletas avançadas
## Carregando pacotes exigidos: viridisLite
##
## Anexando pacote: 'viridis'
##
## O seguinte objeto é mascarado por 'package:scales':
##
## viridis_pal
library(plotly)
##
## Anexando pacote: 'plotly'
##
## O seguinte objeto é mascarado por 'package:ggplot2':
##
## last_plot
##
## O seguinte objeto é mascarado por 'package:stats':
##
## filter
##
## O seguinte objeto é mascarado por 'package:graphics':
##
## layout
library(readxl)
library(ggplot2)
————————————————————
1. Importação e sumarização de dados
————————————————————
Leitura do arquivo (substitua pelo seu arquivo)
dados <- read.table("dados_producao_fisiologia.csv",
sep = ";",
header = TRUE,
dec = ",")
Leitura do arquivo ONLINE (substitua pelo seu arquivo)
dados2 <- read.table("https://raw.githubusercontent.com/leocbc/ANALISE-MULTIVARIADA/refs/heads/main/agro_meteoro.csv",
header = TRUE,
sep = ",")
Visualização inicial
head(dados)
str(dados)
## 'data.frame': 50 obs. of 11 variables:
## $ ID : int 1 2 3 4 5 6 7 8 9 10 ...
## $ Altura_planta_cm : int 98 94 85 96 119 90 95 91 95 114 ...
## $ Área_foliar_cm2 : int 2459 2771 2779 2526 3042 3013 2661 2846 2991 2610 ...
## $ Massa_seca_g : int 37 42 30 41 34 45 40 30 39 31 ...
## $ Clorofila_SPAD : int 45 50 47 39 42 42 39 44 46 50 ...
## $ Taxa_fotossíntese : num 16.8 18.6 18.8 18.4 16.9 19 18.2 17 22 16.7 ...
## $ Condutância_estomática: num 0.34 0.32 0.36 0.31 0.42 0.39 0.45 0.33 0.37 0.41 ...
## $ Transpiração : num 5.7 4.6 6.2 5.8 5 4.8 6.2 5 4.7 4.9 ...
## $ Produtividade_kg_ha : int 3810 3534 4201 3791 3935 3817 3620 3852 4070 4255 ...
## $ Número_vagens : int 73 67 60 75 69 80 62 56 79 71 ...
## $ Índice_colheita : int 44 43 43 46 47 46 40 42 40 47 ...
summary(dados)
## ID Altura_planta_cm Área_foliar_cm2 Massa_seca_g
## Min. : 1.00 Min. : 85 Min. :2401 Min. :30.00
## 1st Qu.:13.25 1st Qu.: 94 1st Qu.:2666 1st Qu.:35.00
## Median :25.50 Median :100 Median :2914 Median :38.50
## Mean :25.50 Mean :103 Mean :2959 Mean :38.64
## 3rd Qu.:37.75 3rd Qu.:113 3rd Qu.:3275 3rd Qu.:43.00
## Max. :50.00 Max. :120 Max. :3575 Max. :45.00
## Clorofila_SPAD Taxa_fotossíntese Condutância_estomática Transpiração
## Min. :38.00 Min. :16.70 Min. :0.2800 Min. :4.50
## 1st Qu.:41.00 1st Qu.:18.23 1st Qu.:0.3300 1st Qu.:4.90
## Median :42.50 Median :19.30 Median :0.3650 Median :5.30
## Mean :43.34 Mean :19.67 Mean :0.3682 Mean :5.31
## 3rd Qu.:46.00 3rd Qu.:21.45 3rd Qu.:0.4175 3rd Qu.:5.60
## Max. :50.00 Max. :22.30 Max. :0.4500 Max. :6.40
## Produtividade_kg_ha Número_vagens Índice_colheita
## Min. :3523 Min. :55.00 Min. :40.00
## 1st Qu.:3768 1st Qu.:62.00 1st Qu.:42.00
## Median :3932 Median :68.50 Median :44.00
## Mean :3928 Mean :68.36 Mean :43.92
## 3rd Qu.:4114 3rd Qu.:74.75 3rd Qu.:46.00
## Max. :4299 Max. :80.00 Max. :47.00
Resumo estatístico detalhado
describe(dados)
————————————————————
2. Avaliação de variáveis individualmente
————————————————————
Histograma
hist(dados$Altura_planta_cm)
ggplot(dados, aes(x = Altura_planta_cm)) +
geom_histogram(bins = 15, fill = "steelblue", color = "white") +
theme_minimal()
Boxplot
ggplot(dados, aes(y = Altura_planta_cm)) +
geom_boxplot(fill = "tomato") +
theme_minimal()
————————————————————
3. Avaliação de todas as variáveis numéricas
————————————————————
usando a familia “apply”
função apply
medias <- apply(dados, 2, mean)
função lapply
medias <- lapply(dados[, 1:10], mean, na.rm = TRUE)
função tapply (aplicando médias por grupos)
Grupo <- rep(c("A","B"), each=25)
tapply(dados$Altura_planta_cm , Grupo, mean)
## A B
## 102.44 103.60
Usando dplyr
num_vars <- dados %>% select(where(is.numeric))
curtose_assimetria <- data.frame(
Variavel = names(num_vars),
Assimetria = sapply(num_vars, skewness),
Curtose = sapply(num_vars, kurtosis)
)
print(curtose_assimetria)
## Variavel Assimetria Curtose
## ID ID 0.000000000 1.799040
## Altura_planta_cm Altura_planta_cm 0.198515103 1.599925
## Área_foliar_cm2 Área_foliar_cm2 0.152110723 1.782871
## Massa_seca_g Massa_seca_g -0.142771017 1.854746
## Clorofila_SPAD Clorofila_SPAD 0.181950174 2.071709
## Taxa_fotossíntese Taxa_fotossíntese -0.002093041 1.647536
## Condutância_estomática Condutância_estomática 0.090608466 1.864852
## Transpiração Transpiração 0.445776256 2.118067
## Produtividade_kg_ha Produtividade_kg_ha -0.124605171 1.881015
## Número_vagens Número_vagens -0.119487203 1.848265
## Índice_colheita Índice_colheita -0.238627478 1.684801
Gráfico de assimetria e curtose
ggplot(curtose_assimetria, aes(x = Assimetria, y = Curtose, label = Variavel)) +
geom_point(color = "red", size = 1) +
geom_text(vjust = -0.2) +
theme_minimal() +
ggtitle("Curtose vs Assimetria das Variáveis")
escalonando (média zero e desvio 1)
num_vars_pad <- as.data.frame(scale(num_vars))
Graficos
num_vars %>%
gather(variavel, valor) %>%
ggplot(aes(x = variavel, y = valor, fill = variavel)) +
geom_boxplot(alpha = 0.8, outlier.color = "black") +
scale_fill_viridis_d(option = "E") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
num_vars_pad %>%
gather(variavel, valor) %>%
ggplot(aes(x = variavel, y = valor, fill = variavel)) +
geom_boxplot(alpha = 0.8, outlier.color = "black") +
scale_fill_viridis_d(option = "E") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
============================================================
Gráfico de bolhas (4 variáveis do dataset)
============================================================
bolhas <- ggplot(dados, aes(x = Altura_planta_cm,
y = Área_foliar_cm2,
size = Produtividade_kg_ha,
color = Clorofila_SPAD)) +
geom_point(alpha = 0.7) +
scale_size(range = c(2, 10)) +
scale_color_viridis(option = "C", direction = -1) +
theme_minimal() +
labs(title = "Gráfico de bolhas - Produção e Fisiologia",
x = "Altura da Planta (cm)",
y = "Área Foliar (cm²)",
size = "Produtividade (kg/ha)",
color = "Clorofila (SPAD)")
bolhas
grafico interativo plotly
p <- ggplot(dados, aes(x = Altura_planta_cm,
y = Área_foliar_cm2,
size = Produtividade_kg_ha,
color = Clorofila_SPAD,
text = paste("Altura:", Altura_planta_cm,
"<br>Área Foliar:", Área_foliar_cm2,
"<br>Produtividade:", Produtividade_kg_ha,
"<br>Clorofila:", Clorofila_SPAD))) +
geom_point(alpha = 0.7) +
scale_size(range = c(2, 12)) +
scale_color_viridis(option = "C", direction = -1) +
theme_minimal() +
labs(title = "Gráfico de Bolhas Interativo",
x = "Altura da Planta (cm)",
y = "Área Foliar (cm²)",
size = "Produtividade (kg/ha)",
color = "Clorofila (SPAD)")
p
Identificação de Outliers (Intervalo Interquartílico (IQR))
outliers <- num_vars %>%
summarise(across(everything(), ~ {
Q1 <- quantile(.x, 0.25, na.rm = TRUE)
Q3 <- quantile(.x, 0.75, na.rm = TRUE)
IQR <- Q3 - Q1
sum(.x < (Q1 - 1.5*IQR) | .x > (Q3 + 1.5*IQR))
}))
as.data.frame(outliers)
outliers
Correlação simples
Criando a matriz de correlação (Pearson)
corr_matrix <- cor(num_vars, method = "pearson")
remontando o arquivo pra poder fazer o gráfico (colocando todas as
variáveis em uma unica coluna)
corr_long <- as.data.frame(as.table(corr_matrix))
names(corr_long) <- c("Var1", "Var2", "Correlacao")
Gráfico de correlação
ggplot(corr_long, aes(x = Var1, y = Var2, fill = Correlacao)) +
geom_tile(color = "white") +
scale_fill_gradient2(low = "blue", mid = "white", high = "red", midpoint = 0) +
geom_text(aes(label = round(Correlacao, 2)), color = "black", size = 4) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = "Mapa de Correlação",
fill = "Correlação")
————————————————————
4. Teste de normalidade
————————————————————
Shapiro-Wilk para cada variável numérica
normalidade <- dados %>%
select(where(is.numeric)) %>%
gather(variavel, valor) %>%
group_by(variavel) %>%
summarise(pvalor = shapiro.test(valor)$p.value)
normalidade
Gráficos de normalidade (histograma + QQplot) para uma variável
ggqqplot(dados$Altura_planta_cm, title = "QQplot - Altura da Planta")
————————————————————
5. Transformações de variáveis
————————————————————
Log transformação (apenas para valores > 0, Reduz a assimetria à
direita)
dados\(log_var <- log(dados\)var
+ 1) adiciona 1 para evitar log(0)
dados <- dados %>%
mutate(across(where(is.numeric), ~ log(. + 1), .names = "log_{col}"))
dados
Raiz quadrada (Suaviza a variabilidade, especialmente em contagens
pequenas)
dados\(sqrt_var <-
sqrt(dados\)var)
dados <- dados %>%
mutate(across(where(is.numeric), ~ sqrt(.), .names = "sqrt_{col}"))
dados
Padronização (Z-score) -> Pré-processamento para análise
multivariada
dados\(z_var <-
scale(dados\)var)
dados <- dados %>%
mutate(across(where(is.numeric), scale, .names = "z_{col}"))
