line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/perl |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
package PDL::Dims; |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
=head1 NAME |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
PDL::Dims - Enhancement to PDL by using named dimensions. |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
If PDL is about arrays, PDL::Dims turns them into hashes |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=cut |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
our $VERSION = '0.011'; |
15
|
|
|
|
|
|
|
|
16
|
1
|
|
|
1
|
|
17772
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
41
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
19
|
1
|
|
|
1
|
|
503
|
use parent 'Exporter','PDL'; |
|
1
|
|
|
|
|
377
|
|
|
1
|
|
|
|
|
6
|
|
20
|
|
|
|
|
|
|
#use base 'PDL'; |
21
|
|
|
|
|
|
|
#@PDL::Dims::ISA=qw/PDL Exporter/; |
22
|
|
|
|
|
|
|
use Scalar::Util qw/looks_like_number/; |
23
|
|
|
|
|
|
|
use PDL::NiceSlice; |
24
|
|
|
|
|
|
|
use Storable qw(dclone); |
25
|
|
|
|
|
|
|
use PDL; |
26
|
|
|
|
|
|
|
#use PDL::Lite; |
27
|
|
|
|
|
|
|
#use PDL::Ufunc qw(min max); |
28
|
|
|
|
|
|
|
#use PDL::Core qw(approx sclr); |
29
|
|
|
|
|
|
|
#no PDL::IO::Pic; |
30
|
|
|
|
|
|
|
use 5.012; |
31
|
|
|
|
|
|
|
our @EXPORT=qw(diminfo dnumeric vals spacing is_sane i2pos pos2i initdim idx didx dimsize dimname sln rmdim nagg dinc dmin dmax nreduce nop ncop copy_dim active_slice nsqueeze); |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
my @keys = qw(pos size num spacing unit min max inc vals index dummy); |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub _fix_old { # This fixes data stored from version <=0.002 |
37
|
|
|
|
|
|
|
my $self=shift; |
38
|
|
|
|
|
|
|
for my $d (@{dimname($self)}) { |
39
|
|
|
|
|
|
|
for my $p (keys %{$self->hdr->{$d}}) { |
40
|
|
|
|
|
|
|
if ((my $n=$p) =~s/^dim//) { |
41
|
|
|
|
|
|
|
#say "$p -> $n ", $self->hdr->{$d}->{$p}; |
42
|
|
|
|
|
|
|
$self->hdr->{$d}->{$n}=$self->hdr->{$d}->{$p}; |
43
|
|
|
|
|
|
|
#say "$p -> $n ", $self->hdr->{$d}->{$n}; |
44
|
|
|
|
|
|
|
delete $self->hdr->{$d}->{$p}; |
45
|
|
|
|
|
|
|
#say "$p -> $n ", $self->hdr->{$d}->{$n}; |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
dnumeric($self,$d,1) unless ($d eq 'channel'); |
49
|
|
|
|
|
|
|
dimsize($self,$d,$self->dim(didx($self,$d))); |
50
|
|
|
|
|
|
|
#say "$d size: ",dimsize($self,$d),' ',dmin($self,$d),' min; max: ',dmax($self,$d); |
51
|
|
|
|
|
|
|
#say "spacing ",spacing($self,$d); |
52
|
|
|
|
|
|
|
spacing($self,$d,1) if ($d eq qw/x y z t/); |
53
|
|
|
|
|
|
|
if ($d eq 'channel') { |
54
|
|
|
|
|
|
|
#say "Channel"; |
55
|
|
|
|
|
|
|
#say dimsize($self,$d); |
56
|
|
|
|
|
|
|
spacing($self,$d,0); |
57
|
|
|
|
|
|
|
dnumeric($self,$d,0); |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
if ($d eq 'channel' and dimsize($self,$d)==1) { |
60
|
|
|
|
|
|
|
vals($self,$d,['combined',]); |
61
|
|
|
|
|
|
|
#say "channel: ",@{vals($self,$d)}; |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
if (!dimsize($self,$d)) { |
64
|
|
|
|
|
|
|
#say "$d has size 1!"; |
65
|
|
|
|
|
|
|
dmax($self,$d,dmin($self,$d)); |
66
|
|
|
|
|
|
|
dinc($self,$d,0); |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
if (spacing($self,$d) and $d ne 't') { |
69
|
|
|
|
|
|
|
dinc($self,$d,(dmax($self,$d)-dmin($self,$d))/((dimsize($self,$d)-1)||1)) ; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
if ($d eq 't') { |
72
|
|
|
|
|
|
|
#say "t: inc ",dinc($self,$d); |
73
|
|
|
|
|
|
|
dmax($self,$d,dmin($self,$d)+(dimsize($self,$d)-1)*dinc($self,$d)); |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
#say "$d size: ",dimsize($self,$d),' ',dmin($self,$d),' min; inc: ',dinc($self,$d),' inc - max ',dmax($self,$d); |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
# returns a list of all dims for one parameter -- intended as an auxillary for internal use only |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
sub _dimpar { |
81
|
|
|
|
|
|
|
my $self=shift; |
82
|
|
|
|
|
|
|
my $p=shift; # par |
83
|
|
|
|
|
|
|
#say "All of ".%{$self->hdr}.", $p"; |
84
|
|
|
|
|
|
|
return unless $p; |
85
|
|
|
|
|
|
|
my @s; |
86
|
|
|
|
|
|
|
for my $i (@{dimname($self)}) { |
87
|
|
|
|
|
|
|
#say "name $i $p"; |
88
|
|
|
|
|
|
|
#next unless chomp $i; |
89
|
|
|
|
|
|
|
#say "name $i: ",$self->hdr->{$i}->{$p}; |
90
|
|
|
|
|
|
|
barf ("Unknown dim $i") unless (ref ($self->hdr->{$i}) eq 'HASH'); |
91
|
|
|
|
|
|
|
push @s,$self->hdr->{$i}->{$p}; |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
#say "Dims ".@{dimname($self)}."Par $p: @s"; |
94
|
|
|
|
|
|
|
return @s; |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
sub dnumeric { |
98
|
|
|
|
|
|
|
my $self=shift; |
99
|
|
|
|
|
|
|
my $d=shift; |
100
|
|
|
|
|
|
|
my $v=shift; |
101
|
|
|
|
|
|
|
return [_dimpar($self,'num')] if (!$d and wantarray); |
102
|
|
|
|
|
|
|
return [_dimpar($self,'num')] unless ($d); |
103
|
|
|
|
|
|
|
return undef unless (ref ($self->hdr->{$d}) eq 'HASH'); |
104
|
|
|
|
|
|
|
#warn "numeric? $d $v.", $self->hdr->{num} ;#if ($d eq 'a' and $v==1); |
105
|
|
|
|
|
|
|
#barf "numeric? $d $v!", $self->hdr->{num} if ($d eq 'a' and $v==1); |
106
|
|
|
|
|
|
|
if (defined $v) { |
107
|
|
|
|
|
|
|
#warn "numeric value? $d $v.", $self->hdr->{num} ;#if ($d eq 'a' and $v==1); |
108
|
|
|
|
|
|
|
$self->hdr->{$d}->{num}=$v; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
if ($self->hdr->{$d}->{num}) { |
111
|
|
|
|
|
|
|
#warn "numeric: $d $v" if ($v and $d eq 'a'); |
112
|
|
|
|
|
|
|
#barf "Channel is not numeric ! " if ($d eq 'channel'); |
113
|
|
|
|
|
|
|
# for (vals($self,$d)) {looks_like_number $_ || barf "$d has non-numeric values";} |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
return $self->hdr->{$d}->{num}; |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
sub spacing { |
119
|
|
|
|
|
|
|
my $self=shift; |
120
|
|
|
|
|
|
|
my $d=shift; # dimname |
121
|
|
|
|
|
|
|
my $v=shift; # value |
122
|
|
|
|
|
|
|
return [_dimpar($self,'spacing')] if (!$d and wantarray); |
123
|
|
|
|
|
|
|
return [_dimpar($self,'spacing')] unless ($d) ; |
124
|
|
|
|
|
|
|
return undef unless (ref ($self->hdr->{$d}) eq 'HASH'); |
125
|
|
|
|
|
|
|
if (defined $v) { |
126
|
|
|
|
|
|
|
int $v; |
127
|
|
|
|
|
|
|
$self->hdr->{$d}->{spacing}=$v; |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
return $self->hdr->{$d}->{spacing}; #, $r{$d}; |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
sub diminfo { |
133
|
|
|
|
|
|
|
my $self=shift; |
134
|
|
|
|
|
|
|
my $str; |
135
|
|
|
|
|
|
|
for my $n (dimname ($self)) { |
136
|
|
|
|
|
|
|
$str.="$n\[".didx($self,$n)."]=>".dimsize($self,$n).", "; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
$str.=$self->info; |
139
|
|
|
|
|
|
|
return $str; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
sub is_sane { |
142
|
|
|
|
|
|
|
my $self=shift; |
143
|
|
|
|
|
|
|
return "piddle" unless $self->isa('PDL'); |
144
|
|
|
|
|
|
|
return "name" unless dimname($self); |
145
|
|
|
|
|
|
|
return "ndims" unless ($self->ndims==1+$#{dimname($self)}); |
146
|
|
|
|
|
|
|
#say "global done."; |
147
|
|
|
|
|
|
|
for my $n (@{dimname($self)}) { |
148
|
|
|
|
|
|
|
next unless (chomp $n); |
149
|
|
|
|
|
|
|
# say "Checking dim $n for $self->hdr->{self}"; |
150
|
|
|
|
|
|
|
return "size ".$n unless ($self->dim(didx($self,$n))==dimsize($self,$n)); |
151
|
|
|
|
|
|
|
return "index " .$n unless (idx($self,$n)
|
152
|
|
|
|
|
|
|
return "index " .$n unless (idx($self,$n)>=0); |
153
|
|
|
|
|
|
|
# say "size and index"; |
154
|
|
|
|
|
|
|
if (spacing($self,$n)) { |
155
|
|
|
|
|
|
|
# say "inc"; |
156
|
|
|
|
|
|
|
return "inc ".$n unless dinc($self,$n); |
157
|
|
|
|
|
|
|
# say dmax($self,$n), dmin($self,$n)+dinc($self,$n)*(dimsize($self,$n)-1); |
158
|
|
|
|
|
|
|
# say "minmax $n"; |
159
|
|
|
|
|
|
|
return "minmax ".$n unless (approx(dmax($self,$n)), |
160
|
|
|
|
|
|
|
dmin($self,$n)+dinc($self,$n)*(dimsize($self,$n)-1)); |
161
|
|
|
|
|
|
|
# say "pos: $n"; |
162
|
|
|
|
|
|
|
# say (dmax($self,$n),i2pos($self,$n,pos2i($self,$n,dmax($self,$n)))); |
163
|
|
|
|
|
|
|
# say "Index: ",(pos2i($self,$n,dmax($self,$n))); |
164
|
|
|
|
|
|
|
# say "Numeric: $n" unless (dnumeric( $self,$n)); |
165
|
|
|
|
|
|
|
return "pos ".$n unless (approx(dmax($self,$n),i2pos($self,$n,pos2i($self,$n,dmax($self,$n))))); |
166
|
|
|
|
|
|
|
} else { |
167
|
|
|
|
|
|
|
# say "vals $n"; |
168
|
|
|
|
|
|
|
return "vals ".$n unless (dimsize($self,$n)==$#{vals($self,$n)}+1); |
169
|
|
|
|
|
|
|
# say "val_pos $n"; |
170
|
|
|
|
|
|
|
# say "Numeric: $n" unless (eval {dnumeric( $self,$n)}); |
171
|
|
|
|
|
|
|
#say i2pos($self,$n,dimsize($self,$n)-1); |
172
|
|
|
|
|
|
|
#say pos2i($self,$n,i2pos($self,$n,dimsize($self,$n)-1))," 1"; |
173
|
|
|
|
|
|
|
#say (dimsize($self,$n) , 1+ |
174
|
|
|
|
|
|
|
#pos2i($self,$n,i2pos($self,$n,dimsize($self,$n)-1))); |
175
|
|
|
|
|
|
|
return "pos ".$n unless (dimsize($self,$n)-1 == @{ |
176
|
|
|
|
|
|
|
pos2i($self,$n,i2pos($self,$n,dimsize($self,$n)-1))}-[-1]); |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
return 0; |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
sub dimsize { # sets size for a dim |
182
|
|
|
|
|
|
|
my $self=shift; |
183
|
|
|
|
|
|
|
my $d=shift; # dimname |
184
|
|
|
|
|
|
|
my $v=shift; # value |
185
|
|
|
|
|
|
|
#say "return all ", _dimpar($self,'size') if (!$d and wantarray); |
186
|
|
|
|
|
|
|
return _dimpar($self,'size') if (!$d and wantarray); |
187
|
|
|
|
|
|
|
return #([values %{$self->hdr->{dimsize}}] |
188
|
|
|
|
|
|
|
# ,[keys %{$self->hdr->{dimsize}}], |
189
|
|
|
|
|
|
|
#) |
190
|
|
|
|
|
|
|
[_dimpar($self,'size')] |
191
|
|
|
|
|
|
|
unless ($d) ; |
192
|
|
|
|
|
|
|
#barf ("Unknown dim $d") unless (ref ($self->hdr->{$d}) eq 'HASH'); |
193
|
|
|
|
|
|
|
return undef unless (ref ($self->hdr->{$d}) eq 'HASH'); |
194
|
|
|
|
|
|
|
#say "size $d $v",$self->info; |
195
|
|
|
|
|
|
|
if (defined $v) { |
196
|
|
|
|
|
|
|
return undef unless (ref ($self->hdr->{$d}) eq 'HASH'); |
197
|
|
|
|
|
|
|
int $v; |
198
|
|
|
|
|
|
|
$self->hdr->{$d}->{size}=$v; |
199
|
|
|
|
|
|
|
idx($self,$d,$v-1) if (idx($self,$d)>=$v-1); |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
return $self->hdr->{$d}->{size}; #, $r{$d}; |
202
|
|
|
|
|
|
|
}# get/set name of a dim by number |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
sub dimname { |
205
|
|
|
|
|
|
|
my $self=shift; |
206
|
|
|
|
|
|
|
my $d=shift; # dim number |
207
|
|
|
|
|
|
|
my $n=shift; # new name |
208
|
|
|
|
|
|
|
barf "Not a piddle!" unless $self->isa('PDL'); |
209
|
|
|
|
|
|
|
#say keys %{$self->hdr} unless defined $d; |
210
|
|
|
|
|
|
|
return @{$self->hdr->{dimnames}} if (! defined ($d) and wantarray); |
211
|
|
|
|
|
|
|
return $self->hdr->{dimnames} unless defined $d; |
212
|
|
|
|
|
|
|
#barf "Unknown dim $d" unless (ref $self->hdr->{dimnames} eq 'HASH'); |
213
|
|
|
|
|
|
|
$self->hdr->{dimnames}->[$d]=$n if $n; |
214
|
|
|
|
|
|
|
return $self->hdr->{dimnames}->[$d]; |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
sub dinc { |
218
|
|
|
|
|
|
|
my $self=shift; |
219
|
|
|
|
|
|
|
my $d=shift; # dimname |
220
|
|
|
|
|
|
|
my $v=shift; # max |
221
|
|
|
|
|
|
|
return _dimpar($self,'inc') if (!$d and wantarray); |
222
|
|
|
|
|
|
|
return [_dimpar($self,'inc')] unless $d; |
223
|
|
|
|
|
|
|
if (defined $v) { |
224
|
|
|
|
|
|
|
#say "dinc: $d $v"; |
225
|
|
|
|
|
|
|
return undef unless (ref $self->hdr->{$d} eq 'HASH'); |
226
|
|
|
|
|
|
|
$self->hdr->{$d}->{inc}=$v; |
227
|
|
|
|
|
|
|
spacing ($self,$d,1); |
228
|
|
|
|
|
|
|
dnumeric ($self,$d,1); |
229
|
|
|
|
|
|
|
$self->hdr->{$d}->{vals}=undef; # |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
return $self->hdr->{$d}->{inc}; #, $r{$d}; |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
sub dmax { |
235
|
|
|
|
|
|
|
my $self=shift; |
236
|
|
|
|
|
|
|
my $d=shift; # dimname |
237
|
|
|
|
|
|
|
my $v=shift; # max |
238
|
|
|
|
|
|
|
return _dimpar($self,'max') if (!$d and wantarray); |
239
|
|
|
|
|
|
|
return [_dimpar($self,'max')] unless $d; |
240
|
|
|
|
|
|
|
#say "$d ".$self->hdr; |
241
|
|
|
|
|
|
|
return undef if (defined $v and ref $self->hdr->{$d} ne 'HASH'); |
242
|
|
|
|
|
|
|
$self->hdr->{$d}->{max}=$v if defined ($v); |
243
|
|
|
|
|
|
|
return $self->hdr->{$d}->{max}; #, $r{$d}; |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
sub dmin { |
247
|
|
|
|
|
|
|
my $self=shift; |
248
|
|
|
|
|
|
|
my $d=shift; # dimname |
249
|
|
|
|
|
|
|
my $v=shift; # min |
250
|
|
|
|
|
|
|
return _dimpar($self,'min') if (!$d and wantarray); |
251
|
|
|
|
|
|
|
return [_dimpar($self,'min')] unless $d; |
252
|
|
|
|
|
|
|
return undef if (defined $v and ref $self->hdr->{$d} ne 'HASH'); |
253
|
|
|
|
|
|
|
#barf "Unknown dim $d" unless (ref $self->hdr->{$d} eq 'HASH'); |
254
|
|
|
|
|
|
|
$self->hdr->{$d}->{min}=$v if defined ($v); |
255
|
|
|
|
|
|
|
return $self->hdr->{$d}->{min}; #, $r{$d}; |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
sub didx { # set/get index - complementary to dimname |
260
|
|
|
|
|
|
|
my $self=shift; |
261
|
|
|
|
|
|
|
my $d=shift; # dimname |
262
|
|
|
|
|
|
|
return _dimpar($self,'pos') if (!$d and wantarray); |
263
|
|
|
|
|
|
|
return [_dimpar($self,'pos')] unless $d; |
264
|
|
|
|
|
|
|
if (ref $d eq 'ARRAY') { |
265
|
|
|
|
|
|
|
@$d; |
266
|
|
|
|
|
|
|
} else { |
267
|
|
|
|
|
|
|
my $n=shift; # new position |
268
|
|
|
|
|
|
|
return if (ref $self->hdr->{$d} ne 'HASH'); |
269
|
|
|
|
|
|
|
barf "Unknown dim $d" unless (ref $self->hdr->{$d} eq 'HASH'); |
270
|
|
|
|
|
|
|
$self->hdr->{$d}->{pos}=$n if defined $n; |
271
|
|
|
|
|
|
|
#say "type $self idx $d ".$self->hdr->{$d}->{pos}; |
272
|
|
|
|
|
|
|
return $self->hdr->{$d}->{pos}; |
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
sub initdim { |
277
|
|
|
|
|
|
|
my $self=shift; |
278
|
|
|
|
|
|
|
my $d=shift || return ; # name |
279
|
|
|
|
|
|
|
#say "Init dim $d ..."; |
280
|
|
|
|
|
|
|
$self->hdr; #ensure the header is intialised. |
281
|
|
|
|
|
|
|
my %p=@_; |
282
|
|
|
|
|
|
|
for my $k (keys %p) { |
283
|
|
|
|
|
|
|
barf "Unkown parameter $k $p{$k}" unless ($k ~~ @keys); |
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
#say "header: ",(keys %{$self->gethdr},); |
286
|
|
|
|
|
|
|
if (ref $self->hdr->{$d} eq 'HASH'){ # dimname exists and is a hash |
287
|
|
|
|
|
|
|
my $n= didx($self,$d); |
288
|
|
|
|
|
|
|
if (defined $n) { |
289
|
|
|
|
|
|
|
$p{pos}=$n; #just to make sure |
290
|
|
|
|
|
|
|
barf "$d exists at pos $n! (".%{$self->hdr->{$d}}."\n"; |
291
|
|
|
|
|
|
|
} else { |
292
|
|
|
|
|
|
|
#say (keys (%{$self->hdr->{$d}}),'-keys'); |
293
|
|
|
|
|
|
|
warn "$d is defined but not a dim! ",%{$self->hdr->{$d}}; |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
} else { |
296
|
|
|
|
|
|
|
$self->hdr->{ndims}=0 unless ($self->hdr->{ndims}); |
297
|
|
|
|
|
|
|
#say keys $self->hdr->{$d}; |
298
|
|
|
|
|
|
|
#say "pars: ",%p; |
299
|
|
|
|
|
|
|
$self->hdr->{$d}=\%p; |
300
|
|
|
|
|
|
|
#say "Creating dim $d at pos. $p{pos}; Ndims ".$self->hdr->{ndims}; |
301
|
|
|
|
|
|
|
if ((!defined $p{pos}) or ($p{pos}>$self->hdr->{ndims})) { |
302
|
|
|
|
|
|
|
$p{pos}=$self->hdr->{ndims}; |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
if ($p{pos}<$self->hdr->{ndims}) { |
305
|
|
|
|
|
|
|
for (my $i=$self->hdr->{ndims}-1;$i>=$p{pos};$i--) { |
306
|
|
|
|
|
|
|
#say dimname($self,$i)," initdim at pos $p{pos} ndims: ",$self->hdr->{ndims}, " $i"; |
307
|
|
|
|
|
|
|
dimname($self,$i+1,dimname($self,$i-0)); # shift the position up! |
308
|
|
|
|
|
|
|
didx($self,dimname($self,$i),$i+1); |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
didx ($self,$d,$p{pos}); |
312
|
|
|
|
|
|
|
$self->hdr->{$d}=\%p; |
313
|
|
|
|
|
|
|
dimname ($self,$p{pos},$d); |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
$p{size}=$self->dim($p{pos}) unless ($p{size}); |
316
|
|
|
|
|
|
|
warn "initdim, dim $d: Size ($p{size}) does not mnatch piddle dim at pos $p{pos} ",$self->dim($p{pos}) |
317
|
|
|
|
|
|
|
unless ($p{size}==$self->dim($p{pos})); |
318
|
|
|
|
|
|
|
dimsize ($self,$d,($p{size}||1)); |
319
|
|
|
|
|
|
|
spacing($self,$d,1) unless defined spacing($self,$d); |
320
|
|
|
|
|
|
|
#say "P: ",%p; |
321
|
|
|
|
|
|
|
#say "Dim $d: ",ref $p{vals},"; ",%p; |
322
|
|
|
|
|
|
|
#say "Dim $d: ",@{$p{vals}} if (ref $p{vals}); #,"; ",@{$p{vals}}; |
323
|
|
|
|
|
|
|
#say "Set values $d",ref($p{vals}); |
324
|
|
|
|
|
|
|
if (ref ($p{vals}) eq 'ARRAY') {# or (dimsize($self,$d) == 1 and defined $p{val})) {# and !spacing($self,$d)) { |
325
|
|
|
|
|
|
|
#say "Set values $d"; |
326
|
|
|
|
|
|
|
my @v=@{$p{vals}}; |
327
|
|
|
|
|
|
|
#say "Values: @v"; |
328
|
|
|
|
|
|
|
#barf "Wrong size of values list! $d " unless ($#{$p{vals}}==dimsize($self,$d)-1); |
329
|
|
|
|
|
|
|
vals ($self,$d,$p{vals}); |
330
|
|
|
|
|
|
|
#warn "numeric $d" ,dnumeric($self,$d);#,($p{num}||1)); |
331
|
|
|
|
|
|
|
#dmin($self,$d,vals($self,$d,0)); |
332
|
|
|
|
|
|
|
#dmax($self,$d,vals($self,$d,dimsize($self,$d))); |
333
|
|
|
|
|
|
|
} |
334
|
|
|
|
|
|
|
unless (spacing($self,$d)){ |
335
|
|
|
|
|
|
|
#barf "$d !"; |
336
|
|
|
|
|
|
|
} else { |
337
|
|
|
|
|
|
|
#say "equal spaced, numeric values $d"; |
338
|
|
|
|
|
|
|
$p{num}=1 unless defined $p{num}; |
339
|
|
|
|
|
|
|
if ($p{inc} and $p{max}) { |
340
|
|
|
|
|
|
|
barf ("Increment and maximum don't fit! ($d min $p{min} max $p{max} inc $p{inc} " |
341
|
|
|
|
|
|
|
.dimsize($self,$d)) |
342
|
|
|
|
|
|
|
unless (approx(pdl ($p{max}-$p{min}) , pdl((dimsize($self,$d)-1)*$p{inc} ))); |
343
|
|
|
|
|
|
|
} elsif ($p{inc}) { |
344
|
|
|
|
|
|
|
$p{max}=$p{inc}*dimsize($self,$d)+$p{min}; |
345
|
|
|
|
|
|
|
} elsif ($p{max}) { |
346
|
|
|
|
|
|
|
$p{inc}=($p{max}-$p{min})/((dimsize($self,$d)-1)||1); |
347
|
|
|
|
|
|
|
} else { |
348
|
|
|
|
|
|
|
$p{max}=dimsize($self,$d)-1; |
349
|
|
|
|
|
|
|
$p{inc}=1; |
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
dmin ($self,$d,$p{min}||0); |
352
|
|
|
|
|
|
|
dinc ($self,$d,$p{inc}); |
353
|
|
|
|
|
|
|
dmax ($self,$d,$p{max}); #||(dimsize($self,$d)-1)*$p{inc}; |
354
|
|
|
|
|
|
|
spacing($self,$d,1); |
355
|
|
|
|
|
|
|
dnumeric($self,$d,); |
356
|
|
|
|
|
|
|
} |
357
|
|
|
|
|
|
|
$self->hdr->{ndims}++; |
358
|
|
|
|
|
|
|
#say "initdim: ndims ",$self->hdr->{ndims} , diminfo $self; |
359
|
|
|
|
|
|
|
idx($self,$d,($p{index}||0));#dmin($self,$d))); |
360
|
|
|
|
|
|
|
my $res=$self; |
361
|
|
|
|
|
|
|
if ($p{dummy} ) { # insert dummy dimension of size size at pos. |
362
|
|
|
|
|
|
|
#say "dummy: $p{pos} $p{size}"; |
363
|
|
|
|
|
|
|
$res=$res->dummy($p{pos},$p{size}); |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
$res->sethdr($self->hdr_copy); |
366
|
|
|
|
|
|
|
#say diminfo ($res); |
367
|
|
|
|
|
|
|
return $res; |
368
|
|
|
|
|
|
|
#say "Done. ($d)"; |
369
|
|
|
|
|
|
|
} |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
sub copy_dim { |
372
|
|
|
|
|
|
|
my $old=shift; |
373
|
|
|
|
|
|
|
my $new=shift; |
374
|
|
|
|
|
|
|
my $dim=shift; |
375
|
|
|
|
|
|
|
unless (exists $old->hdr->{$dim}) { |
376
|
|
|
|
|
|
|
my $err=is_sane($new); |
377
|
|
|
|
|
|
|
warn "copy_dims: inconsistent dims (input), $err ! ",diminfo $old if ($err); |
378
|
|
|
|
|
|
|
for my $dim (dimname($old),){ |
379
|
|
|
|
|
|
|
my $d=dclone($old->hdr->{$dim}); |
380
|
|
|
|
|
|
|
initdim($new,$dim,%$d); |
381
|
|
|
|
|
|
|
} |
382
|
|
|
|
|
|
|
$err=is_sane($new); |
383
|
|
|
|
|
|
|
warn "copy_dims: inconsistent dims (new), $err ! ",diminfo $new if ($err); |
384
|
|
|
|
|
|
|
} else { |
385
|
|
|
|
|
|
|
my $d=dclone($old->hdr->{$dim}); |
386
|
|
|
|
|
|
|
$$d{pos}=shift; |
387
|
|
|
|
|
|
|
initdim($new,$dim,%$d); |
388
|
|
|
|
|
|
|
} |
389
|
|
|
|
|
|
|
} |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
sub rmdim { |
392
|
|
|
|
|
|
|
my $self=shift; |
393
|
|
|
|
|
|
|
my $d=shift; |
394
|
|
|
|
|
|
|
return unless defined $d; |
395
|
|
|
|
|
|
|
#say "removing $d ".didx($self,$d);; |
396
|
|
|
|
|
|
|
my $idx=didx($self,$d); |
397
|
|
|
|
|
|
|
#say @{$self->hdr->{dimnames}},didx($self,$d); # cut out the array |
398
|
|
|
|
|
|
|
splice @{$self->hdr->{dimnames}},$idx,1; # cut out the array |
399
|
|
|
|
|
|
|
#say @{$self->hdr->{dimnames}},didx($self,$d); # cut out the array |
400
|
|
|
|
|
|
|
for my $i ($idx..$self->hdr->{ndims}-1) { |
401
|
|
|
|
|
|
|
didx($self,dimname($self,$i),$i); #update position of following dims |
402
|
|
|
|
|
|
|
} |
403
|
|
|
|
|
|
|
delete $self->hdr->{$d}; |
404
|
|
|
|
|
|
|
barf "This should be undefined! ",$self->hdr->{$d} if defined ($self->hdr->{$d}); |
405
|
|
|
|
|
|
|
#barf "This should be undefined! ",$self->hdr->{dimnamesd} if defined ($self->hdr->{$d}); |
406
|
|
|
|
|
|
|
$self->hdr->{ndims}--; |
407
|
|
|
|
|
|
|
#say "rmdim: ",diminfo $self; |
408
|
|
|
|
|
|
|
} |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
sub unit { |
411
|
|
|
|
|
|
|
#my $self=shift; |
412
|
|
|
|
|
|
|
my $self=shift; |
413
|
|
|
|
|
|
|
die "I don't have data to work on (unit)" unless defined $self->hdr; |
414
|
|
|
|
|
|
|
#say "$self type array "; |
415
|
|
|
|
|
|
|
my $index=shift; |
416
|
|
|
|
|
|
|
return _dimpar($self,'unit') if (! defined ($index) and wantarray); |
417
|
|
|
|
|
|
|
return [_dimpar($self,'unit')] unless defined $index; |
418
|
|
|
|
|
|
|
#barf ("Unknown dim $index") |
419
|
|
|
|
|
|
|
return undef unless (ref ($self->hdr->{$index}) eq 'HASH'); |
420
|
|
|
|
|
|
|
if (defined (my $v=shift)) { |
421
|
|
|
|
|
|
|
$self->hdr->{$index}->{unit}=$v ; |
422
|
|
|
|
|
|
|
} |
423
|
|
|
|
|
|
|
return $self->hdr->{$index}->{unit}; |
424
|
|
|
|
|
|
|
} |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
sub idx { |
427
|
|
|
|
|
|
|
#my $self=shift; |
428
|
|
|
|
|
|
|
my $self=shift; |
429
|
|
|
|
|
|
|
barf "I don't have data to work on (idx)" unless defined $self->hdr; |
430
|
|
|
|
|
|
|
#say "$self type array "; |
431
|
|
|
|
|
|
|
my $index=shift; |
432
|
|
|
|
|
|
|
return _dimpar($self,'index') if (! defined ($index) and wantarray); |
433
|
|
|
|
|
|
|
return [_dimpar($self,'index')] unless defined $index; |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
return undef unless (ref ($self->hdr->{$index}) eq 'HASH'); |
436
|
|
|
|
|
|
|
if (defined (my $v=shift)) { |
437
|
|
|
|
|
|
|
$v<0? 0: $v; |
438
|
|
|
|
|
|
|
$v>=dimsize($self,$index)? dimsize($self,$index)-1 : $v; |
439
|
|
|
|
|
|
|
$self->hdr->{$index}->{index}=int $v ; |
440
|
|
|
|
|
|
|
} |
441
|
|
|
|
|
|
|
return $self->hdr->{$index}->{index}; |
442
|
|
|
|
|
|
|
} |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
sub vals { #individual values of dims -- like the position along an axis in world coords., echo times |
445
|
|
|
|
|
|
|
my $self=shift; |
446
|
|
|
|
|
|
|
my $d=shift; #dim |
447
|
|
|
|
|
|
|
return unless $d; |
448
|
|
|
|
|
|
|
$self->hdr->{$d}->{vals}=[] unless defined $self->hdr->{$d}->{vals}; |
449
|
|
|
|
|
|
|
#say "Vals: $d ",@{$self->hdr->{$d}->{vals}}; |
450
|
|
|
|
|
|
|
my $i=shift; #index or array ref |
451
|
|
|
|
|
|
|
if (defined $i) { # set the whole array or access individual points |
452
|
|
|
|
|
|
|
#say "vals: $d $i"; |
453
|
|
|
|
|
|
|
if (ref $i eq 'ARRAY' and dimsize($self,$d) == $#{$i}+1) { #ref to values array |
454
|
|
|
|
|
|
|
barf "Array size does not match dimsize" unless ($#$i==dimsize($self,$d)-1); |
455
|
|
|
|
|
|
|
$self->hdr->{$d}->{vals}=$i ; |
456
|
|
|
|
|
|
|
spacing ($self,$d,0); #->hdr->{$d}->{spacing}=0; |
457
|
|
|
|
|
|
|
$self->hdr->{$d}->{inc}=undef; |
458
|
|
|
|
|
|
|
for (vals($self,$d)) {looks_like_number $_ || dnumeric($self,$d,0);} |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
if (dnumeric($self,$d)){ |
461
|
|
|
|
|
|
|
barf "not numeric @$i" if ($$i[0] eq 'a'); |
462
|
|
|
|
|
|
|
dmin($self,$d,min(pdl $i)); |
463
|
|
|
|
|
|
|
dmax($self,$d,max(pdl $i)); |
464
|
|
|
|
|
|
|
} else { |
465
|
|
|
|
|
|
|
$self->hdr->{$d}->{max}=undef; |
466
|
|
|
|
|
|
|
$self->hdr->{$d}->{min}=undef; |
467
|
|
|
|
|
|
|
} |
468
|
|
|
|
|
|
|
#say "$d: setting vals @$i"; |
469
|
|
|
|
|
|
|
} else { #individual values |
470
|
|
|
|
|
|
|
my $v=shift; #value |
471
|
|
|
|
|
|
|
if ( defined $v) { |
472
|
|
|
|
|
|
|
$self->hdr->{$d}->{vals}->[$i]=$v ; |
473
|
|
|
|
|
|
|
spacing ($self,$d,0); #->hdr->{$d}->{spacing}=0; |
474
|
|
|
|
|
|
|
$self->hdr->{$d}->{inc}=undef; |
475
|
|
|
|
|
|
|
for (vals($self,$d)) {looks_like_number $_ || dnumeric($self,$d,0);} |
476
|
|
|
|
|
|
|
if (dnumeric($self,$d)){ |
477
|
|
|
|
|
|
|
#barf "not numeric $i" if ($i eq 'a'); |
478
|
|
|
|
|
|
|
dmin($self,$d,min(pdl $i)); |
479
|
|
|
|
|
|
|
dmax($self,$d,max(pdl $i)); |
480
|
|
|
|
|
|
|
} else { |
481
|
|
|
|
|
|
|
$self->hdr->{$d}->{max}=undef; |
482
|
|
|
|
|
|
|
$self->hdr->{$d}->{min}=undef; |
483
|
|
|
|
|
|
|
} |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
if (spacing($self,$d)) { |
486
|
|
|
|
|
|
|
return dmin($self,$d)+$i*dinc($self,$d); |
487
|
|
|
|
|
|
|
} |
488
|
|
|
|
|
|
|
return $self->hdr->{$d}->{vals}->[$i]; |
489
|
|
|
|
|
|
|
} |
490
|
|
|
|
|
|
|
#} else { |
491
|
|
|
|
|
|
|
} |
492
|
|
|
|
|
|
|
if (spacing($self,$d)) { |
493
|
|
|
|
|
|
|
return (list (dmin($self,$d)+dinc($self,$d)*sequence(dimsize($self,$d)))) if (wantarray); |
494
|
|
|
|
|
|
|
return [list (dmin($self,$d)+dinc($self,$d)*sequence(dimsize($self,$d)))] unless wantarray; |
495
|
|
|
|
|
|
|
} |
496
|
|
|
|
|
|
|
if (wantarray) { |
497
|
|
|
|
|
|
|
return @{$self->hdr->{$d}->{vals}}; |
498
|
|
|
|
|
|
|
} else { |
499
|
|
|
|
|
|
|
return $self->hdr->{$d}->{vals}; |
500
|
|
|
|
|
|
|
} |
501
|
|
|
|
|
|
|
} |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
#transformations between piddle and world coords. |
505
|
|
|
|
|
|
|
sub i2pos{ |
506
|
|
|
|
|
|
|
my $self=shift; # dataset |
507
|
|
|
|
|
|
|
my $d=shift || return; # dimname |
508
|
|
|
|
|
|
|
my $i=shift ; #value |
509
|
|
|
|
|
|
|
barf "Unknown dim $d" unless (ref $self->hdr->{$d} eq 'HASH'); |
510
|
|
|
|
|
|
|
$i=idx($self,$d) unless (defined $i); |
511
|
|
|
|
|
|
|
if (spacing($self,$d)) { |
512
|
|
|
|
|
|
|
return $i*dinc($self,$d)+dmin($self,$d); |
513
|
|
|
|
|
|
|
} else { |
514
|
|
|
|
|
|
|
return vals($self,$d,$i); |
515
|
|
|
|
|
|
|
} |
516
|
|
|
|
|
|
|
} |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
sub pos2i{ |
519
|
|
|
|
|
|
|
my $self=shift; |
520
|
|
|
|
|
|
|
(my $d=shift) || return; |
521
|
|
|
|
|
|
|
my $i=shift ; # value |
522
|
|
|
|
|
|
|
barf "Unknown dim $d" unless (ref $self->hdr->{$d} eq 'HASH'); |
523
|
|
|
|
|
|
|
if (spacing($self,$d)) { |
524
|
|
|
|
|
|
|
return rint (($i-dmin($self,$d))/dinc($self,$d)); |
525
|
|
|
|
|
|
|
} else { |
526
|
|
|
|
|
|
|
#say "searching for $i ",$self->hdr->{$d}->{num},"."; |
527
|
|
|
|
|
|
|
#say "Num? ",dnumeric($self,$d,undef); |
528
|
|
|
|
|
|
|
my @a=vals($self,$d); |
529
|
|
|
|
|
|
|
#say "Num? ",dnumeric($self,$d,undef); |
530
|
|
|
|
|
|
|
#say "searching for $i ",$self->hdr->{$d}->{num},"."; |
531
|
|
|
|
|
|
|
my (@res)=grep { $a[$_] == $i } (0 .. $#a)if (dnumeric($self,$d)); |
532
|
|
|
|
|
|
|
my (@res)=grep { $a[$_] eq $i } (0 .. $#a)unless (dnumeric($self,$d)); |
533
|
|
|
|
|
|
|
#my (@res)=grep { chomp($a[$_]) eq chomp('c') } (0 .. $#a)unless (dnumeric($self,$d)); |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
#say "pos2i: returning @res"; |
536
|
|
|
|
|
|
|
if (wantarray) { |
537
|
|
|
|
|
|
|
return @res ; |
538
|
|
|
|
|
|
|
} else { |
539
|
|
|
|
|
|
|
return $res[0]; |
540
|
|
|
|
|
|
|
} |
541
|
|
|
|
|
|
|
} |
542
|
|
|
|
|
|
|
} |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
sub nsqueeze :lvalue { |
545
|
|
|
|
|
|
|
my $self=shift; |
546
|
|
|
|
|
|
|
#my @except=@_; |
547
|
|
|
|
|
|
|
#say $ret->info; |
548
|
|
|
|
|
|
|
#ay $ret->info; |
549
|
|
|
|
|
|
|
# my $d=shift; |
550
|
|
|
|
|
|
|
my $ret; |
551
|
|
|
|
|
|
|
# if (defined didx($slf,$d) { |
552
|
|
|
|
|
|
|
# barf "size of $d is >1" if (dimsize($sslf,$d)-1); |
553
|
|
|
|
|
|
|
# $ret=sln($ret,$d=>'(0)',); |
554
|
|
|
|
|
|
|
# } |
555
|
|
|
|
|
|
|
$ret=$self->squeeze; |
556
|
|
|
|
|
|
|
$ret->sethdr($self->hdr_copy); |
557
|
|
|
|
|
|
|
for my $i (@{dimname($self)}) { |
558
|
|
|
|
|
|
|
#say "keeping $i ".dimsize($self,$i) unless (dimsize($self,$i)==1); |
559
|
|
|
|
|
|
|
#say "Removing $i ".dimsize($self,$i) if (dimsize($self,$i)==1); |
560
|
|
|
|
|
|
|
rmdim($ret,$i) if (dimsize($self,$i)==1); |
561
|
|
|
|
|
|
|
} |
562
|
|
|
|
|
|
|
#say "names: ",@{dimname($ret)}; |
563
|
|
|
|
|
|
|
#say "nsqueeze: return ",$ret->info, @{dimname($ret)}; |
564
|
|
|
|
|
|
|
return $ret; |
565
|
|
|
|
|
|
|
} |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
sub nagg { # aggregate function |
568
|
|
|
|
|
|
|
#no PDL::NiceSlice; |
569
|
|
|
|
|
|
|
my $self=shift; |
570
|
|
|
|
|
|
|
barf "nagg: not a piddle!" unless $self->isa('PDL'); |
571
|
|
|
|
|
|
|
my $op=shift; # |
572
|
|
|
|
|
|
|
my $d=shift; # dimension |
573
|
|
|
|
|
|
|
#say "nagg: ",dimname($self); |
574
|
|
|
|
|
|
|
return unless (defined didx($self,$d)); |
575
|
|
|
|
|
|
|
my $res=$self->mv(didx($self,$d),0); |
576
|
|
|
|
|
|
|
#say $res->info; |
577
|
|
|
|
|
|
|
if (eval {$res->can($op)}) { |
578
|
|
|
|
|
|
|
$res=$res->$op(@_); |
579
|
|
|
|
|
|
|
} else { |
580
|
|
|
|
|
|
|
$res=&$op($res,@_); |
581
|
|
|
|
|
|
|
} |
582
|
|
|
|
|
|
|
barf "nagg: Result undefined for $op on $d." unless defined $res; |
583
|
|
|
|
|
|
|
if (eval {$res->nelem} ) { |
584
|
|
|
|
|
|
|
barf "not an aggregate function! $op", $self->info,$res->info if ($self->ndims==$res->ndims); |
585
|
|
|
|
|
|
|
#if ($res->nelem==$self->nelem-1) |
586
|
|
|
|
|
|
|
if ($res->ndims==$self->ndims-1) |
587
|
|
|
|
|
|
|
{ |
588
|
|
|
|
|
|
|
$res->sethdr($self->hdr_copy); |
589
|
|
|
|
|
|
|
# say "nagg: $d ",dimname($self); |
590
|
|
|
|
|
|
|
rmdim ($res,$d); |
591
|
|
|
|
|
|
|
# say "nagg: $d ",dimname($res); |
592
|
|
|
|
|
|
|
} |
593
|
|
|
|
|
|
|
} |
594
|
|
|
|
|
|
|
#say "nagg: ",diminfo($res); |
595
|
|
|
|
|
|
|
return ($res); |
596
|
|
|
|
|
|
|
} |
597
|
|
|
|
|
|
|
# boundaries of dims in appropriate units (mm, s, ..) |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
sub active_slice :lvalue { # |
600
|
|
|
|
|
|
|
my $self=shift; |
601
|
|
|
|
|
|
|
my @except=@_; |
602
|
|
|
|
|
|
|
my @idx=list (rint(pdl idx($self))); |
603
|
|
|
|
|
|
|
#say "j ".idx($img{$type}); |
604
|
|
|
|
|
|
|
my @n=(dimname($self)); |
605
|
|
|
|
|
|
|
barf "active_slice: not consistent size $#n ",$self->ndims-1 unless ($#n==$self->ndims-1); |
606
|
|
|
|
|
|
|
#say "self: @n"; |
607
|
|
|
|
|
|
|
my $str; |
608
|
|
|
|
|
|
|
my @rm; |
609
|
|
|
|
|
|
|
for my $i (0.. $#n) { |
610
|
|
|
|
|
|
|
unless (/$n[$i]/ ~~ @except){ |
611
|
|
|
|
|
|
|
#say "Selecting $i $n[$i] $idx[$i]"; |
612
|
|
|
|
|
|
|
push @rm,$n[$i]; |
613
|
|
|
|
|
|
|
$str.="$idx[$i]"; |
614
|
|
|
|
|
|
|
} |
615
|
|
|
|
|
|
|
$str.=',' unless ($i==$#n); |
616
|
|
|
|
|
|
|
} |
617
|
|
|
|
|
|
|
#say "$str ",$self->info; |
618
|
|
|
|
|
|
|
my $ret=$self->slice($str); #->nsqueeze; |
619
|
|
|
|
|
|
|
$ret+=0; |
620
|
|
|
|
|
|
|
$ret->sethdr($self->hdr_copy); |
621
|
|
|
|
|
|
|
#say $ret->info; |
622
|
|
|
|
|
|
|
for my $i (0.. $#n) { |
623
|
|
|
|
|
|
|
unless (/$n[$i]/ ~~ @except){ |
624
|
|
|
|
|
|
|
#say "$i $n[$i] ",idx($self,$n[$i]); |
625
|
|
|
|
|
|
|
dimsize($ret,'channel',1); |
626
|
|
|
|
|
|
|
#say "$i $n[$i] ",idx($self,$n[$i]); |
627
|
|
|
|
|
|
|
dimsize($ret,$n[$i],1); |
628
|
|
|
|
|
|
|
my $id=idx($ret,$n[$i]); |
629
|
|
|
|
|
|
|
idx($ret,$n[$i],0); |
630
|
|
|
|
|
|
|
vals($ret,$n[$i],0,vals($self,$n[$i],$id)); |
631
|
|
|
|
|
|
|
#dmin($ret,$n[$i],vals($self,$n[$i],$id)); |
632
|
|
|
|
|
|
|
#dmax($ret,$n[$i],vals($self,$n[$i],$id)); |
633
|
|
|
|
|
|
|
} |
634
|
|
|
|
|
|
|
} |
635
|
|
|
|
|
|
|
#say "active_slice: ",$self->info," return ",@{dimname($ret)},$ret->info; |
636
|
|
|
|
|
|
|
$ret; |
637
|
|
|
|
|
|
|
} |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
sub nreduce { # analogue to PDL::Reduce, perform operation on named rather than numbered dims |
640
|
|
|
|
|
|
|
my $self=shift; |
641
|
|
|
|
|
|
|
my $op=shift; # operation - passed on to reduce |
642
|
|
|
|
|
|
|
require PDL::Reduce; |
643
|
|
|
|
|
|
|
my @list=@_; |
644
|
|
|
|
|
|
|
my @d=map {didx($self,$_)} @list; |
645
|
|
|
|
|
|
|
#say "reduce $op @d (@list)"; |
646
|
|
|
|
|
|
|
my $ret; |
647
|
|
|
|
|
|
|
$ret= $self->reduce($op,@d); |
648
|
|
|
|
|
|
|
$ret->sethdr($self->hdr_copy); |
649
|
|
|
|
|
|
|
for my $d (@list) { |
650
|
|
|
|
|
|
|
# say "removing $d"; |
651
|
|
|
|
|
|
|
rmdim ($ret,$d); |
652
|
|
|
|
|
|
|
} |
653
|
|
|
|
|
|
|
#say "nreduce: ",$ret->info, @{dimname($ret)}; |
654
|
|
|
|
|
|
|
return $ret; |
655
|
|
|
|
|
|
|
} |
656
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
sub nop { # wrapper to functions like sin, exp, rotate operating on one named dimension |
658
|
|
|
|
|
|
|
my $self=shift; |
659
|
|
|
|
|
|
|
my $op=shift; |
660
|
|
|
|
|
|
|
my $dim=shift; |
661
|
|
|
|
|
|
|
my @a=@_; |
662
|
|
|
|
|
|
|
my @n=@{dimname($self)}; |
663
|
|
|
|
|
|
|
#say "nop: (self) @n"; |
664
|
|
|
|
|
|
|
#say "nop: ",diminfo $self; |
665
|
|
|
|
|
|
|
#my $arg=shift; # suitably shaped second argument |
666
|
|
|
|
|
|
|
#say $self; |
667
|
|
|
|
|
|
|
#say "dim $dim, pos ",didx($self,$dim)," ",%{$self->hdr->{$dim}}; |
668
|
|
|
|
|
|
|
$dim=dimname($self,0) unless defined $dim; # trivial |
669
|
|
|
|
|
|
|
my $res=$self->mv(didx($self,$dim),0); |
670
|
|
|
|
|
|
|
if ($op eq 'rotate'){ |
671
|
|
|
|
|
|
|
my $s=shift; |
672
|
|
|
|
|
|
|
#say "schifing $res by $s"; |
673
|
|
|
|
|
|
|
$res=$res->rotate($s); |
674
|
|
|
|
|
|
|
#say "schifing $res by $s"; |
675
|
|
|
|
|
|
|
} else { |
676
|
|
|
|
|
|
|
#say "nop: ",diminfo $self,"op: $op, @a"; |
677
|
|
|
|
|
|
|
if (eval {$res->can($op)}) { |
678
|
|
|
|
|
|
|
$res=$res->$op(@a,); |
679
|
|
|
|
|
|
|
} else { |
680
|
|
|
|
|
|
|
$res=&$op($res,@a); |
681
|
|
|
|
|
|
|
} |
682
|
|
|
|
|
|
|
} |
683
|
|
|
|
|
|
|
$res=$res->mv(0,didx($self,$dim)); |
684
|
|
|
|
|
|
|
$res->sethdr($self->hdr_copy); |
685
|
|
|
|
|
|
|
#say "self $self, op $res, mv ",$res->mv(0,didx($res,$dim)); |
686
|
|
|
|
|
|
|
#say "nop: return", $self->info,@{dimname($res)},$res->info; |
687
|
|
|
|
|
|
|
return ($res); |
688
|
|
|
|
|
|
|
} |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
sub ncop { # named combine operation -- +*-/ ... |
691
|
|
|
|
|
|
|
my $self=shift; |
692
|
|
|
|
|
|
|
my $other=shift; |
693
|
|
|
|
|
|
|
my $op=shift; |
694
|
|
|
|
|
|
|
my $res; |
695
|
|
|
|
|
|
|
#say "ncop: start self, other, ",$self->info, $other->info; |
696
|
|
|
|
|
|
|
unless (eval {$self->isa('PDL')}) { # self is a scalar |
697
|
|
|
|
|
|
|
$self=pdl($self); |
698
|
|
|
|
|
|
|
if (eval {$self->can($op)}) { |
699
|
|
|
|
|
|
|
$res=$self->$op($other,@_); |
700
|
|
|
|
|
|
|
} else { |
701
|
|
|
|
|
|
|
$res=&$op($self,$other,@_); |
702
|
|
|
|
|
|
|
} |
703
|
|
|
|
|
|
|
$res->sethdr($other->hdr_copy) if (eval {$other->isa('PDL')});# both are scalar |
704
|
|
|
|
|
|
|
#say "ncop: other ",diminfo $other; |
705
|
|
|
|
|
|
|
barf "ncop: $op changed dimensions. Use nagg or nreduce for aggregate functions" |
706
|
|
|
|
|
|
|
unless ($other->nelem==$res->nelem); |
707
|
|
|
|
|
|
|
#say "ncop: res ",diminfo $res; |
708
|
|
|
|
|
|
|
return $res; |
709
|
|
|
|
|
|
|
} |
710
|
|
|
|
|
|
|
unless (eval {$other->isa('PDL')}) { # other is a scalar |
711
|
|
|
|
|
|
|
if (eval {$self->can($op)}) { |
712
|
|
|
|
|
|
|
$res=$self->$op($other,@_); |
713
|
|
|
|
|
|
|
} else { |
714
|
|
|
|
|
|
|
$res=&$op($self,$other,@_); |
715
|
|
|
|
|
|
|
} |
716
|
|
|
|
|
|
|
barf "ncop: $op changed dimensions. Use nagg or nreduce for aggregate functions" |
717
|
|
|
|
|
|
|
unless ($self->nelem==$res->nelem); |
718
|
|
|
|
|
|
|
$res->sethdr($self->hdr_copy); |
719
|
|
|
|
|
|
|
return $res; |
720
|
|
|
|
|
|
|
} |
721
|
|
|
|
|
|
|
#say $self->info, $other->info; |
722
|
|
|
|
|
|
|
my @d=@{dimname($self)}; |
723
|
|
|
|
|
|
|
my @e=@{dimname($other)}; |
724
|
|
|
|
|
|
|
#say "self @d other @e"; |
725
|
|
|
|
|
|
|
my $m=0; |
726
|
|
|
|
|
|
|
my @nother=(); # new order in other |
727
|
|
|
|
|
|
|
my @nself=(); # new order in self |
728
|
|
|
|
|
|
|
my @tself=(); # thread dims |
729
|
|
|
|
|
|
|
my @tother=(); |
730
|
|
|
|
|
|
|
my @aself; |
731
|
|
|
|
|
|
|
my @aother; |
732
|
|
|
|
|
|
|
my @add; |
733
|
|
|
|
|
|
|
my @co=(); |
734
|
|
|
|
|
|
|
my $i=0; |
735
|
|
|
|
|
|
|
my $j=0; |
736
|
|
|
|
|
|
|
#say "keys self",keys %{$self->hdr}; |
737
|
|
|
|
|
|
|
#say "keys other",keys %{$other->hdr}; |
738
|
|
|
|
|
|
|
for my $ds (@d) { |
739
|
|
|
|
|
|
|
my $n=didx($self,$ds); |
740
|
|
|
|
|
|
|
#push @aself,$ds; |
741
|
|
|
|
|
|
|
if (defined ($m=didx($other,$ds))) { |
742
|
|
|
|
|
|
|
push @nself,$n; |
743
|
|
|
|
|
|
|
push @nother,$m; |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
# say "$ds $m $n"; |
746
|
|
|
|
|
|
|
# say "self $ds $m $n i $i"; |
747
|
|
|
|
|
|
|
push @co,$i+0; |
748
|
|
|
|
|
|
|
#say "co sn @co"; |
749
|
|
|
|
|
|
|
$i++; |
750
|
|
|
|
|
|
|
} else { |
751
|
|
|
|
|
|
|
push @tself,$n; |
752
|
|
|
|
|
|
|
# say "$ds $m $n i: $i ", ($other->ndims+$i); |
753
|
|
|
|
|
|
|
push @co,($other->ndims+$j); |
754
|
|
|
|
|
|
|
#say "co st @co"; |
755
|
|
|
|
|
|
|
$j++; |
756
|
|
|
|
|
|
|
} |
757
|
|
|
|
|
|
|
} |
758
|
|
|
|
|
|
|
for my $ds (@e) { |
759
|
|
|
|
|
|
|
#push @other,$ds; |
760
|
|
|
|
|
|
|
my $n=didx($other,$ds); |
761
|
|
|
|
|
|
|
if (defined ($m=didx($self,$ds))) { |
762
|
|
|
|
|
|
|
1; |
763
|
|
|
|
|
|
|
} else { |
764
|
|
|
|
|
|
|
push @tother,$n; |
765
|
|
|
|
|
|
|
push @add,$ds; |
766
|
|
|
|
|
|
|
push @co,$i+0; |
767
|
|
|
|
|
|
|
#say "co ot @co"; |
768
|
|
|
|
|
|
|
#say "other $ds $m $n"; |
769
|
|
|
|
|
|
|
$i++; |
770
|
|
|
|
|
|
|
} |
771
|
|
|
|
|
|
|
} |
772
|
|
|
|
|
|
|
#say "Co: @co"; |
773
|
|
|
|
|
|
|
push @aother,@nother if defined ($nother[0]); |
774
|
|
|
|
|
|
|
push @aother,@tother if defined ($tother[0]); |
775
|
|
|
|
|
|
|
push @aself,@nself if defined ($nself[0]); |
776
|
|
|
|
|
|
|
push @aself,@tself if defined ($tself[0]); |
777
|
|
|
|
|
|
|
my $ns=$self->reorder(@aself); |
778
|
|
|
|
|
|
|
my $no=$other->reorder(@aother); |
779
|
|
|
|
|
|
|
#say "keys self",keys %{$self->hdr}; |
780
|
|
|
|
|
|
|
#say "keys other",keys %{$other->hdr}; |
781
|
|
|
|
|
|
|
for my $n (0..$#tother) { # fill in dummy dims |
782
|
|
|
|
|
|
|
$ns=$ns->dummy($#nself+1,1); |
783
|
|
|
|
|
|
|
} |
784
|
|
|
|
|
|
|
#say "ncop: @aother @aself ",$ns->info,$no->info; |
785
|
|
|
|
|
|
|
#say $self->info,$other->info; |
786
|
|
|
|
|
|
|
#### perform the operation |
787
|
|
|
|
|
|
|
if (eval {$ns->can($op)}) { |
788
|
|
|
|
|
|
|
#unshift @_,0 if ($op eq "atan2" and $_[0] != 0); |
789
|
|
|
|
|
|
|
$res=$ns->$op($no,@_); |
790
|
|
|
|
|
|
|
} else{ |
791
|
|
|
|
|
|
|
#unshift @_,0 if ($op eq "atan2");# and $_[0] != 0); |
792
|
|
|
|
|
|
|
$res=&$op($ns,$no,@_) ; |
793
|
|
|
|
|
|
|
} #else { |
794
|
|
|
|
|
|
|
# barf "This operation $op is neither a known method or function"; |
795
|
|
|
|
|
|
|
#say "ncop: ",$ns->info,$res->info; |
796
|
|
|
|
|
|
|
#barf "ncop: $op changed dimensions. Use nagg or nreduce for aggregate functions" |
797
|
|
|
|
|
|
|
#unless ($ns->nelem==$res->nelem); |
798
|
|
|
|
|
|
|
$res=$res->reorder(@co); |
799
|
|
|
|
|
|
|
#say "keys res:",keys %{$res->hdr}; |
800
|
|
|
|
|
|
|
#say %{$res->gethdr},"header."; |
801
|
|
|
|
|
|
|
$res->sethdr($self->hdr_copy); |
802
|
|
|
|
|
|
|
#say "keys self: ",%{$self->hdr}; |
803
|
|
|
|
|
|
|
#say "keys other: ",%{$other->hdr}; |
804
|
|
|
|
|
|
|
#say "keys res: ",%{$res->hdr}; |
805
|
|
|
|
|
|
|
#say "self: ",$self->hdr->{ndims}; |
806
|
|
|
|
|
|
|
#say "other ",$other->hdr->{ndims}; |
807
|
|
|
|
|
|
|
#say "res ",$res->hdr->{ndims}; |
808
|
|
|
|
|
|
|
#say "self: ",@{dimname($self)}; |
809
|
|
|
|
|
|
|
#say "other: ",@{dimname($other)}; |
810
|
|
|
|
|
|
|
#say "res: ",@{dimname($res)}; |
811
|
|
|
|
|
|
|
#$other->hdr; |
812
|
|
|
|
|
|
|
my $i=$self->ndims; |
813
|
|
|
|
|
|
|
for my $ds (0..$#add) { |
814
|
|
|
|
|
|
|
#say "copy $add[$ds]",keys %{$res->hdr}; |
815
|
|
|
|
|
|
|
#initdim($res,$add[$ds]); |
816
|
|
|
|
|
|
|
copy_dim($other,$res,$add[$ds],$i); |
817
|
|
|
|
|
|
|
# say @{dimname($res)}; |
818
|
|
|
|
|
|
|
$i++; |
819
|
|
|
|
|
|
|
} |
820
|
|
|
|
|
|
|
$res->hdr->{ndims}=$i; |
821
|
|
|
|
|
|
|
#say @{dimname($res)}; |
822
|
|
|
|
|
|
|
#say "Co @co"; |
823
|
|
|
|
|
|
|
#say "ncop: returning ... ".$res->info; |
824
|
|
|
|
|
|
|
my $err=is_sane($res); |
825
|
|
|
|
|
|
|
#barf "ncop: sanity check failed $err"; |
826
|
|
|
|
|
|
|
#say "ncop ",diminfo($res); |
827
|
|
|
|
|
|
|
return $res; |
828
|
|
|
|
|
|
|
} |
829
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
sub sln :lvalue { # returns a slice by dimnames and patterns |
831
|
|
|
|
|
|
|
my $self=shift; |
832
|
|
|
|
|
|
|
my %s=@_; # x=>'0:54:-2', t=>47, ... # |
833
|
|
|
|
|
|
|
my $str; |
834
|
|
|
|
|
|
|
#say "sln: args @_, ".$self->hdr->{dimnames},%s; |
835
|
|
|
|
|
|
|
#say ("dimnames @{$self->dimname}"); |
836
|
|
|
|
|
|
|
my @n=@{$s{names}||dimname($self)}; |
837
|
|
|
|
|
|
|
#say "dims @n"; |
838
|
|
|
|
|
|
|
for my $i (0.. $#n) { |
839
|
|
|
|
|
|
|
# say "$i $n[$i] $s{$n[$i]}"; |
840
|
|
|
|
|
|
|
$str.=$s{$n[$i]} if defined ($s{$n[$i]}); |
841
|
|
|
|
|
|
|
$str.=',' unless ($i==$#n); |
842
|
|
|
|
|
|
|
} |
843
|
|
|
|
|
|
|
#say "sln: slice string $str"; |
844
|
|
|
|
|
|
|
my $ret=$self->slice($str); |
845
|
|
|
|
|
|
|
#say $ret->info; |
846
|
|
|
|
|
|
|
$ret->sethdr($self->hdr_copy); |
847
|
|
|
|
|
|
|
for my $d (@n) { |
848
|
|
|
|
|
|
|
$str=$s{$d}; |
849
|
|
|
|
|
|
|
#say "$d $str"; |
850
|
|
|
|
|
|
|
next unless defined $str; |
851
|
|
|
|
|
|
|
chomp $str; |
852
|
|
|
|
|
|
|
if ($str =~/\(\s*\d+\s*\)/) { # e.g. (0) - reduce |
853
|
|
|
|
|
|
|
rmdim ($ret,$d); |
854
|
|
|
|
|
|
|
next; |
855
|
|
|
|
|
|
|
} |
856
|
|
|
|
|
|
|
$str=~m/([+-]?\d+)(:([+-]?\d+)(:([+-]?\d+))?)?/; |
857
|
|
|
|
|
|
|
# say "$d: 1 $1 2 $2 3 $3 4 $4 5 $5"; |
858
|
|
|
|
|
|
|
my $step=int ($5)||1; |
859
|
|
|
|
|
|
|
my $size=int abs((($3||$1)-$1)/$step)+1; # |
860
|
|
|
|
|
|
|
my $min=int min pdl($1,$3); |
861
|
|
|
|
|
|
|
my $max=int max pdl($1,$3); |
862
|
|
|
|
|
|
|
#say "min $min max $max size $size str $str vals "; |
863
|
|
|
|
|
|
|
dimsize($ret,$d,$size); |
864
|
|
|
|
|
|
|
if (spacing ($self,$d)) { |
865
|
|
|
|
|
|
|
dinc($ret,$d,$step*dinc($self,$d)); |
866
|
|
|
|
|
|
|
dmin($ret,$d,dmin($self,$d)+$step*dinc($self,$d)*($min % dimsize($self,$d))); |
867
|
|
|
|
|
|
|
dmax($ret,$d,dmin($ret,$d)+$step*dinc($self,$d)*(dimsize($ret,$d)-1)); |
868
|
|
|
|
|
|
|
#dmax($ret,$d,vals($self,$d,$max % dimsize($self,$d))); |
869
|
|
|
|
|
|
|
idx($ret,$d,sclr (pdl(idx($self,$d))->clip(0,dimsize($ret,$d)-1))); |
870
|
|
|
|
|
|
|
#say "sln: idx ($d):",idx($ret,$d); |
871
|
|
|
|
|
|
|
} else { |
872
|
|
|
|
|
|
|
#say "min $min max $max size $size str $str vals "; |
873
|
|
|
|
|
|
|
#say "vals $d: ",vals($self,$d); |
874
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
if (dnumeric($self,$d)) { |
876
|
|
|
|
|
|
|
my $v=pdl([vals($self,$d),])->($str) ; |
877
|
|
|
|
|
|
|
vals($ret,$d,[vals($self,$d,[list $v])]); |
878
|
|
|
|
|
|
|
idx($ret,$d,sclr (pdl(idx($self,$d))->clip(dmin($ret,$d),dmax($ret,$d)))); |
879
|
|
|
|
|
|
|
} else { |
880
|
|
|
|
|
|
|
my $v=sequence(dimsize($self,$d))->($str); |
881
|
|
|
|
|
|
|
my @values; |
882
|
|
|
|
|
|
|
#say "vals: $d size $size str $str" ,$v->info; |
883
|
|
|
|
|
|
|
for my $ix (0.. $v->nelem-1) { |
884
|
|
|
|
|
|
|
#say "$ix $v ",$v($ix); |
885
|
|
|
|
|
|
|
push @values,vals($self,$d,sclr ($v($ix))); |
886
|
|
|
|
|
|
|
#say "$ix $v ",$v($ix); |
887
|
|
|
|
|
|
|
} |
888
|
|
|
|
|
|
|
vals($ret,$d,[@values]); |
889
|
|
|
|
|
|
|
idx($ret,$d,0); |
890
|
|
|
|
|
|
|
#say "sln, vals ($d): ", vals($ret,$d); |
891
|
|
|
|
|
|
|
} |
892
|
|
|
|
|
|
|
#vals($res,$d,list (); |
893
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
if (dnumeric($self,$d)) { |
895
|
|
|
|
|
|
|
#dmin($ret,$d,min($v)); |
896
|
|
|
|
|
|
|
#dmax($ret,$d,min($v)); |
897
|
|
|
|
|
|
|
} |
898
|
|
|
|
|
|
|
} |
899
|
|
|
|
|
|
|
#dimsize($ret, $n, |
900
|
|
|
|
|
|
|
} |
901
|
|
|
|
|
|
|
#say "sln: return ",diminfo($ret); |
902
|
|
|
|
|
|
|
$ret; |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
} |
905
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
1; |
907
|
|
|
|
|
|
|
#BEGIN { |
908
|
|
|
|
|
|
|
# if ($_[0] eq q/-d/) { |
909
|
|
|
|
|
|
|
# require Carp; |
910
|
|
|
|
|
|
|
# $SIG{__DIE__} = sub {print Carp::longmess(@_); die;}; |
911
|
|
|
|
|
|
|
# } |
912
|
|
|
|
|
|
|
#} |
913
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
=head1 SYNOPSIS |
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
If PDL is about arrays, PDL::Dims makes them into hashes. |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
What it provides is a framework for addressing data not by numbered indices in |
920
|
|
|
|
|
|
|
numbered dimensions but by meaningful names and values. |
921
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
In PDL::Dims the user does not need to know the internal structure, i.e. order of |
923
|
|
|
|
|
|
|
dimensions. It renders calls to functions like mv, reshape, reorder, ... unnecessary. |
924
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
use PDL::Dims; |
926
|
|
|
|
|
|
|
|
927
|
|
|
|
|
|
|
my $data= .... # some way to load data |
928
|
|
|
|
|
|
|
print $data->Info; |
929
|
|
|
|
|
|
|
# PDL: Double D [256,256,20,8,30] |
930
|
|
|
|
|
|
|
# Now name the first dim x, running from -12 to 12 cm |
931
|
|
|
|
|
|
|
initdim ($data, 'x',unit=>'cm',dmin=>-12,dmax=>12); |
932
|
|
|
|
|
|
|
initdim ($data,'y',pos=>1,size=>256, # these are not necessary but you can set them explicitely |
933
|
|
|
|
|
|
|
dmin=>-12, dinc=>0.078125, unit=>'cm' # min -12 max 8 |
934
|
|
|
|
|
|
|
initdim ($data,'n',vals=[@list]); # 20 objects with names in @list |
935
|
|
|
|
|
|
|
initdim ($data,'t',spacing=>0,unit=>'s', vals=>[10,15,25,40,90,120,240,480); # sampled at different time points |
936
|
|
|
|
|
|
|
initdim ($data,'z',min=>30,max=>28,unit=>'mm'); yet another way |
937
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
# x,y,z are equally spaced numeric, n is non-numeric, t is numeric but at arbitrary distances |
939
|
|
|
|
|
|
|
... |
940
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
# load or define $mask with dims x,y,z equal to that of data |
942
|
|
|
|
|
|
|
$i=ncop($data,$mask,'mult',0); # multiply mask onto data. |
943
|
|
|
|
|
|
|
# Since mask has only x,y,z, the dims of $data are unchanged. |
944
|
|
|
|
|
|
|
# x,y,z, in $mask or $data must be either 1 or equal. |
945
|
|
|
|
|
|
|
|
946
|
|
|
|
|
|
|
# Calculate the average over my region of interest: |
947
|
|
|
|
|
|
|
$sum=nreduce($i,'avg','x','y','z'); |
948
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
... |
950
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
Now you want to associate your images with other data recorded at each time point: |
952
|
|
|
|
|
|
|
# $data2: PDL [8, 100] (t,pars) |
953
|
|
|
|
|
|
|
$more_complex=ncop($data,$data2,'plus',0); |
954
|
|
|
|
|
|
|
#This will produce a piddle of size [256,256,20,8,30,100] |
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
# if you want to average over every second object between n = 6 - 12: |
957
|
|
|
|
|
|
|
$avg=nagg(sln($data,n=>'6:12:2'),'average','n'); |
958
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
=head1 DESCRIPTION |
962
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
This module is an extension to PDL by giving the dimensions a meaningful name, |
964
|
|
|
|
|
|
|
values or ranges. The module also provides wrappers to perform most PDL |
965
|
|
|
|
|
|
|
operations based on named dimensions. Each dimension is supposed to have a unique name. |
966
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
If you prefer methods over functions, say |
968
|
|
|
|
|
|
|
|
969
|
|
|
|
|
|
|
bless $piddle, "PDL::Dims"; |
970
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
Names of dims can be any string (x,y,z,t,city, country, lattitude, fruit,pet, ...) |
972
|
|
|
|
|
|
|
|
973
|
|
|
|
|
|
|
Each dim has its own hash with several important keys; |
974
|
|
|
|
|
|
|
|
975
|
|
|
|
|
|
|
=cut #my @keys = qw(pos size num spacing min max inc vals index dummy); |
976
|
|
|
|
|
|
|
|
977
|
|
|
|
|
|
|
=over |
978
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
=item * pos - dimension index 0..ndims-1 |
980
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
=item * dimnames - a string by which the dim is accessed |
982
|
|
|
|
|
|
|
|
983
|
|
|
|
|
|
|
=item * index - current position within a dim. PDL::Dims knows the concept of a current position within a piddle |
984
|
|
|
|
|
|
|
|
985
|
|
|
|
|
|
|
=item * dummy - if true, initdim creates a dim of size at pos |
986
|
|
|
|
|
|
|
|
987
|
|
|
|
|
|
|
=item * num - dimension has numeric properties; if false, no min/max/inc are calculated. E.g. a dim pet may have values for dog, cat, fish, rabbit, mouse, parrot, min/max don't make sense in this case. |
988
|
|
|
|
|
|
|
|
989
|
|
|
|
|
|
|
=item * spacing - if true, values are evenly spaced; inc is undef if false |
990
|
|
|
|
|
|
|
|
991
|
|
|
|
|
|
|
=item * vals - list all values along a dim, if not evenly spaced each value is stored. Can cause memory issues in very large dims |
992
|
|
|
|
|
|
|
|
993
|
|
|
|
|
|
|
=item * min/max - minimum and maximum of numeric dimensions |
994
|
|
|
|
|
|
|
|
995
|
|
|
|
|
|
|
=item * inc - step between two indices in equally spaced dimensions |
996
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
=item * unit - the unit of vals. |
998
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
=back |
1000
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
|
1002
|
|
|
|
|
|
|
=head1 SUBROUTINES/METHODS |
1003
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
|
1005
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
The module has two different types of functions. |
1007
|
|
|
|
|
|
|
|
1008
|
|
|
|
|
|
|
First, there are several utitility functions to manipulate and retrieve the dimension info. |
1009
|
|
|
|
|
|
|
Currently, they only work on the metadata, no operations on the piddle are performed. |
1010
|
|
|
|
|
|
|
It is your responsibility to call the appropriate function whenever piddle dims change. |
1011
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
Then there are functions to perform most PDL operations based on named dimensions instead |
1013
|
|
|
|
|
|
|
of numbered dims. Wrappers to slice (sln), reduce (nreduce) and other functions |
1014
|
|
|
|
|
|
|
(nop, ncop) are implemented. |
1015
|
|
|
|
|
|
|
|
1016
|
|
|
|
|
|
|
The following parameters are currently used by PDL::Dims. It is *strongly* discouraged |
1017
|
|
|
|
|
|
|
to access them directly except during calls to initdim. Use the functions listed below |
1018
|
|
|
|
|
|
|
to manipulate and retrieve values. |
1019
|
|
|
|
|
|
|
|
1020
|
|
|
|
|
|
|
They are usually called like that: |
1021
|
|
|
|
|
|
|
|
1022
|
|
|
|
|
|
|
func ($piddle , [$dim, [value]]); |
1023
|
|
|
|
|
|
|
|
1024
|
|
|
|
|
|
|
if no dim is given, an array reference to all values are returned. |
1025
|
|
|
|
|
|
|
|
1026
|
|
|
|
|
|
|
Otherwise, it returns the given value for a particular $dim, setting it to $value if defined. |
1027
|
|
|
|
|
|
|
|
1028
|
|
|
|
|
|
|
|
1029
|
|
|
|
|
|
|
=head2 diminfo |
1030
|
|
|
|
|
|
|
|
1031
|
|
|
|
|
|
|
|
1032
|
|
|
|
|
|
|
$infostr = diminfo($piddle); |
1033
|
|
|
|
|
|
|
|
1034
|
|
|
|
|
|
|
An extended version of PDLs info, showing dimnames and sizes (from header). |
1035
|
|
|
|
|
|
|
|
1036
|
|
|
|
|
|
|
=head2 dimsize |
1037
|
|
|
|
|
|
|
|
1038
|
|
|
|
|
|
|
dimsize($piddle,[$dim,[$size]]); |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
set/get dimension size of piddle by name. |
1041
|
|
|
|
|
|
|
|
1042
|
|
|
|
|
|
|
=head2 dimname |
1043
|
|
|
|
|
|
|
|
1044
|
|
|
|
|
|
|
dimname($piddle,[$position,[$name]]); |
1045
|
|
|
|
|
|
|
|
1046
|
|
|
|
|
|
|
set/get dimension size of piddle by name. |
1047
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
=head2 idx |
1049
|
|
|
|
|
|
|
|
1050
|
|
|
|
|
|
|
idx($piddle,[$name,[$current]]) |
1051
|
|
|
|
|
|
|
|
1052
|
|
|
|
|
|
|
set/get current index values by name |
1053
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
=head2 didx |
1055
|
|
|
|
|
|
|
|
1056
|
|
|
|
|
|
|
didx($piddle,[$name,[$pos]]); |
1057
|
|
|
|
|
|
|
|
1058
|
|
|
|
|
|
|
get/set position of dims by their names |
1059
|
|
|
|
|
|
|
|
1060
|
|
|
|
|
|
|
=head2 i2pos |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
=head2 pos2i |
1063
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
i2pso($piddle,$dim,[$index]); |
1065
|
|
|
|
|
|
|
pso2i($piddle,$dim,$value); |
1066
|
|
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
Converts value from/to index. So you can say, for example, if you have a piddle counting stuff in different houses, |
1068
|
|
|
|
|
|
|
|
1069
|
|
|
|
|
|
|
sln($house,pets=>pos2i($house,pets,'dog'),rooms=>pos2i(housee,rooms,'kitchen')); |
1070
|
|
|
|
|
|
|
|
1071
|
|
|
|
|
|
|
something more realistic: Imagine you have two images of the same object but with different scaling and resolution or orientation. You want to extract what's between y = 10 and 20 cm of both images |
1072
|
|
|
|
|
|
|
|
1073
|
|
|
|
|
|
|
ya10=pos2i($a,'y',10); |
1074
|
|
|
|
|
|
|
ya20=pos2i($a,'y',20); |
1075
|
|
|
|
|
|
|
$slice=sln($a,y=>"$ya10:$ya20"); |
1076
|
|
|
|
|
|
|
|
1077
|
|
|
|
|
|
|
or if you want to resample something, the index $yb in $b corresponds to the index $ya in $a: |
1078
|
|
|
|
|
|
|
|
1079
|
|
|
|
|
|
|
$ya=pos2i($a,'y',i2pos($b,'y',$yb)); |
1080
|
|
|
|
|
|
|
|
1081
|
|
|
|
|
|
|
|
1082
|
|
|
|
|
|
|
|
1083
|
|
|
|
|
|
|
=head2 dmin |
1084
|
|
|
|
|
|
|
|
1085
|
|
|
|
|
|
|
dmin($piddle,[$dim,[$min]]); |
1086
|
|
|
|
|
|
|
|
1087
|
|
|
|
|
|
|
get/set minimum value for a dimension |
1088
|
|
|
|
|
|
|
|
1089
|
|
|
|
|
|
|
=head2 dmax |
1090
|
|
|
|
|
|
|
|
1091
|
|
|
|
|
|
|
dmax($piddle,[$name,[$max]]); |
1092
|
|
|
|
|
|
|
|
1093
|
|
|
|
|
|
|
get/set maximum value for a dimension |
1094
|
|
|
|
|
|
|
|
1095
|
|
|
|
|
|
|
=head2 dinc |
1096
|
|
|
|
|
|
|
|
1097
|
|
|
|
|
|
|
dinc($piddle,[$name,[$increment]]); |
1098
|
|
|
|
|
|
|
|
1099
|
|
|
|
|
|
|
get/set maximum value for a dimension |
1100
|
|
|
|
|
|
|
|
1101
|
|
|
|
|
|
|
=head2 vals |
1102
|
|
|
|
|
|
|
|
1103
|
|
|
|
|
|
|
vals($piddle,$dim,[$index ,[$val]| $array_ref]) |
1104
|
|
|
|
|
|
|
|
1105
|
|
|
|
|
|
|
get/set values of an axis. As a third argument you can either supply an index, |
1106
|
|
|
|
|
|
|
then you can access that element or a reference to an array of size dimsize supplying |
1107
|
|
|
|
|
|
|
values for that dim. |
1108
|
|
|
|
|
|
|
|
1109
|
|
|
|
|
|
|
Please take a look on i2pos, pos2i, spacing and dnumeric to better understand the behaviour. |
1110
|
|
|
|
|
|
|
|
1111
|
|
|
|
|
|
|
|
1112
|
|
|
|
|
|
|
=head2 unit |
1113
|
|
|
|
|
|
|
|
1114
|
|
|
|
|
|
|
unit($piddle,[$dim,[$unit]]); |
1115
|
|
|
|
|
|
|
|
1116
|
|
|
|
|
|
|
get/set the unit parameter. In the future, each assignment or operation |
1117
|
|
|
|
|
|
|
should be units-avare, e.g. converting autmatically from mm to km or feet, |
1118
|
|
|
|
|
|
|
preventing you from adding apples to peas ... |
1119
|
|
|
|
|
|
|
|
1120
|
|
|
|
|
|
|
=head2 spacing |
1121
|
|
|
|
|
|
|
|
1122
|
|
|
|
|
|
|
spacing ($piddle,[$dim,[$spacing]]); |
1123
|
|
|
|
|
|
|
|
1124
|
|
|
|
|
|
|
if true, the spacing between indices is assumed to be equal. |
1125
|
|
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
=head2 dnumeric |
1127
|
|
|
|
|
|
|
|
1128
|
|
|
|
|
|
|
dnumeric ($piddl,[$dim,[$bool]]); |
1129
|
|
|
|
|
|
|
|
1130
|
|
|
|
|
|
|
get/set the flag if the piddle dim has numeric or other units. This has influence |
1131
|
|
|
|
|
|
|
on vals, dmin, dmax, dinc. |
1132
|
|
|
|
|
|
|
|
1133
|
|
|
|
|
|
|
=head2 initdim |
1134
|
|
|
|
|
|
|
|
1135
|
|
|
|
|
|
|
initializes a dimenson |
1136
|
|
|
|
|
|
|
|
1137
|
|
|
|
|
|
|
usage: |
1138
|
|
|
|
|
|
|
initdim($piddle,$dimname,[%args]); |
1139
|
|
|
|
|
|
|
|
1140
|
|
|
|
|
|
|
Arguments are the fields listed above. This should be called repeatedly after piddle |
1141
|
|
|
|
|
|
|
creation to match the structure. |
1142
|
|
|
|
|
|
|
|
1143
|
|
|
|
|
|
|
If pos is not provided, the next free position is used. If you call |
1144
|
|
|
|
|
|
|
|
1145
|
|
|
|
|
|
|
initidim ($piddle,$name) |
1146
|
|
|
|
|
|
|
|
1147
|
|
|
|
|
|
|
N times on an N-dimensional piddle, it will create N dimensions with sizes corresponding to the |
1148
|
|
|
|
|
|
|
dim of the piddle. |
1149
|
|
|
|
|
|
|
|
1150
|
|
|
|
|
|
|
=head2 rmdim |
1151
|
|
|
|
|
|
|
|
1152
|
|
|
|
|
|
|
removes a dminenso |
1153
|
|
|
|
|
|
|
|
1154
|
|
|
|
|
|
|
rmdim($piddle,$dim); |
1155
|
|
|
|
|
|
|
|
1156
|
|
|
|
|
|
|
|
1157
|
|
|
|
|
|
|
|
1158
|
|
|
|
|
|
|
=head2 copy_dim |
1159
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
copies the diminfo from one piddle to the next. |
1161
|
|
|
|
|
|
|
|
1162
|
|
|
|
|
|
|
copy_dim($a,$b,$dim,[$pos]); |
1163
|
|
|
|
|
|
|
|
1164
|
|
|
|
|
|
|
calls initdim on $b with parameters from $a. You can supply a new position. |
1165
|
|
|
|
|
|
|
|
1166
|
|
|
|
|
|
|
=head2 sln |
1167
|
|
|
|
|
|
|
|
1168
|
|
|
|
|
|
|
sln ($piddle,%slices); |
1169
|
|
|
|
|
|
|
|
1170
|
|
|
|
|
|
|
This replaces slice and it's derivatives. |
1171
|
|
|
|
|
|
|
|
1172
|
|
|
|
|
|
|
perform slicing based on names. Returns correct dimension info. Unspecified |
1173
|
|
|
|
|
|
|
dims are returned fully. If you want to squeeze, use |
1174
|
|
|
|
|
|
|
sln($piddle, $dim=>"($value)"); |
1175
|
|
|
|
|
|
|
|
1176
|
|
|
|
|
|
|
or nsqueeze on the result, if you want all squeezed. Both will do the necessary rmdim calls for you, |
1177
|
|
|
|
|
|
|
|
1178
|
|
|
|
|
|
|
|
1179
|
|
|
|
|
|
|
Example: |
1180
|
|
|
|
|
|
|
$sl=sln($a,x=>'0:10:2',t=>'4:',); |
1181
|
|
|
|
|
|
|
|
1182
|
|
|
|
|
|
|
You can omit dims; it parses each key-value pair and constructs a slice string, |
1183
|
|
|
|
|
|
|
so what typically works for slice, works here. |
1184
|
|
|
|
|
|
|
|
1185
|
|
|
|
|
|
|
=head2 nop |
1186
|
|
|
|
|
|
|
|
1187
|
|
|
|
|
|
|
This is the way to perform non-aggregate operations on one piddle which work only on one dim, |
1188
|
|
|
|
|
|
|
like e.g. rotate. |
1189
|
|
|
|
|
|
|
|
1190
|
|
|
|
|
|
|
usage: |
1191
|
|
|
|
|
|
|
$res=nop($a,$operation,[@args]); |
1192
|
|
|
|
|
|
|
|
1193
|
|
|
|
|
|
|
|
1194
|
|
|
|
|
|
|
=head2 ncop |
1195
|
|
|
|
|
|
|
|
1196
|
|
|
|
|
|
|
This is the way to perform any operations involving two operands when using PDL::Dims. |
1197
|
|
|
|
|
|
|
|
1198
|
|
|
|
|
|
|
operates on two piddles, combining them by names. Equally named dimensions have |
1199
|
|
|
|
|
|
|
to obey the usual threding rules. For opertators like '+' use the named version |
1200
|
|
|
|
|
|
|
and an additional argument of 0. |
1201
|
|
|
|
|
|
|
|
1202
|
|
|
|
|
|
|
usage: |
1203
|
|
|
|
|
|
|
$c=ncop($a,$b,$operation,[@args]); |
1204
|
|
|
|
|
|
|
|
1205
|
|
|
|
|
|
|
=head2 nagg |
1206
|
|
|
|
|
|
|
|
1207
|
|
|
|
|
|
|
Use to perform aggregate functions, that reduce the dim by 1. |
1208
|
|
|
|
|
|
|
|
1209
|
|
|
|
|
|
|
nagg($piddle,$operation,$dim,[@args]); |
1210
|
|
|
|
|
|
|
|
1211
|
|
|
|
|
|
|
Use this to perform sumover, average, ... |
1212
|
|
|
|
|
|
|
|
1213
|
|
|
|
|
|
|
|
1214
|
|
|
|
|
|
|
=head2 nreduce |
1215
|
|
|
|
|
|
|
|
1216
|
|
|
|
|
|
|
a wrapper around reduce (requires PDL::Reduce) calling with names instead. |
1217
|
|
|
|
|
|
|
|
1218
|
|
|
|
|
|
|
nreduce($piddle,$operations,@dimnames); |
1219
|
|
|
|
|
|
|
|
1220
|
|
|
|
|
|
|
=head2 active_slice |
1221
|
|
|
|
|
|
|
|
1222
|
|
|
|
|
|
|
A conveniance function, similar to sln, but it returns a slice at the current position (index). |
1223
|
|
|
|
|
|
|
|
1224
|
|
|
|
|
|
|
useage |
1225
|
|
|
|
|
|
|
|
1226
|
|
|
|
|
|
|
$slice=active_slice($piddle,@ignore); |
1227
|
|
|
|
|
|
|
|
1228
|
|
|
|
|
|
|
returns the current selection (as accessed by idx) as a slice. Returns full dims on supplied dim list. |
1229
|
|
|
|
|
|
|
|
1230
|
|
|
|
|
|
|
Call nsqueeze afterwards if that is what you want. |
1231
|
|
|
|
|
|
|
|
1232
|
|
|
|
|
|
|
=head2 nsqueeze |
1233
|
|
|
|
|
|
|
|
1234
|
|
|
|
|
|
|
A wrapper to squeeze. It makes the appropriate header updates (i.e. calls to rmdim). |
1235
|
|
|
|
|
|
|
|
1236
|
|
|
|
|
|
|
|
1237
|
|
|
|
|
|
|
=head2 is_sane |
1238
|
|
|
|
|
|
|
|
1239
|
|
|
|
|
|
|
A sanity check for piddles. This is your friend when working with PDL::Dims! |
1240
|
|
|
|
|
|
|
|
1241
|
|
|
|
|
|
|
$err=is_sane($piddle) |
1242
|
|
|
|
|
|
|
|
1243
|
|
|
|
|
|
|
|
1244
|
|
|
|
|
|
|
returns 0 upon success, otherwise the first inconsisteny found is returned. This may |
1245
|
|
|
|
|
|
|
change in future releases. |
1246
|
|
|
|
|
|
|
|
1247
|
|
|
|
|
|
|
=head1 AUTHOR |
1248
|
|
|
|
|
|
|
|
1249
|
|
|
|
|
|
|
Ingo Schmid |
1250
|
|
|
|
|
|
|
|
1251
|
|
|
|
|
|
|
|
1252
|
|
|
|
|
|
|
|
1253
|
|
|
|
|
|
|
|
1254
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
1255
|
|
|
|
|
|
|
|
1256
|
|
|
|
|
|
|
Copyright 2014 Ingo Schmid. |
1257
|
|
|
|
|
|
|
|
1258
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
1259
|
|
|
|
|
|
|
under the terms of the the Artistic License (2.0). You may obtain a |
1260
|
|
|
|
|
|
|
copy of the full license at: |
1261
|
|
|
|
|
|
|
|
1262
|
|
|
|
|
|
|
L |
1263
|
|
|
|
|
|
|
|
1264
|
|
|
|
|
|
|
Any use, modification, and distribution of the Standard or Modified |
1265
|
|
|
|
|
|
|
Versions is governed by this Artistic License. By using, modifying or |
1266
|
|
|
|
|
|
|
distributing the Package, you accept this license. Do not use, modify, |
1267
|
|
|
|
|
|
|
or distribute the Package, if you do not accept this license. |
1268
|
|
|
|
|
|
|
|
1269
|
|
|
|
|
|
|
If your Modified Version has been derived from a Modified Version made |
1270
|
|
|
|
|
|
|
by someone other than you, you are nevertheless required to ensure that |
1271
|
|
|
|
|
|
|
your Modified Version complies with the requirements of this license. |
1272
|
|
|
|
|
|
|
|
1273
|
|
|
|
|
|
|
This license does not grant you the right to use any trademark, service |
1274
|
|
|
|
|
|
|
mark, tradename, or logo of the Copyright Holder. |
1275
|
|
|
|
|
|
|
|
1276
|
|
|
|
|
|
|
This license includes the non-exclusive, worldwide, free-of-charge |
1277
|
|
|
|
|
|
|
patent license to make, have made, use, offer to sell, sell, import and |
1278
|
|
|
|
|
|
|
otherwise transfer the Package with respect to any patent claims |
1279
|
|
|
|
|
|
|
licensable by the Copyright Holder that are necessarily infringed by the |
1280
|
|
|
|
|
|
|
Package. If you institute patent litigation (including a cross-claim or |
1281
|
|
|
|
|
|
|
counterclaim) against any party alleging that the Package constitutes |
1282
|
|
|
|
|
|
|
direct or contributory patent infringement, then this Artistic License |
1283
|
|
|
|
|
|
|
to you shall terminate on the date that such litigation is filed. |
1284
|
|
|
|
|
|
|
|
1285
|
|
|
|
|
|
|
Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER |
1286
|
|
|
|
|
|
|
AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. |
1287
|
|
|
|
|
|
|
THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR |
1288
|
|
|
|
|
|
|
PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY |
1289
|
|
|
|
|
|
|
YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR |
1290
|
|
|
|
|
|
|
CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR |
1291
|
|
|
|
|
|
|
CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, |
1292
|
|
|
|
|
|
|
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
1293
|
|
|
|
|
|
|
|
1294
|
|
|
|
|
|
|
|
1295
|
|
|
|
|
|
|
=cut |
1296
|
|
|
|
|
|
|
|
1297
|
|
|
|
|
|
|
1; # End of PDL::Dims |