format.char() speedup

[Jens Oehlschlägel-Akiyoshi]

Happy new Year!

Here is a slightly changed version of format.char(), which really speeds up
for big data.


Regards


Jens Oehlschlägel-Akiyoshi


format.char.old <- format.char

format.char <-
function (x, width = NULL, flag = "-")
{
    if (is.null(x))
        return("")
    if (!is.character(x)) {
        warning("format.char: coercing 'x' to 'character'")
        x <- as.character(x)
    }
    if (is.null(width) && flag == "-")
        return(format(x))
    at <- attributes(x)
    nc <- nchar(x)
    if (is.null(width))
        width <- max(nc)
    else if (width < 0) {
        flag <- "-"
        width <- -width
    }
    # start of accelerate
    no <- pmax(0, width - nc)
    tab <- unique(no)
    tabpad <- sapply(tab+1, function(no) paste(character(no), collapse = "
"))
    pad <- tabpad[match(no, tab)]
    # end of accelerate
    r <- if (flag == "-")
        paste(x, pad, sep = "")
    else paste(pad, x, sep = "")
    if (!is.null(at))
        attributes(r) <- at
    r
}

> system.time(format.char(character(10), width=30))
[1] 0.01 0.00 0.01   NA   NA
> system.time(format.char.old(character(10), width=30))
[1] 0.01 0.00 0.01   NA   NA

> system.time(format.char(character(100000), width=30))
[1] 3.90 0.02 3.92   NA   NA
> system.time(format.char.old(character(100000), width=30))
[1] 92.33  0.35 92.69    NA    NA

> system.time(format.char(character(1000), width=1:1000))
[1] 2.69 0.00 2.68   NA   NA
> system.time(format.char.old(character(1000), width=1:1000))
[1] 2.55 0.00 2.55   NA   NA

> system.time(format.char(character(100000), width=1:1000))
[1] 28.71  0.00 28.72    NA    NA
> system.time(format.char.old(character(100000), width=1:1000))
Error: heap memory (65536 Kb) exhausted [needed 0 Kb more]
       See "help(Memory)" on how to increase the heap size.
Timing stopped at: 269.1 0.28 269.56 NA NA




--
Dr. Jens Oehlschlägel-Akiyoshi
MD FACTORY GmbH
Bayerstrasse 21

80335 München

Tel.: 089 545 28-27
Fax.: 089 545 28-10
http://www.mdfactory.de

Standard Disclaimers: Opinions expressed here are personal
and are not otherwise represented.


-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-devel mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !)  To: r-devel-request@stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._