The R Project SVN R

#! @PERL@
#-*- perl -*- (for Rprof.in)

# Post-process profiling files generated by Rprof().

# Copyright (C) 2000 R Development 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, 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 via WWW at
# http://www.gnu.org/copyleft/gpl.html.  You can also obtain it by
# writing to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA  02111-1307  USA.

# Send any bug reports to r-bugs@r-project.org.

use Getopt::Long;
use R::Utils;

my $revision = ' $Revision: 1.4 $ ';
my $version;
my $name;

$revision =~ / ([\d\.]*) /;
$version = $1;
($name = $0) =~ s|.*/||;

sub usage {
    print STDERR <<END;
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 Rprof version info and exit

Email bug reports to <r-bugs\@r-project.org>.
END
  exit 0;
}

@knownoptions = ("h|help", "v|version");
GetOptions(@knownoptions) || &usage();
&R_version("R profiling post-processor", $version) if $opt_v;
&usage() if $opt_h;

%leafcounts = ();
%totalcounts = ();

while (<>) {
    if (/^sample\.interval=/) {
    s/sample\.interval=//;
    $sample = $_ / 1e6;
    } else {
    chomp;
    @line = split(/ /);
    %names = ();
    $leaf = @line[0];
    foreach $name (@line) {
        $names{$name} = 1;
    }
    $total = $total + $sample;
    foreach $name (keys %names) {
        $totalcounts{$name} = $totalcounts{$name} + $sample;
    }
    $leafcounts{$leaf} = $leafcounts{$leaf} + $sample;
    }
}

print "\n";
print "Each sample represents $sample seconds.\n";
print "Total run time: $total seconds.\n\n";
print "Total seconds: time spent in function and callees.\n";
print "Self seconds: time spent in function alone.\n";

print "\n";
print "   %       total       %       self\n";
print " total    seconds     self    seconds    name\n";

@order = sort { $totalcounts{$b} <=> $totalcounts{$a} } keys %totalcounts;
foreach $name (@order) {
    printf "%6.2f%10.2f%10.2f%10.2f     %s\n",
    100 * $totalcounts{$name}/$total, $totalcounts{$name},
    100 * $leafcounts{$name}/$total, $leafcounts{$name},
    $name;
}

print "\n";
print "   %       self        %       total\n";
print " self     seconds    total    seconds    name\n";
   
@order = sort { $leafcounts{$b} <=> $leafcounts{$a} } keys %leafcounts;
foreach $name (@order) {
    printf "%6.2f%10.2f%10.2f%10.2f     %s\n",
    100 * $leafcounts{$name}/$total, $leafcounts{$name},
    100 * $totalcounts{$name}/$total, $totalcounts{$name},
    $name;
}