#' Schoeller Diagram
#'
#' @param df dataframe of environmental data in tidy format. The function
#' will convert data from mg/L to meq/L
#' @param location_id the column for sample locations
#' @param sample_date column for sample date
#' @param param_name the column of parameter names
#' @param analysis_result column containing the numerical analysis result
#' @param default_unit column containing the units. Assumes mg/L.
#' @param calcium name of calcium. Default is "Calcium, dissolved"
#' @param magnesium name of magnesium. Default is "Magnesium, dissolved"
#' @param sodium name for sodium. Default is "Sodium, dissolved"
#' @param potassium name for potassium. Default is "Potassium, dissolved"
#' @param chloride name for chloride. Default is "Chloride, total"
#' @param alkalinity name for alkalinity. Default is "Alkalinity, total (lab)"
#' @param sulfate name of sulfate. Default is "Sulfate, total"
#' @param facet_var parameter to facet plots by. Default is location
#' @param title title of plot
#' @param lwt lineweight
#'
#' @examples
#' data(gw_data)
#' gw_data %>%
#' filter(location_id %in% c("MW-1", "MW-2")) %>%
#' schoeller_plot(., facet_var = "location_id", title = "Example Scholler Plot")
#'
#' gw_data %>%
#' filter(location_id %in% c("MW-1", "MW-2")) %>%
#' schoeller_plot(., facet_var = "sample_date", lwt = 2)
#'
#' @export
schoeller_plot <- function(df,
location_id = "location_id",
sample_date = "sample_date",
param_name = "param_name",
analysis_result = "analysis_result",
default_unit = "default_unit",
calcium = "Calcium, dissolved",
magnesium = "Magnesium, dissolved",
sodium = "Sodium, dissolved",
potassium = "Potassium, dissolved",
chloride = "Chloride, total",
alkalinity = "Alkalinity, total (lab)",
sulfate = "Sulfate, total",
facet_var = "location_id",
title = NULL,
lwt = 1) {
df <- df %>%
.transform_schoeller_data(location_id = location_id,
sample_date = sample_date,
param_name = param_name,
analysis_result = analysis_result,
default_unit = default_unit,
calcium = calcium,
magnesium = magnesium,
sodium = sodium,
potassium = potassium,
chloride = chloride,
alkalinity = alkalinity,
sulfate = sulfate)
p <- ggplot(df, aes(x = param_name, y = analysis_result, group = 1),
size = lwt) +
scale_y_continuous(trans = scales::log10_trans(),
breaks = scales::pretty_breaks(),
labels = prettyNum) +
scale_x_discrete() +
theme_bw() +
theme(axis.title.y = element_blank(),
axis.title.x = element_blank()) +
ggtitle(paste(title)) +
theme(plot.title = element_text(hjust = 0.5))
if (facet_var == "sample_date") {
p <- p + facet_wrap(~sample_date, scale = "free_y") +
geom_line(aes(colour = location_id, group = location_id), size = lwt) +
guides(colour = guide_legend("Location ID"))
}
if (facet_var == "location_id") {
p <- p + facet_wrap(~location_id, scale = "free_y") +
geom_line(aes(colour = factor(sample_date), group = sample_date),
size = lwt) +
guides(colour = guide_legend("Sample Date"))
}
if (requireNamespace("viridis", quietly = TRUE)) {
p <- p + viridis::scale_colour_viridis(discrete = TRUE)
} else {
p <- p + scale_color_discrete()
}
return(p)
}
#' Help function to transform data to schoeller coordinates
#'
#' @noRd
.transform_schoeller_data <- function(df,
location_id = "location_id",
sample_date = "sample_date",
param_name = "param_name",
analysis_result = "analysis_result",
default_unit = "default_unit",
calcium = "Calcium, dissolved",
magnesium = "Magnesium, dissolved",
sodium = "Sodium, dissolved",
potassium = "Potassium, dissolved",
chloride = "Chloride, total",
alkalinity = "Alkalinity, total (lab)",
sulfate = "Sulfate, total"
) {
df <- df %>%
.get_schoeller_ions(location_id = location_id,
sample_date = sample_date,
param_name = param_name,
analysis_result = analysis_result,
default_unit = default_unit,
calcium = calcium,
magnesium = magnesium,
sodium = sodium,
potassium = potassium,
chloride = chloride,
alkalinity = alkalinity,
sulfate = sulfate) %>%
conc_to_meq(., magnesium = magnesium, calcium = calcium, sodium = sodium,
potassium = potassium, chloride = chloride, sulfate = sulfate,
alkalinity = alkalinity)
df <- df %>%
select(sodium, potassium) %>%
mutate(`Na + K` = rowSums(.)) %>%
select(`Na + K`) %>%
bind_cols(df) %>%
select(location_id = location_id, sample_date = sample_date,
default_unit = default_unit, Mg = magnesium, Ca = calcium,
`Na + K` = `Na + K`, Cl = chloride, SO4 = sulfate, Alk = alkalinity)
df <- df %>%
gather(key = param_name,
value = analysis_result,
-c(location_id, default_unit, sample_date))
return(df)
}
#' Function to gather major ions for scholler diagram.
#'
#' @noRd
.get_schoeller_ions <- function(df,
location_id = "location_id",
sample_date = "sample_date",
param_name = "param_name",
analysis_result = "analysis_result",
default_unit = "default_unit",
calcium = "Calcium, dissolved",
magnesium = "Magnesium, dissolved",
sodium = "Sodium, dissolved",
potassium = "Potassium, dissolved",
chloride = "Chloride, total",
alkalinity = "Alkalinity, total (lab)",
sulfate = "Sulfate, total"
) {
ions <- c(calcium, magnesium, sodium,
potassium, chloride, alkalinity, sulfate)
df <- df %>%
filter_(~param_name %in% ions) %>%
spread_(param_name, analysis_result) %>%
group_by_(~location_id, ~sample_date, ~default_unit) %>%
summarise_at(vars(ions), mean, na.rm = TRUE) %>%
ungroup()
return(df)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.