[R-gregmisc-commits] r2038 - in branches: . gtools-generalize-mixedorder gtools-generalize-mixedorder/R gtools-generalize-mixedorder/inst gtools-generalize-mixedorder/man gtools-generalize-mixedorder/tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed May 27 02:28:23 CEST 2015
Author: warnes
Date: 2015-05-27 02:28:22 +0200 (Wed, 27 May 2015)
New Revision: 2038
Added:
branches/gtools-generalize-mixedorder/
branches/gtools-generalize-mixedorder/NAMESPACE
branches/gtools-generalize-mixedorder/R/asc.R
branches/gtools-generalize-mixedorder/R/dirichlet.R
branches/gtools-generalize-mixedorder/R/mixedsort.R
branches/gtools-generalize-mixedorder/R/roman2int.R
branches/gtools-generalize-mixedorder/man/asc.Rd
branches/gtools-generalize-mixedorder/man/mixedsort.Rd
branches/gtools-generalize-mixedorder/man/quantcut.Rd
branches/gtools-generalize-mixedorder/man/unByteCode.Rd
branches/gtools-generalize-mixedorder/tests/test_ddirichlet.R
Removed:
branches/gtools-generalize-mixedorder/NAMESPACE
branches/gtools-generalize-mixedorder/R/dirichlet.R
branches/gtools-generalize-mixedorder/R/mixedsort.R
branches/gtools-generalize-mixedorder/R/roman2int.R
branches/gtools-generalize-mixedorder/man/mixedsort.Rd
branches/gtools-generalize-mixedorder/man/quantcut.Rd
branches/gtools-generalize-mixedorder/man/unByteCode.Rd
Modified:
branches/gtools-generalize-mixedorder/DESCRIPTION
branches/gtools-generalize-mixedorder/inst/NEWS
Log:
Branch for generalization of mixedorder()
Modified: branches/gtools-generalize-mixedorder/DESCRIPTION
===================================================================
--- pkg/gtools/DESCRIPTION 2015-05-02 17:38:35 UTC (rev 2018)
+++ branches/gtools-generalize-mixedorder/DESCRIPTION 2015-05-27 00:28:22 UTC (rev 2038)
@@ -21,7 +21,7 @@
- modify the TCP\_NODELAY ('de-Nagle') flag for socket objects,
- efficient 'rbind' of data frames, even if the column names don't match ('smartbind'),
- generate significance stars from p-values ('stars.pval').
-Version: 3.4.3
+Version: 3.4.3.0
Date: 2015-04-23
Author: Gregory R. Warnes, Ben Bolker, and Thomas Lumley
Maintainer: Gregory R. Warnes <greg at warnes.net>
Deleted: branches/gtools-generalize-mixedorder/NAMESPACE
===================================================================
--- pkg/gtools/NAMESPACE 2015-05-02 17:38:35 UTC (rev 2018)
+++ branches/gtools-generalize-mixedorder/NAMESPACE 2015-05-27 00:28:22 UTC (rev 2038)
@@ -1,40 +0,0 @@
-useDynLib(gtools)
-
-export(
- addLast,
- ask,
- assert,
- ASCIIfy,
- binsearch,
- capture,
- checkRVersion,
- combinations,
- ddirichlet,
- defmacro,
- even,
- foldchange,
- foldchange2logratio,
- getDependencies,
- inv.logit,
- invalid,
- keywords,
- lastAdd,
- loadedPackages,
- logit,
- logratio2foldchange,
- mixedorder,
- mixedsort,
- na.replace,
- odd,
- permutations,
- permute,
- quantcut,
- rdirichlet,
- running,
- scat,
- setTCPNoDelay,
- smartbind,
- sprint,
- stars.pval,
- strmacro
- )
Copied: branches/gtools-generalize-mixedorder/NAMESPACE (from rev 2035, pkg/gtools/NAMESPACE)
===================================================================
--- branches/gtools-generalize-mixedorder/NAMESPACE (rev 0)
+++ branches/gtools-generalize-mixedorder/NAMESPACE 2015-05-27 00:28:22 UTC (rev 2038)
@@ -0,0 +1,45 @@
+useDynLib(gtools)
+
+export(
+ addLast,
+ asc,
+ ASCIIfy,
+ ask,
+ assert,
+ assignEdgewise,
+ binsearch,
+ capture,
+ chr,
+ checkRVersion,
+ combinations,
+ ddirichlet,
+ defmacro,
+ even,
+ foldchange,
+ foldchange2logratio,
+ getDependencies,
+ inv.logit,
+ invalid,
+ keywords,
+ lastAdd,
+ loadedPackages,
+ logit,
+ logratio2foldchange,
+ mixedorder,
+ mixedsort,
+ na.replace,
+ odd,
+ permutations,
+ permute,
+ quantcut,
+ rdirichlet,
+ running,
+ scat,
+ setTCPNoDelay,
+ smartbind,
+ sprint,
+ stars.pval,
+ strmacro,
+ unByteCode,
+ unByteCodeAssign
+ )
Copied: branches/gtools-generalize-mixedorder/R/asc.R (from rev 2034, pkg/gtools/R/asc.R)
===================================================================
--- branches/gtools-generalize-mixedorder/R/asc.R (rev 0)
+++ branches/gtools-generalize-mixedorder/R/asc.R 2015-05-27 00:28:22 UTC (rev 2038)
@@ -0,0 +1,2 @@
+asc <- function(char) sapply(char, function(x) strtoi(charToRaw(x),16L) )
+chr <- function(n) sapply(n, function(x) rawToChar(as.raw(x)) )
Deleted: branches/gtools-generalize-mixedorder/R/dirichlet.R
===================================================================
--- pkg/gtools/R/dirichlet.R 2015-05-02 17:38:35 UTC (rev 2018)
+++ branches/gtools-generalize-mixedorder/R/dirichlet.R 2015-05-27 00:28:22 UTC (rev 2038)
@@ -1,70 +0,0 @@
-# $Id$
-
-# Posted by Ben Bolker to R-News on Fri Dec 15 2000
-# http://www.r-project.org/nocvs/mail/r-help/2000/3865.html
-#
-# Some code (originally contributed by Ian Wilson
-# <i.wilson at maths.abdn.ac.uk>
-
-
-# functions for the "Dirichlet function", the multidimensional
-# generalization of the beta distribution: it's the Bayesian
-# canonical # distribution for the parameter estimates of a
-# multinomial distribution.
-
-# "pdirichlet" and "qdirichlet" (distribution function and quantiles)
-# would be more difficult because you'd first have to decide how to
-# define the distribution function for a multivariate distribution
-# ... I'm sure this could be done but I don't know how
-
-
-
-ddirichlet<-function(x,alpha)
-## probability density for the Dirichlet function, where x=vector of
-## probabilities
-## and (alpha-1)=vector of observed samples of each type
-## ddirichlet(c(p,1-p),c(x1,x2)) == dbeta(p,x1,x2)
-{
-
- dirichlet1 <- function(x, alpha)
- {
- logD <- sum(lgamma(alpha)) - lgamma(sum(alpha))
- s<-sum((alpha-1)*log(x))
- exp(sum(s)-logD)
-
- }
-
- # make sure x is a matrix
- if(!is.matrix(x))
- if(is.data.frame(x))
- x <- as.matrix(x)
- else
- x <- t(x)
-
- if(!is.matrix(alpha))
- alpha <- matrix( alpha, ncol=length(alpha), nrow=nrow(x), byrow=TRUE)
-
- if( any(dim(x) != dim(alpha)) )
- stop("Mismatch between dimensions of 'x' and 'alpha'.")
-
- pd <- vector(length=nrow(x))
- for(i in 1:nrow(x))
- pd[i] <- dirichlet1(x[i,],alpha[i,])
-
- # Enforce 0 <= x[i,j] <= 1, sum(x[i,]) = 1
- pd[ apply( x, 1, function(z) any( z <0 | z > 1)) ] <- 0
- pd[ apply( x, 1, function(z) all.equal(sum( z ),1) !=TRUE) ] <- 0
- pd
-}
-
-
-rdirichlet<-function(n,alpha)
-## generate n random deviates from the Dirichlet function with shape
-## parameters alpha
-{
- l<-length(alpha);
- x<-matrix(rgamma(l*n,alpha),ncol=l,byrow=TRUE);
- sm<-x%*%rep(1,l);
- x/as.vector(sm);
-}
-
Copied: branches/gtools-generalize-mixedorder/R/dirichlet.R (from rev 2020, pkg/gtools/R/dirichlet.R)
===================================================================
--- branches/gtools-generalize-mixedorder/R/dirichlet.R (rev 0)
+++ branches/gtools-generalize-mixedorder/R/dirichlet.R 2015-05-27 00:28:22 UTC (rev 2038)
@@ -0,0 +1,70 @@
+# $Id$
+
+# Posted by Ben Bolker to R-News on Fri Dec 15 2000
+# http://www.r-project.org/nocvs/mail/r-help/2000/3865.html
+#
+# Some code (originally contributed by Ian Wilson
+# <i.wilson at maths.abdn.ac.uk>
+
+
+# functions for the "Dirichlet function", the multidimensional
+# generalization of the beta distribution: it's the Bayesian
+# canonical # distribution for the parameter estimates of a
+# multinomial distribution.
+
+# "pdirichlet" and "qdirichlet" (distribution function and quantiles)
+# would be more difficult because you'd first have to decide how to
+# define the distribution function for a multivariate distribution
+# ... I'm sure this could be done but I don't know how
+
+
+
+ddirichlet<-function(x,alpha)
+## probability density for the Dirichlet function, where x=vector of
+## probabilities
+## and (alpha-1)=vector of observed samples of each type
+## ddirichlet(c(p,1-p),c(x1,x2)) == dbeta(p,x1,x2)
+{
+
+ dirichlet1 <- function(x, alpha)
+ {
+ logD <- sum(lgamma(alpha)) - lgamma(sum(alpha))
+ s <-(alpha-1)*log(x)
+ s <- ifelse(alpha==1 & x==0, -Inf, s)
+ exp(sum(s)-logD)
+ }
+
+ # make sure x is a matrix
+ if(!is.matrix(x))
+ if(is.data.frame(x))
+ x <- as.matrix(x)
+ else
+ x <- t(x)
+
+ if(!is.matrix(alpha))
+ alpha <- matrix( alpha, ncol=length(alpha), nrow=nrow(x), byrow=TRUE)
+
+ if( any(dim(x) != dim(alpha)) )
+ stop("Mismatch between dimensions of 'x' and 'alpha'.")
+
+ pd <- vector(length=nrow(x))
+ for(i in 1:nrow(x))
+ pd[i] <- dirichlet1(x[i,],alpha[i,])
+
+ # Enforce 0 <= x[i,j] <= 1, sum(x[i,]) = 1
+ pd[ apply( x, 1, function(z) any( z <0 | z > 1)) ] <- 0
+ pd[ apply( x, 1, function(z) all.equal(sum( z ),1) !=TRUE) ] <- 0
+ pd
+}
+
+
+rdirichlet<-function(n,alpha)
+## generate n random deviates from the Dirichlet function with shape
+## parameters alpha
+{
+ l<-length(alpha);
+ x<-matrix(rgamma(l*n,alpha),ncol=l,byrow=TRUE);
+ sm<-x%*%rep(1,l);
+ x/as.vector(sm);
+}
+
Deleted: branches/gtools-generalize-mixedorder/R/mixedsort.R
===================================================================
--- pkg/gtools/R/mixedsort.R 2015-05-02 17:38:35 UTC (rev 2018)
+++ branches/gtools-generalize-mixedorder/R/mixedsort.R 2015-05-27 00:28:22 UTC (rev 2038)
@@ -1,116 +0,0 @@
-mixedsort <- function(x, decreasing=FALSE, na.last=TRUE, blank.last=FALSE)
- {
- ord <- mixedorder(x, decreasing=decreasing, na.last=na.last,
- blank.last=blank.last)
- x[ord]
- }
-
-mixedorder <- function(x, decreasing=FALSE, na.last=TRUE, blank.last=FALSE)
- {
- # - Split each each character string into an vector of strings and
- # numbers
- # - Separately rank numbers and strings
- # - Combine orders so that strings follow numbers
-
- if(length(x)<1)
- return(NULL)
- else if(length(x)==1)
- return(1)
-
- if( !is.character(x) )
- return( order(x, decreasing=decreasing, na.last=na.last) )
-
- delim="\\$\\@\\$"
-
- numeric <- function(x)
- {
- suppressWarnings( as.numeric(x) )
- }
-
- nonnumeric <- function(x)
- {
- suppressWarnings( ifelse(is.na(as.numeric(x)), toupper(x), NA) )
- }
-
- x <- as.character(x)
-
- which.nas <- which(is.na(x))
- which.blanks <- which(x=="")
-
- ####
- # - Convert each character string into an vector containing single
- # character and numeric values.
- ####
-
- # find and mark numbers in the form of +1.23e+45.67
- delimited <- gsub("([+-]{0,1}[0-9]+\\.{0,1}[0-9]*([eE][\\+\\-]{0,1}[0-9]+\\.{0,1}[0-9]*){0,1})",
- paste(delim,"\\1",delim,sep=""), x)
-
- # separate out numbers
- step1 <- strsplit(delimited, delim)
-
- # remove empty elements
- step1 <- lapply( step1, function(x) x[x>""] )
-
- # create numeric version of data
- step1.numeric <- lapply( step1, numeric )
-
- # create non-numeric version of data
- step1.character <- lapply( step1, nonnumeric )
-
- # now transpose so that 1st vector contains 1st element from each
- # original string
- maxelem <- max(sapply(step1, length))
-
- step1.numeric.t <- lapply(1:maxelem,
- function(i)
- sapply(step1.numeric,
- function(x)x[i])
- )
-
- step1.character.t <- lapply(1:maxelem,
- function(i)
- sapply(step1.character,
- function(x)x[i])
- )
-
- # now order them
- rank.numeric <- sapply(step1.numeric.t, rank)
- rank.character <- sapply(step1.character.t,
- function(x) as.numeric(factor(x)))
-
- # and merge
- rank.numeric[!is.na(rank.character)] <- 0 # mask off string values
-
- rank.character <- t(
- t(rank.character) +
- apply(matrix(rank.numeric),2,max,na.rm=TRUE)
- )
-
- rank.overall <- ifelse(is.na(rank.character),rank.numeric,rank.character)
-
- order.frame <- as.data.frame(rank.overall)
- if(length(which.nas) > 0)
- if(is.na(na.last))
- order.frame[which.nas,] <- NA
- else if(na.last)
- order.frame[which.nas,] <- Inf
- else
- order.frame[which.nas,] <- -Inf
-
- if(length(which.blanks) > 0)
- if(is.na(blank.last))
- order.frame[which.blanks,] <- NA
- else if(blank.last)
- order.frame[which.blanks,] <- 1e99
- else
- order.frame[which.blanks,] <- -1e99
-
- order.frame <- as.list(order.frame)
- order.frame$decreasing <- decreasing
- order.frame$na.last <- NA
-
- retval <- do.call("order", order.frame)
-
- return(retval)
- }
Copied: branches/gtools-generalize-mixedorder/R/mixedsort.R (from rev 2019, pkg/gtools/R/mixedsort.R)
===================================================================
--- branches/gtools-generalize-mixedorder/R/mixedsort.R (rev 0)
+++ branches/gtools-generalize-mixedorder/R/mixedsort.R 2015-05-27 00:28:22 UTC (rev 2038)
@@ -0,0 +1,191 @@
+mixedsort <- function(x, decreasing=FALSE, na.last=TRUE, blank.last=FALSE)
+ {
+ ord <- mixedorder(x, decreasing=decreasing, na.last=na.last,
+ blank.last=blank.last)
+ x[ord]
+ }
+
+mixedorder <- function(x,
+ decreasing=FALSE,
+ na.last=TRUE,
+ blank.last=FALSE,
+ type=c('inf',
+ 'decimal',
+ 'roman',
+ 'character'),
+ roman.case=c("both", "lower", "upper"),
+ hex.case=c("both", "lower", "upper")
+ )
+ {
+ ## - Split each each character string into an vector of strings and
+ ## numbers
+ ## - Separately rank numbers and strings
+ ## - Combine orders so that strings follow numbers
+
+ TOKEN.TYPES <- c('inf', 'decimal', 'roman', 'hexadecimal', 'octal', 'binary', 'character')
+ type <- match.arg(type,
+ choices=TOKEN.TYPES,
+ several.ok=TRUE)
+
+ tokens <- rep('', length=length(TOKEN.TYPES))
+ names(tokens) <- TOKEN.TYPES
+ tokens[which(TOKEN.TYPES %in% type)] <- chr(1:length(type))
+
+
+ if(length(x)<1)
+ return(NULL)
+ else if(length(x)==1)
+ return(1)
+
+ if( !is.character(x) )
+ return( order(x, decreasing=decreasing, na.last=na.last) )
+
+ toDecimal <- function(x)
+ {
+ as.numeric(x)
+ }
+
+ toRoman <- function(x)
+ {
+ roman2int(x)
+ }
+
+ toString <- function(x)
+ {
+ ifelse( is.na(as.numeric(x)) || is.na(roman2int(x)), toupper(x), NA)
+ }
+
+ x <- as.character(x)
+
+ which.nas <- which(is.na(x))
+ which.blanks <- which(x=="")
+
+ ####
+ ## Insert delimters bracketing numeric and roman values
+ ####
+
+ regex <- list()
+
+ ## numbers in the form of +1.23e+45.67
+ regex$decimal <- "(?:(?i)(?:[-+]?)(?:(?=[.]?[0123456789])(?:[0123456789]*)(?:(?:[.])(?:[0123456789]{0,}))?)(?:(?:[eE])(?:(?:[-+]?)(?:[0123456789]+))|))"
+
+ ## +-Inf
+ regex$inf <- "\\b([+-]*Inf)\\b"
+
+ ## Roman numerals
+ if(roman.case=="lower")
+ regex$roman <- "\\b([ivxcldm]+)\\b"
+ else if(roman.case=="upper")
+ regex$roman <- "\\b([IVXCLDM]+)\\b"
+ else if(roman.case=="both")
+ regex$roman <- "\\b([IVXCLDMivxcldm]+)\\b"
+ else stop("invalid value for roman.case: ", roman.case)
+
+ ## Hexadecimal
+ if(hex.case=="lower")
+ regex$hex <- "\\b([0-9a-f]+)\\b"
+ else if(hex.case=="upper")
+ regex$hex <- "\\b([0-9A-F]+)\\b"
+ else if (hex.case=="both")
+ regex$hex <- "\\b([0-9A-Fa-f]+)\\b"
+ else stop("invalid value for hex.case: ", hex.case)
+
+ ## Octal
+ regex$octal <- "([0-8]+)"
+
+ ## Binary numbers
+ regex$binary <- "([01]+)"
+
+ ## Character
+ regex$character <- "[A-Za-z]+"
+
+ ## Delimiters
+ regex$delim <- "[\001-\007]"
+ regex$nondelim <- "[^\001-\007]+"
+
+ matches <- list()
+
+ ## tokenize...
+ delimited <- x
+ for( tt in TOKEN.TYPES )
+ {
+ if(tt %in% type)
+ {
+ m <- gregexpr(regex[[tt]], delimited, perl=TRUE, ignore.case=FALSE)
+ matches[[tt]] <- regmatches(delimited, m)
+ regmatches(delimited, m) <- tokens[tt]
+
+
+ }
+ }
+
+ ## Remove all non-token characters
+ delimited <- gsub( regex.nondelim, "", delimited)
+
+ ntokens <- sapply(delimited, nchar)
+
+ ## remove empty elements
+ step1 <- lapply( step1, function(x) x[x>""] )
+
+ ## create decimal version of data
+ suppressWarnings( step1.decimal <- lapply( step1, toDecimal ) )
+
+ ## create non-numeric version of data
+ suppressWarnings( step1.character <- lapply( step1, toString ) )
+
+ ## now transpose so that 1st vector contains 1st element from each
+ ## original string
+ maxelem <- max(sapply(step1, length))
+
+ step1.decimal.t <- lapply(1:maxelem,
+ function(i)
+ sapply(step1.decimal,
+ function(x)x[i])
+ )
+
+ step1.character.t <- lapply(1:maxelem,
+ function(i)
+ sapply(step1.character,
+ function(x)x[i])
+ )
+
+ ## now order them
+ rank.decimal <- sapply(step1.decimal.t, rank)
+ rank.character <- sapply(step1.character.t,
+ function(x) as.numeric(factor(x)))
+
+ ## and merge
+ rank.decimal[!is.na(rank.character)] <- 0 # mask off string values
+
+ rank.character <- t(
+ t(rank.character) +
+ apply(matrix(rank.decimal),2,max,na.rm=TRUE)
+ )
+
+ rank.overall <- ifelse(is.na(rank.character),rank.decimal,rank.character)
+
+ order.frame <- as.data.frame(rank.overall)
+ if(length(which.nas) > 0)
+ if(is.na(na.last))
+ order.frame[which.nas,] <- NA
+ else if(na.last)
+ order.frame[which.nas,] <- Inf
+ else
+ order.frame[which.nas,] <- -Inf
+
+ if(length(which.blanks) > 0)
+ if(is.na(blank.last))
+ order.frame[which.blanks,] <- NA
+ else if(blank.last)
+ order.frame[which.blanks,] <- 1e99
+ else
+ order.frame[which.blanks,] <- -1e99
+
+ order.frame <- as.list(order.frame)
+ order.frame$decreasing <- decreasing
+ order.frame$na.last <- NA
+
+ retval <- do.call("order", order.frame)
+
+ return(retval)
+ }
Deleted: branches/gtools-generalize-mixedorder/R/roman2int.R
===================================================================
--- pkg/gtools/R/roman2int.R 2015-05-02 17:38:35 UTC (rev 2018)
+++ branches/gtools-generalize-mixedorder/R/roman2int.R 2015-05-27 00:28:22 UTC (rev 2038)
@@ -1,37 +0,0 @@
-testConvert <- function()
- {
- roman <- 'IVXLCDM'
- retval <- romandigit.convert(roman)
- stopifnot(retval==c(1,5,10,50,100,500,1000))
- return(TRUE)
- }
-
-romandigit.convert <- function(roman)
- {
- retval <- .C('convert',
- roman=as.character(roman),
- nchar=as.integer(nchar(roman)),
- values=integer(nchar(roman))
- )
- retval$values
- }
-
-roman2int.inner <- function(roman)
- {
- results <- .C("roman2int",
- roman = as.character(roman),
- nchar = as.integer(nchar(roman)),
- value = integer(1),
-
- PACKAGE="gtools")
-
- return(results$value)
- }
-
-roman2int <- function(roman)
- {
- roman <- trim(toupper(as.character(roman)))
- retval <- sapply(roman, roman2int.inner)
- retval
- }
-
Copied: branches/gtools-generalize-mixedorder/R/roman2int.R (from rev 2036, pkg/gtools/R/roman2int.R)
===================================================================
--- branches/gtools-generalize-mixedorder/R/roman2int.R (rev 0)
+++ branches/gtools-generalize-mixedorder/R/roman2int.R 2015-05-27 00:28:22 UTC (rev 2038)
@@ -0,0 +1,48 @@
+testConvert <- function()
+ {
+ roman <- 'IVXLCDM'
+ retval <- romandigit.convert(roman)
+ stopifnot(retval==c(1,5,10,50,100,500,1000))
+ return(TRUE)
+ }
+
+romandigit.convert <- function(roman)
+ {
+ retval <- .C('convert',
+ roman=as.character(roman),
+ nchar=as.integer(nchar(roman)),
+ values=integer(nchar(roman))
+ )
+ retval$values
+ }
+
+roman2int.inner <- function(roman)
+ {
+ results <- .C("roman2int",
+ roman = as.character(roman),
+ nchar = as.integer(nchar(roman)),
+ value = integer(1),
+
+ PACKAGE="gtools")
+
+ return(results$value)
+ }
+
+roman2int <- function(roman)
+ {
+ roman <- trim(toupper(as.character(roman)))
+
+ tryIt <- function(x)
+ {
+ retval <- try(roman2int.inner(x), silent=TRUE)
+ if(is.numeric(retval))
+ retval
+ else
+ NA
+ }
+
+ retval <- sapply(roman, tryIt)
+
+ retval
+ }
+
Modified: branches/gtools-generalize-mixedorder/inst/NEWS
===================================================================
--- pkg/gtools/inst/NEWS 2015-05-02 17:38:35 UTC (rev 2018)
+++ branches/gtools-generalize-mixedorder/inst/NEWS 2015-05-27 00:28:22 UTC (rev 2038)
@@ -1,3 +1,23 @@
+gtools 3.5.0 - 2015-04-28
+-------------------------
+
+Enhacements:
+
+- mixedsort() and mixedorder() now have arguments 'decreasing',
+ 'na.last', and 'blank.last' arguments to control sort ordering.
+
+- speed up mixedorder() (and hence mixedsort()) by moving
+ suppressWarnings outside of lapply loops. (Suggestion by Henrik
+ Bengtsson.)
+
+- new function roman2int() to convert roman numerals to integers.
+
+Bug fixes:
+
+
+Other changes:
+
+
gtools 3.4.3 - 2015-04-06
-------------------------
Copied: branches/gtools-generalize-mixedorder/man/asc.Rd (from rev 2037, pkg/gtools/man/asc.Rd)
===================================================================
--- branches/gtools-generalize-mixedorder/man/asc.Rd (rev 0)
+++ branches/gtools-generalize-mixedorder/man/asc.Rd 2015-05-27 00:28:22 UTC (rev 2038)
@@ -0,0 +1,67 @@
+\name{asc}
+\alias{asc}
+\alias{chr}
+\title{Convert between characters and ASCII codes}
+\description{
+ \code{asc} returns the ASCII codes for the specified characters.
+ \code{chr} returns the characters corresponding to the specified ASCII codes.
+}
+\usage{
+ asc(char, simplify=TRUE)
+ chr(ascii)
+}
+\arguments{
+ \item{char}{vector of character strings}
+
+ \item{simplify}{logical indicating whether to attempt to convert the
+ result into a vector or matrix object. See \code{\link[base]{sapply}}
+ for details.
+ }
+ \item{ascii}{vector or list of vectors containing integer ASCII codes}
+}
+\value{
+ \code{asc} returns the integer ASCII values for each character
+ in the elements of \code{char}. If \code{simplify=FALSE} the result
+ will be a list contining one vector per element of \code{char}. If
+ \code{simplify=TRUE}, the code will attempt to convert the result into
+ a vector or matrix.
+
+ \code{asc} returns the characters corresponding to the provided ASCII
+ values.
+}
+\author{
+ Adapted by Gregory R. Warnes \email{greg at warnes.net} from code posted
+ on the 'Data Debrief' blog on 2011-03-09 at
+ \url{http://datadebrief.blogspot.com/2011/03/ascii-code-table-in-r.html}.
+}
+\seealso{
+ \code{\link[base]{strtoi}},
+ \code{\link[base]{charToRaw}},
+ \code{\link[base]{rawToChar}},
+ \code{\link[base]{as.raw}}
+}
+\examples{
+ ## ascii codes for lowercase letters
+ asc(letters)
+
+ ## uppercase letters from ascii codes
+ chr(65:90)
+
+ ## works on muti-character strings
+ ( tmp <- asc('hello!') )
+ chr(tmp)
+
+ ## Use 'simplify=FALSE' to return the result as a list
+ ( tmp <- asc('hello!', simplify=FALSE) )
+ chr(tmp)
+
+ ## When simplify=FALSE the results can be...
+ asc( c('a', 'e', 'i', 'o', 'u', 'y' ) ) # a vector
+ asc( c('ae', 'io', 'uy' ) ) # or a matrix
+
+ ## When simplify=TRUE the results are always a list...
+ asc( c('a', 'e', 'i', 'o', 'u', 'y' ), simplify=FALSE )
+ asc( c('ae', 'io', 'uy' ), simplify=FALSE)
+}
+\keyword{character}
+\keyword{programming}
Deleted: branches/gtools-generalize-mixedorder/man/mixedsort.Rd
===================================================================
--- pkg/gtools/man/mixedsort.Rd 2015-05-02 17:38:35 UTC (rev 2018)
+++ branches/gtools-generalize-mixedorder/man/mixedsort.Rd 2015-05-27 00:28:22 UTC (rev 2038)
@@ -1,88 +0,0 @@
-\name{mixedsort}
-\alias{mixedsort}
-\alias{mixedorder}
-\title{Order or Sort strings with embedded numbers so that the numbers
- are in the correct order}
-\description{
- These functions sort or order character strings containing embedded
- numbers so that the numbers are numerically sorted rather than sorted
- by character value. I.e. "Asprin 50mg" will come before
- "Asprin 100mg". In addition, case of character strings is ignored so
- that "a", will come before "B" and "C".
-}
-\usage{
-mixedsort(x, decreasing=FALSE, na.last=TRUE, blank.last=FALSE, ...)
-mixedorder(x, decreasing=FALSE, na.last=TRUE, blank.last=FALSE, ...)
-}
-\arguments{
- \item{x}{Vector to be sorted.}
- \item{decreasing}{logical. Should the sort be increasing or
- decreasing? Note that \code{descending=TRUE} reverses the meanings of
- \code{na.lst} and \code{blanks.last}.}
- \item{na.last}{for controlling the treatment of ‘NA’s. If ‘TRUE’, missing
- values in the data are put last; if ‘FALSE’, they are put
- first; if ‘NA’, they are removed.}
-}
-\details{
- I often have character vectors (e.g. factor labels), such as compound
- and dose, that contain both text and numeric data. This function
- is useful for sorting these character vectors into a logical order.
-
- It does so by splitting each character vector into a sequence of
- character and numeric sections, and then sorting along these sections,
- with numbers being sorted by numeric value (e.g. "50" comes before
- "100"), followed by characters strings sorted by character
- value (e.g. "A" comes before "B").
-
- By default, sort order is ascending, empty strings are sorted to the front,
- and \code{NA} values to the end. Setting \code{descending=TRUE}
- changes the sort order to descending and reverses the meanings of
- \code{na.last} and \code{blank.last}.
-}
-\value{
- \code{mixedorder} returns a vector giving the sort order of the input
- elements. \code{mixedsort} returns the sorted vector.
-}
-\author{ Gregory R. Warnes \email{greg at warnes.net} }
-\seealso{ \code{\link[base]{sort}}, \code{\link[base]{order}} }
-\examples{
-## compound & dose labels
-Treatment <- c("Control", "Asprin 10mg/day", "Asprin 50mg/day",
- "Asprin 100mg/day", "Acetomycin 100mg/day",
- "Acetomycin 1000mg/day")
-
-## ordinary sort puts the dosages in the wrong order
-sort(Treatment)
-
-## but mixedsort does the 'right' thing
-mixedsort(Treatment)
-
-## Here is a more complex example
-x <- rev(c("AA 0.50 ml", "AA 1.5 ml", "AA 500 ml", "AA 1500 ml",
- "EXP 1", "AA 1e3 ml", "A A A", "1 2 3 A", "NA", NA, "1e2",
- "", "-", "1A", "1 A", "100", "100A", "Inf"))
-
-mixedorder(x)
-
-mixedsort(x) # Notice that plain numbers, including 'Inf' show up
- # before strings, NAs at the end, and blanks at the
- # beginning .
-
-
-mixedsort(x, na.last=TRUE) # default
-mixedsort(x, na.last=FALSE) # push NAs to the front
-
-
-mixedsort(x, blank.last=FALSE) # default
-mixedsort(x, blank.last=TRUE) # push blanks to the end
-
-mixedsort(x, decreasing=FALSE) # default
-mixedsort(x, decreasing=TRUE) # reverse sort order
-}
-\keyword{univar}
-\keyword{manip}
-
-
-\concept{natural sort}
-\concept{dictionary sort}
-
Copied: branches/gtools-generalize-mixedorder/man/mixedsort.Rd (from rev 2027, pkg/gtools/man/mixedsort.Rd)
===================================================================
--- branches/gtools-generalize-mixedorder/man/mixedsort.Rd (rev 0)
+++ branches/gtools-generalize-mixedorder/man/mixedsort.Rd 2015-05-27 00:28:22 UTC (rev 2038)
@@ -0,0 +1,92 @@
+\name{mixedsort}
+\alias{mixedsort}
+\alias{mixedorder}
+\title{Order or Sort strings with embedded numbers so that the numbers
+ are in the correct order}
+\description{
+ These functions sort or order character strings containing embedded
+ numbers so that the numbers are numerically sorted rather than sorted
+ by character value. I.e. "Asprin 50mg" will come before
+ "Asprin 100mg". In addition, case of character strings is ignored so
+ that "a", will come before "B" and "C".
+}
+\usage{
+mixedsort(x, decreasing=FALSE, na.last=TRUE, blank.last=FALSE)
+mixedorder(x, decreasing=FALSE, na.last=TRUE, blank.last=FALSE)
+}
+\arguments{
+ \item{x}{Vector to be sorted.}
+ \item{decreasing}{logical. Should the sort be increasing or
+ decreasing? Note that \code{descending=TRUE} reverses the meanings of
+ \code{na.last} and \code{blanks.last}.}
+ \item{na.last}{for controlling the treatment of \code{NA} values. If \code{TRUE}, missing
+ values in the data are put last; if \code{FALSE}, they are put
+ first; if \code{NA}, they are removed.}
+ \item{blank.last}{for controlling the treatment of blank values. If \code{TRUE}, blank
+ values in the data are put last; if \code{FALSE}, they are put
+ first; if \code{NA}, they are removed.}
+}
+\details{
+ I often have character vectors (e.g. factor labels), such as compound
+ and dose, that contain both text and numeric data. This function
+ is useful for sorting these character vectors into a logical order.
+
+ It does so by splitting each character vector into a sequence of
+ character and numeric sections, and then sorting along these sections,
+ with numbers being sorted by numeric value (e.g. "50" comes before
+ "100"), followed by characters strings sorted by character
+ value (e.g. "A" comes before "B") \emph{ignoring case} (e.g. 'A' has
+ the same sort order as 'a').
+
+ By default, sort order is ascending, empty strings are sorted to the front,
+ and \code{NA} values to the end. Setting \code{descending=TRUE}
+ changes the sort order to descending and reverses the meanings of
+ \code{na.last} and \code{blank.last}.
+}
+\value{
+ \code{mixedorder} returns a vector giving the sort order of the input
+ elements. \code{mixedsort} returns the sorted vector.
+}
+\author{ Gregory R. Warnes \email{greg at warnes.net} }
+\seealso{ \code{\link[base]{sort}}, \code{\link[base]{order}} }
+\examples{
+## compound & dose labels
+Treatment <- c("Control", "Asprin 10mg/day", "Asprin 50mg/day",
+ "Asprin 100mg/day", "Acetomycin 100mg/day",
+ "Acetomycin 1000mg/day")
+
+## ordinary sort puts the dosages in the wrong order
+sort(Treatment)
+
+## but mixedsort does the 'right' thing
+mixedsort(Treatment)
+
+## Here is a more complex example
+x <- rev(c("AA 0.50 ml", "AA 1.5 ml", "AA 500 ml", "AA 1500 ml",
+ "EXP 1", "AA 1e3 ml", "A A A", "1 2 3 A", "NA", NA, "1e2",
+ "", "-", "1A", "1 A", "100", "100A", "Inf"))
+
+mixedorder(x)
+
+mixedsort(x) # Notice that plain numbers, including 'Inf' show up
+ # before strings, NAs at the end, and blanks at the
+ # beginning .
+
+
+mixedsort(x, na.last=TRUE) # default
+mixedsort(x, na.last=FALSE) # push NAs to the front
+
+
+mixedsort(x, blank.last=FALSE) # default
+mixedsort(x, blank.last=TRUE) # push blanks to the end
+
+mixedsort(x, decreasing=FALSE) # default
+mixedsort(x, decreasing=TRUE) # reverse sort order
+}
+\keyword{univar}
+\keyword{manip}
+
+
+\concept{natural sort}
+\concept{dictionary sort}
+
Deleted: branches/gtools-generalize-mixedorder/man/quantcut.Rd
===================================================================
--- pkg/gtools/man/quantcut.Rd 2015-05-02 17:38:35 UTC (rev 2018)
+++ branches/gtools-generalize-mixedorder/man/quantcut.Rd 2015-05-27 00:28:22 UTC (rev 2038)
@@ -1,76 +0,0 @@
-% $Id$
-%
-\name{quantcut}
-\alias{quantcut}
-
-\title{ Create a Factor Variable Using the Quantiles of a Continuous Variable}
-\description{
- Create a factor variable using the quantiles of a continous variable.
-}
-\usage{
-quantcut(x, q=seq(0,1,by=0.25), na.rm=TRUE, ...)
-}
-%- maybe also `usage' for other objects documented here.
-\arguments{
- \item{x}{ Continous variable. }
- \item{q}{ Either a integer number of equally spaced quantile groups to
- create, or a vector of quantiles used for creating groups. Defaults to
- \code{q=4} which is equivalent to \code{q=seq(0, 1, by=0.25)}.
- See \code{\link{quantile}} for details. }
- \item{na.rm}{ Boolean indicating whether missing values should be
- removed when computing quantiles. Defaults to TRUE.}
- \item{\dots}{ Optional arguments passed to \code{\link{cut}}. }
-}
-\details{
-
- This function uses \code{\link{quantile}} to obtain the specified
- quantiles of \code{x}, then calls \code{\link{cut}} to create a factor
- variable using the intervals specified by these quantiles.
-
- It properly handles cases where more than one quantile obtains the
- same value, as in the second example below. Note that in this case,
- there will be fewer generated factor levels than the specified number
- of quantile intervals.
-}
-\value{
- Factor variable with one level for each quantile interval.
-}
-
-\author{Gregory R. Warnes \email{greg at warnes.net}}
-
-\seealso{ \code{\link{cut}}, \code{\link{quantile}} }
-
-\examples{
-
- ## create example data
- \testonly{
- set.seed(1234)
- }
- x <- rnorm(1000)
-
- ## cut into quartiles
- quartiles <- quantcut( x )
- table(quartiles)
-
- ## cut into deciles
- deciles.1 <- quantcut( x, 10 )
- table(deciles.1)
- # or equivalently
- deciles.2 <- quantcut( x, seq(0,1,by=0.1) )
-
- \testonly{
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/r-gregmisc -r 2038
More information about the R-gregmisc-commits
mailing list