#' Label wet-bulb temperature
#'
#' Format numbers as main variables on the psychrometric chart.
#'
#' @param x A numeric vector
#' @param units A single string indcating the unit system to use. Should be either
#' `"SI"` or `"IP"`
#' @param parse If `TRUE`, the labels will be parsed into expressions and
#' displayed as described in `?plotmath`. Default: `FALSE`.
#' @inherit scales::number_format params return
#'
#' @examples
#' demo_scale(10:50, labels = label_drybulb(units = "SI", parse = TRUE))
#' demo_scale(10:50, labels = label_drybulb(units = "IP", parse = TRUE))
#'
#' demo_scale(10:20, labels = label_humratio(scale = 0.001, units = "SI", parse = TRUE))
#' demo_scale(10:20, labels = label_humratio(scale = 0.007, units = "IP", parse = TRUE))
#'
#' demo_scale(10:50, labels = label_relhum(units = "SI"))
#' demo_scale(10:50, labels = label_relhum(units = "IP"))
#'
#' demo_scale(10:50, labels = label_wetbulb(units = "SI", parse = TRUE))
#' demo_scale(10:50, labels = label_wetbulb(units = "IP", parse = TRUE))
#'
#' demo_scale(10:50, labels = label_specvol(units = "SI", parse = TRUE))
#' demo_scale(10:50, labels = label_specvol(units = "IP", parse = TRUE))
#'
#' demo_scale(10:50, labels = label_vappres(units = "SI"))
#' demo_scale(10:50, labels = label_vappres(units = "IP"))
#'
#' demo_scale(seq(1000, 2000), labels = label_enthalpy(units = "SI", parse = TRUE))
#' demo_scale(seq(1000, 2000), labels = label_enthalpy(units = "IP", parse = TRUE))
#'
#' @rdname label
#' @export
# label_drybulb {{{
label_drybulb <- function(x, accuracy = NULL, scale = 1, units,
big.mark = ",", decimal.mark = ".", trim = TRUE, parse = FALSE, ...) {
label_unit(x, accuracy = accuracy, scale = scale, type = "drybulb", units = units,
big.mark, decimal.mark, trim, parse, ...)
}
# }}}
#' @rdname label
#' @export
# label_humratio {{{
label_humratio <- function(x, accuracy = NULL, scale = 1, units,
big.mark = ",", decimal.mark = ".", trim = TRUE, parse = FALSE, ...) {
label_unit(x, accuracy = accuracy, scale = scale, type = "humratio", units = units,
big.mark, decimal.mark, trim, parse, ...)
}
# }}}
#' @rdname label
#' @export
# label_relhum {{{
label_relhum <- function(x, accuracy = NULL, scale = 1, units,
big.mark = ",", decimal.mark = ".", trim = TRUE, parse = FALSE, ...) {
label_unit(x, accuracy = accuracy, scale = scale, type = "relhum", units = units,
big.mark, decimal.mark, trim, parse, ...)
}
# }}}
#' @rdname label
#' @export
# label_wetbulb {{{
label_wetbulb <- function(x, accuracy = NULL, scale = 1, units,
big.mark = ",", decimal.mark = ".", trim = TRUE, parse = FALSE, ...) {
label_unit(x, accuracy = accuracy, scale = scale, type = "wetbulb", units = units,
big.mark, decimal.mark, trim, parse, ...)
}
# }}}
#' @rdname label
#' @export
# label_vappres {{{
label_vappres <- function(x, accuracy = NULL, scale = 1, units,
big.mark = ",", decimal.mark = ".", trim = TRUE, parse = FALSE, ...) {
label_unit(x, accuracy = accuracy, scale = scale, type = "vappres", units = units,
big.mark, decimal.mark, trim, parse, ...)
}
# }}}
#' @rdname label
#' @export
# label_specvol {{{
label_specvol <- function(x, accuracy = NULL, scale = 1, units,
big.mark = ",", decimal.mark = ".", trim = TRUE, parse = FALSE, ...) {
label_unit(x, accuracy = accuracy, scale = scale, type = "specvol", units = units,
big.mark, decimal.mark, trim, parse, ...)
}
# }}}
#' @rdname label
#' @export
# label_enthalpy {{{
label_enthalpy <- function(x, accuracy = NULL, scale = 1, units,
big.mark = ",", decimal.mark = ".", trim = TRUE, parse = FALSE, ...) {
label_unit(x, accuracy = accuracy, scale = scale, type = "enthalpy", units = units,
big.mark, decimal.mark, trim, parse, ...)
}
# }}}
#' @rdname label
#' @export
drybulb_format <- label_drybulb
#' @rdname label
#' @export
humratio_format <- label_humratio
#' @rdname label
#' @export
relhum_format <- label_relhum
#' @rdname label
#' @export
wetbulb_format <- label_wetbulb
#' @rdname label
#' @export
vappres_format <- label_vappres
#' @rdname label
#' @export
specvol_format <- label_specvol
#' @rdname label
#' @export
enthalpy_format <- label_enthalpy
# label_unit {{{
#' @importFrom scales number
label_unit <- function (x, accuracy = NULL, scale = 1, type, units,
big.mark = ",", decimal.mark = ".", trim = TRUE, parse = FALSE,
...) {
force_all(
accuracy,
scale,
units,
big.mark,
decimal.mark,
trim,
...
)
units <- match.arg(units, c("SI", "IP"))
prefix <- get_prefix(type)
suffix <- paste0(" ", get_unit(units, type))
if (parse && suffix == " %") suffix <- paste0("'", suffix, "'")
if (parse || need_parse(type)) {
prefix <- paste0("'", prefix, " '*")
suffix <- paste("*~", suffix)
big.mark <- paste0("*'", big.mark, "'*")
decimal.mark <- paste0("*'", decimal.mark, "'*")
}
function (x) {
if (type == "relhum") x <- x * 100.0
if (type == "vappres") x <- x / 1000.0
if (type == "enthalpy") x <- x / 1000.0
num <- number(x, accuracy = accuracy, scale = scale,
prefix = "", suffix = suffix,
big.mark = big.mark, decimal.mark = decimal.mark,
trim = trim, ...)
if (need_parse(type)) {
num <- gsub("(\\d+)", "'\\1'", num, perl = TRUE)
}
num[1] <- paste(prefix, num[1])
if (parse) {
parse(text = num)
} else {
num
}
}
}
# }}}
# get_unit {{{
get_unit <- function (unit, type) {
.unit_list[[unit]][[type]]
}
# }}}
# get_prefix {{{
get_prefix <- function (type) {
if (type == "relhum") {
"RH"
} else {
pre <- gsub("_", " ", gsub("_(\\w)", "\\U\\1", type, perl = TRUE))
gsub("^(\\w)", "\\U\\1", pre, perl = TRUE)
}
}
# }}}
# need_parse {{{
need_parse <- function (type) {
.unit_list$parse[[type]]
}
# }}}
# force_all {{{
# reference r-lib/scales/R/utils.r
force_all <- function (...) list(...)
# }}}
# demo_scale {{{
# adopted from scales::demo_continuous
#' Demonstrate scales functions with ggplot2 code
#'
#' This function generates ggplot2 code needed to use scales functions for real
#' code.
#'
#' @param x A vector of data
#' @param ... Other arguments pass to scale functions
#'
#' @keywords internal
#' @export
demo_scale <- function (x, ...) {
df <- data.frame(x = x, stringsAsFactors = FALSE)
ggplot2::ggplot(df, ggplot2::aes(x, 1)) +
ggplot2::geom_blank() +
ggplot2::scale_x_continuous(NULL, ...) +
ggplot2::scale_y_continuous(NULL, breaks = NULL) +
ggplot2::theme(aspect.ratio = 1 / 5)
}
# }}}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.