Definições da sessão
#-----------------------------------------------------------------------
# Investigar se os laboratórios apresentam diferenças na determinação da
# concentração de Ca, Mg e pH.
#
# Prof. Dr. Walmes M. Zeviani
# leg.ufpr.br/~walmes · github.com/walmes
# walmes@ufpr.br · @walmeszeviani
# Laboratory of Statistics and Geoinformation (LEG)
# Department of Statistics · Federal University of Paraná
# 2020-abr-30 · Curitiba/PR/Brazil
#-----------------------------------------------------------------------
#-----------------------------------------------------------------------
# Pacotes.
rm(list = objects())
library(tidyverse)
## ── Attaching packages ─────────────────────────── tidyverse 1.3.0 ──
## ✔ ggplot2 3.3.0 ✔ purrr 0.3.3
## ✔ tibble 2.1.3 ✔ dplyr 0.8.5
## ✔ tidyr 1.0.2 ✔ stringr 1.4.0
## ✔ readr 1.3.1 ✔ forcats 0.5.0
## ── Conflicts ────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
library(readxl)
Importação e preparo dos dados
#-----------------------------------------------------------------------
# Importa as tabelas de dados.
# Nome dos arquivos.
fls <- list.files(pattern = "^Planilha.*\\.xls")
# Lê as tabelas.
tbs <- fls %>%
map(read_xls, na = "---")
## New names:
## * `` -> ...49
str(tbs)
## List of 2
## $ :Classes 'tbl_df', 'tbl' and 'data.frame': 8725 obs. of 48 variables:
## ..$ Proprietário : chr [1:8725] "FUNDACAOMT/PMA" "FUNDACAOMT/PMA" "FUNDACAOMT/PMA" "FUNDACAOMT/PMA" ...
## ..$ Propriedade : chr [1:8725] "FAZ. SANTA TEREZINHA" "FAZ. SANTA TEREZINHA" "FAZ. SANTA TEREZINHA" "FAZ. SANTA TEREZINHA" ...
## ..$ Município : chr [1:8725] "NOVA MUTUM" "NOVA MUTUM" "NOVA MUTUM" "NOVA MUTUM" ...
## ..$ UF : chr [1:8725] "MT" "MT" "MT" "MT" ...
## ..$ Laboratorio : chr [1:8725] "AGROANALISE" "AGROANALISE" "AGROANALISE" "AGROANALISE" ...
## ..$ Safra : num [1:8725] 2016 2016 2016 2016 2016 ...
## ..$ Data : POSIXct[1:8725], format: "2016-06-17" ...
## ..$ N. Lab. : num [1:8725] 110103 110104 110105 110106 110107 ...
## ..$ Experimento : chr [1:8725] NA NA NA NA ...
## ..$ Original : chr [1:8725] "1 AMARELO" "1 AMARELO" "2 AMARELO" "2 AMARELO" ...
## ..$ Campo : chr [1:8725] "1" "1" "2" "2" ...
## ..$ Sub01 : chr [1:8725] "AMARELO" "AMARELO" "AMARELO" "AMARELO" ...
## ..$ Sub02 : chr [1:8725] NA NA NA NA ...
## ..$ Prof : chr [1:8725] "0-20" "20-40" "0-20" "20-40" ...
## ..$ P res IAC : logi [1:8725] NA NA NA NA NA NA ...
## ..$ P res AgrAn. : logi [1:8725] NA NA NA NA NA NA ...
## ..$ P remanescente: num [1:8725] NA NA NA NA NA NA NA NA NA NA ...
## ..$ pH_água : num [1:8725] 5.2 4.9 6.2 5.7 6.1 5.7 5.7 5.1 6.2 5.3 ...
## ..$ pH_CaCl2 : num [1:8725] 4.5 4.1 5.4 4.9 5.2 4.9 5 4.3 5.5 4.5 ...
## ..$ P : num [1:8725] 3 1.4 3.6 1.7 19.6 3 4.6 0.6 5.3 0.3 ...
## ..$ K : num [1:8725] 37.1 24.4 42.4 23.8 30.5 23.8 35.5 24.1 36.6 20.9 ...
## ..$ Ca_Mg : num [1:8725] 1.4 0.7 3.2 1.6 3.2 1.8 2.4 0.8 4 1.4 ...
## ..$ Ca : num [1:8725] 1 0.5 2.3 1.1 2.3 1.3 1.8 0.6 2.9 1 ...
## ..$ Mg : num [1:8725] 0.4 0.2 0.9 0.5 0.9 0.5 0.7 0.3 1.1 0.4 ...
## ..$ Al : num [1:8725] 0.4 0.6 0 0 0 0 0 0.6 0 0.3 ...
## ..$ H : num [1:8725] 3.8 2.8 2.5 2.2 3.1 2.5 3.2 3.4 3 3 ...
## ..$ MO : num [1:8725] 20.6 12.8 21.3 10.7 24.8 13.9 21.3 16.8 29.5 16.8 ...
## ..$ Areia : num [1:8725] NA NA NA NA NA NA NA NA NA NA ...
## ..$ Silte : num [1:8725] NA NA NA NA NA NA NA NA NA NA ...
## ..$ Argila : num [1:8725] NA NA NA NA NA NA NA NA NA NA ...
## ..$ Sb : num [1:8725] 1.495 0.763 3.309 1.661 3.278 ...
## ..$ CTC : num [1:8725] 5.7 4.16 5.81 3.86 6.38 ...
## ..$ V% : num [1:8725] 26.3 18.3 57 43 51.4 ...
## ..$ CaMg : num [1:8725] 2.5 2.5 2.56 2.2 2.56 ...
## ..$ CaK : num [1:8725] 10.51 7.99 21.16 18.03 29.41 ...
## ..$ MgK : num [1:8725] 4.2 3.2 8.28 8.19 11.51 ...
## ..$ Ca% : num [1:8725] 17.6 12 39.6 28.5 36.1 ...
## ..$ Mg% : num [1:8725] 7.02 4.8 15.49 12.95 14.11 ...
## ..$ Al% : num [1:8725] 7.02 14.41 0 0 0 ...
## ..$ K% : num [1:8725] 1.67 1.5 1.87 1.58 1.23 ...
## ..$ H% : num [1:8725] 66.7 67.3 43 57 48.6 ...
## ..$ Sat. Al : num [1:8725] 21.1 44 0 0 0 ...
## ..$ Zn : num [1:8725] NA NA NA NA NA NA NA NA NA NA ...
## ..$ Cu : num [1:8725] NA NA NA NA NA NA NA NA NA NA ...
## ..$ Fe : num [1:8725] NA NA NA NA NA NA NA NA NA NA ...
## ..$ Mn : num [1:8725] NA NA NA NA NA NA NA NA NA NA ...
## ..$ S : num [1:8725] 11.8 17.4 10.5 15.5 9.9 15.2 10.7 16.1 11.2 15.4 ...
## ..$ B : num [1:8725] NA NA NA NA NA NA NA NA NA NA ...
## $ :Classes 'tbl_df', 'tbl' and 'data.frame': 44887 obs. of 49 variables:
## ..$ ProprietArio : chr [1:44887] "FUNDACAOMT/CAD" "FUNDACAOMT/CAD" "FUNDACAOMT/CAD" "FUNDACAOMT/CAD" ...
## ..$ Propriedade : chr [1:44887] "FAZ. UIRAPURU" "FAZ. UIRAPURU" "FAZ. UIRAPURU" "FAZ. GRINGO" ...
## ..$ Município : chr [1:44887] NA NA NA NA ...
## ..$ UF : chr [1:44887] NA NA NA NA ...
## ..$ Laboratorio : chr [1:44887] "SOLO ANALISE" "SOLO ANALISE" "SOLO ANALISE" "SOLO ANALISE" ...
## ..$ Safra : chr [1:44887] NA NA NA NA ...
## ..$ Data : POSIXct[1:44887], format: "2014-09-25" ...
## ..$ N. Lab. : chr [1:44887] "36150" "36151" "36152" "36153" ...
## ..$ Experimento : chr [1:44887] NA NA NA NA ...
## ..$ Original : chr [1:44887] "1" "2" "3" "1" ...
## ..$ Campo : chr [1:44887] "1" "2" "3" "1" ...
## ..$ Sub01 : chr [1:44887] NA NA NA NA ...
## ..$ Sub02 : logi [1:44887] NA NA NA NA NA NA ...
## ..$ Prof : chr [1:44887] "0-10" "10-20" "20-40" "0-10" ...
## ..$ P res IAC : logi [1:44887] NA NA NA NA NA NA ...
## ..$ P resina : logi [1:44887] NA NA NA NA NA NA ...
## ..$ P remanescente: logi [1:44887] NA NA NA NA NA NA ...
## ..$ pH_água : num [1:44887] 6.27 6.3 6.15 6.1 6.11 5.82 5.27 5.45 5.46 6.59 ...
## ..$ pH_CaCl2 : num [1:44887] 5.56 5.02 4.76 5.3 5.02 4.66 4.54 4.45 4.51 5.69 ...
## ..$ P : num [1:44887] 54.6 18 2.8 49.3 4.8 2 8.2 8.9 6.3 11.2 ...
## ..$ K : num [1:44887] 24.4 21.5 20.5 39.1 20.5 19.6 65.5 40.1 22.5 54.7 ...
## ..$ Ca_Mg : num [1:44887] 0.06 0.06 0.05 0.1 0.05 0.05 3.21 2.56 1.89 5.42 ...
## ..$ Ca : num [1:44887] 2.78 1.38 0.7 2.67 1.56 0.68 2.37 1.94 1.47 3.75 ...
## ..$ Mg : num [1:44887] 0.75 0.42 0.19 0.46 0.23 0.15 0.84 0.62 0.42 1.67 ...
## ..$ Al : num [1:44887] 0 0 0.08 0 0 0.1 0.14 0.26 0.23 0 ...
## ..$ H : num [1:44887] 2.58 3.09 2.7 2.55 2.78 2.71 7.75 7.55 6.51 3.33 ...
## ..$ MO : num [1:44887] 21.5 13.7 8.9 24.6 14.7 9 36.3 31.1 25 35.6 ...
## ..$ Areia : num [1:44887] 755 NA NA 795 NA NA NA NA NA NA ...
## ..$ Silte : num [1:44887] 45 NA NA 35 NA NA NA NA NA NA ...
## ..$ Argila : num [1:44887] 200 NA NA 170 NA NA NA NA NA NA ...
## ..$ Sb : num [1:44887] 0.123 0.115 0.103 0.2 0.103 ...
## ..$ CTC : num [1:44887] 2.7 3.21 2.96 2.75 2.88 ...
## ..$ V% : num [1:44887] 4.54 3.59 3.46 7.28 3.56 ...
## ..$ CaMg : num [1:44887] 3.71 3.29 3.68 5.8 6.78 ...
## ..$ CaK : num [1:44887] 44.4 25 13.3 26.6 29.7 ...
## ..$ MgK : num [1:44887] 11.99 7.62 3.61 4.59 4.38 ...
## ..$ Ca% : num [1:44887] 102.9 43.1 23.6 97.1 54.1 ...
## ..$ Mg% : num [1:44887] 27.75 13.1 6.41 16.73 7.98 ...
## ..$ Al% : num [1:44887] 0 0 2.7 0 0 ...
## ..$ K% : num [1:44887] 2.31 1.72 1.77 3.65 1.82 ...
## ..$ H% : num [1:44887] 95.5 96.4 93.8 92.7 96.4 ...
## ..$ Sat. Al : num [1:44887] 0 0 43.8 0 0 ...
## ..$ Zn : num [1:44887] 10.2 4.1 1.7 6.2 1.6 0.4 7.6 6.9 NA 6.5 ...
## ..$ Cu : num [1:44887] 2.4 1.5 0.3 0.7 0.4 0.2 1.7 1.7 NA 1.3 ...
## ..$ Fe : num [1:44887] 69.9 111 100.4 127.7 165.4 ...
## ..$ Mn : num [1:44887] 15.1 5.9 1.5 26.5 13.7 6.6 27.1 25.6 NA 28.1 ...
## ..$ S : num [1:44887] 11.3 10.6 11.1 9.9 11.4 14.8 10.8 11.7 11.6 9.6 ...
## ..$ B : num [1:44887] 0.39 0.34 0.35 0.4 0.45 0.38 0.76 0.58 NA 0.59 ...
## ..$ ...49 : logi [1:44887] NA NA NA NA NA NA ...
# Verifica o tipo de valor das variáveis.
v <- tbs %>%
map(~unlist(lapply(., class))) %>%
map(enframe) %>%
reduce(inner_join, by = "name") %>%
filter(value.x != value.y) %>%
pull(name)
# Converte variáveis para o tipo mais geral.
tbs <- tbs %>%
map(~mutate_at(., v, as.character))
# Número de registros.
tbs %>%
map_int(nrow)
## [1] 8725 44887
# Junta as tabelas.
tb <- tbs %>%
bind_rows()
# Elimina as variáveis de tipo `logical` e as cheias de NA.
tb <- tb %>%
select_if(~!(is.logical(.) || all(is.na(.))))
# Faz cópia como fator.
tb <- tb %>%
mutate(lab = factor(Laboratorio, labels = c("AGRO", "SOLO")),
dt = as.numeric(Data - min(Data, na.rm = TRUE)))
# Elimina valores extremos.
tb <- tb %>%
filter(pH_água < 10,
pH_CaCl2 > 3,
Silte < 1000)
# Empilhar nas variáveis para fazer gráficos.
tbl <- tb %>%
select_if(~is.numeric(.) || is.factor(.)) %>%
gather(key = "var", value = "val", -lab) %>%
filter(is.finite(val))
str(tbl)
## Classes 'tbl_df', 'tbl' and 'data.frame': 276031 obs. of 3 variables:
## $ lab: Factor w/ 2 levels "AGRO","SOLO": 1 1 1 1 1 1 1 1 1 1 ...
## $ var: chr "pH_água" "pH_água" "pH_água" "pH_água" ...
## $ val: num 6.1 6 5.8 6.2 6 5.9 5.7 5.4 6.1 6 ...
Análise gráfica exploratória
# Gráfico de caixas.
ggplot(data = tbl,
mapping = aes(x = lab, y = val)) +
facet_wrap(facets = ~var, scales = "free_y") +
geom_boxplot() +
labs(x = "Laboratório", y = "Valor")

# Gráficos de densidade.
ggplot(data = tbl,
mapping = aes(x = val, color = lab)) +
facet_wrap(facets = ~var, scales = "free") +
geom_density() +
geom_rug() +
labs(color = "Laboratório", y = "Densidade", x = "Valor")

# Gráficos de distribuição acumulada.
ggplot(data = tbl,
mapping = aes(x = val, color = lab)) +
facet_wrap(facets = ~var, scales = "free_x") +
stat_ecdf() +
labs(color = "Laboratório", y = "Frequência", x = "Valor")

# Distribuição das análises por UF.
ggplot(data = tb,
mapping = aes(x = reorder(UF, UF, length), fill = lab)) +
geom_bar(position = "dodge") +
scale_y_log10() +
coord_flip() +
labs(fill = "Laboratório", y = "Frequência (log 10)", x = "Estado")

# Distribuição das análises por Município.
ggplot(data = tb,
mapping = aes(x = reorder(Município, Município, length), fill = lab)) +
geom_bar(position = "dodge") +
scale_y_log10() +
coord_flip() +
labs(fill = "Laboratório", y = "Frequência (log 10)", x = "Município")

# Distribuição das análises por Profundidade.
ggplot(data = tb,
mapping = aes(x = reorder(Prof, Prof, length), fill = lab)) +
geom_bar(position = "dodge") +
scale_y_log10() +
coord_flip() +
labs(color = "Laboratório", y = "Frequência (log 10)", x = "Profundidade")

# Distribuição das análises por Safra.
ggplot(data = tb,
mapping = aes(x = reorder(Safra, Safra, length), fill = lab)) +
geom_bar(position = "dodge") +
scale_y_log10() +
coord_flip() +
labs(fill = "Laboratório", y = "Frequência (log 10)", x = "Safra")

Relação Cálcio x Magnésio
#-----------------------------------------------------------------------
# Gráficos.
# Gráficos de dispersão.
ggplot(data = tb,
mapping = aes(x = Mg,
y = Ca,
# color = UF,
# color = Safra,
)) +
facet_wrap(facets = ~lab) +
geom_point(pch = 1) +
labs(x = "Conteúdo de Magnésio (Mg)",
y = "Conteúdo de Cálcio (Ca)")

ggplot(data = tb,
mapping = aes(y = `Ca%`, x = `Mg%`)) +
facet_wrap(facets = ~lab) +
geom_point() +
labs(x = "Conteúdo de Magnésio (Mg, %)",
y = "Conteúdo de Cálcio (Ca, %)")

v <- names(tb) %>%
str_subset("^(Ca|Mg)[^[:lower:]]?") %>%
str_subset("[^Ko]$")
v
## [1] "Ca_Mg" "Ca" "Mg" "CaMg" "Ca%" "Mg%"
# Gráficos de densidade.
ggplot(data = filter(tbl, var %in% v),
mapping = aes(x = val, color = lab)) +
facet_wrap(facets = ~var, scales = "free") +
geom_density() +
geom_rug() +
labs(color = "Laboratório", y = "Densidade", x = "Valor")

# Matriz de diagramas de dispersão.
lattice::splom(tb[, v],
groups = factor(tb$lab, rev(levels(tb$lab))),
as.matrix = TRUE,
pch = 1,
cex = 0.5,
auto.key = TRUE)

# pH, Ca, Mg, V% e Al.
v <- names(tb) %>%
str_subset("(pH|Al|V)[^[:lower:]]") %>%
append(c("Ca", "Mg"))
v
## [1] "pH_água" "pH_CaCl2" "V%" "Al%" "Ca"
## [6] "Mg"
# Matriz de diagramas de dispersão.
lattice::splom(tb[, v],
groups = factor(tb$lab, rev(levels(tb$lab))),
as.matrix = TRUE,
pch = 1,
cex = 0.5,
auto.key = TRUE)

Dados pareados
# Mesmas amostras enviadas para os dois labs.
tbp <- read_xlsx(path = "Tabela de Resultados - CIAQAS.xlsx")
## New names:
## * `` -> ...2
str(tbp)
## Classes 'tbl_df', 'tbl' and 'data.frame': 676 obs. of 46 variables:
## $ Proprietário : chr "FUNDAÇÃO MT / PMA" "FUNDAÇÃO MT / PMA" "FUNDAÇÃO MT / PMA" "FUNDAÇÃO MT / PMA" ...
## $ ...2 : num 1 1 1 1 1 1 1 1 1 1 ...
## $ Laboratorio : chr "SOLOANALISE" "SOLOANALISE" "SOLOANALISE" "SOLOANALISE" ...
## $ Data : chr "-" "-" "-" "-" ...
## $ Remessa : chr "4º" "1º" "1º" "2º" ...
## $ Original : chr "TMG (0-20)" "T 02 - C" "T 03 - B" "125 - A (0-20)" ...
## $ Código : chr "M1" "M2" "M3" "M4" ...
## $ Local : chr "NMTAR" "NMTAN" "LRVTAR" "LRVTMAR" ...
## $ Sub02 : logi NA NA NA NA NA NA ...
## $ Ano : num 2013 2013 2013 2013 2013 ...
## $ AB : chr "A" "A" "A" "A" ...
## $ Prof : logi NA NA NA NA NA NA ...
## $ P res IAC : logi NA NA NA NA NA NA ...
## $ P remanescente: logi NA NA NA NA NA NA ...
## $ P resina : logi NA NA NA NA NA NA ...
## $ pH_água : num 6.14 6.01 5.61 6.19 5.55 5.61 6.09 6.59 5.66 6.12 ...
## $ pH_CaCl2 : num 5.3 5.14 4.77 5.33 4.69 4.83 5.29 5.8 4.83 5.27 ...
## $ P : num 7.9 46.7 24.1 13.3 7.3 ...
## $ K : num 68.4 9.78 78.2 45.94 54.74 ...
## $ Ca_Mg : num 3.5 2.5 3.13 4.78 2.91 ...
## $ Ca : num 2.93 2.08 2.61 3.71 2.43 ...
## $ Mg : num 0.57 0.42 0.523 1.07 0.48 ...
## $ Al : num 0 0 0 0 0.13 0 0 0 0 0 ...
## $ H+Al : num 3.93 2.84 5.07 3.58 5.93 ...
## $ MO : num 29.4 20.2 30.7 31.9 35.3 ...
## $ Areia : num 450 850 310 305 235 435 235 755 200 280 ...
## $ Silte : num 45 25 60 55 60 50 60 40 85 55 ...
## $ Argila : num 505 125 630 640 705 515 705 205 715 665 ...
## $ Sb : num 3.68 2.52 3.33 4.9 3.05 ...
## $ CTC : num 7.61 5.37 8.4 8.48 9.11 ...
## $ V% : num 48.3 47 39.6 57.8 33.5 ...
## $ CaMg : num 5.14 4.95 4.98 3.47 5.06 ...
## $ CaK : num 16.7 82.9 13 31.5 17.3 ...
## $ MgK : num 3.25 16.76 2.61 9.08 3.42 ...
## $ Ca% : num 38.5 38.7 31 43.8 26.7 ...
## $ Mg% : num 7.49 7.83 6.22 12.62 5.27 ...
## $ Al% : num 0 0 0 0 1.43 ...
## $ K% : num 2.306 0.467 2.386 1.389 1.541 ...
## $ H% : num 51.7 53 60.4 42.2 65.1 ...
## $ Sat. Al : num 0 0 0 0 4.09 ...
## $ Zn : num 2.3 1.4 10 10.3 2.3 3.1 4 1.9 3.3 9.8 ...
## $ Cu : num 0.8 0.5 2.6 2.7 0.9 0.8 0.7 0.9 4.3 1.3 ...
## $ Fe : num 202.5 116.6 100.1 77.2 123.3 ...
## $ Mn : num 17.3 20.2 11.9 20.4 5.4 12.5 20.4 16.4 79.1 13.2 ...
## $ S : num 19.4 9.6 12.8 10.2 9.4 19.3 8.4 8.8 14.2 8.9 ...
## $ B : num 1 0.3 0.9 0.6 0.7 1.2 0.8 0.5 0.5 0.9 ...
# Cria um ID para usar no pivotamento.
tbp <- tbp %>%
mutate(id = str_c(Local, Ano, AB, Código, Remessa),
lab = factor(Laboratorio, unique(tbp$Laboratorio)))
# Verifica se a chave serve para pivotar.
tbp %>%
select(id, lab, Ca, Mg) %>%
filter(id == id[1])
## # A tibble: 2 x 4
## id lab Ca Mg
## <chr> <fct> <dbl> <dbl>
## 1 NMTAR2013AM14º SOLOANALISE 2.93 0.570
## 2 NMTAR2013AM14º AGROANALISE 2.9 1.1
names(tbp)
## [1] "Proprietário" "...2" "Laboratorio"
## [4] "Data" "Remessa" "Original"
## [7] "Código" "Local" "Sub02"
## [10] "Ano" "AB" "Prof"
## [13] "P res IAC" "P remanescente" "P resina"
## [16] "pH_água" "pH_CaCl2" "P"
## [19] "K" "Ca_Mg" "Ca"
## [22] "Mg" "Al" "H+Al"
## [25] "MO" "Areia" "Silte"
## [28] "Argila" "Sb" "CTC"
## [31] "V%" "CaMg" "CaK"
## [34] "MgK" "Ca%" "Mg%"
## [37] "Al%" "K%" "H%"
## [40] "Sat. Al" "Zn" "Cu"
## [43] "Fe" "Mn" "S"
## [46] "B" "id" "lab"
# Empilha+ nas variáveis e desempilha nos laboratórios.
tbp2 <- tbp %>%
select(id, lab, `pH_água`:`B`) %>%
gather(key = "var", value = "val", -(1:2)) %>%
spread(key = "lab", value = "val") %>%
rename("AG" = "AGROANALISE", "SL" = "SOLOANALISE") %>%
drop_na()
tbp2
## # A tibble: 10,478 x 4
## id var SL AG
## <chr> <chr> <dbl> <dbl>
## 1 BJATMD2013AV54º Al 0 0
## 2 BJATMD2013AV54º Al% 0 0
## 3 BJATMD2013AV54º Areia 695 190
## 4 BJATMD2013AV54º Argila 270 644
## 5 BJATMD2013AV54º B 0.5 0.47
## 6 BJATMD2013AV54º Ca 2.73 2.8
## 7 BJATMD2013AV54º Ca_Mg 3.49 3.9
## 8 BJATMD2013AV54º Ca% 33.0 31.2
## 9 BJATMD2013AV54º CaK 15.1 16.5
## 10 BJATMD2013AV54º CaMg 3.59 2.55
## # … with 10,468 more rows
ggplot(data = tbp2,
mapping = aes(x = AG, y = SL)) +
facet_wrap(facets = ~var, scale = "free") +
geom_point(pch = 1) +
geom_abline(intercept = 0, slope = 1, color = "orange")

# Para padronizar os dados.
my_scale <- function(x, m, s) {
(x - m)/s
}
# Cria uma versão normalizada.
tbp3 <- tbp2 %>%
group_by(var) %>%
mutate(AG = my_scale(AG, mean(c(AG, SL)), sd(c(AG, SL))),
SL = my_scale(SL, mean(c(AG, SL)), sd(c(AG, SL)))) %>%
ungroup()
ggplot(data = tbp3,
mapping = aes(x = AG, y = SL)) +
facet_wrap(facets = ~var, nrow = 4) +
geom_point(pch = 1) +
geom_rug() +
geom_smooth(method = "lm", se = FALSE, color = "orange") +
geom_abline(intercept = 0, slope = 1, color = "gray40", linetype = 2) +
coord_equal()
## `geom_smooth()` using formula 'y ~ x'

# Gráficos de dispersão.
ggplot(data = tbp,
mapping = aes(x = Mg,
y = Ca)) +
facet_wrap(facets = ~lab) +
geom_point(pch = 1) +
labs(x = "Conteúdo de Magnésio (Mg)",
y = "Conteúdo de Cálcio (Ca)")

v <- names(tb) %>%
str_subset("^(Ca|Mg)[^[:lower:]]?") %>%
str_subset("[^Ko]$")
v
## [1] "Ca_Mg" "Ca" "Mg" "CaMg" "Ca%" "Mg%"
# Matriz de diagramas de dispersão.
lattice::splom(tbp[, v],
# groups = factor(tb$Laboratorio, rev(levels(tb$lab))),
groups = tbp$lab,
as.matrix = TRUE,
pch = 1,
cex = 0.5,
auto.key = TRUE)

# pH, Ca, Mg, V% e Al.
v <- names(tb) %>%
str_subset("(pH|Al|V)[^[:lower:]]") %>%
append(c("Ca", "Mg"))
v
## [1] "pH_água" "pH_CaCl2" "V%" "Al%" "Ca"
## [6] "Mg"
# Matriz de diagramas de dispersão.
lattice::splom(tbp[, v],
groups = tbp$lab,
as.matrix = TRUE,
pch = 1,
cex = 0.5,
auto.key = TRUE)
