The R Project SVN – R – Diff – /trunk/src/scripts/Rprof.in


#! @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;
}

Rev 11515	Rev 31770
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;`	25	`use Getopt::Long;`
26	`use R::Utils;`	26	`use R::Utils;`
27		27
28	`my $revision = ' $Revision: 1.4 $ ';`	28	`my $revision = ' $Revision: 1.4 $ ';`
29	`my $version;`	29	`my $version;`
30	`my $name;`	30	`my $name;`
31		31
32	`$revision =~ / ([\d\.]*) /;`	32	`$revision =~ / ([\d\.]*) /;`
33	`$version = $1;`	33	`$version = $1;`
34	`($name = $0) =~ s\|.*/\|\|;`	34	`($name = $0) =~ s\|.*/\|\|;`
35		35
36	`sub usage {`	36	`sub usage {`
37	`print STDERR <<END;`	37	`print STDERR <<END;`
38	`Usage: R CMD Rprof [options] file`	38	`Usage: R CMD Rprof [options] file`
39		39
40	`Post-process profiling information in file generated by Rprof().`	40	`Post-process profiling information in file generated by Rprof().`
41		41
42	`Options:`	42	`Options:`
43	`-h, --help print short help message and exit`	43	`-h, --help print short help message and exit`
44	`-v, --version print version info and exit`	44	`-v, --version print Rprof version info and exit`
45		45
46	`Email bug reports to <r-bugs\@r-project.org>.`	46	`Email bug reports to <r-bugs\@r-project.org>.`
47	`END`	47	`END`
48	`exit 0;`	48	`exit 0;`
49	`}`	49	`}`
50		50
51	`@knownoptions = ("h\|help", "v\|version");`	51	`@knownoptions = ("h\|help", "v\|version");`
52	`GetOptions(@knownoptions) \|\| &usage();`	52	`GetOptions(@knownoptions) \|\| &usage();`
53	`&R_version("R profiling post-processor", $version) if $opt_v;`	53	`&R_version("R profiling post-processor", $version) if $opt_v;`
54	`&usage() if $opt_h;`	54	`&usage() if $opt_h;`
55		55
56	`%leafcounts = ();`	56	`%leafcounts = ();`
57	`%totalcounts = ();`	57	`%totalcounts = ();`
58		58
59	`while (<>) {`	59	`while (<>) {`
60	`if (/^sample\.interval=/) {`	60	`if (/^sample\.interval=/) {`
61	`s/sample\.interval=//;`	61	`s/sample\.interval=//;`
62	`$sample = $_ / 1e6;`	62	`$sample = $_ / 1e6;`
63	`} else {`	63	`} else {`
64	`chomp;`	64	`chomp;`
65	`@line = split(/ /);`	65	`@line = split(/ /);`
66	`%names = ();`	66	`%names = ();`
67	`$leaf = @line[0];`	67	`$leaf = @line[0];`
68	`foreach $name (@line) {`	68	`foreach $name (@line) {`
69	`$names{$name} = 1;`	69	`$names{$name} = 1;`
70	`}`	70	`}`
71	`$total = $total + $sample;`	71	`$total = $total + $sample;`
72	`foreach $name (keys %names) {`	72	`foreach $name (keys %names) {`
73	`$totalcounts{$name} = $totalcounts{$name} + $sample;`	73	`$totalcounts{$name} = $totalcounts{$name} + $sample;`
74	`}`	74	`}`
75	`$leafcounts{$leaf} = $leafcounts{$leaf} + $sample;`	75	`$leafcounts{$leaf} = $leafcounts{$leaf} + $sample;`
76	`}`	76	`}`
77	`}`	77	`}`
78		78
79	`print "\n";`	79	`print "\n";`
80	`print "Each sample represents $sample seconds.\n";`	80	`print "Each sample represents $sample seconds.\n";`
81	`print "Total run time: $total seconds.\n\n";`	81	`print "Total run time: $total seconds.\n\n";`
82	`print "Total seconds: time spent in function and callees.\n";`	82	`print "Total seconds: time spent in function and callees.\n";`
83	`print "Self seconds: time spent in function alone.\n";`	83	`print "Self seconds: time spent in function alone.\n";`
84		84
85	`print "\n";`	85	`print "\n";`
86	`print " % total % self\n";`	86	`print " % total % self\n";`
87	`print " total seconds self seconds name\n";`	87	`print " total seconds self seconds name\n";`
88		88
89	`@order = sort { $totalcounts{$b} <=> $totalcounts{$a} } keys %totalcounts;`	89	`@order = sort { $totalcounts{$b} <=> $totalcounts{$a} } keys %totalcounts;`
90	`foreach $name (@order) {`	90	`foreach $name (@order) {`
91	`printf "%6.2f%10.2f%10.2f%10.2f %s\n",`	91	`printf "%6.2f%10.2f%10.2f%10.2f %s\n",`
92	`100 * $totalcounts{$name}/$total, $totalcounts{$name},`	92	`100 * $totalcounts{$name}/$total, $totalcounts{$name},`
93	`100 * $leafcounts{$name}/$total, $leafcounts{$name},`	93	`100 * $leafcounts{$name}/$total, $leafcounts{$name},`
94	`$name;`	94	`$name;`
95	`}`	95	`}`
96		96
97	`print "\n";`	97	`print "\n";`
98	`print " % self % total\n";`	98	`print " % self % total\n";`
99	`print " self seconds total seconds name\n";`	99	`print " self seconds total seconds name\n";`
100		100
101	`@order = sort { $leafcounts{$b} <=> $leafcounts{$a} } keys %leafcounts;`	101	`@order = sort { $leafcounts{$b} <=> $leafcounts{$a} } keys %leafcounts;`
102	`foreach $name (@order) {`	102	`foreach $name (@order) {`
103	`printf "%6.2f%10.2f%10.2f%10.2f %s\n",`	103	`printf "%6.2f%10.2f%10.2f%10.2f %s\n",`
104	`100 * $leafcounts{$name}/$total, $leafcounts{$name},`	104	`100 * $leafcounts{$name}/$total, $leafcounts{$name},`
105	`100 * $totalcounts{$name}/$total, $totalcounts{$name},`	105	`100 * $totalcounts{$name}/$total, $totalcounts{$name},`
106	`$name;`	106	`$name;`
107	`}`	107	`}`

The R Project SVN R

(root)/trunk/src/scripts/Rprof.in @ 36498 – Rev 11515 → 31770