Rprof.R

#  File src/library/tools/R/Rprof.R
#  Part of the R package, http://www.R-project.org
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  A copy of the GNU General Public License is available at
#  http://www.r-project.org/Licenses/

.Rprof <- function(args = NULL)
{
    do_exit <- function(status = 1L) q("no", status = status, runLast = FALSE)

    Usage <- function() {
        cat("Usage: R CMD Rprof [options] [file]",
            "",
            "Post-process profiling information in file generated by Rprof().",
            "",
            "Options:",
            "  -h, --help		print short help message and exit",
            "  -v, --version		print version info and exit",
            "  --total	       	print only by total",
            "  --self	       	print only by self",
            "  --min%total     	minimum % to print for 'by total'",
            "  --min%self      	minimum % to print for 'by self'",
            "",
            "If 'file' is omitted 'Rprof.out' is used",
            "",
            "Report bugs at bugs.r-project.org .", sep="\n")
    }

    if (is.null(args)) {
        args <- commandArgs(TRUE)
        ## it seems that splits on spaces, so try harder.
        args <- paste(args, collapse=" ")
        args <- strsplit(args,'nextArg', fixed = TRUE)[[1L]][-1L]
    }

    files <- character()
    bytotal <- byself <- TRUE
    mintotal <- minself <- -1L
    while(length(args)) {
        a <- args[1L]
        if (a %in% c("-h", "--help")) {
            Usage()
            do_exit(0L)
        }
        else if (a %in% c("-v", "--version")) {
            cat("R profiling post-processor: ",
                R.version[["major"]], ".",  R.version[["minor"]],
                " (r", R.version[["svn rev"]], ")\n", sep = "")
            cat("",
                "Copyright (C) 1997-2010 The R Core Team.",
                "This is free software; see the GNU General Public License version 2",
                "or later for copying conditions.  There is NO warranty.",
                sep="\n")
            do_exit(0L)
        } else if (a == "--total") {
            byself <- FALSE
        } else if (a == "--self") {
            byself <- TRUE
            bytotal <- FALSE
        } else if (substr(a, 1, 12)  == "--min%total=") {
            mintotal <- as.integer(substr(a, 13, 1000))
        } else if (substr(a, 1, 11)  == "--min%self=") {
            minself <- as.integer(substr(a, 12, 1000))
        } else files <- c(files, a)
        args <- args[-1L]
    }
    file <- if (!length(files)) "Rprof.out" else files[1L]

    res <- utils::summaryRprof(file)

    cat("\nEach sample represents", format(res$sample.interval), "seconds.\n")
    cat("Total run time:", format(res$sampling.time), "seconds.\n")
    cat("\nTotal seconds: time spent in function and callees.\n")
    cat("Self seconds: time spent in function alone.\n\n")

    if (bytotal) {
        m <- data.frame(res$by.total[c(2,1,4,3)], row.names(res$by.total))
        if(mintotal > 0) m <- m[m[,1L] >= mintotal,]
        writeLines(c("   %       total       %        self",
                     " total    seconds     self    seconds    name",
                     sprintf("%6.1f%10.2f%10.1f%10.2f     %s",
                             m[,1L], m[,2L], m[,3L], m[,4L], m[,5L])))
    }
    if(bytotal && byself) cat("\n\n")
    if(byself) {
        m <- data.frame(res$by.self[c(2,1,4,3)], row.names(res$by.self))
        if(minself > 0) m <- m[m[,1L] >= minself,]
        writeLines(c("   %        self       %      total",
                     "  self    seconds    total   seconds    name",
                     sprintf("%6.1f%10.2f%10.1f%10.2f     %s",
                             m[,1L], m[,2L], m[,3L], m[,4L], m[,5L])))
    }
    do_exit(0L)
}