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;

}