Skip to content

Instantly share code, notes, and snippets.

@benmarwick

benmarwick/munsell-plot.R

Last active Mar 16, 2019
Embed
What would you like to do?
Make a stratigraphic-style plot-schematic of sediment colour using munsell values
# 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
@benmarwick

This comment has been minimized.

Copy link
Owner Author

@benmarwick benmarwick commented Apr 1, 2018

image

image

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment