Codebase list libpdl-vectorvalued-perl / 6cd008d
New upstream version 1.0.16 Bas Couwenberg 2 years ago
9 changed file(s) with 449 addition(s) and 389 deletion(s). Raw diff Collapse all Expand all
+4
-0
ChangeLog less more
00 ##-*- Mode: Change-Log; coding: utf-8; -*-
11 ##
22 ## Change log for perl distribution PDL::VectorValued
3
4 v1.0.16 Sat, 12 Mar 2022 15:48:13 +0100 moocow
5 * overhaul set operations implicit threading/broadcasting dimensions and empty results
6 - should hopefully fix https://github.com/moocow-the-bovine/PDL-VectorValued/issues/4
37
48 v1.0.15 Sun, 20 Feb 2022 13:40:45 +0100 moocow
59 * fix for PDL v2.075
+1
-1
META.json less more
4444 "web" : "https://github.com/moocow-the-bovine/PDL-VectorValued"
4545 }
4646 },
47 "version" : "v1.0.15",
47 "version" : "v1.0.16",
4848 "x_serialization_backend" : "JSON::PP version 4.02"
4949 }
+1
-1
META.yml less more
2121 Test::More: '0'
2222 resources:
2323 repository: git://github.com/moocow-the-bovine/PDL-VectorValued.git
24 version: v1.0.15
24 version: v1.0.16
2525 x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
+237
-336
Utils/Utils.pm less more
0
01 #
12 # GENERATED WITH PDL::PP! Don't modify!
23 #
34 package PDL::VectorValued::Utils;
45
5 our @EXPORT_OK = qw(rlevec rldvec enumvec enumvecg rleseq rldseq vsearchvec cmpvec vv_qsortvec vv_qsortveci vv_union vv_intersect vv_setdiff v_union v_intersect v_setdiff vv_vcos );
6 our %EXPORT_TAGS = (Func=>\@EXPORT_OK);
6 @EXPORT_OK = qw( PDL::PP rlevec PDL::PP rldvec PDL::PP enumvec PDL::PP enumvecg PDL::PP rleseq PDL::PP rldseq PDL::PP vsearchvec PDL::PP cmpvec vv_qsortvec vv_qsortveci PDL::PP vv_union PDL::PP vv_intersect PDL::PP vv_setdiff PDL::PP v_union PDL::PP v_intersect PDL::PP v_setdiff PDL::PP vv_vcos );
7 %EXPORT_TAGS = (Func=>[@EXPORT_OK]);
78
89 use PDL::Core;
910 use PDL::Exporter;
1011 use DynaLoader;
1112
1213
13 our $VERSION = '1.0.15';
14 our @ISA = ( 'PDL::Exporter','DynaLoader' );
14
15 $PDL::VectorValued::Utils::VERSION = 1.0.16;
16 @ISA = ( 'PDL::Exporter','DynaLoader' );
1517 push @PDL::Core::PP, __PACKAGE__;
1618 bootstrap PDL::VectorValued::Utils $VERSION;
1719
1921
2022
2123
22
23 #line 21 "utils.pd"
24
25
2624 use strict;
2725
2826 =pod
4038 ## ... stuff happens
4139
4240 =cut
43 #line 45 "Utils.pm"
41
4442
4543
4644
4947
5048 =head1 FUNCTIONS
5149
52 =cut
53
54
55
56
57 #line 67 "utils.pd"
50
51
52 =cut
53
54
55
5856
5957
6058 =pod
6260 =head1 Vector-Based Run-Length Encoding and Decoding
6361
6462 =cut
65 #line 67 "Utils.pm"
66
67
68
69 #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
63
64
7065
7166
7267
9691 =for bad
9792
9893 rlevec does not process bad values.
99 It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
100
101
102 =cut
103 #line 105 "Utils.pm"
104
105
106
107 #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
94 It will set the bad-value flag of all output piddles if the flag is set for any of the input piddles.
95
96
97 =cut
98
99
100
101
102
108103
109104 *rlevec = \&PDL::rlevec;
110 #line 112 "Utils.pm"
111
112
113
114 #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
105
106
115107
116108
117109
135127 =for bad
136128
137129 rldvec does not process bad values.
138 It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
139
140
141 =cut
142 #line 144 "Utils.pm"
143
144
145
146 #line 1059 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
130 It will set the bad-value flag of all output piddles if the flag is set for any of the input piddles.
131
132
133 =cut
134
135
136
147137
148138 sub PDL::rldvec {
149139 my ($a,$b,$c) = @_;
158148 &PDL::_rldvec_int($a,$b,$c);
159149 return $c;
160150 }
161 #line 163 "Utils.pm"
162
163
164
165 #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
151
166152
167153 *rldvec = \&PDL::rldvec;
168 #line 170 "Utils.pm"
169
170
171
172 #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
154
155
173156
174157
175158
193176 =for bad
194177
195178 enumvec does not process bad values.
196 It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
197
198
199 =cut
200 #line 202 "Utils.pm"
201
202
203
204 #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
179 It will set the bad-value flag of all output piddles if the flag is set for any of the input piddles.
180
181
182 =cut
183
184
185
186
187
205188
206189 *enumvec = \&PDL::enumvec;
207 #line 209 "Utils.pm"
208
209
210
211 #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
190
191
212192
213193
214194
233213 =for bad
234214
235215 enumvecg does not process bad values.
236 It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
237
238
239 =cut
240 #line 242 "Utils.pm"
241
242
243
244 #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
216 It will set the bad-value flag of all output piddles if the flag is set for any of the input piddles.
217
218
219 =cut
220
221
222
223
224
245225
246226 *enumvecg = \&PDL::enumvecg;
247 #line 249 "Utils.pm"
248
249
250
251 #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
227
228
252229
253230
254231
272249 =for bad
273250
274251 rleseq does not process bad values.
275 It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
276
277
278 =cut
279 #line 281 "Utils.pm"
280
281
282
283 #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
252 It will set the bad-value flag of all output piddles if the flag is set for any of the input piddles.
253
254
255 =cut
256
257
258
259
260
284261
285262 *rleseq = \&PDL::rleseq;
286 #line 288 "Utils.pm"
287
288
289
290 #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
263
264
291265
292266
293267
314288 =for bad
315289
316290 rldseq does not process bad values.
317 It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
318
319
320 =cut
321 #line 323 "Utils.pm"
322
323
324
325 #line 1059 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
291 It will set the bad-value flag of all output piddles if the flag is set for any of the input piddles.
292
293
294 =cut
295
296
297
326298
327299 sub PDL::rldseq {
328300 my ($a,$b,$c) = @_;
335307 &PDL::_rldseq_int($a,$b,$c);
336308 return $c;
337309 }
338 #line 340 "Utils.pm"
339
340
341
342 #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
310
343311
344312 *rldseq = \&PDL::rldseq;
345 #line 347 "Utils.pm"
346
347
348
349 #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
313
314
350315
351316
352317
380345 =for bad
381346
382347 vsearchvec does not process bad values.
383 It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
384
385
386 =cut
387 #line 389 "Utils.pm"
388
389
390
391 #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
348 It will set the bad-value flag of all output piddles if the flag is set for any of the input piddles.
349
350
351 =cut
352
353
354
355
356
392357
393358 *vsearchvec = \&PDL::vsearchvec;
394 #line 396 "Utils.pm"
395
396
397
398 #line 392 "utils.pd"
359
360
399361
400362
401363 =pod
409371 for a bug in PDL-2.4.3, which has long since been fixed.
410372
411373 =cut
412 #line 414 "Utils.pm"
413
414
415
416 #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
374
375
417376
418377
419378
423382
424383 Signature: (a(N); b(N); int [o]cmp())
425384
385 =for ref
386
426387 Lexicographically compare a pair of vectors.
427388
428389
430391 =for bad
431392
432393 cmpvec does not process bad values.
433 It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
434
435
436 =cut
437 #line 439 "Utils.pm"
438
439
440
441 #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
394 It will set the bad-value flag of all output piddles if the flag is set for any of the input piddles.
395
396
397 =cut
398
399
400
401
402
442403
443404 *cmpvec = \&PDL::cmpvec;
444 #line 446 "Utils.pm"
445
446
447
448 #line 422 "utils.pd"
405
406
449407
450408
451409 =head2 vv_qsortvec
478436 *vv_qsortvec = *PDL::vv_qsortvec = *PDL::qsortvec;
479437 *vv_qsortveci = *PDL::vv_qsortveci = *PDL::qsortveci;
480438 }
481 #line 483 "Utils.pm"
482
483
484
485 #line 463 "utils.pd"
439
440
486441
487442
488443 =pod
493448 sorted vector-valued PDLs.
494449
495450 =cut
496 #line 498 "Utils.pm"
497
498
499
500 #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
451
452
501453
502454
503455
521473 =for bad
522474
523475 vv_union does not process bad values.
524 It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
525
526
527 =cut
528 #line 530 "Utils.pm"
529
530
531
532 #line 1059 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
476 It will set the bad-value flag of all output piddles if the flag is set for any of the input piddles.
477
478
479 =cut
480
481
482
533483
534484
535485 sub PDL::vv_union {
536486 my ($a,$b,$c,$nc) = @_;
537 barf("PDL::VectorValued::vv_union(): dimension mismatch") if ($a->dim(-2) != $b->dim(-2));
538 my @adims = $a->dims;
487 my ($MA,$NA,@adims) = $a->dims;
488 my ($MB,$NB,@bdims) = $b->dims;
489 barf("PDL::VectorValued::vv_union(): dimension mismatch") if ($MA != $MB);
539490 if (!defined($c)) {
540491 my $ctype = $a->type > $b->type ? $a->type : $b->type;
541 $c = PDL->zeroes($ctype, @adims[0..($#adims-1)], $adims[$#adims] + $b->dim(-1));
492 $c = PDL->zeroes($ctype, $MA, ($NA+$NB), @adims);
542493 }
543 $nc = PDL->zeroes(PDL::long(), (@adims > 2 ? @adims[0..($#adims-2)] : 1)) if (!defined($nc));
494 $nc = PDL->zeroes(PDL::long(), @adims ? @adims : 1) if (!defined($nc));
544495 &PDL::_vv_union_int($a,$b,$c,$nc);
545496 return ($c,$nc) if (wantarray);
546 return $c->mv(-1,0)->slice("0:".($nc->sclr-1))->mv(0,-1);
497 return $c->mv(1,0)->slice("0:".($nc->max-1))->mv(0,1);
547498 }
548 #line 550 "Utils.pm"
549
550
551
552 #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
499
553500
554501 *vv_union = \&PDL::vv_union;
555 #line 557 "Utils.pm"
556
557
558
559 #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
502
503
560504
561505
562506
579523 =for bad
580524
581525 vv_intersect does not process bad values.
582 It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
583
584
585 =cut
586 #line 588 "Utils.pm"
587
588
589
590 #line 1059 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
526 It will set the bad-value flag of all output piddles if the flag is set for any of the input piddles.
527
528
529 =cut
530
531
532
591533
592534
593535 sub PDL::vv_intersect {
594536 my ($a,$b,$c,$nc) = @_;
595 barf("PDL::VectorValued::vv_intersect(): dimension mismatch") if ($a->dim(-2) != $b->dim(-2));
596 my @adims = $a->dims;
597 my $NA = $adims[$#adims];
598 my $NB = $b->dim(-1);
537 my ($MA,$NA,@adims) = $a->dims;
538 my ($MB,$NB,@bdims) = $b->dims;
539 barf("PDL::VectorValued::vv_intersect(): dimension mismatch") if ($MA != $MB);
599540 if (!defined($c)) {
600541 my $ctype = $a->type > $b->type ? $a->type : $b->type;
601 $c = PDL->zeroes($ctype, @adims[0..($#adims-1)], $NA < $NB ? $NA : $NB);
542 $c = PDL->zeroes($ctype, $MA, ($NA < $NB ? $NA : $NB), @adims);
602543 }
603 $nc = PDL->zeroes(PDL::long(), (@adims > 2 ? @adims[0..($#adims-2)] : 1)) if (!defined($nc));
544 $nc = PDL->zeroes(PDL::long(), @adims ? @adims : 1) if (!defined($nc));
604545 &PDL::_vv_intersect_int($a,$b,$c,$nc);
605546 return ($c,$nc) if (wantarray);
606 return $c->mv(-1,0)->slice("0:".($nc->sclr-1))->mv(0,-1);
547 my $nc_max = $nc->max;
548 return ($nc_max > 0
549 ? $c->mv(1,0)->slice("0:".($nc_max-1))->mv(0,1)
550 : $c->reshape($c->dim(0), 0, ($c->dims)[2..($c->ndims-1)]));
607551 }
608 #line 610 "Utils.pm"
609
610
611
612 #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
552
613553
614554 *vv_intersect = \&PDL::vv_intersect;
615 #line 617 "Utils.pm"
616
617
618
619 #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
555
556
620557
621558
622559
639576 =for bad
640577
641578 vv_setdiff does not process bad values.
642 It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
643
644
645 =cut
646 #line 648 "Utils.pm"
647
648
649
650 #line 1059 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
579 It will set the bad-value flag of all output piddles if the flag is set for any of the input piddles.
580
581
582 =cut
583
584
585
651586
652587
653588 sub PDL::vv_setdiff {
654 my ($a,$b,$c,$nc) = @_;
655 barf("PDL::VectorValued::vv_setdiff(): dimension mismatch") if ($a->dim(-2) != $b->dim(-2));
656 my @adims = $a->dims;
657 my $NA = $adims[$#adims];
658 my $NB = $b->dim(-1);
659 if (!defined($c)) {
660 my $ctype = $a->type > $b->type ? $a->type : $b->type;
661 $c = PDL->zeroes($ctype, @adims[0..($#adims-1)], $NA);
662 }
663 $nc = PDL->zeroes(PDL::long(), (@adims > 2 ? @adims[0..($#adims-2)] : 1)) if (!defined($nc));
664 &PDL::_vv_setdiff_int($a,$b,$c,$nc);
665 return ($c,$nc) if (wantarray);
666 return $c->mv(-1,0)->slice("0:".($nc->sclr-1))->mv(0,-1);
589 my ($a,$b,$c,$nc) = @_;
590 my ($MA,$NA,@adims) = $a->dims;
591 my ($MB,$NB,@bdims) = $b->dims;
592 barf("PDL::VectorValued::vv_setdiff(): dimension mismatch") if ($MA != $MB);
593 if (!defined($c)) {
594 my $ctype = $a->type > $b->type ? $a->type : $b->type;
595 $c = PDL->zeroes($ctype, $MA, $NA, @adims);
596 }
597 $nc = PDL->zeroes(PDL::long(), @adims ? @adims : 1) if (!defined($nc));
598 &PDL::_vv_setdiff_int($a,$b,$c,$nc);
599 return ($c,$nc) if (wantarray);
600 my $nc_max = $nc->max;
601 return ($nc_max > 0
602 ? $c->mv(1,0)->slice("0:".($nc_max-1))->mv(0,1)
603 : $c->reshape($c->dim(0), 0, ($c->dims)[2..($c->ndims-1)]));
667604 }
668 #line 670 "Utils.pm"
669
670
671
672 #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
605
673606
674607 *vv_setdiff = \&PDL::vv_setdiff;
675 #line 677 "Utils.pm"
676
677
678
679 #line 674 "utils.pd"
608
609
680610
681611
682612 =pod
688618 than the corresponding implementations via PDL::Primitive::setops().
689619
690620 =cut
691 #line 693 "Utils.pm"
692
693
694
695 #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
621
622
696623
697624
698625
714641 =for bad
715642
716643 v_union does not process bad values.
717 It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
718
719
720 =cut
721 #line 723 "Utils.pm"
722
723
724
725 #line 1059 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
644 It will set the bad-value flag of all output piddles if the flag is set for any of the input piddles.
645
646
647 =cut
648
649
650
726651
727652
728653 sub PDL::v_union {
729654 my ($a,$b,$c,$nc) = @_;
730 barf("PDL::VectorValued::v_union(): only 1d vectors are supported") if ($a->ndims > 1 || $b->ndims > 1);
731 $nc = PDL->pdl(PDL::long(), $a->dim(0) + $b->dim(0)) if (!defined($nc));
655 my ($NA,@adims) = $a->dims;
656 my ($NB,@bdims) = $b->dims;
732657 if (!defined($c)) {
733658 my $ctype = $a->type > $b->type ? $a->type : $b->type;
734 $c = PDL->zeroes($ctype, ref($nc) ? $nc->sclr : $nc);
659 $c = PDL->zeroes($ctype, ($NA+$NB), @adims);
735660 }
661 $nc = PDL->pdl(PDL::long(), @adims ? @adims : 1) if (!defined($nc));
736662 &PDL::_v_union_int($a,$b,$c,$nc);
737663 return ($c,$nc) if (wantarray);
738 return $c->reshape($nc->sclr);
664 return $c->slice("0:".($nc->max-1));
739665 }
740 #line 742 "Utils.pm"
741
742
743
744 #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
666
745667
746668 *v_union = \&PDL::v_union;
747 #line 749 "Utils.pm"
748
749
750
751 #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
669
670
752671
753672
754673
770689 =for bad
771690
772691 v_intersect does not process bad values.
773 It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
774
775
776 =cut
777 #line 779 "Utils.pm"
778
779
780
781 #line 1059 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
692 It will set the bad-value flag of all output piddles if the flag is set for any of the input piddles.
693
694
695 =cut
696
697
698
782699
783700
784701 sub PDL::v_intersect {
785702 my ($a,$b,$c,$nc) = @_;
786 barf("PDL::VectorValued::v_intersect(): only 1d vectors are supported") if ($a->ndims > 1 || $b->ndims > 1);
787 my $NA = $a->dim(0);
788 my $NB = $b->dim(0);
789 $nc = PDL->pdl(PDL::long(), $NA < $NB ? $NA : $NB) if (!defined($nc));
703 my ($NA,@adims) = $a->dims;
704 my ($NB,@bdims) = $b->dims;
790705 if (!defined($c)) {
791706 my $ctype = $a->type > $b->type ? $a->type : $b->type;
792 $c = PDL->zeroes($ctype, ref($nc) ? $nc->sclr : $nc);
707 $c = PDL->zeroes($ctype, ($NA < $NB ? $NA : $NB), @adims);
793708 }
709 $nc = PDL->pdl(PDL::long(), @adims ? @adims : 1) if (!defined($nc));
794710 &PDL::_v_intersect_int($a,$b,$c,$nc);
795711 return ($c,$nc) if (wantarray);
796 return $c->reshape($nc->sclr);
712 my $nc_max = $nc->max;
713 return ($nc_max > 0
714 ? $c->slice("0:".($nc_max-1))
715 : $c->reshape(0, ($c->dims)[1..($c->ndims-1)]));
797716 }
798 #line 800 "Utils.pm"
799
800
801
802 #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
717
803718
804719 *v_intersect = \&PDL::v_intersect;
805 #line 807 "Utils.pm"
806
807
808
809 #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
720
721
810722
811723
812724
828740 =for bad
829741
830742 v_setdiff does not process bad values.
831 It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
832
833
834 =cut
835 #line 837 "Utils.pm"
836
837
838
839 #line 1059 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
743 It will set the bad-value flag of all output piddles if the flag is set for any of the input piddles.
744
745
746 =cut
747
748
749
840750
841751
842752 sub PDL::v_setdiff {
843753 my ($a,$b,$c,$nc) = @_;
844 barf("PDL::VectorValued::v_setdiff(): only 1d vectors are supported") if ($a->ndims > 1 || $b->ndims > 1);
845 my $NA = $a->dim(0);
846 my $NB = $b->dim(0);
847 $nc = PDL->pdl(PDL::long(), $NA) if (!defined($nc));
754 my ($NA,@adims) = $a->dims;
755 my ($NB,@bdims) = $b->dims;
848756 if (!defined($c)) {
849757 my $ctype = $a->type > $b->type ? $a->type : $b->type;
850 $c = PDL->zeroes($ctype, $NA);
758 $c = PDL->zeroes($ctype, $NA, @adims);
851759 }
760 $nc = PDL->pdl(PDL::long(), @adims ? @adims : 1) if (!defined($nc));
852761 &PDL::_v_setdiff_int($a,$b,$c,$nc);
853762 return ($c,$nc) if (wantarray);
854 return $c->reshape($nc->sclr);
763 my $nc_max = $nc->max;
764 return ($nc_max > 0
765 ? $c->slice("0:".($nc_max-1))
766 : $c->reshape(0, ($c->dims)[1..($c->ndims-1)]));
855767 }
856 #line 858 "Utils.pm"
857
858
859
860 #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
768
861769
862770 *v_setdiff = \&PDL::v_setdiff;
863 #line 865 "Utils.pm"
864
865
866
867 #line 875 "utils.pd"
771
772
868773
869774
870775 =pod
872777 =head1 Miscellaneous Vector-Valued Operations
873778
874779 =cut
875 #line 877 "Utils.pm"
876
877
878
879 #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
780
781
880782
881783
882784
910812
911813
912814 =cut
913 #line 915 "Utils.pm"
914
915
916
917 #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm"
815
816
817
818
819
918820
919821 *vv_vcos = \&PDL::vv_vcos;
920 #line 922 "Utils.pm"
921
922
923
924 #line 985 "utils.pd"
822
823
925824
926825
927826 ##---------------------------------------------------------------------
998897 perl(1), PDL(3perl)
999898
1000899 =cut
1001 #line 1003 "Utils.pm"
1002
1003
1004
900
901
902
903 ;
1005904
1006905
1007906
1008907 # Exit with OK status
1009908
1010909 1;
910
911 ⏎
+57
-47
Utils/utils.pd less more
44 ##======================================================================
55
66 #require "../VectorValued/Version.pm"; ##-- use perl-reversion from Perl::Version instead
7 my $VERSION = '1.0.15';
7 my $VERSION = '1.0.16';
88 pp_setversion($VERSION);
99
1010 require "../VectorValued/Dev.pm";
481481 (q(
482482 sub PDL::vv_union {
483483 my ($a,$b,$c,$nc) = @_;
484 barf("PDL::VectorValued::vv_union(): dimension mismatch") if ($a->dim(-2) != $b->dim(-2));
485 my @adims = $a->dims;
484 my ($MA,$NA,@adims) = $a->dims;
485 my ($MB,$NB,@bdims) = $b->dims;
486 barf("PDL::VectorValued::vv_union(): dimension mismatch") if ($MA != $MB);
486487 if (!defined($c)) {
487488 my $ctype = $a->type > $b->type ? $a->type : $b->type;
488 $c = PDL->zeroes($ctype, @adims[0..($#adims-1)], $adims[$#adims] + $b->dim(-1));
489 }
490 $nc = PDL->zeroes(PDL::long(), (@adims > 2 ? @adims[0..($#adims-2)] : 1)) if (!defined($nc));
489 $c = PDL->zeroes($ctype, $MA, ($NA+$NB), @adims);
490 }
491 $nc = PDL->zeroes(PDL::long(), @adims ? @adims : 1) if (!defined($nc));
491492 &PDL::_vv_union_int($a,$b,$c,$nc);
492493 return ($c,$nc) if (wantarray);
493 return $c->mv(-1,0)->slice("0:".($nc->sclr-1))->mv(0,-1);
494 return $c->mv(1,0)->slice("0:".($nc->max-1))->mv(0,1);
494495 }
495496 )),
496497 Code =>
548549 (q(
549550 sub PDL::vv_intersect {
550551 my ($a,$b,$c,$nc) = @_;
551 barf("PDL::VectorValued::vv_intersect(): dimension mismatch") if ($a->dim(-2) != $b->dim(-2));
552 my @adims = $a->dims;
553 my $NA = $adims[$#adims];
554 my $NB = $b->dim(-1);
552 my ($MA,$NA,@adims) = $a->dims;
553 my ($MB,$NB,@bdims) = $b->dims;
554 barf("PDL::VectorValued::vv_intersect(): dimension mismatch") if ($MA != $MB);
555555 if (!defined($c)) {
556556 my $ctype = $a->type > $b->type ? $a->type : $b->type;
557 $c = PDL->zeroes($ctype, @adims[0..($#adims-1)], $NA < $NB ? $NA : $NB);
558 }
559 $nc = PDL->zeroes(PDL::long(), (@adims > 2 ? @adims[0..($#adims-2)] : 1)) if (!defined($nc));
557 $c = PDL->zeroes($ctype, $MA, ($NA < $NB ? $NA : $NB), @adims);
558 }
559 $nc = PDL->zeroes(PDL::long(), @adims ? @adims : 1) if (!defined($nc));
560560 &PDL::_vv_intersect_int($a,$b,$c,$nc);
561561 return ($c,$nc) if (wantarray);
562 return $c->mv(-1,0)->slice("0:".($nc->sclr-1))->mv(0,-1);
562 my $nc_max = $nc->max;
563 return ($nc_max > 0
564 ? $c->mv(1,0)->slice("0:".($nc_max-1))->mv(0,1)
565 : $c->reshape($c->dim(0), 0, ($c->dims)[2..($c->ndims-1)]));
563566 }
564567 )),
565568 Code =>
609612 PMCode=>
610613 (q(
611614 sub PDL::vv_setdiff {
612 my ($a,$b,$c,$nc) = @_;
613 barf("PDL::VectorValued::vv_setdiff(): dimension mismatch") if ($a->dim(-2) != $b->dim(-2));
614 my @adims = $a->dims;
615 my $NA = $adims[$#adims];
616 my $NB = $b->dim(-1);
617 if (!defined($c)) {
618 my $ctype = $a->type > $b->type ? $a->type : $b->type;
619 $c = PDL->zeroes($ctype, @adims[0..($#adims-1)], $NA);
620 }
621 $nc = PDL->zeroes(PDL::long(), (@adims > 2 ? @adims[0..($#adims-2)] : 1)) if (!defined($nc));
622 &PDL::_vv_setdiff_int($a,$b,$c,$nc);
623 return ($c,$nc) if (wantarray);
624 return $c->mv(-1,0)->slice("0:".($nc->sclr-1))->mv(0,-1);
615 my ($a,$b,$c,$nc) = @_;
616 my ($MA,$NA,@adims) = $a->dims;
617 my ($MB,$NB,@bdims) = $b->dims;
618 barf("PDL::VectorValued::vv_setdiff(): dimension mismatch") if ($MA != $MB);
619 if (!defined($c)) {
620 my $ctype = $a->type > $b->type ? $a->type : $b->type;
621 $c = PDL->zeroes($ctype, $MA, $NA, @adims);
622 }
623 $nc = PDL->zeroes(PDL::long(), @adims ? @adims : 1) if (!defined($nc));
624 &PDL::_vv_setdiff_int($a,$b,$c,$nc);
625 return ($c,$nc) if (wantarray);
626 my $nc_max = $nc->max;
627 return ($nc_max > 0
628 ? $c->mv(1,0)->slice("0:".($nc_max-1))->mv(0,1)
629 : $c->reshape($c->dim(0), 0, ($c->dims)[2..($c->ndims-1)]));
625630 }
626631 )),
627632 Code =>
693698 (q(
694699 sub PDL::v_union {
695700 my ($a,$b,$c,$nc) = @_;
696 barf("PDL::VectorValued::v_union(): only 1d vectors are supported") if ($a->ndims > 1 || $b->ndims > 1);
697 $nc = PDL->pdl(PDL::long(), $a->dim(0) + $b->dim(0)) if (!defined($nc));
701 my ($NA,@adims) = $a->dims;
702 my ($NB,@bdims) = $b->dims;
698703 if (!defined($c)) {
699704 my $ctype = $a->type > $b->type ? $a->type : $b->type;
700 $c = PDL->zeroes($ctype, ref($nc) ? $nc->sclr : $nc);
701 }
705 $c = PDL->zeroes($ctype, ($NA+$NB), @adims);
706 }
707 $nc = PDL->pdl(PDL::long(), @adims ? @adims : 1) if (!defined($nc));
702708 &PDL::_v_union_int($a,$b,$c,$nc);
703709 return ($c,$nc) if (wantarray);
704 return $c->reshape($nc->sclr);
710 return $c->slice("0:".($nc->max-1));
705711 }
706712 )),
707713 Code =>
756762 (q(
757763 sub PDL::v_intersect {
758764 my ($a,$b,$c,$nc) = @_;
759 barf("PDL::VectorValued::v_intersect(): only 1d vectors are supported") if ($a->ndims > 1 || $b->ndims > 1);
760 my $NA = $a->dim(0);
761 my $NB = $b->dim(0);
762 $nc = PDL->pdl(PDL::long(), $NA < $NB ? $NA : $NB) if (!defined($nc));
765 my ($NA,@adims) = $a->dims;
766 my ($NB,@bdims) = $b->dims;
763767 if (!defined($c)) {
764768 my $ctype = $a->type > $b->type ? $a->type : $b->type;
765 $c = PDL->zeroes($ctype, ref($nc) ? $nc->sclr : $nc);
766 }
769 $c = PDL->zeroes($ctype, ($NA < $NB ? $NA : $NB), @adims);
770 }
771 $nc = PDL->pdl(PDL::long(), @adims ? @adims : 1) if (!defined($nc));
767772 &PDL::_v_intersect_int($a,$b,$c,$nc);
768773 return ($c,$nc) if (wantarray);
769 return $c->reshape($nc->sclr);
774 my $nc_max = $nc->max;
775 return ($nc_max > 0
776 ? $c->slice("0:".($nc_max-1))
777 : $c->reshape(0, ($c->dims)[1..($c->ndims-1)]));
770778 }
771779 )),
772780 Code =>
815823 (q(
816824 sub PDL::v_setdiff {
817825 my ($a,$b,$c,$nc) = @_;
818 barf("PDL::VectorValued::v_setdiff(): only 1d vectors are supported") if ($a->ndims > 1 || $b->ndims > 1);
819 my $NA = $a->dim(0);
820 my $NB = $b->dim(0);
821 $nc = PDL->pdl(PDL::long(), $NA) if (!defined($nc));
826 my ($NA,@adims) = $a->dims;
827 my ($NB,@bdims) = $b->dims;
822828 if (!defined($c)) {
823829 my $ctype = $a->type > $b->type ? $a->type : $b->type;
824 $c = PDL->zeroes($ctype, $NA);
825 }
830 $c = PDL->zeroes($ctype, $NA, @adims);
831 }
832 $nc = PDL->pdl(PDL::long(), @adims ? @adims : 1) if (!defined($nc));
826833 &PDL::_v_setdiff_int($a,$b,$c,$nc);
827834 return ($c,$nc) if (wantarray);
828 return $c->reshape($nc->sclr);
835 my $nc_max = $nc->max;
836 return ($nc_max > 0
837 ? $c->slice("0:".($nc_max-1))
838 : $c->reshape(0, ($c->dims)[1..($c->ndims-1)]));
829839 }
830840 )),
831841 Code =>
+1
-1
VectorValued/Dev.pm less more
1616 #use PDL::PP; ##-- do NOT do this!
1717 use Exporter;
1818
19 our $VERSION = '1.0.15'; ##-- v1.0.4: use perl-reversion from Perl::Version instead
19 our $VERSION = '1.0.16'; ##-- v1.0.4: use perl-reversion from Perl::Version instead
2020 our @ISA = qw(Exporter);
2121 our @EXPORT_OK =
2222 (
+1
-1
VectorValued/Version.pm less more
66 ##======================================================================
77
88 package PDL::VectorValued::Version;
9 our $VERSION = '1.0.15';
9 our $VERSION = '1.0.16';
1010 #$PDL::VectorValued::VERSION = $VERSION; ##-- use perl-reversion from Perl::Version instead
1111 #$PDL::VectorValued::Dev::VERSION = $VERSION; ##-- use perl-reversion from Perl::Version instead
1212
+1
-1
VectorValued.pm less more
2626 );
2727
2828 ## VERSION was formerly set by PDL::VectorValued::Version, now use perl-reversion from Perl::Version instead
29 our $VERSION = '1.0.15';
29 our $VERSION = '1.0.16';
3030
3131 ##======================================================================
3232 ## pod: header
+146
-1
t/03_setops.t less more
00 # -*- Mode: CPerl -*-
11 # t/03_setops.t: test PDL::VectorValued set operations
2 use Test::More tests=>12;
2 use Test::More;
33
44 ##-- common subs
55 my $TEST_DIR;
6060 ## 12: v_setdiff
6161 pdlok("v_setdiff", scalar($a->v_setdiff($b)), $all->where($amask & $bmask->not));
6262
63 ##--------------------------------------------------------------
64 ## vv_*: dim-checks and implicit thread dimensions
65 ## + see https://github.com/moocow-the-bovine/PDL-VectorValued/issues/4
66
67 sub test_vv_thread_dimensions {
68 ##-- vv_union
69
70 my $empty = zeroes(3,0);
71 my $uw = pdl([[-3,-2,-1],[1,2,3]]);
72 my $wx = pdl([[1,2,3],[4,5,6]]);
73 my $xy = pdl([[4,5,6],[7,8,9]]);
74
75 # vv_union: basic
76 pdlok("vv_union - thread dims - uw+wx", scalar($uw->vv_union($wx)), pdl([[-3,-2,-1],[1,2,3],[4,5,6]]));
77 pdlok("vv_union - thread dims - uw+xy", scalar($uw->vv_union($xy)), pdl([[-3,-2,-1],[1,2,3],[4,5,6],[7,8,9]]));
78 pdlok("vv_union - thread dims - 0+wx", scalar($empty->vv_union($wx)), $wx);
79 pdlok("vv_union - thread dims - wx+0", scalar($wx->vv_union($empty)), $wx);
80 pdlok("vv_union - thread dims - 0+0", scalar($empty->vv_union($empty)), $empty);
81
82 # vv_union: threading/broadcasting
83 my $k = 2;
84 my $kempty = $empty->slice(",,*$k");
85 my $kuw = $uw->slice(",,*$k");
86 my $kwx = $wx->slice(",,*$k");
87 my $kxy = $xy->slice(",,*$k");
88 pdlok("vv_union - thread dims - uw(*k)+wx", scalar($kuw->vv_union($wx)), pdl([[-3,-2,-1],[1,2,3],[4,5,6]])->slice(",,*$k"));
89 pdlok("vv_union - thread dims - uw(*k)+xy", scalar($kuw->vv_union($xy)), pdl([[-3,-2,-1],[1,2,3],[4,5,6],[7,8,9]])->slice(",,*$k"));
90 pdlok("vv_union - thread dims - 0(*k)+wx", scalar($kempty->vv_union($wx)), $kwx);
91 pdlok("vv_union - thread dims - wx(*k)+0", scalar($kwx->vv_union($empty)), $kwx);
92 pdlok("vv_union - thread dims - 0(*k)+0", scalar($kempty->vv_union($empty)), $kempty);
93
94
95 ##-- vv_intersect
96
97 my $needle0 = pdl([[-3,-2,-1]]);
98 my $needle1 = pdl([[1,2,3]]);
99 my $needles = pdl([[-3,-2,-1],[1,2,3]]);
100 my $haystack = pdl([[1,2,3],[4,5,6],[7,8,9],[10,11,12]]);
101
102 # vv_intersect: basic
103 pdlok("vv_intersect - thread dims - needle0&haystack", scalar($needle0->vv_intersect($haystack)), $empty);
104 pdlok("vv_intersect - thread dims - needle1&haystack", scalar($needle1->vv_intersect($haystack)), $needle1);
105 pdlok("vv_intersect - thread dims - needles&haystack", scalar($needles->vv_intersect($haystack)), $needle1);
106 pdlok("vv_intersect - thread dims - haystack&haystack", scalar($haystack->vv_intersect($haystack)), $haystack);
107 pdlok("vv_intersect - thread dims - haystack&empty", scalar($haystack->vv_intersect($empty)), $empty);
108 pdlok("vv_intersect - thread dims - empty&haystack", scalar($empty->vv_intersect($haystack)), $empty);
109
110 # vv_intersect: threading/broadcasting
111 my $kneedle0 = $needle0->slice(",,*$k");
112 my $kneedle1 = $needle1->slice(",,*$k");
113 my $kneedles = $needle0->slice(",,*1")->glue(2, $needle1->slice(",,*1"));
114 my $khaystack = $haystack->slice(",,*$k");
115 pdlok("vv_intersect - thread dims - needle0(*k)&haystack", scalar($kneedle0->vv_intersect($haystack)), $kempty);
116 pdlok("vv_intersect - thread dims - needle1(*k)&haystack", scalar($kneedle1->vv_intersect($haystack)), $kneedle1);
117 pdlok("vv_intersect - thread dims - needles(*k)&haystack",
118 scalar($kneedles->vv_intersect($haystack)),
119 pdl([[[0,0,0]],[[1,2,3]]]));
120 pdlok("vv_intersect - thread dims - haystack(*k)&haystack", scalar($khaystack->vv_intersect($haystack)), $khaystack);
121 pdlok("vv_intersect - thread dims - haystack(*k)&empty", scalar($khaystack->vv_intersect($empty)), $kempty);
122 pdlok("vv_intersect - thread dims - empty(*k)&haystack", scalar($kempty->vv_intersect($haystack)), $kempty);
123
124 ##-- vv_setdiff
125
126 # vv_setdiff: basic
127 pdlok("vv_setdiff - thread dims - haystack-needle0", scalar($haystack->vv_setdiff($needle0)), $haystack);
128 pdlok("vv_setdiff - thread dims - haystack-needle1", scalar($haystack->vv_setdiff($needle1)), $haystack->slice(",1:-1"));
129 pdlok("vv_setdiff - thread dims - haystack-needles", scalar($haystack->vv_setdiff($needles)), $haystack->slice(",1:-1"));
130 pdlok("vv_setdiff - thread dims - haystack-haystack", scalar($haystack->vv_setdiff($haystack)), $empty);
131 pdlok("vv_setdiff - thread dims - haystack-empty", scalar($haystack->vv_setdiff($empty)), $haystack);
132 pdlok("vv_setdiff - thread dims - empty-haystack", scalar($empty->vv_setdiff($haystack)), $empty);
133
134 # vv_setdiff: threading/broadcasting
135 pdlok("vv_setdiff - thread dims - haystack(*k)-needle0", scalar($khaystack->vv_setdiff($needle0)), $khaystack);
136 pdlok("vv_setdiff - thread dims - haystack(*k)-needle1", scalar($khaystack->vv_setdiff($needle1)), $khaystack->slice(",1:-1,"));
137 pdlok("vv_setdiff - thread dims - haystack(*k)-needles", scalar($khaystack->vv_setdiff($needles)), $khaystack->slice(",1:-1,"));
138 pdlok("vv_setdiff - thread dims - haystack(*k)-haystack", scalar($khaystack->vv_setdiff($haystack)), $kempty);
139 pdlok("vv_setdiff - thread dims - haystack(*k)-empty", scalar($khaystack->vv_setdiff($empty)), $khaystack);
140 pdlok("vv_setdiff - thread dims - empty(*k)-haystack", scalar($kempty->vv_setdiff($haystack)), $kempty);
141 }
142 test_vv_thread_dimensions();
143
144 ##--------------------------------------------------------------
145 ## v_*: dim-checks and implicit thread dimensions
146 ## + analogous to https://github.com/moocow-the-bovine/PDL-VectorValued/issues/4
147
148 sub test_v_thread_dimensions {
149 # data: basic
150 my $empty = zeroes(0);
151 my $v1_2 = pdl([1,2]);
152 my $v3_4 = pdl([3,4]);
153 my $v1_4 = $v1_2->cat($v3_4)->flat;
154
155 # data: threading/broadcasting
156 my $k = 2;
157 my $kempty = $empty->slice(",*$k");
158 my $kv1_2 = $v1_2->slice(",*$k");
159 my $kv3_4 = $v3_4->slice(",*$k");
160 my $kv1_4 = $v1_4->slice(",*$k");
161
162 #-- v_union
163 pdlok("v_union - thread dims - 12+34", scalar($v1_2->v_union($v3_4)), $v1_4);
164 pdlok("v_union - thread dims - 34+1234", scalar($v3_4->v_union($v1_4)), $v1_4);
165 pdlok("v_union - thread dims - 0+1234", scalar($empty->v_union($v1_4)), $v1_4);
166 pdlok("v_union - thread dims - 1234+0", scalar($v1_4->v_union($empty)), $v1_4);
167 pdlok("v_union - thread dims - 0+0", scalar($empty->v_union($empty)), $empty);
168 #
169 pdlok("v_union - thread dims - 12(*k)+34", scalar($kv1_2->v_union($v3_4)), $kv1_4);
170 pdlok("v_union - thread dims - 34(*k)+1234", scalar($kv3_4->v_union($v1_4)), $kv1_4);
171 pdlok("v_union - thread dims - 0(*k)+1234", scalar($kempty->v_union($v1_4)), $kv1_4);
172 pdlok("v_union - thread dims - 1234(*k)+0", scalar($kv1_4->v_union($empty)), $kv1_4);
173 pdlok("v_union - thread dims - 0(*k)+0", scalar($kempty->v_union($empty)), $kempty);
174
175 #-- v_intersect
176 pdlok("v_intersect - thread dims - 12&34", scalar($v1_2->v_intersect($v3_4)), $empty);
177 pdlok("v_intersect - thread dims - 34&1234", scalar($v3_4->v_intersect($v1_4)), $v3_4);
178 pdlok("v_intersect - thread dims - 0&1234", scalar($empty->v_intersect($v1_4)), $empty);
179 pdlok("v_intersect - thread dims - 1234&0", scalar($v1_4->v_intersect($empty)), $empty);
180 pdlok("v_intersect - thread dims - 0&0", scalar($empty->v_intersect($empty)), $empty);
181 #
182 pdlok("v_intersect - thread dims - 12(*k)&34", scalar($kv1_2->v_intersect($v3_4)), $kempty);
183 pdlok("v_intersect - thread dims - 34(*k)&1234", scalar($kv3_4->v_intersect($v1_4)), $kv3_4);
184 pdlok("v_intersect - thread dims - 0(*k)&1234", scalar($kempty->v_intersect($v1_4)), $kempty);
185 pdlok("v_intersect - thread dims - 1234(*k)&0", scalar($kv1_4->v_intersect($empty)), $kempty);
186 pdlok("v_intersect - thread dims - 0(*k)&0", scalar($kempty->v_intersect($empty)), $kempty);
187
188 #-- v_setdiff
189 pdlok("v_setdiff - thread dims - 12-34", scalar($v1_2->v_setdiff($v3_4)), $v1_2);
190 pdlok("v_setdiff - thread dims - 34-1234", scalar($v3_4->v_setdiff($v1_4)), $empty);
191 pdlok("v_setdiff - thread dims - 1234-0", scalar($v1_4->v_setdiff($empty)), $v1_4);
192 pdlok("v_setdiff - thread dims - 0-1234", scalar($empty->v_setdiff($v1_4)), $empty);
193 pdlok("v_setdiff - thread dims - 0-0", scalar($empty->v_setdiff($empty)), $empty);
194 #
195 pdlok("v_setdiff - thread dims - 12(*k)-34", scalar($kv1_2->v_setdiff($v3_4)), $kv1_2);
196 pdlok("v_setdiff - thread dims - 34(*k)-1234", scalar($kv3_4->v_setdiff($v1_4)), $kempty);
197 pdlok("v_setdiff - thread dims - 1234(*k)-0", scalar($kv1_4->v_setdiff($empty)), $kv1_4);
198 pdlok("v_setdiff - thread dims - 0(*k)-1234", scalar($kempty->v_setdiff($v1_4)), $kempty);
199 pdlok("v_setdiff - thread dims - 0(*k)-0", scalar($kempty->v_setdiff($empty)), $kempty);
200
201 }
202 test_v_thread_dimensions();
203
204
205
63206 print "\n";
207 done_testing();
64208 # end of t/03_setops.t
65209
210