# File src/library/tools/R/Rprof.R # Part of the R package, http://www.R-project.org # # Copyright (C) 1995-2013 The R Core Team # # 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", " --lines print line information", " --total print only by total", " --self print only by self", " --linesonly print only by line (implies --lines)", " --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 <- bylines <- TRUE lines <- FALSE 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-2013 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") { bytotal <- TRUE byself <- FALSE bylines <- FALSE } else if (a == "--self") { bytotal <- FALSE byself <- TRUE bylines <- FALSE } else if (a == "--linesonly") { lines <- TRUE byself <- FALSE bytotal <- FALSE bylines <- TRUE } else if (a == "--lines") { lines <- TRUE } 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, lines = if (lines) "show" else "hide") 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") printed <- FALSE 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,,drop = FALSE] 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]))) printed <- TRUE } if(byself) { if (printed) cat("\n\n") m <- data.frame(res$by.self[c(2,1,4,3)], row.names(res$by.self)) if(minself > 0) m <- m[m[,1L] >= minself,,drop = FALSE] 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]))) printed <- TRUE } if(lines && bylines) { if (printed) cat("\n\n") m <- data.frame(res$by.line[c(2,1,4,3)], row.names(res$by.line)) if(minself > 0) m <- m[m[,1L] >= minself,,drop = FALSE] if(mintotal > 0) m <- m[m[,1L] >= mintotal,,drop = FALSE] 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) }