`%|%` <- function(x, y) ifelse(is.na(x), y, x)
`%empty%` <- function(x, y) if(length(x)==0) y else x
pcc <- function(...) paste0(..., collapse = ", ")
#' Get information about valid units
#'
#' These functions require the \pkg{xml2} package, and return data frames with
#' complete information about pre-defined units from UDUNITS2. Inspect this data
#' frames to determine what inputs are accepted by \code{as_units} (and the
#' other functions it powers: \code{as_units}, \code{set_units} , \code{units<-}).
#'
#' Any entry listed under \code{symbol} , \code{symbol_aliases} , \code{
#' name_singular} , \code{name_singular_aliases} , \code{name_plural} , or
#' \code{name_plural_aliases} is valid. Additionally, any entry under
#' \code{symbol} or \code{symbol_aliases} may can also contain a valid prefix,
#' as specified by \code{valid_udunits_prefixes()} .
#'
#' Note, this is primarily intended for interactive use, the exact format of the
#' returned data frames may change in the future.
#'
#' @param quiet logical, defaults \code{TRUE} to give a message about the location of
#' the udunits database being read.
#'
#' @return a data frame with columns \code{symbol} , \code{symbol_aliases} ,
#' \code{name_singular} , \code{name_singular_aliases} , \code{name_plural} ,
#' or \code{name_plural_aliases} , \code{def} , \code{definition} ,
#' \code{comment} , \code{dimensionless} and \code{source_xml}
#'
#' @export
#'
#' @name valid_udunits
#' @examples
#' if (requireNamespace("xml2", quietly = TRUE)) {
#' valid_udunits()
#' valid_udunits_prefixes()
#' if(interactive())
#' View(valid_udunits())
#' }
valid_udunits <- function(quiet = FALSE) {
db <- .read_ud_db(type="unit")
if (!quiet) message(.startup_msg())
xml_nodes <- xml2::xml_children(db)
l <- lapply(seq_len(xml2::xml_length(db)), function(i) {
unit <- xml_nodes[[i]]
source_xml <- xml2::xml_text(xml2::xml_find_first(unit, ".//source"))
symbols <- xml2::xml_find_all(unit, ".//symbol")
symbols <- xml2::xml_text(symbols) %empty% ""
symbol <- symbols[ 1]
symbol_aliases <- pcc(symbols[-1])
unit_names <- xml2::xml_find_all(unit, ".//name")
all_names <- unlist(lapply(unit_names, function(.x)
xml2::xml_text(xml2::xml_children(.x))))
singular <- xml2::xml_find_all(unit_names, ".//singular")
singular <- xml2::xml_text(singular)
plural <- xml2::xml_find_all(unit_names, ".//plural")
plural <- xml2::xml_text(plural)
name_singular <- singular[ 1] %|% ""
name_singular_aliases <- pcc(singular[-1]) %|% ""
name_plural <- plural[ 1] %|% ""
name_plural_aliases <- pcc(plural[-1]) %|% ""
def <- xml2::xml_find_all(unit, ".//def")
def <- xml2::xml_text(def) %empty% ""
definition <- xml2::xml_find_all(unit, ".//definition")
definition <- xml2::xml_text(definition) %empty% ""
comment <- xml2::xml_find_all(unit, ".//comment")
comment <- xml2::xml_text(comment) %empty% ""
dimensionless <- xml2::xml_find_all(unit, ".//dimensionless")
dimensionless <- as.logical(length(dimensionless))
# all node names that might be in a unit node
# db %>% xml_children() %>% map(~xml_children(.x) %>% xml_name()) %>%
# unique() %>% unlist() %>% unique()
# [1] "base" "name" "symbol"
# [4] "aliases" "definition" "def"
# [7] "comment" "dimensionless"
# rest_xml <- unit %>% xml_children()
# rest <- map(rest_xml, xml_text)
# names(rest) <- rest_xml %>% xml_name()
# rest <- list(rest)
data.frame(symbol, symbol_aliases,
name_singular, name_singular_aliases,
name_plural, name_plural_aliases,
def, definition, comment, dimensionless, source_xml, #, rest
stringsAsFactors = FALSE)
})
df <- do.call(rbind, c(l, stringsAsFactors=FALSE, make.row.names=FALSE))
class(df) <- c( "tbl_df", "tbl", "data.frame")
df
}
#' @name valid_udunits
#' @export
valid_udunits_prefixes <- function(quiet = FALSE) {
db <- .read_ud_db(type="prefix")
if (!quiet) message(.startup_msg())
# all prefix valid names
# db %>% xml_children() %>% map(~xml_children(.x) %>% xml_name()) %>%
# unlist() %>% unique()
# "value" "name" "symbol"
l <- lapply( xml2::xml_children(db), function(prefix) {
symbols <- xml2::xml_find_all(prefix, ".//symbol")
symbols <- xml2::xml_text(symbols)
symbol <- symbols[1]
symbol_aliases <- pcc(symbols[-1])
name <- xml2::xml_find_all(prefix, ".//name")
name <- xml2::xml_text(name)
value <- xml2::xml_find_all(prefix, ".//value")
value <- xml2::xml_double(value)
data.frame(symbol, symbol_aliases, name, value)
})
df <- do.call(rbind.data.frame,
c(l, stringsAsFactors = FALSE, make.row.names = FALSE))
class(df) <- c( "tbl_df", "tbl", "data.frame")
df
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.