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)