line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
=head1 NAME |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
PDLA::Reduce -- a C function for PDLA |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 DESCRIPTION |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
Many languages have a C function used to reduce |
8
|
|
|
|
|
|
|
the rank of an N-D array by one. It works by applying a selected |
9
|
|
|
|
|
|
|
operation along a specified dimension. This module implements |
10
|
|
|
|
|
|
|
such a function for PDLA by providing a simplified interface |
11
|
|
|
|
|
|
|
to the existing projection functions (e.g. C, |
12
|
|
|
|
|
|
|
C, C, etc). |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=head1 SYNOPSIS |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
use PDLA::Reduce; |
17
|
|
|
|
|
|
|
$x = sequence 5,5; |
18
|
|
|
|
|
|
|
# reduce by adding all |
19
|
|
|
|
|
|
|
# elements along 2nd dimension |
20
|
|
|
|
|
|
|
$y = $x->reduce('add',1); |
21
|
|
|
|
|
|
|
@ops = $x->canreduce; # return a list of all allowed operations |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
=head1 FUNCTIONS |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=cut |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# in a very similar vein we want the following methods |
28
|
|
|
|
|
|
|
# (1) accumulate |
29
|
|
|
|
|
|
|
# (2) outer |
30
|
|
|
|
|
|
|
# what's reduceat ?? |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
# TODO |
33
|
|
|
|
|
|
|
# - aliases (e.g. plus -> add) |
34
|
|
|
|
|
|
|
# - other binary ops? |
35
|
|
|
|
|
|
|
# - allow general subs? |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
package PDLA::Reduce; |
38
|
1
|
|
|
1
|
|
357
|
use PDLA::Core ''; # barf |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
5
|
|
39
|
1
|
|
|
1
|
|
6
|
use PDLA::Exporter; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
4
|
|
40
|
1
|
|
|
1
|
|
3
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
393
|
|
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
@PDLA::Reduce::ISA = qw/PDLA::Exporter/; |
43
|
|
|
|
|
|
|
@PDLA::Reduce::EXPORT_OK = qw/reduce canreduce/; |
44
|
|
|
|
|
|
|
%PDLA::Reduce::EXPORT_TAGS = (Func=>[@PDLA::Reduce::EXPORT_OK]); |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
# maps operations onto underlying PDLA primitives |
47
|
|
|
|
|
|
|
my %reduce = ( |
48
|
|
|
|
|
|
|
add => 'sumover', |
49
|
|
|
|
|
|
|
'+' => 'sumover', |
50
|
|
|
|
|
|
|
plus => 'sumover', |
51
|
|
|
|
|
|
|
mult => 'prodover', |
52
|
|
|
|
|
|
|
'*' => 'prodover', |
53
|
|
|
|
|
|
|
dadd => 'dsumover', |
54
|
|
|
|
|
|
|
dmult => 'dprodover', |
55
|
|
|
|
|
|
|
avg => 'average', |
56
|
|
|
|
|
|
|
davg => 'daverage', |
57
|
|
|
|
|
|
|
and => 'andover', |
58
|
|
|
|
|
|
|
band => 'bandover', |
59
|
|
|
|
|
|
|
bor => 'borover', |
60
|
|
|
|
|
|
|
or => 'orover', |
61
|
|
|
|
|
|
|
median => 'medover', |
62
|
|
|
|
|
|
|
integral => 'intover', |
63
|
|
|
|
|
|
|
max => 'maximum', |
64
|
|
|
|
|
|
|
min => 'minimum', |
65
|
|
|
|
|
|
|
oddmedian => 'oddmedover', |
66
|
|
|
|
|
|
|
iszero => 'zcover', |
67
|
|
|
|
|
|
|
); |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=head2 reduce |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=for ref |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
reduce dimension of piddle by one by applying an operation |
74
|
|
|
|
|
|
|
along the specified dimension |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=for example |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
$x = sequence 5,5; |
79
|
|
|
|
|
|
|
# reduce by adding all |
80
|
|
|
|
|
|
|
# elements along 2nd dimension |
81
|
|
|
|
|
|
|
$y = $x->reduce('add',1); |
82
|
|
|
|
|
|
|
$y = $x->reduce('plus',1); |
83
|
|
|
|
|
|
|
$y = $x->reduce('+',1); # three ways to do the same thing |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
[ As an aside: if you are familiar with threading you will see that |
86
|
|
|
|
|
|
|
this is actually the same as |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
$y = $x->mv(1,0)->sumover |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
] |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
NOTE: You should quote the name of the operation (1st arg) that |
93
|
|
|
|
|
|
|
you want C to perform. This is important since some of the |
94
|
|
|
|
|
|
|
names are identical to the names of the actual PDLA functions |
95
|
|
|
|
|
|
|
which might be imported into your namespace. And you definitely |
96
|
|
|
|
|
|
|
want a string as argument, not a function invocation! For example, |
97
|
|
|
|
|
|
|
this will probably fail: |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
$y = $x->reduce(avg,1); # gives an error from invocation of 'avg' |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
Rather use |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
$y = $x->reduce('avg',1); |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
C provides a simple and unified interface to the |
106
|
|
|
|
|
|
|
I functions and makes people coming from other |
107
|
|
|
|
|
|
|
data/array languages hopefully feel more at home. |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=for usage |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
$result = $pdl->reduce($operation [,@dims]); |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
C applies the named operation along the specified |
114
|
|
|
|
|
|
|
dimension(s) reducing the input piddle dimension by as many |
115
|
|
|
|
|
|
|
dimensions as supplied as arguments. If the |
116
|
|
|
|
|
|
|
dimension(s) argument is omitted the operation is applied along the first |
117
|
|
|
|
|
|
|
dimension. To get a list of valid operations see L. |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
NOTE - new power user feature: you can now supply a code |
120
|
|
|
|
|
|
|
reference as operation to reduce with. |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
=for example |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
# reduce by summing over dims 0 and 2 |
125
|
|
|
|
|
|
|
$result = $pdl->reduce(\&sumover, 0, 2); |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
It is your responsibility to ensure that this is indeed a |
128
|
|
|
|
|
|
|
PDLA projection operation that turns vectors into scalars! |
129
|
|
|
|
|
|
|
You have been warned. |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
=cut |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
*reduce = \&PDLA::reduce; |
134
|
|
|
|
|
|
|
sub PDLA::reduce ($$;$) { |
135
|
5
|
|
|
5
|
0
|
20
|
my ($pdl, $op, @dims) = @_; |
136
|
|
|
|
|
|
|
barf "trying to reduce using unknown operation" |
137
|
5
|
50
|
66
|
|
|
147
|
unless exists $reduce{$op} || ref $op eq 'CODE'; |
138
|
5
|
|
|
|
|
68
|
my $dim; |
139
|
5
|
100
|
|
|
|
16
|
if (@dims > 1) { |
140
|
1
|
|
|
|
|
4
|
my $n = $pdl->getndims; |
141
|
1
|
50
|
|
|
|
3
|
@dims = map { $_ < 0 ? $_ + $n : $_ } @dims; |
|
2
|
|
|
|
|
7
|
|
142
|
1
|
|
|
|
|
2
|
my $min = $n; |
143
|
1
|
|
|
|
|
2
|
my $max = 0; |
144
|
1
|
100
|
|
|
|
3
|
for (@dims) { $min = $_ if $_ < $min; $max = $_ if $_ > $max } |
|
2
|
100
|
|
|
|
5
|
|
|
2
|
|
|
|
|
5
|
|
145
|
1
|
50
|
33
|
|
|
6
|
barf "dimension out of bounds (one of @dims >= $n)" |
146
|
|
|
|
|
|
|
if $min >= $n || $max >= $n; |
147
|
1
|
|
|
|
|
2
|
$dim = $min; # this will be the resulting dim of the clumped piddle |
148
|
1
|
|
|
|
|
4
|
$pdl = $pdl->clump(@dims); |
149
|
|
|
|
|
|
|
} else { |
150
|
4
|
100
|
|
|
|
10
|
$dim = @dims > 0 ? $dims[0] : 0; |
151
|
|
|
|
|
|
|
} |
152
|
5
|
100
|
66
|
|
|
23
|
if (defined $dim && $dim != 0) { # move the target dim to the front |
153
|
2
|
|
|
|
|
7
|
my $n = $pdl->getndims; |
154
|
2
|
50
|
|
|
|
5
|
$dim += $n if $dim < 0; |
155
|
2
|
50
|
33
|
|
|
8
|
barf "dimension out of bounds" if $dim <0 || $dim >= $n; |
156
|
2
|
|
|
|
|
17
|
$pdl = $pdl->mv($dim,0); |
157
|
|
|
|
|
|
|
} |
158
|
5
|
100
|
|
|
|
14
|
my $method = ref $op eq 'CODE' ? $op : $reduce{$op}; |
159
|
5
|
|
|
|
|
215
|
return $pdl->$method(); |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=head2 canreduce |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=for ref |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
return list of valid named C operations |
167
|
|
|
|
|
|
|
Some common operations can be accessed using a |
168
|
|
|
|
|
|
|
number of names, e.g. C<'+'>, C and C |
169
|
|
|
|
|
|
|
all sum the elements along the chosen dimension. |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=for example |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
@ops = PDLA->canreduce; |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
This list is useful if you want to make sure which |
176
|
|
|
|
|
|
|
operations can be used with C. |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=cut |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
*canreduce = \&PDLA::canreduce; |
181
|
|
|
|
|
|
|
sub PDLA::canreduce { |
182
|
0
|
|
|
0
|
0
|
|
my ($this) = @_; |
183
|
0
|
|
|
|
|
|
return keys %reduce; |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
=head1 AUTHOR |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
Copyright (C) 2000 Christian Soeller (c.soeller@auckland.ac.nz). All |
189
|
|
|
|
|
|
|
rights reserved. There is no warranty. You are allowed to redistribute |
190
|
|
|
|
|
|
|
this software / documentation under certain conditions. For details, |
191
|
|
|
|
|
|
|
see the file COPYING in the PDLA distribution. If this file is |
192
|
|
|
|
|
|
|
separated from the PDLA distribution, the copyright notice should be |
193
|
|
|
|
|
|
|
included in the file. |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
=cut |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
1; |