annoporci/currency_format.R

## currency_format.R
#' Currency formatter: round to nearest cent and display currency symbol.
#' Particular emphasis on the following currency symbols:
#' euro , pound/sterling, yen (Japan), renminbi/yuan (China).
#' French and British formatting styles (U.S. style in scales package)
#' intended for use with ggplot2 and the scales package
#'
#' Dependencies:
#' \code{require(scales)}
#' \code{require(plyr)}  # function round_any
#'
#' The returned function will format a vector of values as currency.
#' Values are rounded to the nearest cent, and cents are displayed if
#' any of the values has a non-zero cents and the largest value is less
#' than \code{largest_with_cents} which by default is 100000.
#'
#' @return a function with single paramater x, a numeric vector, that
#'   returns a character vector
#' @param largest_with_cents the value that all values of \code{x} must
#'   be less than in order for the cents to be displayed
#' @param x a numeric vector to format
#' @export
#' @examples
#' dollar_format()(c(100, 0.23, 1.456565, 2e3))
#' dollar_format()(c(1:10 * 10))
#' dollar(c(100, 0.23, 1.456565, 2e3))
#' dollar(c(1:10 * 10))
#' dollar(10^(1:8))
#'
#'
#' extension of dollar_format from library scales
currency_format <- function(symbol_currency = "$", symbol_position = "before", symbol_spacing = "none", separator_thousand = ",", separator_thousand_interval = 3, separator_decimal = ".", separator_decimal_interval = 3, largest_with_cents = 100000, nsmall = 0L, trim = TRUE, scientific = FALSE, digits = 1L, drop0trailing = TRUE, currency_unit = "", negative_parentheses = FALSE) {
  function(x) {
    # format numeric axis labels
    x <- plyr::round_any(x, 0.01)
    if (max(x, na.rm = TRUE) < largest_with_cents &
      !all(x == floor(x), na.rm = TRUE)) {
      nsmall <- 2L
    } else {
      x <- plyr::round_any(x, 1)
      nsmall <- 0L
    }
    labels_format <- format(x, nsmall = nsmall, trim = trim, scientific = scientific, digits = digits, drop0trailing = drop0trailing, big.mark = separator_thousand, big.interval = separator_thousand_interval, decimal.mark = separator_decimal, small.interval = separator_decimal_interval)
    # add currency symbol to labels and position according to style
    if (symbol_spacing == "none" & symbol_position == "after")
      labels <- paste0(labels_format, symbol_currency)
    if (symbol_spacing == "single" & symbol_position == "before")
      labels <- paste0(symbol_currency, " ", labels_format)
    if (symbol_spacing == "single" & symbol_position == "after")
      labels <- paste0(labels_format, " ", symbol_currency)
    if (symbol_spacing == "none" & symbol_position == "before")
      labels <- paste0(symbol_currency, labels_format)
    # millions
    if (currency_unit == "million_us")  # overrules label/symbol positions
      labels <- paste0(symbol_currency, labels_format, "M")
    if (currency_unit == "million_uk")  # overrules label/symbol positions
      labels <- paste0(symbol_currency, labels_format, "m")
    if (currency_unit == "million_french")  # overrules label/symbol positions
      labels <- paste0(labels_format, " Mio ", symbol_currency)
    # billions
    if (currency_unit == "billion_us")  # overrules label/symbol positions
      labels <- paste0(symbol_currency, labels_format, "B")
    if (currency_unit == "billion_uk")  # overrules label/symbol positions
      labels <- paste0(symbol_currency, labels_format, "bn")
    if (currency_unit == "billion_french")  # overrules label/symbol positions
      labels <- paste0(labels_format, " Mrd ", symbol_currency)

    return(labels)
  }
}
#'
#'
#'
#'
#' Create currency labellers
#' To do: define separate U.S. and French styles
#' and pass vector to currency_format
#'
#'
#' dollar currency in standard U.S. style (default)
#' duplicate of dollar in library scales
dollar_format2 <- currency_format # default currency and style
dollar2 <- dollar_format2()
dollar_code_format <- function(x, ...) currency_format(symbol_currency = "USD ")
dollar_code <- dollar_code_format()
USD <- dollar_code
#'
#' euro currency in U.S. style
euro_format <- function(x, ...) currency_format(symbol_currency = "€")
euro <- euro_format()
euro_code_format <- function(x, ...) currency_format(symbol_currency = "EUR ")
euro_code <- euro_code_format()
EUR <- euro_code
#'
#' pound/sterling currency in U.S. style
sterling_format <- function(x, ...) currency_format(symbol_currency = "£")
sterling <- sterling_format()
sterling_code_format <- function(x, ...) currency_format(symbol_currency = "GBP ")
sterling_code <- sterling_code_format()
GBP <- sterling_code
#'
#' yen currency in U.S. style
yen_format <- function(x, ...) currency_format(symbol_currency = "¥")
yen <- yen_format()
yen_code_format <- function(x, ...) currency_format(symbol_currency = "JPY ")
yen_code <- yen_code_format()
JPY <- yen_code
#'
#' yuan/renminbi currency in U.S. style
yuan_format <- function(x, ...) currency_format(symbol_currency = "¥")  # use "¥" instead of "元"
yuan <- yuan_format()
yuan_code_format <- function(x, ...) currency_format(symbol_currency = "CNY ")
yuan_code <- yuan_code_format()
CNY <- yuan_code
#'
#' hong kong dollar currency in U.S. style
hkd_format <- function(x, ...) currency_format(symbol_currency = "HK$")
hkd <- hkd_format()
hkd_code_format <- function(x, ...) currency_format(symbol_currency = "HKD ")
hkd_code <- hkd_code_format()
HKD <- hkd_code
#'
#' hong kong dollar currency in U.S. style
mop_format <- function(x, ...) currency_format(symbol_currency = "MOP$")
mop <- mop_format()
mop_code_format <- function(x, ...) currency_format(symbol_currency = "MOP ")
mop_code <- mop_code_format()
MOP <- mop_code
#'
#' French styles
#' dollar currency in French style
dollar_french_format <- function(x, ...) currency_format(symbol_currency = "$", symbol_position = "after", symbol_spacing = "single", separator_thousand = " ", separator_decimal = ",")
dollar_french <- dollar_french_format()
dollar_french_code_format <- function(x, ...) currency_format(symbol_currency = "USD", symbol_position = "after", symbol_spacing = "single", separator_thousand = " ", separator_decimal = ",")
dollar_french_code <- dollar_french_code_format()
#'
#' euro currency in French style
euro_french_format <- function(x, ...) currency_format(symbol_currency = "€", symbol_position = "after", symbol_spacing = "single", separator_thousand = " ", separator_decimal = ",")
euro_french <- euro_french_format()
euro_french_code_format <- function(x, ...) currency_format(symbol_currency = "EUR", symbol_position = "after", symbol_spacing = "single", separator_thousand = " ", separator_decimal = ",")
euro_french_code <- euro_french_code_format()
#'
#' sterling currency in French style
sterling_french_format <- function(x, ...) currency_format(symbol_currency = "£", symbol_position = "after", symbol_spacing = "single", separator_thousand = " ", separator_decimal = ",")
sterling_french <- sterling_french_format()
sterling_french_code_format <- function(x, ...) currency_format(symbol_currency = "GBP", symbol_position = "after", symbol_spacing = "single", separator_thousand = " ", separator_decimal = ",")
sterling_french_code <- sterling_french_code_format()
#'
#' yen currency in French style
yen_french_format <- function(x, ...) currency_format(symbol_currency = "¥", symbol_position = "after", symbol_spacing = "single", separator_thousand = " ", separator_decimal = ",")
yen_french <- yen_french_format()
yen_french_code_format <- function(x, ...) currency_format(symbol_currency = "JPY", symbol_position = "after", symbol_spacing = "single", separator_thousand = " ", separator_decimal = ",")
yen_french_code <- yen_french_code_format()
#'
#' yuan currency in French style
yuan_french_format <- function(x, ...) currency_format(symbol_currency = "¥", symbol_position = "after", symbol_spacing = "single", separator_thousand = " ", separator_decimal = ",")
yuan_french <- yuan_french_format()
yuan_french_code_format <- function(x, ...) currency_format(symbol_currency = "CNY", symbol_position = "after", symbol_spacing = "single", separator_thousand = " ", separator_decimal = ",")
yuan_french_code <- yuan_french_code_format()
#'
#'
#'

## currency_format_test.R
# Load packages
library(ggplot2)
library(scales)
library(plyr)  # round_any

# check style attributes
attr(style_us(), "complete")
attr(style_french(), "complete")

# visual inspection
p <- qplot(x = seq(0, 10, length = 10), y = rnorm(10, sd = 1000000)) + xlab(NULL)  + ylab(NULL)

# weird tests
p + scale_y_continuous(labels = currency_format(separator_thousand = "/", currency_unit = "million_uk")) + scale_x_continuous(labels = currency_format(separator_decimal = "/", currency_unit = "billion_french"))

# dollar
p + scale_x_continuous(labels = dollar2) + scale_y_continuous(labels = dollar_format2())

# dollar / code
p + scale_x_continuous(labels = dollar_code) + scale_y_continuous(labels = dollar_code_format2())

# dollar / french
p + scale_x_continuous(labels = dollar_french) + scale_y_continuous(labels = dollar_french_format())

# dollar / french / code
p + scale_x_continuous(labels = dollar_french_code) + scale_y_continuous(labels = dollar_french_code_format())

# euro
p + scale_x_continuous(labels = euro) + scale_y_continuous(labels = euro_format())

# euro / code
p + scale_x_continuous(labels = euro_code) + scale_y_continuous(labels = euro_code_format())

# euro / french
p + scale_x_continuous(labels = euro_french) + scale_y_continuous(labels = euro_french_format())

# euro / french / code
p + scale_x_continuous(labels = euro_french_code) + scale_y_continuous(labels = euro_french_code_format())

# sterling
p + scale_x_continuous(labels = sterling) + scale_y_continuous(labels = sterling_format())

# sterling / french
p + scale_x_continuous(labels = sterling_french) + scale_y_continuous(labels = sterling_french_format())

# sterling / french / code
p + scale_x_continuous(labels = sterling_french_code) + scale_y_continuous(labels = sterling_french_code_format())


## currency_format_to_do.R
#' To do: make the currency selection process more automatic
#' See preliminary stuff below
#'
#' map currency name to currency symbol
#' partial mapping only, based merely on my current needs
#' ref: http://en.wikipedia.org/wiki/Currency_symbol
currency_symbol <- function(x = dollar) {
    # currencies in use as of January 2015
    if (x %in% c("dollar")) "$"
    if (x %in% c("euro")) "€"
    if (x %in% c("sterling", "pound")) "£"
    if (x %in% c("forint")) "Ft"
    if (x %in% c("krone", "krona")) "kr"
    if (x %in% c("rand")) "R"
    if (x %in% c("real", "dollar_real")) "R$"
    if (x %in% c("ruble")) "₽"
    if (x %in% c("rupee")) "₹"
    if (x %in% c("shekel")) "₪"
    if (x %in% c("franc_suisse", "franc_swiss", "swiss_franc")) "CHF"
    if (x %in% c("won")) "₩"
    if (x %in% c("yuen")) "¥"
    if (x %in% c("yuan", "renminbi")) "¥"
    if (x %in% c("zloty")) "zł"
    if (x %in% c("baht", "bitcoin")) "฿"
    if (x %in% c("cent", "centavo")) "¢"
    if (x %in% c("dollar_us")) "US$"
    if (x %in% c("dollar_australia")) "A$"
    if (x %in% c("dollar_canada")) "CA$"
    if (x %in% c("dollar_mexico")) "MEX$"
    if (x %in% c("dollar_newzealand", "dollar_nz")) "NZ$"
    if (x %in% c("dollar_singapore")) "S$"
    if (x %in% c("dollar_taiwan")) "NT$"
    if (x %in% c("dollar_hk", "dollar_hongkong")) "HK$"
    if (x %in% c("pataca", "dollar_mop")) "MOP$"
    if (x %in% c("dollar_taiwan_ch", "dollar_hk_ch", "dollar_hongkong_ch", "pataca_ch", "mop_ch", "yuan_ch")) "元"  # 'more' Chinese
    # obsolete currencies
    # Finland
    if (x %in% c("markka")) "markka"  #  (-2001)
    # Germany
    if (x %in% c("mark", "mark_westgerman")) "ℳ"  # (1875–1923)
    if (x %in% c("mark_reichsmark")) "ℛℳ"  # (1923–1948)
    if (x %in% c("deutschemark_east")) "DM"  # (1948–1964)
    if (x %in% c("mark_mdn")) "MDN"  # (1964–1968)
    if (x %in% c("mark_ddr")) "M"  # (1968–1990)
    if (x %in% c("deutschemark", "deutschemark_west")) "DM"  #  (1948–2001)
    # France
    if (x %in% c("franc")) "Fr"  #  (1795-2001)
    # Italy
    if (x %in% c("lira")) "£"  #  (1861-2001)
    # Portugal
    # http://en.wikipedia.org/wiki/Cifr%C3%A3o
    # two-lign sign a mess and replaced by dollar sign
    if (x %in% c("real", "reais", "reis")) "Réis$"  # (1430-1911)
    if (x %in% c("escudo")) "$"  # (1911-2001)
    # Slovakia
    if (x %in% c("koruna_slovak")) "Sk"   #  (1993–2008)
    # Spain
    if (x %in% c("peseta", "pesetas")) "₧"  #  (1869-2001)
}
#'
#'
currency_names_list <- list(
    "dollar", "euro", "sterling", "pound", "forint", "krone", "krona", "rand", "real", "dollar_real", "ruble", "rupee", "shekel", "franc_suisse", "franc_swiss", "swiss_franc", "won", "yuen", "yuan", "renminbi", "zloty", "baht", "bitcoin", "cent", "centavo", "dollar_us", "dollar_australia", "dollar_canada", "dollar_mexico", "dollar_newzealand", "dollar_singapore", "dollar_taiwan", "dollar_hk", "dollar_hongkong", "pataca", "dollar_mop", "dollar_taiwan_ch", "dollar_hk_ch", "dollar_hongkong_ch", "pataca_ch", "mop_ch", "yuan_ch", "markka", "mark", "mark_westgerman", "mark_reichsmark", "deutschemark_east", "mark_mdn", "mark_ddr", "deutschemark", "deutschemark_west", "franc", "lira", "real", "reais", "reis", "escudo", "koruna_slovak", "peseta", "pesetas"
)
#'
#'
#'
#'
#' To do: create a 'theme' for currency styles
#' style() adapted from theme() of package ggplot2
style <- function(..., complete = FALSE) {
    elements <- list(...)
    structure(elements, class = c("style"), complete = complete)
}
.style <- (function() {
    style <- style_usa()
    list(
        get = function() style,
        set = function(new) {
            missing <- setdiff(names(style_usa()), names(new))
            if (length(missing) > 0) {
            warning("New style missing the following elements: ",
            paste(missing, collapse = ", "), call. = FALSE)
        }
        old <- style
        style <<- new
        invisible(old)
        }
    )
})()
#'
# style_get adapted from theme_get() of package ggplot2
style_get <- .style$get

# style_set adapted from theme_set() of package ggplot2
style_set <- .style$set

# is_style adapted from is.theme() of package ggplot2
is_style <- function(x) inherits(x, "style")

# %+style_replace% adapted from %+replace% of package ggplot2
"%+style_replace%" <- function(e1, e2) {
    if (!is_style(e1) || !is_style(e2)) {
        stop("%+replace% requires two style objects", call. = FALSE)
    }
    # Can't use modifyList here since it works recursively and drops NULLs
    e1[names(e2)] <- e2
    e1
}

# style_update adapted from theme_update() of package ggplot2
style_update <- function(...) {
    # Make a call to style, then add to style
    style_set(style_get() %+replace% do.call(style, list(...)))
}

update_style <- function(oldstyle, newstyle) {
    # If the newstyle is a complete one, don't bother searching
    # the default style -- just replace everything with newstyle
    if (attr(newstyle, "complete"))
        return(newstyle)
    # These are elements in newstyle that aren't already set in oldstyle.
    # They will be pulled from the default style.
    newitems <- !names(newstyle) %in% names(oldstyle)
    newitem_names <- names(newstyle)[newitems]
    oldstyle[newitem_names] <- style_get()[newitem_names]
    # Update the style elements with the things from newstyle
    # Turn the 'style' list into a proper style object first, and preserve
    # the 'complete' attribute. It's possible that oldstyle is an empty
    # list, and in that case, set complete to FALSE.
    oldstyle <- do.call(style, c(oldstyle,
    complete = isTRUE(attr(oldstyle, "complete"))))
    oldstyle + newstyle
}


style_us <- function() {
    style(
        symbol_currency = "$",
        symbol_position = "before",
        symbol_spacing = "none",
        separator_thousand = ",",
        separator_decimal = ".",
        largest_with_cents = 100000,
        nsmall = 0L,
        trim = TRUE,
        scientific = FALSE,
        digits = 1L,
        complete = TRUE
    )
}

style_french <- function() {
    style(
        symbol_currency = "$",
        symbol_position = "after",
        symbol_spacing = "single",
        separator_thousand = " ",
        separator_decimal = ",",
        largest_with_cents = 100000,
        nsmall = 0L,
        trim = TRUE,
        scientific = FALSE,
        digits = 1L,
        complete = TRUE
    )
}


### To do: negative numbers
# https://github.com/hadley/scales/pull/40
my_dollar_format <- function (largest_with_cents = 1e+05, negative_parentheses = FALSE) {
    old_dollar <- scales::dollar_format(largest_with_cents = largest_with_cents)
    new_dollar <- function(x) {
        x[!is.na(x)] <- old_dollar(x[!is.na(x)])
        if (negative_parentheses) {
            gsub("\\$-(.*)", "($\\1)", x)
        } else {
            gsub("\\$-", "-$", x)
        }
    }
}

d <- c(100.02, 25.32, -24.42, NA)
my_dollar_format()(d)
## [1] "$100.02" "$25.32"  "-$24.42" NA
my_dollar_format(negative_parentheses=TRUE)(d)
## [1] "$100.02"  "$25.32"   "($24.42)" NA

## unicode for some currencies
for reference, in case it has some future use:

# Currency symbols

    # http://www.fileformat.info/info/unicode/category/Sc/list.htm
    Character 	Name 	Browser 	Image
    \u0024 	DOLLAR SIGN 	$
    \u00A2 	CENT SIGN 	¢
    \u00A3 	POUND SIGN 	£
    \u00A4 	CURRENCY SIGN 	¤
    \u00A5 	YEN SIGN 	¥
    \u058F 	ARMENIAN DRAM SIGN 	֏
    \u060B 	AFGHANI SIGN 	؋
    \u09F2 	BENGALI RUPEE MARK 	৲
    \u09F3 	BENGALI RUPEE SIGN 	৳
    \u09FB 	BENGALI GANDA MARK 	৻
    \u0AF1 	GUJARATI RUPEE SIGN 	૱
    \u0BF9 	TAMIL RUPEE SIGN 	௹
    \u0E3F 	THAI CURRENCY SYMBOL BAHT 	฿
    \u17DB 	KHMER CURRENCY SYMBOL RIEL 	៛
    \u20A0 	EURO-CURRENCY SIGN 	₠
    \u20A1 	COLON SIGN 	₡
    \u20A2 	CRUZEIRO SIGN 	₢
    \u20A3 	FRENCH FRANC SIGN 	₣
    \u20A4 	LIRA SIGN 	₤
    \u20A5 	MILL SIGN 	₥
    \u20A6 	NAIRA SIGN 	₦
    \u20A7 	PESETA SIGN 	₧
    \u20A8 	RUPEE SIGN 	₨
    \u20A9 	WON SIGN 	₩
    \u20AA 	NEW SHEQEL SIGN 	₪
    \u20AB 	DONG SIGN 	₫
    \u20AC 	EURO SIGN 	€
    \u20AD 	KIP SIGN 	₭
    \u20AE 	TUGRIK SIGN 	₮
    \u20AF 	DRACHMA SIGN 	₯
    \u20B0 	GERMAN PENNY SIGN 	₰
    \u20B1 	PESO SIGN 	₱
    \u20B2 	GUARANI SIGN 	₲
    \u20B3 	AUSTRAL SIGN 	₳
    \u20B4 	HRYVNIA SIGN 	₴
    \u20B5 	CEDI SIGN 	₵
    \u20B6 	LIVRE TOURNOIS SIGN 	₶
    \u20B7 	SPESMILO SIGN 	₷
    \u20B8 	TENGE SIGN 	₸
    \u20B9 	INDIAN RUPEE SIGN 	₹
    \u20BA 	TURKISH LIRA SIGN 	₺
    \u20BB 	NORDIC MARK SIGN 	₻
    \u20BC 	MANAT SIGN 	₼
    \u20BD 	RUBLE SIGN 	₽
    \uA838 	NORTH INDIC RUPEE MARK 	꠸
    \uFDFC 	RIAL SIGN 	﷼
    \uFE69 	SMALL DOLLAR SIGN 	﹩
    \uFF04 	FULLWIDTH DOLLAR SIGN 	＄
    \uFFE0 	FULLWIDTH CENT SIGN 	￠
    \uFFE1 	FULLWIDTH POUND SIGN 	￡
    \uFFE5 	FULLWIDTH YEN SIGN 	￥
    \uFFE6 	FULLWIDTH WON SIGN 	￦
	#' Currency formatter: round to nearest cent and display currency symbol.
	#' Particular emphasis on the following currency symbols:
	#' euro , pound/sterling, yen (Japan), renminbi/yuan (China).
	#' French and British formatting styles (U.S. style in scales package)
	#' intended for use with ggplot2 and the scales package
	#'
	#' Dependencies:
	#' \code{require(scales)}
	#' \code{require(plyr)} # function round_any
	#'
	#' The returned function will format a vector of values as currency.
	#' Values are rounded to the nearest cent, and cents are displayed if
	#' any of the values has a non-zero cents and the largest value is less
	#' than \code{largest_with_cents} which by default is 100000.
	#'
	#' @return a function with single paramater x, a numeric vector, that
	#' returns a character vector
	#' @param largest_with_cents the value that all values of \code{x} must
	#' be less than in order for the cents to be displayed
	#' @param x a numeric vector to format
	#' @export
	#' @examples
	#' dollar_format()(c(100, 0.23, 1.456565, 2e3))
	#' dollar_format()(c(1:10 * 10))
	#' dollar(c(100, 0.23, 1.456565, 2e3))
	#' dollar(c(1:10 * 10))
	#' dollar(10^(1:8))
	#'
	#'
	#' extension of dollar_format from library scales
	currency_format <- function(symbol_currency = "$", symbol_position = "before", symbol_spacing = "none", separator_thousand = ",", separator_thousand_interval = 3, separator_decimal = ".", separator_decimal_interval = 3, largest_with_cents = 100000, nsmall = 0L, trim = TRUE, scientific = FALSE, digits = 1L, drop0trailing = TRUE, currency_unit = "", negative_parentheses = FALSE) {
	function(x) {
	# format numeric axis labels
	x <- plyr::round_any(x, 0.01)
	if (max(x, na.rm = TRUE) < largest_with_cents &
	!all(x == floor(x), na.rm = TRUE)) {
	nsmall <- 2L
	} else {
	x <- plyr::round_any(x, 1)
	nsmall <- 0L
	}
	labels_format <- format(x, nsmall = nsmall, trim = trim, scientific = scientific, digits = digits, drop0trailing = drop0trailing, big.mark = separator_thousand, big.interval = separator_thousand_interval, decimal.mark = separator_decimal, small.interval = separator_decimal_interval)
	# add currency symbol to labels and position according to style
	if (symbol_spacing == "none" & symbol_position == "after")
	labels <- paste0(labels_format, symbol_currency)
	if (symbol_spacing == "single" & symbol_position == "before")
	labels <- paste0(symbol_currency, " ", labels_format)
	if (symbol_spacing == "single" & symbol_position == "after")
	labels <- paste0(labels_format, " ", symbol_currency)
	if (symbol_spacing == "none" & symbol_position == "before")
	labels <- paste0(symbol_currency, labels_format)
	# millions
	if (currency_unit == "million_us") # overrules label/symbol positions
	labels <- paste0(symbol_currency, labels_format, "M")
	if (currency_unit == "million_uk") # overrules label/symbol positions
	labels <- paste0(symbol_currency, labels_format, "m")
	if (currency_unit == "million_french") # overrules label/symbol positions
	labels <- paste0(labels_format, " Mio ", symbol_currency)
	# billions
	if (currency_unit == "billion_us") # overrules label/symbol positions
	labels <- paste0(symbol_currency, labels_format, "B")
	if (currency_unit == "billion_uk") # overrules label/symbol positions
	labels <- paste0(symbol_currency, labels_format, "bn")
	if (currency_unit == "billion_french") # overrules label/symbol positions
	labels <- paste0(labels_format, " Mrd ", symbol_currency)

	return(labels)
	}
	}
	#'
	#'
	#'
	#'
	#' Create currency labellers
	#' To do: define separate U.S. and French styles
	#' and pass vector to currency_format
	#'
	#'
	#' dollar currency in standard U.S. style (default)
	#' duplicate of dollar in library scales
	dollar_format2 <- currency_format # default currency and style
	dollar2 <- dollar_format2()
	dollar_code_format <- function(x, ...) currency_format(symbol_currency = "USD ")
	dollar_code <- dollar_code_format()
	USD <- dollar_code
	#'
	#' euro currency in U.S. style
	euro_format <- function(x, ...) currency_format(symbol_currency = "€")
	euro <- euro_format()
	euro_code_format <- function(x, ...) currency_format(symbol_currency = "EUR ")
	euro_code <- euro_code_format()
	EUR <- euro_code
	#'
	#' pound/sterling currency in U.S. style
	sterling_format <- function(x, ...) currency_format(symbol_currency = "£")
	sterling <- sterling_format()
	sterling_code_format <- function(x, ...) currency_format(symbol_currency = "GBP ")
	sterling_code <- sterling_code_format()
	GBP <- sterling_code
	#'
	#' yen currency in U.S. style
	yen_format <- function(x, ...) currency_format(symbol_currency = "¥")
	yen <- yen_format()
	yen_code_format <- function(x, ...) currency_format(symbol_currency = "JPY ")
	yen_code <- yen_code_format()
	JPY <- yen_code
	#'
	#' yuan/renminbi currency in U.S. style
	yuan_format <- function(x, ...) currency_format(symbol_currency = "¥") # use "¥" instead of "元"
	yuan <- yuan_format()
	yuan_code_format <- function(x, ...) currency_format(symbol_currency = "CNY ")
	yuan_code <- yuan_code_format()
	CNY <- yuan_code
	#'
	#' hong kong dollar currency in U.S. style
	hkd_format <- function(x, ...) currency_format(symbol_currency = "HK$")
	hkd <- hkd_format()
	hkd_code_format <- function(x, ...) currency_format(symbol_currency = "HKD ")
	hkd_code <- hkd_code_format()
	HKD <- hkd_code
	#'
	#' hong kong dollar currency in U.S. style
	mop_format <- function(x, ...) currency_format(symbol_currency = "MOP$")
	mop <- mop_format()
	mop_code_format <- function(x, ...) currency_format(symbol_currency = "MOP ")
	mop_code <- mop_code_format()
	MOP <- mop_code
	#'
	#' French styles
	#' dollar currency in French style
	dollar_french_format <- function(x, ...) currency_format(symbol_currency = "$", symbol_position = "after", symbol_spacing = "single", separator_thousand = " ", separator_decimal = ",")
	dollar_french <- dollar_french_format()
	dollar_french_code_format <- function(x, ...) currency_format(symbol_currency = "USD", symbol_position = "after", symbol_spacing = "single", separator_thousand = " ", separator_decimal = ",")
	dollar_french_code <- dollar_french_code_format()
	#'
	#' euro currency in French style
	euro_french_format <- function(x, ...) currency_format(symbol_currency = "€", symbol_position = "after", symbol_spacing = "single", separator_thousand = " ", separator_decimal = ",")
	euro_french <- euro_french_format()
	euro_french_code_format <- function(x, ...) currency_format(symbol_currency = "EUR", symbol_position = "after", symbol_spacing = "single", separator_thousand = " ", separator_decimal = ",")
	euro_french_code <- euro_french_code_format()
	#'
	#' sterling currency in French style
	sterling_french_format <- function(x, ...) currency_format(symbol_currency = "£", symbol_position = "after", symbol_spacing = "single", separator_thousand = " ", separator_decimal = ",")
	sterling_french <- sterling_french_format()
	sterling_french_code_format <- function(x, ...) currency_format(symbol_currency = "GBP", symbol_position = "after", symbol_spacing = "single", separator_thousand = " ", separator_decimal = ",")
	sterling_french_code <- sterling_french_code_format()
	#'
	#' yen currency in French style
	yen_french_format <- function(x, ...) currency_format(symbol_currency = "¥", symbol_position = "after", symbol_spacing = "single", separator_thousand = " ", separator_decimal = ",")
	yen_french <- yen_french_format()
	yen_french_code_format <- function(x, ...) currency_format(symbol_currency = "JPY", symbol_position = "after", symbol_spacing = "single", separator_thousand = " ", separator_decimal = ",")
	yen_french_code <- yen_french_code_format()
	#'
	#' yuan currency in French style
	yuan_french_format <- function(x, ...) currency_format(symbol_currency = "¥", symbol_position = "after", symbol_spacing = "single", separator_thousand = " ", separator_decimal = ",")
	yuan_french <- yuan_french_format()
	yuan_french_code_format <- function(x, ...) currency_format(symbol_currency = "CNY", symbol_position = "after", symbol_spacing = "single", separator_thousand = " ", separator_decimal = ",")
	yuan_french_code <- yuan_french_code_format()
	#'
	#'
	#'
	# Load packages
	library(ggplot2)
	library(scales)
	library(plyr) # round_any

	# check style attributes
	attr(style_us(), "complete")
	attr(style_french(), "complete")

	# visual inspection
	p <- qplot(x = seq(0, 10, length = 10), y = rnorm(10, sd = 1000000)) + xlab(NULL) + ylab(NULL)

	# weird tests
	p + scale_y_continuous(labels = currency_format(separator_thousand = "/", currency_unit = "million_uk")) + scale_x_continuous(labels = currency_format(separator_decimal = "/", currency_unit = "billion_french"))

	# dollar
	p + scale_x_continuous(labels = dollar2) + scale_y_continuous(labels = dollar_format2())

	# dollar / code
	p + scale_x_continuous(labels = dollar_code) + scale_y_continuous(labels = dollar_code_format2())

	# dollar / french
	p + scale_x_continuous(labels = dollar_french) + scale_y_continuous(labels = dollar_french_format())

	# dollar / french / code
	p + scale_x_continuous(labels = dollar_french_code) + scale_y_continuous(labels = dollar_french_code_format())

	# euro
	p + scale_x_continuous(labels = euro) + scale_y_continuous(labels = euro_format())

	# euro / code
	p + scale_x_continuous(labels = euro_code) + scale_y_continuous(labels = euro_code_format())

	# euro / french
	p + scale_x_continuous(labels = euro_french) + scale_y_continuous(labels = euro_french_format())

	# euro / french / code
	p + scale_x_continuous(labels = euro_french_code) + scale_y_continuous(labels = euro_french_code_format())

	# sterling
	p + scale_x_continuous(labels = sterling) + scale_y_continuous(labels = sterling_format())

	# sterling / french
	p + scale_x_continuous(labels = sterling_french) + scale_y_continuous(labels = sterling_french_format())

	# sterling / french / code
	p + scale_x_continuous(labels = sterling_french_code) + scale_y_continuous(labels = sterling_french_code_format())
	#' To do: make the currency selection process more automatic
	#' See preliminary stuff below
	#'
	#' map currency name to currency symbol
	#' partial mapping only, based merely on my current needs
	#' ref: http://en.wikipedia.org/wiki/Currency_symbol
	currency_symbol <- function(x = dollar) {
	# currencies in use as of January 2015
	if (x %in% c("dollar")) "$"
	if (x %in% c("euro")) "€"
	if (x %in% c("sterling", "pound")) "£"
	if (x %in% c("forint")) "Ft"
	if (x %in% c("krone", "krona")) "kr"
	if (x %in% c("rand")) "R"
	if (x %in% c("real", "dollar_real")) "R$"
	if (x %in% c("ruble")) "₽"
	if (x %in% c("rupee")) "₹"
	if (x %in% c("shekel")) "₪"
	if (x %in% c("franc_suisse", "franc_swiss", "swiss_franc")) "CHF"
	if (x %in% c("won")) "₩"
	if (x %in% c("yuen")) "¥"
	if (x %in% c("yuan", "renminbi")) "¥"
	if (x %in% c("zloty")) "zł"
	if (x %in% c("baht", "bitcoin")) "฿"
	if (x %in% c("cent", "centavo")) "¢"
	if (x %in% c("dollar_us")) "US$"
	if (x %in% c("dollar_australia")) "A$"
	if (x %in% c("dollar_canada")) "CA$"
	if (x %in% c("dollar_mexico")) "MEX$"
	if (x %in% c("dollar_newzealand", "dollar_nz")) "NZ$"
	if (x %in% c("dollar_singapore")) "S$"
	if (x %in% c("dollar_taiwan")) "NT$"
	if (x %in% c("dollar_hk", "dollar_hongkong")) "HK$"
	if (x %in% c("pataca", "dollar_mop")) "MOP$"
	if (x %in% c("dollar_taiwan_ch", "dollar_hk_ch", "dollar_hongkong_ch", "pataca_ch", "mop_ch", "yuan_ch")) "元" # 'more' Chinese
	# obsolete currencies
	# Finland
	if (x %in% c("markka")) "markka" # (-2001)
	# Germany
	if (x %in% c("mark", "mark_westgerman")) "ℳ" # (1875–1923)
	if (x %in% c("mark_reichsmark")) "ℛℳ" # (1923–1948)
	if (x %in% c("deutschemark_east")) "DM" # (1948–1964)
	if (x %in% c("mark_mdn")) "MDN" # (1964–1968)
	if (x %in% c("mark_ddr")) "M" # (1968–1990)
	if (x %in% c("deutschemark", "deutschemark_west")) "DM" # (1948–2001)
	# France
	if (x %in% c("franc")) "Fr" # (1795-2001)
	# Italy
	if (x %in% c("lira")) "£" # (1861-2001)
	# Portugal
	# http://en.wikipedia.org/wiki/Cifr%C3%A3o
	# two-lign sign a mess and replaced by dollar sign
	if (x %in% c("real", "reais", "reis")) "Réis$" # (1430-1911)
	if (x %in% c("escudo")) "$" # (1911-2001)
	# Slovakia
	if (x %in% c("koruna_slovak")) "Sk" # (1993–2008)
	# Spain
	if (x %in% c("peseta", "pesetas")) "₧" # (1869-2001)
	}
	#'
	#'
	currency_names_list <- list(
	"dollar", "euro", "sterling", "pound", "forint", "krone", "krona", "rand", "real", "dollar_real", "ruble", "rupee", "shekel", "franc_suisse", "franc_swiss", "swiss_franc", "won", "yuen", "yuan", "renminbi", "zloty", "baht", "bitcoin", "cent", "centavo", "dollar_us", "dollar_australia", "dollar_canada", "dollar_mexico", "dollar_newzealand", "dollar_singapore", "dollar_taiwan", "dollar_hk", "dollar_hongkong", "pataca", "dollar_mop", "dollar_taiwan_ch", "dollar_hk_ch", "dollar_hongkong_ch", "pataca_ch", "mop_ch", "yuan_ch", "markka", "mark", "mark_westgerman", "mark_reichsmark", "deutschemark_east", "mark_mdn", "mark_ddr", "deutschemark", "deutschemark_west", "franc", "lira", "real", "reais", "reis", "escudo", "koruna_slovak", "peseta", "pesetas"
	)
	#'
	#'
	#'
	#'
	#' To do: create a 'theme' for currency styles
	#' style() adapted from theme() of package ggplot2
	style <- function(..., complete = FALSE) {
	elements <- list(...)
	structure(elements, class = c("style"), complete = complete)
	}
	.style <- (function() {
	style <- style_usa()
	list(
	get = function() style,
	set = function(new) {
	missing <- setdiff(names(style_usa()), names(new))
	if (length(missing) > 0) {
	warning("New style missing the following elements: ",
	paste(missing, collapse = ", "), call. = FALSE)
	}
	old <- style
	style <<- new
	invisible(old)
	}
	)
	})()
	#'
	# style_get adapted from theme_get() of package ggplot2
	style_get <- .style$get

	# style_set adapted from theme_set() of package ggplot2
	style_set <- .style$set

	# is_style adapted from is.theme() of package ggplot2
	is_style <- function(x) inherits(x, "style")

	# %+style_replace% adapted from %+replace% of package ggplot2
	"%+style_replace%" <- function(e1, e2) {
	if (!is_style(e1) \|\| !is_style(e2)) {
	stop("%+replace% requires two style objects", call. = FALSE)
	}
	# Can't use modifyList here since it works recursively and drops NULLs
	e1[names(e2)] <- e2
	e1
	}

	# style_update adapted from theme_update() of package ggplot2
	style_update <- function(...) {
	# Make a call to style, then add to style
	style_set(style_get() %+replace% do.call(style, list(...)))
	}

	update_style <- function(oldstyle, newstyle) {
	# If the newstyle is a complete one, don't bother searching
	# the default style -- just replace everything with newstyle
	if (attr(newstyle, "complete"))
	return(newstyle)
	# These are elements in newstyle that aren't already set in oldstyle.
	# They will be pulled from the default style.
	newitems <- !names(newstyle) %in% names(oldstyle)
	newitem_names <- names(newstyle)[newitems]
	oldstyle[newitem_names] <- style_get()[newitem_names]
	# Update the style elements with the things from newstyle
	# Turn the 'style' list into a proper style object first, and preserve
	# the 'complete' attribute. It's possible that oldstyle is an empty
	# list, and in that case, set complete to FALSE.
	oldstyle <- do.call(style, c(oldstyle,
	complete = isTRUE(attr(oldstyle, "complete"))))
	oldstyle + newstyle
	}



	style_us <- function() {
	style(
	symbol_currency = "$",
	symbol_position = "before",
	symbol_spacing = "none",
	separator_thousand = ",",
	separator_decimal = ".",
	largest_with_cents = 100000,
	nsmall = 0L,
	trim = TRUE,
	scientific = FALSE,
	digits = 1L,
	complete = TRUE
	)
	}

	style_french <- function() {
	style(
	symbol_currency = "$",
	symbol_position = "after",
	symbol_spacing = "single",
	separator_thousand = " ",
	separator_decimal = ",",
	largest_with_cents = 100000,
	nsmall = 0L,
	trim = TRUE,
	scientific = FALSE,
	digits = 1L,
	complete = TRUE
	)
	}





	### To do: negative numbers
	# https://github.com/hadley/scales/pull/40
	my_dollar_format <- function (largest_with_cents = 1e+05, negative_parentheses = FALSE) {
	old_dollar <- scales::dollar_format(largest_with_cents = largest_with_cents)
	new_dollar <- function(x) {
	x[!is.na(x)] <- old_dollar(x[!is.na(x)])
	if (negative_parentheses) {
	gsub("\\$-(.*)", "($\\1)", x)
	} else {
	gsub("\\$-", "-$", x)
	}
	}
	}

	d <- c(100.02, 25.32, -24.42, NA)
	my_dollar_format()(d)
	## [1] "$100.02" "$25.32" "-$24.42" NA
	my_dollar_format(negative_parentheses=TRUE)(d)
	## [1] "$100.02" "$25.32" "($24.42)" NA
	for reference, in case it has some future use:

	# Currency symbols

	# http://www.fileformat.info/info/unicode/category/Sc/list.htm
	Character Name Browser Image
	\u0024 DOLLAR SIGN $
	\u00A2 CENT SIGN ¢
	\u00A3 POUND SIGN £
	\u00A4 CURRENCY SIGN ¤
	\u00A5 YEN SIGN ¥
	\u058F ARMENIAN DRAM SIGN ֏
	\u060B AFGHANI SIGN ؋
	\u09F2 BENGALI RUPEE MARK ৲
	\u09F3 BENGALI RUPEE SIGN ৳
	\u09FB BENGALI GANDA MARK ৻
	\u0AF1 GUJARATI RUPEE SIGN ૱
	\u0BF9 TAMIL RUPEE SIGN ௹
	\u0E3F THAI CURRENCY SYMBOL BAHT ฿
	\u17DB KHMER CURRENCY SYMBOL RIEL ៛
	\u20A0 EURO-CURRENCY SIGN ₠
	\u20A1 COLON SIGN ₡
	\u20A2 CRUZEIRO SIGN ₢
	\u20A3 FRENCH FRANC SIGN ₣
	\u20A4 LIRA SIGN ₤
	\u20A5 MILL SIGN ₥
	\u20A6 NAIRA SIGN ₦
	\u20A7 PESETA SIGN ₧
	\u20A8 RUPEE SIGN ₨
	\u20A9 WON SIGN ₩
	\u20AA NEW SHEQEL SIGN ₪
	\u20AB DONG SIGN ₫
	\u20AC EURO SIGN €
	\u20AD KIP SIGN ₭
	\u20AE TUGRIK SIGN ₮
	\u20AF DRACHMA SIGN ₯
	\u20B0 GERMAN PENNY SIGN ₰
	\u20B1 PESO SIGN ₱
	\u20B2 GUARANI SIGN ₲
	\u20B3 AUSTRAL SIGN ₳
	\u20B4 HRYVNIA SIGN ₴
	\u20B5 CEDI SIGN ₵
	\u20B6 LIVRE TOURNOIS SIGN ₶
	\u20B7 SPESMILO SIGN ₷
	\u20B8 TENGE SIGN ₸
	\u20B9 INDIAN RUPEE SIGN ₹
	\u20BA TURKISH LIRA SIGN ₺
	\u20BB NORDIC MARK SIGN ₻
	\u20BC MANAT SIGN ₼
	\u20BD RUBLE SIGN ₽
	\uA838 NORTH INDIC RUPEE MARK ꠸
	\uFDFC RIAL SIGN ﷼
	\uFE69 SMALL DOLLAR SIGN ﹩
	\uFF04 FULLWIDTH DOLLAR SIGN ＄
	\uFFE0 FULLWIDTH CENT SIGN ￠
	\uFFE1 FULLWIDTH POUND SIGN ￡
	\uFFE5 FULLWIDTH YEN SIGN ￥
	\uFFE6 FULLWIDTH WON SIGN ￦