#' An alternative to \code{summaryRprof()} #' #' \code{proftools} parses a profiling file and prints an easy-to-understand #' table showing the most time-intensive function calls. #' #' Line numbers are included if \code{Rprof()} was run with #' \code{line.numbering=TRUE}. If it was run with \code{memory.profiling=TRUE}, #' this function will probably break. #' #' Below the table are printed any files identified if line numbering is true, #' the total time recorded by \code{Rprof()}, and the "parent call". The #' parent call consists of the parent call stack of all the call stacks in the\ #' table. Note that this is the parent call stack of only the printed lines, #' not of all stacks recorded by \code{Rprof()}. This makes the table easier to read and fit into the console. #' #' @export #' @param file A profiling file generated by \code{Rprof()} #' @param lines The number of lines (call stacks) you want returned. Lines are #' printed from most time-intensive to least. proftable <- function(file, lines = 10) { profdata <- readLines(file) interval <- as.numeric(strsplit(profdata[1L], "=")[[1L]][2L]) / 1e+06 filelines <- grep("#File", profdata) files <- profdata[filelines] profdata <- profdata[-c(1, filelines)] total.time <- interval * length(profdata) ncalls <- length(profdata) profdata <- gsub("\\\"| $", "", profdata) calls <- lapply(profdata, function(x) rev(unlist(strsplit(x, " ")))) stacktable <- as.data.frame(table(sapply(calls, function(x) paste(x, collapse = " > "))) / ncalls * 100, stringsAsFactors = FALSE) stacktable <- stacktable[order(stacktable$Freq[], decreasing = TRUE), 2:1] colnames(stacktable) <- c("PctTime", "Call") stacktable <- utils::head(stacktable, lines) shortcalls = strsplit(stacktable$Call, " > ") shortcalls.len <- range(sapply(shortcalls, length)) parent.call <- unlist(lapply(seq(shortcalls.len[1]), function(i) Reduce(intersect, lapply(shortcalls,"[[", i)))) shortcalls <- lapply(shortcalls, function(x) setdiff(x, parent.call)) stacktable$Call = sapply(shortcalls, function(x) paste(x, collapse = " > ")) if (length(parent.call) > 0) { parent.call <- paste(paste(parent.call, collapse = " > "), "> ...") } else { parent.call <- "None" } frac <- sum(stacktable$PctTime) attr(stacktable, "total.time") <- total.time attr(stacktable, "parent.call") <- parent.call attr(stacktable, "files") <- files attr(stacktable, "total.pct.time") <- frac print(stacktable, row.names=FALSE, right=FALSE, digits=3) if(length(files) > 0) { cat("\n") cat(paste(files, collapse="\n")) cat("\n") } cat(paste("\nParent Call:", parent.call)) cat(paste("\n\nTotal Time:", total.time, "seconds\n")) cat(paste0("Percent of run time represented: ", format(frac, digits=3)), "%") invisible(stacktable) }