Make a stratigraphic-style plot-schematic of sediment colour using munsell values

munsell-plot.R

# read in data
soil_colour <- 
  readxl::read_excel("KWL_chronology.xlsx", 
                     sheet = "soil_color")

layer_depths <- 
  readxl::read_excel("KWL_chronology.xlsx", 
                     sheet = "depth") # some of the Pit IDs don't match the Pit IDs in the soil_colour sheet...

library(tidyverse)

# tidy data into long format
colours_by_levels  <- 
soil_colour %>% 
  gather(layer, colour, -Pits) %>% 
  mutate(ymin = parse_number(layer)) %>% 
  arrange(Pits, ymin) %>% 
  group_by(Pits) %>% 
  mutate(diff = ymin - lag(ymin, default = 0))  %>% 
  ungroup() %>% 
  filter(!is.na(colour))

# depths into long format
layer_depths_long <- 
  layer_depths %>% 
  gather(layer, depth, -Pits) %>% 
  arrange(Pits, depth) %>% 
  mutate(start_depth = lag(depth) ) %>% 
  mutate(pits_simple = str_extract(Pits, "P[0-9]*"))

# combine colours by levels with level depths
to_plot <- 
  colours_by_levels %>% 
  mutate(pits_simple = str_extract(Pits, "P[0-9]*")) %>% # because they don't all match due to PXXXABC etc.
  left_join(layer_depths_long,
            by = c("pits_simple",  "layer"))

# get munsell colours in proper format
# and check if exists as valid colour
# convert to hex code for colour so
# ggplot can use it as a colour value

library(soilprofile)

to_plot$mun_col <- 
  str_split(to_plot$colour,
            "(?=[A-Za-z])(?<=[0-9])|(?=[0-9])(?<=[A-Za-z])",
            simplify = TRUE) %>% 
  as_data_frame() %>% 
  mutate(munsell = glue::glue('{V1}{V2} {V3}')) %>% 
  mutate(munsell = ifelse(V3 == "", glue::glue('{V1} {V2}'), munsell)) %>% 
  mutate(mun_col = map_chr(munsell, ~munsell_to_rgb(.x))) %>% 
  mutate(mun_col = if_else(is.na(mun_col), "#ffffff", mun_col)) %>% 
  pull(mun_col)

# put values in order so they plot as expected
to_plot$mun_col <- fct_reorder(to_plot$mun_col, to_plot$ymin)
  
# plot by levels
ggplot(to_plot,
       aes(Pits.x,
           diff,
           fill = mun_col)) +
  geom_col(position = position_stack(reverse = TRUE)) +
  scale_y_reverse() +
  scale_fill_identity() +
  theme_minimal() +
  ylab("Excavation level") +
  theme(axis.text.x = element_text(angle = 90,
                                   vjust = 0.5,
                                   hjust=1))

# plot by depths 
ggplot(to_plot) +
  geom_segment(aes(x = Pits.x, 
                   y = depth, 
                   xend = Pits.x, 
                   yend = start_depth, 
                   colour = mun_col),
               size = 10, 
               lineend = "butt"
               ) +
  scale_colour_identity() +
  theme_minimal() +
  ylab("Depth below datum") +
  theme(axis.text.x = element_text(angle = 90,
                                   vjust = 0.5,
                                   hjust=1))


> sessionInfo()
# R version 3.4.4 (2018-03-15)
# Platform: x86_64-w64-mingw32/x64 (64-bit)
# Running under: Windows 7 x64 (build 7601) Service Pack 1
# 
# Matrix products: default
# 
# locale:
# [1] LC_COLLATE=English_Australia.1252  LC_CTYPE=English_Australia.1252   
# [3] LC_MONETARY=English_Australia.1252 LC_NUMERIC=C                      
# [5] LC_TIME=English_Australia.1252    
# 
# attached base packages:
# [1] stats     graphics  grDevices utils     datasets  methods   base     
# 
# other attached packages:
#  [1] soilprofile_1.0    splancs_2.01-40    sp_1.2-7           munsell_0.4.3     
#  [5] lattice_0.20-35    aqp_1.15           bindrcpp_0.2.2     forcats_0.3.0     
#  [9] stringr_1.3.0      dplyr_0.7.4        purrr_0.2.4        readr_1.2.0       
# [13] tidyr_0.8.0.9000   tibble_1.4.2       ggplot2_2.2.1.9000 tidyverse_1.2.1   
# 
# loaded via a namespace (and not attached):
#  [1] httr_1.3.1            jsonlite_1.5          splines_3.4.4         modelr_0.1.1         
#  [5] Formula_1.2-2         assertthat_0.2.0      latticeExtra_0.6-28   cellranger_1.1.0.9000
#  [9] yaml_2.1.18           pillar_1.2.1          backports_1.1.2       glue_1.2.0           
# [13] digest_0.6.15         RColorBrewer_1.1-2    checkmate_1.8.5       rvest_0.3.2          
# [17] colorspace_1.3-2      htmltools_0.3.6       Matrix_1.2-12         plyr_1.8.4           
# [21] psych_1.8.3.3         pkgconfig_2.0.1       broom_0.4.4           haven_1.1.1          
# [25] scales_0.5.0.9000     htmlTable_1.11.2      withr_2.1.2           nnet_7.3-12          
# [29] lazyeval_0.2.1        cli_1.0.0             mnormt_1.5-5          survival_2.41-3      
# [33] magrittr_1.5          crayon_1.3.4          readxl_1.0.0          nlme_3.1-131.1       
# [37] MASS_7.3-49           xml2_1.2.0            foreign_0.8-69        tools_3.4.4          
# [41] data.table_1.10.4-3   hms_0.4.2             cluster_2.0.6         plotrix_3.7          
# [45] compiler_3.4.4        rlang_0.2.0.9001      grid_3.4.4            rstudioapi_0.7.0-9000
# [49] htmlwidgets_1.0       labeling_0.3          base64enc_0.1-3       gtable_0.2.0         
# [53] reshape_0.8.7         reshape2_1.4.3        R6_2.2.2              gridExtra_2.3        
# [57] lubridate_1.7.3       knitr_1.20            bindr_0.1.1           Hmisc_4.1-1          
# [61] stringi_1.1.7         parallel_3.4.4        Rcpp_0.12.16          rpart_4.1-13         
# [65] acepack_1.4.1         tidyselect_0.2.4