File Coverage

blib/lib/CXC/Number/Grid.pm
Criterion Covered Total %
statement 262 302 86.7
branch 34 48 70.8
condition 16 22 72.7
subroutine 52 57 91.2
pod 21 22 95.4
total 385 451 85.3


line stmt bran cond sub pod time code
1             package CXC::Number::Grid;
2              
3             # ABSTRACT: A class representing a one dimensional numeric grid
4              
5 12     12   2150348 use v5.28;
  12         69  
6              
7 12     12   6568 use POSIX ();
  12         95938  
  12         517  
8              
9 12     12   7727 use Types::Standard qw( ArrayRef Bool Dict Enum HashRef InstanceOf Optional Slurpy );
  12         1790136  
  12         191  
10 12     12   69525 use Type::Params qw( signature signature_for );
  12         78230  
  12         134  
11 12     12   12582 use Ref::Util qw( is_plain_hashref is_blessed_ref );
  12         7786  
  12         4900  
12 12     12   93 use List::Util qw( uniqnum );
  12         26  
  12         978  
13              
14 12     12   6417 use CXC::Number::Grid::Types -types;
  12         726  
  12         232  
15 12     12   27456 use CXC::Number::Grid::Failure qw( parameter_interface parameter_constraint internal );
  12         52  
  12         161  
16              
17 12     12   6534 use CXC::Number::Grid::Tree;
  12         50  
  12         579  
18 12     12   108 use constant Tree => 'CXC::Number::Grid::Tree';
  12         26  
  12         1002  
19              
20 12     12   6682 use Safe::Isa;
  12         7044  
  12         2146  
21              
22 12     12   6841 use Moo;
  12         83499  
  12         141  
23              
24             our $VERSION = '0.13';
25              
26 12     12   19729 use constant GridObject => InstanceOf [ ( __PACKAGE__ ) ];
  12         20  
  12         97  
27 12     12   8806 use constant IncludeArray => ArrayRef [ Enum [ 0, 1 ] ];
  12         24  
  12         95  
28              
29 12     12   230346 use experimental 'signatures';
  12         28  
  12         132  
30              
31 12     12   8954 use Exporter::Shiny qw( join_n overlay_n );
  12         6567  
  12         110  
32              
33 12     12   6856 use namespace::clean;
  12         180291  
  12         117  
34              
35 12     12   12410 use MooX::StrictConstructor;
  12         119367  
  12         78  
36              
37             use overload
38             '!' => \&_overload_not,
39             '|' => \&_overload_or,
40             '&' => \&_overload_and,
41             fallback => 1,
42 12     12   399635 bool => sub { 1 };
  12     0   24  
  12         170  
  0         0  
43              
44 12     12   1818 BEGIN { with 'MooX::Tag::TO_HASH' } # so can see has
45              
46             my sub _croak {
47             require Carp;
48             goto \&Carp::croak;
49             }
50              
51 56     56   95 sub _convert ( $self, $bignum ) {
  56         90  
  56         83  
  56         81  
52 56         513 require Ref::Util;
53              
54             return Ref::Util::is_plain_arrayref( $bignum )
55 56 100       278 ? [ map { $_->numify } $bignum->@* ]
  228         28887  
56             : $bignum->numify;
57             }
58              
59              
60              
61              
62              
63              
64              
65              
66              
67             has oob => (
68             is => 'ro',
69             isa => Bool,
70             default => 0,
71             to_hash => 1,
72             );
73              
74              
75              
76              
77              
78              
79              
80             has _raw_edges => (
81             is => 'ro',
82             init_arg => 'edges',
83             isa => BinEdges,
84             required => 1,
85             coerce => 1,
86             to_hash => 'edges',
87             );
88              
89              
90              
91              
92              
93              
94              
95             has _include => (
96             is => 'lazy',
97             init_arg => 'include',
98             isa => IncludeArray,
99 28     28   344 builder => sub { [ ( 1 ) x $_[0]->nbins ] },
100             to_hash => 'include,if_exists',
101             );
102              
103              
104              
105              
106              
107              
108              
109              
110              
111              
112              
113              
114              
115              
116              
117              
118              
119              
120              
121              
122              
123              
124              
125              
126              
127              
128              
129              
130              
131              
132              
133              
134              
135              
136              
137              
138              
139              
140              
141              
142              
143              
144              
145              
146              
147              
148              
149              
150              
151             my sub edges_from_bounds;
152              
153             around BUILDARGS => sub ( $orig, $class, @args ) {
154              
155             my $args = $class->$orig( @args );
156              
157             _croak( 'specify either <edges> or <bounds> but not both' )
158             if exists $args->{edges} && exists $args->{bounds};
159              
160             edges_from_bounds( $args )
161             if exists $args->{bounds};
162              
163             return $args;
164              
165             };
166              
167             sub edges_from_bounds ( $args ) {
168              
169             my $bounds = BinBounds->assert_coerce( $args->{bounds} );
170             my $includes;
171              
172             if ( exists $args->{include} ) {
173             $includes = IncludeArray->assert_coerce( $args->{include} );
174             _croak( 'number of <include> flags does not match number of bounds pairs passed via <bounds>' )
175             unless ( $bounds->@* ) / 2 == $includes->@*;
176             }
177              
178             my $n = $bounds->@*;
179             my $b_idx = 0;
180             my $i_idx = 0;
181              
182             my @edges = $bounds->@[ $b_idx++, $b_idx++ ];
183             my @include = ( $includes->[ $i_idx++ ] // 1 );
184              
185             while ( $b_idx < $n ) {
186             my ( $start, $end ) = $bounds->@[ $b_idx++, $b_idx++ ];
187             if ( $edges[-1] != $start ) {
188             push @edges, $start;
189             push @include, 0;
190             }
191             push @edges, $end;
192             push @include, ( $includes->[ $i_idx++ ] // 1 );
193             }
194              
195             delete $args->{bounds};
196             $args->{edges} = \@edges;
197             $args->{include} = \@include;
198             }
199              
200 100     100 0 6767 sub BUILD ( $self, $ ) {
  100         199  
  100         171  
201              
202 100 100       366 parameter_interface->throw( "the number of bins ( @{[ $self->nbins ]} ) "
  2         7  
203 2         52 . "and includes ( @{[ scalar $self->_include->@* ]} ) must be equal" )
204             if $self->nbins != $self->_include->@*;
205             }
206              
207              
208              
209              
210              
211              
212              
213              
214              
215              
216              
217              
218              
219              
220 6     6 1 11988 sub bin_edges ( $self ) {
  6         14  
  6         13  
221 6         13 my @edges;
222 6 50       48 push @edges, Math::BigFloat->new( POSIX::DBL_MAX ) if $self->oob;
223 6         39 push @edges, $self->_raw_edges->@*;
224 6 50       26 unshift @edges, Math::BigFloat->new( - POSIX::DBL_MAX )
225             if $self->oob;
226              
227 6         41 return $self->_convert( \@edges );
228             }
229              
230              
231              
232              
233              
234              
235              
236              
237              
238              
239              
240              
241 0     0 1 0 sub lb ( $self ) {
  0         0  
  0         0  
242 0         0 return $self->_convert( [ $self->_raw_edges->@[ 0 .. $self->nbins - 1 ] ] );
243             }
244              
245              
246              
247              
248              
249              
250              
251              
252              
253              
254              
255 0     0 1 0 sub ub ( $self ) {
  0         0  
  0         0  
256 0         0 return $self->_convert( [ $self->_raw_edges->@[ 1 .. $self->nbins ] ] );
257             }
258              
259              
260              
261              
262              
263              
264              
265              
266              
267              
268 29     29 1 39605 sub edges ( $self ) {
  29         66  
  29         42  
269 29         167 return $self->_convert( $self->_raw_edges );
270             }
271              
272              
273              
274              
275              
276              
277              
278              
279              
280 162     162 1 710 sub nedges ( $self ) {
  162         250  
  162         210  
281 162         3321 scalar $self->_raw_edges->@*;
282             }
283              
284              
285              
286              
287              
288              
289              
290              
291              
292 160     160 1 5857 sub nbins ( $self ) {
  160         283  
  160         225  
293 160         480 $self->nedges - 1;
294             }
295              
296              
297              
298              
299              
300              
301              
302              
303              
304              
305 51     51 1 34947 sub include ( $self ) {
  51         126  
  51         86  
306 51         1866 return [ $self->_include->@* ];
307             }
308              
309              
310              
311              
312              
313              
314              
315              
316              
317              
318 1     1 1 451 sub spacing ( $self ) {
  1         2  
  1         1  
319 1         4 my $edges = $self->_raw_edges;
320 1         8 return $self->_convert( [ map { ( $edges->[$_] - $edges->[ $_ - 1 ] ) } 1 .. $self->nbins ] );
  11         3377  
321             }
322              
323              
324              
325              
326              
327              
328              
329              
330              
331 21     21 1 23111 sub min ( $self ) {
  21         37  
  21         28  
332 21         104 return $self->_convert( $self->_raw_edges->[0] );
333             }
334              
335              
336              
337              
338              
339              
340              
341              
342              
343 3     3 1 1733 sub max ( $self ) {
  3         8  
  3         6  
344 3         21 return $self->_convert( $self->_raw_edges->[-1] );
345             }
346              
347              
348              
349              
350              
351              
352              
353              
354              
355 5     5 1 115 sub split ( $self ) { ## no critic (Subroutines::ProhibitBuiltinHomonyms)
  5         12  
  5         7  
356              
357 5         9 my @grids;
358              
359 5         8 my $last_idx = 0;
360              
361 5         83 my $include = $self->_include;
362              
363 5         45 foreach my $idx ( 0 .. ( $include->@* - 1 ) ) {
364              
365 55 100       87 if ( !$include->[$idx] ) {
366              
367             # skip over consecutive excludes
368 23 100       36 if ( $last_idx == $idx ) {
369 20         23 ++$last_idx;
370 20         25 next;
371             }
372              
373             # there's one more edge than include values
374 3         21 my @edges = $self->_raw_edges->@[ $last_idx .. $idx ];
375 3         52 my @include = $self->_include->@[ $last_idx .. $idx - 1 ];
376              
377 3         95 push @grids,
378             __PACKAGE__->new( {
379             edges => \@edges,
380             include => \@include,
381             oob => $self->oob,
382             } );
383              
384 3         39 $last_idx = $idx + 1;
385             }
386             }
387              
388 5 100       70 if ( $last_idx < $self->_include->@* ) {
389 2         15 my $nbins = $self->nbins;
390 2         37 push @grids,
391             __PACKAGE__->new( {
392             edges => [ $self->_raw_edges->@[ $last_idx .. $nbins ] ],
393             include => [ $self->_include->@[ $last_idx .. $nbins - 1 ] ],
394             oob => $self->oob,
395             } );
396             }
397              
398 5         67 return @grids;
399             }
400              
401              
402              
403              
404              
405              
406              
407              
408              
409              
410              
411              
412              
413              
414              
415              
416              
417              
418              
419              
420              
421              
422              
423 1     1 1 94 sub overlay ( $self, @args ) {
  1         3  
  1         3  
  1         2  
424 1         5 return overlay_n( $self, @args );
425             }
426              
427              
428              
429              
430              
431              
432              
433              
434              
435              
436              
437              
438              
439              
440              
441              
442              
443              
444              
445              
446              
447              
448              
449              
450              
451              
452              
453              
454              
455              
456              
457              
458              
459              
460              
461              
462              
463              
464              
465              
466              
467              
468              
469              
470              
471              
472              
473              
474              
475              
476              
477              
478              
479              
480              
481              
482              
483              
484              
485              
486              
487              
488              
489              
490              
491              
492              
493              
494              
495              
496              
497              
498              
499              
500              
501              
502              
503              
504              
505              
506              
507              
508              
509             sub overlay_n {
510              
511 5     5 1 88 state $signature = signature(
512             positional => [
513             ArrayRef [GridObject],
514             Optional [
515             Dict [
516             snap_dist => Optional [BigPositiveOrZeroNum],
517             snap_to => Optional [ Enum [ 'underlay', 'overlay' ] ],
518             ],
519             ],
520             ],
521             );
522              
523 5 100 66     45055 my @dict = ( @_ && is_plain_hashref( $_[-1] ) ? pop @_ : () );
524              
525 5         29 my ( $grids, $opt ) = $signature->( \@_, @dict, );
526              
527 5   100     3813 $opt->{snap_to} //= 'underlay';
528 5   66     61 $opt->{snap_dist} //= Math::BigFloat->bzero;
529              
530 5         414 my $tr = Tree->new;
531              
532 5         241 my $gi = 0;
533 5         12 for my $grid ( $grids->@* ) {
534 11         22 ++$gi;
535 11         53 my $edges = $grid->_raw_edges;
536 11         39 my $include = $grid->include;
537             $tr->range_set( $edges->[$_], $edges->[ $_ + 1 ], [ $gi, $include->[$_] ] )
538 11         169 for 0 .. ( $grid->nbins - 1 );
539              
540             # snap bin edges if they are from different grids and are too close.
541             # do this in the loop so that there are only two grids at a time
542             $tr->snap_overlaid( $gi, $opt->{snap_to}, $opt->{snap_dist} )
543 11 100       2957 if $gi > 1;
544             }
545              
546 5         1629 return $tr->to_grid;
547             }
548              
549              
550              
551              
552              
553              
554              
555              
556              
557              
558              
559              
560              
561              
562              
563              
564              
565              
566              
567              
568              
569              
570              
571              
572              
573              
574              
575              
576              
577              
578              
579              
580              
581              
582              
583              
584              
585              
586              
587              
588              
589              
590              
591              
592              
593              
594              
595              
596              
597              
598              
599              
600              
601              
602              
603              
604              
605              
606              
607              
608              
609              
610              
611              
612              
613              
614              
615              
616              
617              
618              
619              
620              
621              
622              
623              
624              
625              
626              
627              
628              
629              
630              
631              
632              
633              
634              
635              
636              
637              
638              
639              
640              
641              
642              
643              
644              
645              
646              
647              
648              
649              
650              
651              
652              
653              
654              
655              
656              
657              
658              
659              
660              
661              
662              
663              
664              
665              
666              
667              
668              
669              
670              
671              
672              
673             sub join_n {
674              
675             ## no critic(NamingConventions::ProhibitAmbiguousNames)
676              
677             # these are called as $sub->( \@edges, \@include, \@right_edges, \@right_include );
678             # @edges and @include are mutable and always contain the left grid
679              
680             state %dispatch = (
681             'shift-right' => sub {
682 1     1   9 my ( $edges, $include, $redges, $rinclude ) = @_;
683              
684 1         6 my $delta = $redges->[0] - $edges->[-1];
685 1         388 $_ += $delta for $edges->@*;
686 1         589 pop @$edges;
687 1         7 push @$edges, $redges->@*;
688 1         7 push @$include, $rinclude->@*;
689             },
690              
691             'shift-left' => sub {
692 1     1   13 my ( $edges, $include, $redges, $rinclude ) = @_;
693              
694 1         9 my $delta = $redges->[0] - $edges->[-1];
695 1         707 my $left = pop @$edges;
696 1         5 my $idx = @$edges;
697 1         4 push @$edges, map { $_ - $delta } $redges->@*;
  3         1103  
698 1         573 $edges->[$idx] = $left;
699              
700 1         10 push @$include, $rinclude->@*;
701             },
702              
703             'snap-right' => sub {
704 1     1   16 my ( $edges, $include, $redges, $rinclude ) = @_;
705              
706 1         4 pop @$edges;
707 1         6 push @$edges, $redges->@*;
708 1         5 push @$include, $rinclude->@*;
709             },
710              
711             'snap-left' => sub {
712 1     1   14 my ( $edges, $include, $redges, $rinclude ) = @_;
713              
714 1         3 my $left = pop @$edges;
715 1         3 my $idx = @$edges;
716              
717 1         6 push @$edges, $redges->@*;
718 1         3 $edges->[$idx] = $left;
719 1         6 push @$include, $rinclude->@*;
720             },
721              
722             'snap-both' => sub {
723 1     1   14 my ( $edges, $include, $redges, $rinclude ) = @_;
724              
725 1         9 my $middle = ( $redges->[0] + $edges->[-1] ) / 2;
726              
727 1         1880 pop @$edges;
728 1         142 my $idx = @$edges;
729 1         6 push @$edges, $redges->@*;
730 1         4 $edges->[$idx] = $middle;
731              
732 1         5 push @$include, $rinclude->@*;
733             },
734              
735             'include' => sub {
736 2     2   16 my ( $edges, $include, $redges, $rinclude ) = @_;
737              
738             # just in case grids actually abut
739 2 50       8 if ( $edges->[-1] == $redges->[0] ) {
    50          
740              
741 0         0 pop @$edges;
742 0         0 push @$edges, $redges->@*;
743 0         0 push @$include, $rinclude->@*;
744             }
745             elsif ( $edges->[-1] < $redges->[0] ) {
746 2         708 push @$edges, $redges->@*;
747 2         6 push @$include, 1, $rinclude->@*;
748             }
749             else {
750 0         0 parameter_constraint->throw( 'add-bin-include cannot handle overlapping grids' );
751             }
752             },
753              
754             'exclude' => sub {
755 1     1   8 my ( $edges, $include, $redges, $rinclude ) = @_;
756              
757             # just in case grids actually abut
758 1 50       4 if ( $edges->[-1] == $redges->[0] ) {
    50          
759              
760 0         0 pop @$edges;
761 0         0 push @$edges, $redges->@*;
762 0         0 push @$include, $rinclude->@*;
763             }
764             elsif ( $edges->[-1] < $redges->[0] ) {
765 1         342 push @$edges, $redges->@*;
766 1         3 push @$include, 0, $rinclude->@*;
767             }
768             else {
769 0         0 parameter_constraint->throw( 'add-bin-exclude cannot handle overlapping grids' );
770             }
771             },
772              
773 17     17 1 2595 );
774              
775              
776 17         38 state $check = signature(
777             positional => [
778             ArrayRef [GridObject],
779             Optional [
780             Dict [
781             gap => Enum [ qw(
782             shift-right
783             shift-left
784             snap-right
785             snap-left
786             snap-both
787             include
788             exclude
789             ),
790             ],
791             ],
792             ],
793             ],
794             );
795              
796 17 100 100     17035 my @dict = ( @_ && is_plain_hashref( $_[-1] ) ? pop @_ : () );
797              
798 17         87 my ( $grids, $opts ) = $check->( \@_, @dict, );
799              
800 17   100     495 $opts->{gap} //= 'include';
801              
802 17 100       93 parameter_interface->throw( 'join_n: no grids supplied' )
803             unless $grids->@*;
804              
805             # sort grids
806 16         95 my @grid_idx = sort { $grids->[$a]->min <=> $grids->[$b]->min } 0 .. ( $grids->@* - 1 );
  9         49  
807              
808 16         1183 my ( $left, @rest ) = @grid_idx;
809 16         27 my $gl = $grids->[$left];
810              
811 16         58 my @edges = $gl->_raw_edges->@*;
812 16         344 my @include = $gl->_include->@*;
813              
814 16         133 my $gr;
815              
816 16         32 for my $right ( @rest ) {
817              
818 9         26 $gr = $grids->[$right];
819              
820             ## no critic( ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions )
821 9 100 66     67 parameter_constraint->throw( "grid[$right] overlaps grid[$left] by more than one bin" )
822             unless $gl->_raw_edges->[-2] < $gr->_raw_edges->[0]
823             && $gl->_raw_edges->[-1] < $gr->_raw_edges->[1];
824              
825 8   33     4282 my $join = $dispatch{ $opts->{gap} } // internal->throw( "unexpected dispatch key: $opts->{gap}" );
826              
827             eval {
828 8         222 $join->( \@edges, \@include, $gr->_raw_edges, $gr->_include );
829 8         55 1;
830 8 50       19 } or do {
831 0         0 my $error = $@;
832 0 0       0 if ( !is_blessed_ref $error ) {
833 0         0 $error = "grid[$right]: $error";
834             }
835             else {
836 0         0 $error->$_call_if_can( msg => "grid[$right]: " . $error->msg );
837             }
838              
839 0         0 die $error;
840             };
841             }
842             continue {
843 8         19 $left = $right;
844 8         24 $gl = $gr;
845             }
846              
847 15         338 return __PACKAGE__->new( edges => \@edges, include => \@include );
848             }
849              
850              
851              
852              
853              
854              
855              
856              
857              
858              
859              
860              
861              
862              
863              
864 1     1 1 3 sub not ( $self ) { ## no critic (Subroutines::ProhibitBuiltinHomonyms)
  1         2  
  1         2  
865              
866 1         7 my $hash = $self->TO_HASH;
867 1 100       10 $_ = $_ ? 0 : 1 for $hash->{include}->@*;
868 1         34 return __PACKAGE__->new( $hash );
869             }
870              
871 1     1   29 sub _overload_not ( $self, $, $ ) {
  1         3  
  1         2  
872 1         5 return $self->not;
873             }
874              
875              
876              
877              
878              
879              
880              
881              
882              
883              
884              
885              
886              
887             # need extra args if bitwise feature is on.
888 2     2   62 sub _overload_or ( $self, $other, $ =, $ =, $ = ) {
  2         4  
  2         6  
  2         4  
889 2 50       14 $other->$_isa( __PACKAGE__ )
890 0         0 or die( "can only perform the | operation between two ${ \__PACKAGE__ } objects " );
891 2         59 return $self->or( $other );
892             }
893              
894              
895              
896              
897              
898              
899              
900              
901              
902              
903 2     2 1 5 sub or ( $self, @args ) { ## no critic (Subroutines::ProhibitBuiltinHomonyms)
  2         4  
  2         7  
  2         5  
904 2         14 return or_n( $self, @args );
905             }
906              
907              
908              
909              
910              
911              
912              
913              
914              
915              
916              
917              
918              
919              
920              
921              
922              
923              
924              
925              
926              
927              
928              
929              
930              
931              
932              
933              
934              
935              
936              
937             signature_for or_n => ( positional => [ Slurpy [ ArrayRef [GridObject] ] ], );
938             sub or_n ( $grids ) {
939             my $tr = Tree->new;
940              
941             my $gi = 0;
942              
943             # the code for and_n is easier to understand; rewrite this to use
944             # that algorithm.
945             for my $grid ( $grids->@* ) {
946             ++$gi;
947             my $edges = $grid->_raw_edges;
948             my $include = $grid->include;
949              
950             my @idx = 0 .. ( $grid->nbins - 1 );
951             @idx = grep $include->[$_], @idx
952             if $gi > 1;
953              
954             $tr->range_set( $edges->@[ $_, $_ + 1 ], $include->[$_] ) for @idx;
955             }
956              
957             return $tr->to_grid;
958             }
959              
960              
961              
962              
963              
964              
965              
966              
967              
968              
969              
970              
971              
972             # need extra args if bitwise feature is on.
973 2     2   51 sub _overload_and ( $self, $other, $ =, $ =, $ = ) {
  2         4  
  2         4  
  2         4  
974 2 50       14 $other->$_isa( __PACKAGE__ )
975 0         0 or die( "can only perform the | operation between two ${ \__PACKAGE__ } objects " );
976 2         40 return $self->and( $other );
977             }
978              
979              
980              
981              
982              
983              
984              
985              
986              
987              
988 2     2 1 5 sub and ( $self, @args ) { ## no critic (Subroutines::ProhibitBuiltinHomonyms)
  2         2  
  2         5  
  2         5  
989 2         9 return and_n( $self, @args );
990             }
991              
992              
993              
994              
995              
996              
997              
998              
999              
1000              
1001              
1002              
1003              
1004              
1005              
1006              
1007              
1008              
1009              
1010              
1011              
1012              
1013              
1014              
1015              
1016              
1017              
1018              
1019              
1020              
1021              
1022             signature_for and_n => ( positional => [ Slurpy [ ArrayRef [GridObject] ] ], );
1023             sub and_n ( $grids ) {
1024              
1025              
1026             # need to get all of the grid's bins on the same grid.
1027              
1028             # create a sorted list of bin edges from all of the grids, then,
1029             # ask each grid what it's include value is for each bin and
1030              
1031             my @edge = uniqnum sort { $a <=> $b } map { $_->_raw_edges->@* } $grids->@*;
1032             my @include = ( 1 ) x ( @edge - 1 );
1033             my $nbins = @include;
1034              
1035             for my $grid ( $grids->@* ) {
1036             my $tree = Tree->from_grid( $grid );
1037              
1038             # we don't care about the last edge, as anything beyond that
1039             # has fallen off the edge of the universe.
1040             for my $idx ( 0 .. $nbins - 1 ) {
1041             my ( $v ) = $tree->get_range( $edge[$idx] );
1042             $include[$idx] &&= $v // 0;
1043             }
1044             }
1045              
1046             return __PACKAGE__->new(
1047             edges => \@edge,
1048             include => \@include,
1049             );
1050             }
1051              
1052              
1053              
1054              
1055              
1056              
1057              
1058              
1059              
1060              
1061              
1062              
1063              
1064              
1065              
1066              
1067              
1068              
1069              
1070              
1071 5     5 1 7512 sub combine_bins ( $self ) {
  5         12  
  5         10  
1072              
1073 5         30 my $edges = $self->_raw_edges;
1074 5         18 my $include = $self->include;
1075              
1076             my $tr = Tree->new( {
1077 76 100 66 76   13090 'equal-p' => sub { defined $_[0] && defined $_[1] && $_[0] == $_[1] },
1078 5         169 } );
1079              
1080 5         258 $tr->range_set( $edges->[$_], $edges->[ $_ + 1 ], $include->[$_] ) for 0 .. ( $include->@* - 1 );
1081              
1082 5         1777 return $tr->to_grid;
1083             }
1084              
1085              
1086              
1087              
1088              
1089              
1090              
1091              
1092              
1093              
1094              
1095              
1096              
1097              
1098              
1099              
1100              
1101              
1102              
1103 1     1 1 20 sub bignum ( $self ) {
  1         2  
  1         2  
1104 1         7 require Moo::Role;
1105 1         9 return Moo::Role->apply_roles_to_object(
1106             __PACKAGE__->new( $self->TO_HASH ),
1107             __PACKAGE__ . '::Role::BigNum',
1108             );
1109             }
1110              
1111              
1112              
1113              
1114              
1115              
1116              
1117              
1118              
1119              
1120              
1121              
1122              
1123              
1124              
1125              
1126              
1127 0     0 1 0 sub pdl ( $self ) {
  0         0  
  0         0  
1128 0         0 require Moo::Role;
1129 0         0 return Moo::Role->apply_roles_to_object(
1130             __PACKAGE__->new( $self->TO_HASH ),
1131             __PACKAGE__ . '::Role::PDL',
1132             );
1133             }
1134              
1135              
1136              
1137              
1138              
1139              
1140              
1141              
1142              
1143              
1144              
1145 2     2   1864 sub _modify_hashr ( $self, $hash ) {
  2         4  
  2         6  
  2         3  
1146 2         8 $hash->{edges} = [ map { $_->copy } $hash->{edges}->@* ];
  15         310  
1147             $hash->{include} = [ $hash->{include}->@* ]
1148 2 50       67 if exists $hash->{include};
1149             }
1150              
1151              
1152              
1153              
1154              
1155              
1156              
1157              
1158              
1159              
1160 0     0 1   sub to_string ( $self ) {
  0            
  0            
1161              
1162 0           my @edge = map { $_->numify } $self->_raw_edges->@*;
  0            
1163 0           my @bin = map { [ $edge[$_], $edge[ $_ + 1 ] ] } 0 .. @edge - 2;
  0            
1164              
1165 0 0         if ( $self->_has_include ) {
1166 0           push $bin[$_]->@*, $self->include->[$_] for 0 .. @bin - 1;
1167             }
1168              
1169 0           return join "\n", map { join ', ', $_->@* } @bin;
  0            
1170             }
1171              
1172              
1173             1;
1174              
1175             #
1176             # This file is part of CXC-Number
1177             #
1178             # This software is Copyright (c) 2019 by Smithsonian Astrophysical Observatory.
1179             #
1180             # This is free software, licensed under:
1181             #
1182             # The GNU General Public License, Version 3, June 2007
1183             #
1184              
1185             __END__
1186              
1187             =pod
1188              
1189             =for :stopwords Diab Jerius Smithsonian Astrophysical Observatory nbins ndarrays nedges oob
1190             ub unobscured Extrema bignum pdl
1191              
1192             =head1 NAME
1193              
1194             CXC::Number::Grid - A class representing a one dimensional numeric grid
1195              
1196             =head1 VERSION
1197              
1198             version 0.13
1199              
1200             =head1 SYNOPSIS
1201              
1202             $grid1 = CXC::Number::Grid->new( edges => [ 1, 2, 3 ] );
1203             $grid2 = CXC::Number::Grid->new( edges => [ 4, 5, 6 ] );
1204              
1205             $gridj = $grid1->join( $grid2 );
1206              
1207             =head1 DESCRIPTION
1208              
1209             C<CXC::Number::Grid> provides an abstraction of a one dimensional
1210             grid. A grid is composed of contiguous bins, each of which has a flag
1211             indicating whether or not it should be included in a process (where
1212             I<process> is defined by the user of the grid).
1213              
1214             This class provides facilities to I<join> grids (e.g. butt them
1215             together) and I<overlay> grids, with a number of approaches to
1216             handle the consequences of inevitable numeric imprecision.
1217              
1218             Underneath the grid is stored as L<Math::BigFloat> objects.
1219              
1220             =head1 OBJECT ATTRIBUTES
1221              
1222             =head2 oob
1223              
1224             A boolean, which, if true, indicates that extra bins are added to
1225             either end of the grid which catch values outside of the range of the
1226             grid.
1227              
1228             =head2 edges
1229              
1230             An array of ascending numbers which represent the edges of the bins in the grid.
1231              
1232             =head2 include
1233              
1234             An array of flags (C<0>, C<1>), one per bin, indicating whether the bin should be included when binning or not.
1235              
1236             =head1 CONSTRUCTORS
1237              
1238             =head2 new
1239              
1240             $grid = CXC::Number::Grid->new( \%args );
1241              
1242             The constructor takes the following arguments:
1243              
1244             =over
1245              
1246             =item C<edges> => I<array of numbers or Math::BigFloat objects>
1247              
1248             The bin edges in the grid. Will be converted to L<Math::BigFloat>
1249             objects if they're not already. These must be in ascending order.
1250              
1251             Specify either C<bounds> or C<edges> but not both.
1252              
1253             =item C<include> => I<array of Flags>
1254              
1255             An array of flags (C<0>, C<1>), one per I<bin> (not one per edge!),
1256             indicating whether the bin should be included when binning or not.
1257              
1258             =item C<oob> I<Boolean>
1259              
1260             If true, C<< L</bin_edges> >> will extend the grid by one bin at each end.
1261             The new lower bound is C<-POSIX::DBL_MAX> and the new upper bounds
1262             will be C<POSIX::DBL_MAX>. This allows out-of-bounds data to be accumulated
1263             at the front and back of the grid.
1264              
1265             =item C<bounds> => I<array of numbers or Math::BigFloat objects>
1266              
1267             Instead of specifying the bin edges, the upper and lower bounds for
1268             each bin may be specified. If the supplied bins are not contiguous,
1269             interstitial bins will be created with an include flag of 0.
1270              
1271             The bounds are specified as I<lower bound>, I<upper bound> pairs in the
1272             passed array, e.g.
1273              
1274             [ $lb0, $ub0, $lb1, $ub1 ]
1275              
1276             Specify either C<bounds> or C<edges> but not both.
1277              
1278             =back
1279              
1280             =head1 METHODS
1281              
1282             =head2 bin_edges
1283              
1284             $bin_edges = $grid->bin_edges;
1285              
1286             Return the bin edges which should be used for binning as an array of
1287             Perl numbers. This differs from C<< L</edges> >> in that this
1288             includes the extra bins required to collect out-of-bounds values if
1289             the C<< L</oob> >> parameter is true. Extrema edges are set to
1290             C<-POSIX::DBL_MAX> and C<POSIX::DBL_MAX>.
1291              
1292             =head2 lb
1293              
1294             $lb = $grid->lb;
1295              
1296             Returns a reference to an array of Perl numbers which contains the
1297             lower bound values for the bins in the grid. This does I<not> return
1298             out-of-bounds bin values.
1299              
1300             =head2 ub
1301              
1302             $ub = $grid->ub;
1303              
1304             Returns a reference to an array of Perl numbers which contains the
1305             upper bound values for the bins in the grid. This does I<not> return
1306             out-of-bounds bin values.
1307              
1308             =head2 edges
1309              
1310             $edges = $grid->edges;
1311              
1312             Returns a reference to an array of Perl numbers which contains the edge values
1313             for the bins in the grid.
1314              
1315             =head2 nedges
1316              
1317             $nedges = $grid->nedges;
1318              
1319             The number of bin edges.
1320              
1321             =head2 nbins
1322              
1323             $nbins = $grid->nbins;
1324              
1325             The number of bins.
1326              
1327             =head2 include
1328              
1329             $include = $grid->include;
1330              
1331             Returns a reference to an array of flags C<0>, C<1>, indicating whether a bin
1332             should be included in a I<process>.
1333              
1334             =head2 spacing
1335              
1336             $spacing = $grid->spacing;
1337              
1338             Returns a reference to an array of Perl numbers which contains the widths of each bin
1339             in the grid.
1340              
1341             =head2 min
1342              
1343             $min = $grid->min;
1344              
1345             Returns the minimum bound of the grid as a Perl number.
1346              
1347             =head2 max
1348              
1349             $max = $grid->max;
1350              
1351             Returns the maximum bound of the grid as a Perl number.
1352              
1353             =head2 split
1354              
1355             @grids = $grid->split;
1356              
1357             Splits a grid on bins with an include value of C<0>.
1358              
1359             =head2 join
1360              
1361             $grid = $grid1->join( $grid2, $grid3, ..., ?\%options );
1362              
1363             Join two grids together. This is akin to a I<butt> joint, with control
1364             over how to handle any gap between the grids.
1365              
1366             See C<< L</join_n> >> for a description of the options.
1367              
1368             =head2 overlay
1369              
1370             $grid = $grid1->overlay( $grid2, ..., $gridn, ?\%options );
1371              
1372             Overlay one or more grids on top of C<$grid1> and return a new grid.
1373              
1374             See C<< L</overlay_n> >> for a description of the options.
1375              
1376             =head2 not
1377              
1378             $flipped = $grid->not;
1379              
1380             return a copy of C<$grid> with a Boolean not of its include values.
1381              
1382             =head2 or
1383              
1384             $ABC = $A->or( $B, $C, ..., ?\%options );
1385              
1386             Perform the logical OR of grids and return a new grid.
1387             See C<< L</or_n> >> for a description of the options.
1388              
1389             =head2 and
1390              
1391             $ABC = $A->and( $B, $C, ..., ?\%options );
1392              
1393             Perform the logical AND of grids and return a new grid.
1394             See C<< L</and_n> >> for a description of the options.
1395              
1396             =head2 combine_bins
1397              
1398             $combined = $grid->combine_bins
1399              
1400             Combine adjacent bins with the same C<include> value.
1401              
1402             For instance, a grid with the following construction:
1403              
1404             edges => [ 0, 2, 4, 8, 12, 16 ]
1405             include => [ 0, 0, 1, 1, 0 ]
1406              
1407             Would be combined into
1408              
1409             edges => [ 0, 4, 12, 16 ]
1410             include => [ 0, 1, 0 ]
1411              
1412             =head2 bignum
1413              
1414             $bin_edges = $grid->bignum->bin_edges;
1415              
1416             Returns an object which returns copies of the internal
1417             L<Math::BigFloat> objects for the following methods
1418              
1419             edges -> Array[Math::BigFloat]
1420             bin_edges -> Array[Math::BigFloat]
1421             spacing -> Array[Math::BigFloat]
1422             lb -> Array[Math::BigFloat]
1423             ub -> Array[Math::BigFloat]
1424             min -> Math::BigFloat
1425             max -> Math::BigFloat
1426              
1427             =head2 pdl
1428              
1429             $bin_edges = $grid->pdl->bin_edges;
1430              
1431             Returns an object which returns ndarrays for the following methods
1432              
1433             edges -> ndarray
1434             include -> ndarray
1435             bin_edges -> ndarray
1436             spacing -> ndarray
1437             lb -> ndarray
1438             ub -> ndarray
1439              
1440             =head2 to_string
1441              
1442             $string = $grid->to_string
1443              
1444             Create a fairly readable string representation of the structure of a
1445             grid.
1446              
1447             =head1 OVERLOAD
1448              
1449             =head2 !
1450              
1451             The logical NOT C<!> operator is overloaded; see L</not> for details.
1452              
1453             =head2 |
1454              
1455             $AB = $A | $B
1456              
1457             The logical OR C<!> operator is overloaded via
1458              
1459             $AB = $A->or($B);
1460              
1461             see L</or> for details.
1462              
1463             =head2 &
1464              
1465             $AB = $A | $B
1466              
1467             The logical AND C<&> operator is overloaded via
1468              
1469             $AB = $A->and($B);
1470              
1471             see L</or> for details.
1472              
1473             =head1 SUBROUTINES
1474              
1475             =head2 overlay_n
1476              
1477             $grid = CXC::Number::Grid::overlay_n( $grid1, $grid2, ... $gridN, ?\%options );
1478              
1479             Overlay each successive grid on the overlay of the previous sequence of grids.
1480             The process essentially excises the range in the underlying grid covered by the
1481             overlying grid and inserts the overlying grid in that place. For example, if
1482              
1483             $overlay = overlay_n( $grid1, $grid2 );
1484              
1485             with
1486              
1487             $grid1:
1488             : +-------------------------------------------------+
1489             : | | | | | | | | | | |
1490             : +-------------------------------------------------+
1491             $grid2:
1492             : +--------------------------------+
1493             : | | | |
1494             : +--------------------------------+
1495             $overlay:
1496             : +-------------------------------------------------+
1497             : | | | | | | | |
1498             : +-------------------------------------------------+
1499              
1500             The C<%options> hash is optional; the following options are available:
1501              
1502             =over
1503              
1504             =item C<snap_dist> => I<float>
1505              
1506             If the minimum or maximum edge of an overlying grid is closer than
1507             this number to the nearest unobscured edge in the underlying grid,
1508             snap the grid edges according to the value of L<snap_to>.
1509              
1510             The default value is C<0>, which turns off snapping.
1511              
1512             =item C<snap_to> => C<underlay> | C<overlay>
1513              
1514             This indicates how to treat bin edges when C<< L</snap_dist> >> is not zero.
1515             From the above example of the overlay of two grids:
1516              
1517             0 1 2 3 4 5 6 7
1518             +-------------------------------------------------+
1519             | | | | | | | |
1520             +-------------------------------------------------+
1521             1 1 2 2 2 2 1 1
1522              
1523             The upper numbers are the edge indices and the lower indicate the grid
1524             the edge came from.
1525              
1526             Note how close edges I<1> and I<2> are. Imagine that they are
1527             actually supposed to be the same, but numerical imprecision is at
1528             play.
1529              
1530             Setting C<snap_to> to C<underlay> will adjust edge I<2> (which
1531             originates from C<$grid2>, the overlying grid) so that it is equal to
1532             edge I<1> (from C<$grid1>, the underlying grid).
1533              
1534             0 1 2 3 4 5 6
1535             +-------------------------------------------------+
1536             | | | | | | |
1537             +-------------------------------------------------+
1538             1 1 2 2 2 1 1
1539              
1540             Conversely, setting C<snap_to> to C<overlay> will adjust edge I<1>
1541             (originating from C<$grid1>, the underlying grid) so that it is equal
1542             to edge I<2> (from C<$grid2> the overlying grid).
1543              
1544             0 1 2 3 4 5 6
1545             +-------------------------------------------------+
1546             | | | | | | |
1547             +-------------------------------------------------+
1548             1 2 2 2 2 1 1
1549              
1550             =back
1551              
1552             =head2 join_n
1553              
1554             $grid = CXC::Number::Grid::join_n( $grid1, $grid2, ..., $gridN, ?\%options );
1555              
1556             Join one or more grids. This is akin to a I<butt> joint, with control
1557             over how to handle any gap between the grids.
1558              
1559             While normally grids should not overlap, up to one overlapping bin is
1560             allowed in order to accommodate numerical imprecision. The C<< L</gap> >>
1561             option determines how to handle overlaps or gap.
1562              
1563             The C<%options> hash is optional; the following options are available:
1564              
1565             =over
1566              
1567             =item gap => I<directive>
1568              
1569             What to do if the two grids do not exactly touch. The default is C<include>.
1570              
1571             Available directives are:
1572              
1573             =over
1574              
1575             =item C<shift-right>
1576              
1577             Translate the left grid until its maximum edge coincides with the right grid's minimum edge.
1578              
1579             Before:
1580             : +-----------------------+ +-----------------------+
1581             : | | | | | | | | | | | | | | | | | |
1582             : +-----------------------+ +-----------------------+
1583             After:
1584             : +-----------------------+-----------------------+
1585             : | | | | | | | | | | | | | | | | |
1586             : +-----------------------+-----------------------+
1587              
1588             =item C<shift-left>
1589              
1590             Translate the right grid until its minimum edge coincides with the let grid's maximum edge.
1591              
1592             Before:
1593             : +-----------------------+ +-----------------------+
1594             : | | | | | | | | | | | | | | | | | |
1595             : +-----------------------+ +-----------------------+
1596             After:
1597             : +-----------------------+-----------------------+
1598             : | | | | | | | | | | | | | | | | |
1599             : +-----------------------+-----------------------+
1600              
1601             =item C<snap-right>
1602              
1603             Set the left grid's maximum edge to the right grid's minimum edge.
1604              
1605             Before:
1606             : +-----------------------+ +-----------------------+
1607             : | | | | | | | | | | | | | | | | | |
1608             : +-----------------------+ +-----------------------+
1609             After:
1610             : +-------------------------------------------------+
1611             : | | | | | | | | | | | | | | | | |
1612             : +-------------------------------------------------+
1613              
1614             =item C<snap-left>
1615              
1616             Set the right grid's minimum edge to the left grid's maximum edge.
1617              
1618             Before:
1619             : +-----------------------+ +-----------------------+
1620             : | | | | | | | | | | | | | | | | | |
1621             : +-----------------------+ +-----------------------+
1622             After:
1623             : +-------------------------------------------------+
1624             : | | | | | | | | | | | | | | | | |
1625             : +-------------------------------------------------+
1626              
1627             =item C<snap-both>
1628              
1629             Set both the right grid's minimum edge and the left grid's maximum edge
1630             to the average of the two.
1631              
1632             Before:
1633             : +-----------------------+ +-----------------------+
1634             : | | | | | | | | | | | | | | | | | |
1635             : +-----------------------+ +-----------------------+
1636             After:
1637             : +-------------------------------------------------+
1638             : | | | | | | | | | | | | | | | | |
1639             : +-------------------------------------------------+
1640              
1641             =item C<include>
1642              
1643             Add a new bin
1644              
1645             Before:
1646             : +-----------------------+ +-----------------------+
1647             : | | | | | | | | | | | | | | | | | |
1648             : +-----------------------+ +-----------------------+
1649             After:
1650             : +-------------------------------------------------+
1651             : | | | | | | | | | | | | | | | | | |
1652             : +-------------------------------------------------+
1653              
1654             =back
1655              
1656             =item C<exclude>
1657              
1658             Add a new bin, and mark it as being excluded
1659              
1660             Before:
1661             : +-----------------------+ +-----------------------+
1662             : | | | | | | | | | | | | | | | | | |
1663             : +-----------------------+ +-----------------------+
1664             After:
1665             : +-------------------------------------------------+
1666             : | | | | | | | | |X| | | | | | | | |
1667             : +-------------------------------------------------+
1668              
1669             =back
1670              
1671             =head2 or_n
1672              
1673             $grid = CXC::Number::Grid::or_n( $grid1, $grid2, ..., $gridN, ?\%options );
1674              
1675             Logical OR of grids based upon their include values. For example, given
1676             two grids:
1677              
1678             Grid A:
1679              
1680             edges => [ 0, 2, 4, 8, 12, 16 ]
1681             include => [ 0, 1, 0, 1, 0 ]
1682              
1683             Grid B;
1684             edges => [ 0, 3, 6, 9, 10, 11, 16 ]
1685             include => [ 1, 0, 1, 0, 1, 0 ]
1686              
1687             The result of
1688              
1689             $A | $B
1690              
1691             would be
1692              
1693             edges => [ 0, 3, 4, 6, 9, 10, 11, 12, 16 ];
1694             include => [ 1, 1, 0, 1, 1, 1, 1, 0 ];
1695              
1696             The L</oob> option for the returned grid is set to the default value.
1697              
1698             =head2 and_n
1699              
1700             $grid = CXC::Number::Grid::and_n( $grid1, $grid2, ..., $gridN, ?\%options );
1701              
1702             Logical AND of grids based upon their include values. For example, given
1703             two grids:
1704              
1705             Grid A:
1706              
1707             edges => [ 0, 2, 4, 8, 10, 16, 18 ]
1708             include => [ 0, 1, 0, 1, 0, 1 ]
1709              
1710             Grid B;
1711             edges => [ 1, 3, 6, 9, 10, 11, 16 ]
1712             include => [ 1, 0, 1, 0, 1, 0 ]
1713              
1714             The result of
1715              
1716             $A & $B
1717              
1718             would be
1719              
1720             edges => [ 0, 1, 2, 3, 4, 6, 8, 9, 10, 11, 16, 18 ];
1721             include => [ 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0 ];
1722              
1723             The L</oob> option for the returned grid is set to the default value.
1724              
1725             =head1 INTERNALS
1726              
1727             =head2 Methods
1728              
1729             =head3 _modify_hashr
1730              
1731             This is called by MooX::Tag::TO_HASH to modify the generated hash
1732             representation.
1733              
1734             This routine makes copies of the structures so that the hash
1735             can be modified without affecting the parent object.
1736              
1737             =for Pod::Coverage BUILDARGS
1738             BUILD
1739              
1740             =head1 SUPPORT
1741              
1742             =head2 Bugs
1743              
1744             Please report any bugs or feature requests to bug-cxc-number@rt.cpan.org or through the web interface at: L<https://rt.cpan.org/Public/Dist/Display.html?Name=CXC-Number>
1745              
1746             =head2 Source
1747              
1748             Source is available at
1749              
1750             https://gitlab.com/djerius/cxc-number
1751              
1752             and may be cloned from
1753              
1754             https://gitlab.com/djerius/cxc-number.git
1755              
1756             =head1 SEE ALSO
1757              
1758             Please see those modules/websites for more information related to this module.
1759              
1760             =over 4
1761              
1762             =item *
1763              
1764             L<CXC::Number|CXC::Number>
1765              
1766             =item *
1767              
1768             L<CXC::Number::Sequence|CXC::Number::Sequence>
1769              
1770             =back
1771              
1772             =head1 AUTHOR
1773              
1774             Diab Jerius <djerius@cpan.org>
1775              
1776             =head1 COPYRIGHT AND LICENSE
1777              
1778             This software is Copyright (c) 2019 by Smithsonian Astrophysical Observatory.
1779              
1780             This is free software, licensed under:
1781              
1782             The GNU General Public License, Version 3, June 2007
1783              
1784             =cut