The R Project SVN R

Rev

Rev 10633 | Only display areas with differences | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 10633 Rev 11515
1 
#! @PERL@
 1 
#! @PERL@
2 
#-*- perl -*- (for Rprof.in)
 2 
#-*- perl -*- (for Rprof.in)
3 
 
 3 
 
4 
# Post-process profiling files generated by Rprof().
 4 
# Post-process profiling files generated by Rprof().
5 
 
 5 
 
6 
# Copyright (C) 2000 R Development Core Team
 6 
# Copyright (C) 2000 R Development Core Team
7 
#
 7 
#
8 
# This program is free software; you can redistribute it and/or modify
 8 
# This program is free software; you can redistribute it and/or modify
9 
# it under the terms of the GNU General Public License as published by
 9 
# it under the terms of the GNU General Public License as published by
10 
# the Free Software Foundation; either version 2, or (at your option)
 10 
# the Free Software Foundation; either version 2, or (at your option)
11 
# any later version.
 11 
# any later version.
12 
#
 12 
#
13 
# This program is distributed in the hope that it will be useful, but
 13 
# This program is distributed in the hope that it will be useful, but
14 
# WITHOUT ANY WARRANTY; without even the implied warranty of
 14 
# WITHOUT ANY WARRANTY; without even the implied warranty of
15 
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	See the GNU
 15 
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	See the GNU
16 
# General Public License for more details.
 16 
# General Public License for more details.
17 
#
 17 
#
18 
# A copy of the GNU General Public License is available via WWW at
 18 
# A copy of the GNU General Public License is available via WWW at
19 
# http://www.gnu.org/copyleft/gpl.html.	 You can also obtain it by
 19 
# http://www.gnu.org/copyleft/gpl.html.	 You can also obtain it by
20 
# writing to the Free Software Foundation, Inc., 59 Temple Place,
 20 
# writing to the Free Software Foundation, Inc., 59 Temple Place,
21 
# Suite 330, Boston, MA  02111-1307  USA.
 21 
# Suite 330, Boston, MA  02111-1307  USA.
22 
 
 22 
 
23 
# Send any bug reports to r-bugs@r-project.org.
 23 
# Send any bug reports to r-bugs@r-project.org.
24 
 
 24 
 
- 
 
 25 
use Getopt::Long;
- 
 
 26 
use R::Utils;
- 
 
 27 
 
- 
 
 28 
my $revision = ' $Revision: 1.4 $ ';
- 
 
 29 
my $version;
- 
 
 30 
my $name;
- 
 
 31 
 
- 
 
 32 
$revision =~ / ([\d\.]*) /;
- 
 
 33 
$version = $1;
- 
 
 34 
($name = $0) =~ s|.*/||;
- 
 
 35 
 
- 
 
 36 
sub usage {
- 
 
 37 
    print STDERR <<END;
- 
 
 38 
Usage: R CMD Rprof [options] file
- 
 
 39 
 
- 
 
 40 
Post-process profiling information in file generated by Rprof().
- 
 
 41 
 
- 
 
 42 
Options:
- 
 
 43 
  -h, --help		print short help message and exit
- 
 
 44 
  -v, --version		print version info and exit
- 
 
 45 
 
- 
 
 46 
Email bug reports to <r-bugs\@r-project.org>.
- 
 
 47 
END
- 
 
 48 
  exit 0;
- 
 
 49 
}
- 
 
 50 
 
- 
 
 51 
@knownoptions = ("h|help", "v|version");
- 
 
 52 
GetOptions(@knownoptions) || &usage();
- 
 
 53 
&R_version("R profiling post-processor", $version) if $opt_v;
- 
 
 54 
&usage() if $opt_h;
- 
 
 55 
 
25 
%leafcounts = ();
 56 
%leafcounts = ();
26 
%totalcounts = ();
 57 
%totalcounts = ();
27 
 
 58 
 
28 
while (<>) {
 59 
while (<>) {
29 
    if (/^sample\.interval=/) {
 60 
    if (/^sample\.interval=/) {
30 
	s/sample\.interval=//;
 61 
	s/sample\.interval=//;
31 
	$sample = $_ / 1e6;
 62 
	$sample = $_ / 1e6;
32 
    } else {
 63 
    } else {
33 
	chomp;
 64 
	chomp;
34 
	@line = split(/ /);
 65 
	@line = split(/ /);
35 
	%names = ();
 66 
	%names = ();
36 
	$leaf = @line[0];
 67 
	$leaf = @line[0];
37 
	foreach $name (@line) {
 68 
	foreach $name (@line) {
38 
	    $names{$name} = 1;
 69 
	    $names{$name} = 1;
39 
	}
 70 
	}
40 
	$total = $total + $sample;
 71 
	$total = $total + $sample;
41 
	foreach $name (keys %names) {
 72 
	foreach $name (keys %names) {
42 
	    $totalcounts{$name} = $totalcounts{$name} + $sample;
 73 
	    $totalcounts{$name} = $totalcounts{$name} + $sample;
43 
	}
 74 
	}
44 
	$leafcounts{$leaf} = $leafcounts{$leaf} + $sample;
 75 
	$leafcounts{$leaf} = $leafcounts{$leaf} + $sample;
45 
    }
 76 
    }
46 
}
 77 
}
47 
 
 78 
 
48 
print "\n";
 79 
print "\n";
49 
print "Each sample represents $sample seconds.\n";
 80 
print "Each sample represents $sample seconds.\n";
50 
print "Total run time: $total seconds.\n\n";
 81 
print "Total run time: $total seconds.\n\n";
51 
print "Total seconds: time spent in function and callees.\n";
 82 
print "Total seconds: time spent in function and callees.\n";
52 
print "Self seconds: time spent in function alone.\n";
 83 
print "Self seconds: time spent in function alone.\n";
53 
 
 84 
 
54 
print "\n";
 85 
print "\n";
55 
print "   %       total       %       self\n";
 86 
print "   %       total       %       self\n";
56 
print " total    seconds     self    seconds    name\n";
 87 
print " total    seconds     self    seconds    name\n";
57 
 
 88 
 
58 
@order = sort { $totalcounts{$b} <=> $totalcounts{$a} } keys %totalcounts;
 89 
@order = sort { $totalcounts{$b} <=> $totalcounts{$a} } keys %totalcounts;
59 
foreach $name (@order) {
 90 
foreach $name (@order) {
60 
    printf "%6.2f%10.2f%10.2f%10.2f     %s\n",
 91 
    printf "%6.2f%10.2f%10.2f%10.2f     %s\n",
61 
    100 * $totalcounts{$name}/$total, $totalcounts{$name},
 92 
    100 * $totalcounts{$name}/$total, $totalcounts{$name},
62 
    100 * $leafcounts{$name}/$total, $leafcounts{$name},
 93 
    100 * $leafcounts{$name}/$total, $leafcounts{$name},
63 
    $name;
 94 
    $name;
64 
}
 95 
}
65 
 
 96 
 
66 
print "\n";
 97 
print "\n";
67 
print "   %       self        %       total\n";
 98 
print "   %       self        %       total\n";
68 
print " self     seconds    total    seconds    name\n";
 99 
print " self     seconds    total    seconds    name\n";
69
100
70 
@order = sort { $leafcounts{$b} <=> $leafcounts{$a} } keys %leafcounts;
 101 
@order = sort { $leafcounts{$b} <=> $leafcounts{$a} } keys %leafcounts;
71 
foreach $name (@order) {
 102 
foreach $name (@order) {
72 
    printf "%6.2f%10.2f%10.2f%10.2f     %s\n",
 103 
    printf "%6.2f%10.2f%10.2f%10.2f     %s\n",
73 
    100 * $leafcounts{$name}/$total, $leafcounts{$name},
 104 
    100 * $leafcounts{$name}/$total, $leafcounts{$name},
74 
    100 * $totalcounts{$name}/$total, $totalcounts{$name},
 105 
    100 * $totalcounts{$name}/$total, $totalcounts{$name},
75 
    $name;
 106 
    $name;
76 
}
 107 
}