The R Project SVN R

Rev

Rev 9705 | Rev 10633 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 9705 Rev 9869
Line 1... Line 1...
1 
#! @PERL@
 1 
#! @PERL@
- 
 
 2 
#-*- perl -*- (for Rprof.in)
- 
 
 3 
 
- 
 
 4 
# Post-process profiling files generated by Rprof().
- 
 
 5 
 
- 
 
 6 
# Copyright (C) 2000 R Development Core Team
- 
 
 7 
#
- 
 
 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
- 
 
 10 
# the Free Software Foundation; either version 2, or (at your option)
- 
 
 11 
# any later version.
- 
 
 12 
#
- 
 
 13 
# This program is distributed in the hope that it will be useful, but
- 
 
 14 
# WITHOUT ANY WARRANTY; without even the implied warranty of
- 
 
 15 
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	See the GNU
- 
 
 16 
# General Public License for more details.
- 
 
 17 
#
- 
 
 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
- 
 
 20 
# writing to the Free Software Foundation, Inc., 59 Temple Place,
- 
 
 21 
# Suite 330, Boston, MA  02111-1307  USA.
- 
 
 22 
 
- 
 
 23 
# Send any bug reports to R-bugs@lists.r-project.org.
2 
 
 24 
 
3 
%leafcounts = ();
 25 
%leafcounts = ();
4 
%totalcounts = ();
 26 
%totalcounts = ();
5 
 
 27 
 
6 
while (<>) {
 28 
while (<>) {
7 
    if (! $sample) {
 29 
    if (/^sample\.interval=/) {
8 
	$sample = $_ / 1000000
 30 
	s/sample\.interval=//;
9 
    }
 31 
	$sample = $_ / 1e6;
10 
    else {
 32 
    } else {
11 
	chomp;
 33 
	chomp;
12 
	@line = split(/ /);
 34 
	@line = split(/ /);
13 
	%names = ();
 35 
	%names = ();
14 
	$leaf = @line[0];
 36 
	$leaf = @line[0];
15 
	foreach $name (@line) {
 37 
	foreach $name (@line) {
16 
	    if (! exists $names{$name}) {
 - 
 
17 
		$names{$name} = 1;
 38 
	    $names{$name} = 1;
18 
	    }
 - 
 
19 
	}
 39 
	}
- 
 
 40 
	$total = $total + $sample;
20 
	foreach $name (keys %names) {
 41 
	foreach $name (keys %names) {
21 
	    if (exists $totalcounts{$name}) {
 - 
 
22 
		$totalcounts{$name} = $totalcounts{$name} + 1;
 42 
	    $totalcounts{$name} = $totalcounts{$name} + $sample;
23 
	    }
 - 
 
24 
	    else { $totalcounts{$name} = 1; }
 - 
 
25 
	}
 - 
 
26 
	if (exists $leafcounts{$leaf}) {
 - 
 
27 
	    $leafcounts{$leaf} = $leafcounts{$leaf} + 1;
 - 
 
28 
	}
 43 
	}
29 
	else { $leafcounts{$leaf} = 1; }
 44 
	$leafcounts{$leaf} = $leafcounts{$leaf} + $sample;
30 
    }
 45 
    }
31 
}
 46 
}
32 
 
 47 
 
33 
$total = $. - 1;
 - 
 
34 
$runtime = $total * $sample;
 - 
 
35 
 
 - 
 
36 
print "\n";
 48 
print "\n";
37 
print "Each sample represents $sample seconds.\n";
 49 
print "Each sample represents $sample seconds.\n";
38 
print "Total run time: $runtime seconds.\n\n";
 50 
print "Total run time: $total seconds.\n\n";
39 
print "Total seconds: time spent in function and callees.\n";
 51 
print "Total seconds: time spent in function and callees.\n";
40 
print "Self seconds: time spent in function alone.\n";
 52 
print "Self seconds: time spent in function alone.\n";
41 
 
 53 
 
42 
print "\n";
 54 
print "\n";
43 
print "   %       total       %       self\n";
 55 
print "   %       total       %       self\n";
44 
print " total    seconds     self    seconds    name\n";
 56 
print " total    seconds     self    seconds    name\n";
45 
 
 57 
 
46 
@order = sort { $totalcounts{$b} <=> $totalcounts{$a} } keys %totalcounts;
 58 
@order = sort { $totalcounts{$b} <=> $totalcounts{$a} } keys %totalcounts;
47 
foreach $name (@order) {
 59 
foreach $name (@order) {
48 
    printf "%6.2f%10.2f%10.2f%10.2f     %s\n",
 60 
    printf "%6.2f%10.2f%10.2f%10.2f     %s\n",
49 
    100 * $totalcounts{$name}/$total, $totalcounts{$name} * $sample,
 61 
    100 * $totalcounts{$name}/$total, $totalcounts{$name},
50 
    100 * $leafcounts{$name}/$total, $leafcounts{$name} * $sample,
 62 
    100 * $leafcounts{$name}/$total, $leafcounts{$name},
51 
    $name;
 63 
    $name;
52 
}
 64 
}
53 
 
 65 
 
54 
print "\n";
 66 
print "\n";
55 
print "   %       self        %       total\n";
 67 
print "   %       self        %       total\n";
56 
print " self     seconds    total    seconds    name\n";
 68 
print " self     seconds    total    seconds    name\n";
57
69
58 
@order = sort { $leafcounts{$b} <=> $leafcounts{$a} } keys %leafcounts;
 70 
@order = sort { $leafcounts{$b} <=> $leafcounts{$a} } keys %leafcounts;
59 
foreach $name (@order) {
 71 
foreach $name (@order) {
60 
    printf "%6.2f%10.2f%10.2f%10.2f     %s\n",
 72 
    printf "%6.2f%10.2f%10.2f%10.2f     %s\n",
61 
    100 * $leafcounts{$name}/$total, $leafcounts{$name} * $sample,
 73 
    100 * $leafcounts{$name}/$total, $leafcounts{$name},
62 
    100 * $totalcounts{$name}/$total, $totalcounts{$name} * $sample,
 74 
    100 * $totalcounts{$name}/$total, $totalcounts{$name},
63 
    $name;
 75 
    $name;
64 
}
 76 
}