Skip to content

Instantly share code, notes, and snippets.

@arturaugusto
Created November 21, 2014 00:01
Show Gist options
  • Select an option

  • Save arturaugusto/418ccf29a70b36b450bd to your computer and use it in GitHub Desktop.

Select an option

Save arturaugusto/418ccf29a70b36b450bd to your computer and use it in GitHub Desktop.
*Untested* functions to format numbers
fmt_nsignif <- function(x, n){
return(format(sprintf(signif(x, n), fmt=paste("%#.", n, "g", sep = "")), scientific=FALSE))
}
get_nsignif <- function(x){
str <- gsub("^([0\\s\\D])*", "", x, perl=TRUE)
n <- sum(nchar(strsplit(str, "\\.")[[1]]))
return(n)
}
round2 <- function(x, n){
x_num <- as.numeric(x)
if(x_num == 0) return(0)
sig <- x_num/abs(x_num)
k <- (10^n)
x_str <- format(x_num*k, scientific=FALSE)
x_sep_strings <- strsplit(x_str, "\\.")[[1]]
x_dec_nchars <- ifelse(is.na(x_sep_strings[2]), 0, nchar(x_sep_strings[2]))
if(x_dec_nchars){
f <- as.integer(substr(x_sep_strings[2],1,1))
x_int_nchars <- nchar(x_sep_strings[1])
to_round <- as.integer(substr(x_sep_strings[1],x_int_nchars,x_int_nchars))
if( ((f == 5) && (to_round %% 2)) || (f > 5) ){
return((as.integer(x_sep_strings[1])+(1*sig))/k)
}else{
return(trunc(as.numeric(x_str))/k)
}
}else{
return(x)
}
}
fmt_mresol <- function(x, m){
m_sep_strings <- strsplit(m, "\\.")[[1]]
m_dec_nchars <- ifelse(is.na(m_sep_strings[2]), 0, nchar(m_sep_strings[2]))
return(format(sprintf(round2(x, m_dec_nchars), fmt=paste("%#.", m_dec_nchars, "g", sep = "")), scientific=FALSE))
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment