1package Data::Range::Compare;
2
3use strict;
4use warnings;
5use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
6use overload '""'=>\&notation ,fallback=>1;
7
8require Exporter;
9$VERSION='1.031';
10
11@ISA=qw(Exporter);
12
13use constant key_helper    => 0;
14use constant key_start     => 1;
15use constant key_end       => 2;
16use constant key_generated => 3;
17use constant key_missing   => 4;
18use constant key_data      => 5;
19
20@EXPORT_OK=qw(
21  key_helper
22  key_start
23  key_end
24  key_generated
25  key_missing
26  key_data
27
28  add_one
29  sub_one
30  cmp_values
31
32  sort_largest_range_end_first
33  sort_largest_range_start_first
34  sort_smallest_range_start_first
35  sort_smallest_range_end_first
36  sort_in_consolidate_order
37  sort_in_presentation_order
38
39  HELPER_CB
40);
41
42%EXPORT_TAGS=(
43  KEYS=>[qw(
44 	  key_helper
45          key_start
46          key_end
47          key_generated
48          key_missing
49          key_data
50  )]
51
52  ,ALL=>\@EXPORT_OK
53
54  ,HELPER_CB=>[qw(HELPER_CB)]
55  ,HELPER=>[qw(add_one sub_one cmp_values)]
56  ,SORT=>[qw(
57    sort_largest_range_end_first
58    sort_largest_range_start_first
59    sort_smallest_range_start_first
60    sort_smallest_range_end_first
61    sort_in_consolidate_order
62    sort_in_presentation_order
63   )]
64);
65
66sub new {
67  my $s=shift @_;
68  bless [@_],$s;
69}
70
71sub helper_cb { my ($s,$key,@args)=@_; $s->[key_helper]->{$key}->(@args) }
72
73sub range_start () { $_[0]->[key_start] }
74sub range_end () { $_[0]->[key_end] }
75
76sub notation {
77  my $notation=join ' - ',$_[0]->range_start,$_[0]->range_end;
78  $notation;
79}
80sub helper_hash () { $_[0]->[key_helper] }
81sub missing () {$_[0]->[key_missing] }
82sub generated () {$_[0]->[key_generated] }
83
84sub data () {
85  my ($s)=@_;
86  return $s->[key_data] if ref($s->[key_data]);
87  $s->[key_data]={};
88  $s->[key_data]
89}
90
91sub overlap ($) {
92  my ($range_a,$range_b)=@_;
93  return 1 if
94      $range_a->cmp_range_start($range_b)!=1
95        &&
96      $range_a->cmp_range_end($range_b)!=-1;
97  return 1 if
98      $range_a->helper_cb(
99        'cmp_values'
100	,$range_a->range_start
101	,$range_b->range_end
102      )!=1
103        &&
104      $range_a->helper_cb(
105        'cmp_values'
106	,$range_a->range_end
107	,$range_b->range_end
108      )!=-1;
109
110  return 1 if
111      $range_b->cmp_range_start($range_a)!=1
112        &&
113      $range_b->cmp_range_end($range_a)!=-1;
114
115  return 1 if
116      #$range_b->range_start <=$range_a->range_end
117      $range_a->helper_cb(
118        'cmp_values'
119	,$range_b->range_start
120	,$range_a->range_end
121      )!=1
122        &&
123      $range_a->helper_cb(
124        'cmp_values'
125	,$range_b->range_end
126	,$range_a->range_end
127      )!=-1;
128
129  undef
130}
131
132sub grep_overlap ($) { [ grep {$_[0]->overlap($_) } @{$_[1]} ] }
133sub grep_nonoverlap ($) { [ grep { $_[0]->overlap($_) ? 0 : 1 } @{$_[1]} ] }
134
135sub contains_value ($) {
136  my ($s,$cmp)=@_;
137  return 0 if $s->helper_cb('cmp_values',$s->range_start,$cmp)==1;
138  return 0 if $s->helper_cb('cmp_values',$cmp,$s->range_end)==1;
139  1
140}
141
142sub next_range_start () { $_[0]->helper_cb('add_one',$_[0]->range_end)  }
143sub previous_range_end () { $_[0]->helper_cb('sub_one',$_[0]->range_start)  }
144
145sub cmp_range_start($) {
146  my ($s,$cmp)=@_;
147  $s->helper_cb('cmp_values',$s->range_start,$cmp->range_start)
148}
149
150sub cmp_range_end($) {
151  my ($s,$cmp)=@_;
152  $s->helper_cb('cmp_values',$s->range_end,$cmp->range_end)
153}
154
155sub contiguous_check ($) {
156  my ($cmp_a,$cmp_b)=@_;
157  $cmp_a->helper_cb(
158   'cmp_values'
159   ,$cmp_a->next_range_start
160   ,$cmp_b->range_start
161  )==0
162}
163
164sub cmp_ranges ($) {
165  my ($range_a,$range_b)=@_;
166  my $cmp=$range_a->cmp_range_start($range_b);
167  if($cmp==0) {
168    return $range_a->cmp_range_end($range_b);
169  }
170  return $cmp;
171}
172
173sub HELPER_CB () {
174  add_one=>\&add_one
175  ,sub_one=>\&sub_one
176  ,cmp_values=>\&cmp_values
177}
178
179sub add_one { $_[0] + 1 }
180sub sub_one { $_[0] -1 }
181sub cmp_values { $_[0] <=> $_[1] }
182
183sub get_common_range {
184  my ($class,$helper,$ranges)=@_;
185
186  my ($range_start)=sort sort_largest_range_start_first @$ranges;
187  my ($range_end)=sort sort_smallest_range_end_first @$ranges;
188
189  new($class,
190    $helper
191    ,$range_start->range_start
192    ,$range_end->range_end
193  );
194}
195
196sub get_overlapping_range {
197  my ($class,$helper,$ranges,%opt)=@_;
198
199  my ($range_start)=sort sort_smallest_range_start_first @$ranges;
200  my ($range_end)=sort sort_largest_range_end_first @$ranges;
201
202  my $obj=new($class,$helper,$range_start->range_start,$range_end->range_end);
203  $obj->[key_generated]=1;
204  $obj;
205}
206
207sub sort_in_presentation_order ($$) {
208	my ($cmp_a,$cmp_b)=@_;
209	$cmp_a->cmp_ranges($cmp_b);
210}
211
212sub sort_in_consolidate_order ($$) {
213  my ($range_a,$range_b)=@_;
214  $range_a->cmp_range_start($range_b)
215    ||
216  $range_b->cmp_range_end($range_a);
217}
218
219sub sort_largest_range_end_first ($$) {
220  my ($range_a,$range_b)=@_;
221  $range_b->cmp_range_end($range_a)
222}
223
224sub sort_smallest_range_start_first ($$) {
225  my ($range_a,$range_b)=@_;
226  $range_a->cmp_range_start($range_b)
227}
228
229sub sort_smallest_range_end_first ($$) {
230  my ($range_a,$range_b)=@_;
231  $range_a->cmp_range_end($range_b)
232
233}
234
235sub sort_largest_range_start_first ($$) {
236  my ($range_a,$range_b)=@_;
237  $range_b->cmp_range_start($range_a)
238}
239
240sub consolidate_ranges {
241  my ($class,$helper,$ranges,%opt)=@_;
242  @$ranges=sort sort_in_consolidate_order @$ranges;
243  my $cmp=shift @$ranges;
244  my $return_ref=[];
245  while( my $next=shift @$ranges) {
246    if($cmp->overlap($next)) {
247      my $overlap=$cmp->cmp_ranges($next)==0 ?
248        $cmp
249	:
250        $class->get_overlapping_range($helper,[$cmp,$next]);
251      $cmp=$overlap;
252
253    } else {
254      push @$return_ref,$cmp;
255      $cmp=$next;
256    }
257
258  }
259  push @$return_ref,$cmp;
260  $return_ref;
261}
262
263sub fill_missing_ranges {
264  my ($class,$helper,$ranges,%args)=@_;
265  %args=(consolidate_ranges=>0,%args);
266
267  $ranges=consolidate_ranges($helper,$ranges) if $args{consolidate_ranges};
268  my $return_ref=[];
269
270  my $cmp=shift @$ranges;
271  while(my $next=shift @$ranges) {
272    push @$return_ref,$cmp;
273    unless($cmp->contiguous_check($next)) {
274      my $missing=new($class,
275        $helper
276        ,$cmp->next_range_start
277        ,$next->previous_range_end);
278      $missing->[key_missing]=1;
279      push @$return_ref,$missing;
280    }
281    $cmp=$next;
282  }
283
284  push @$return_ref,$cmp;
285
286  $return_ref;
287}
288
289sub range_start_end_fill {
290  my ($class,$helper,$ranges,%opt)=@_;
291
292  my ($range_start)=sort sort_smallest_range_start_first
293    map { $_->[0] } @$ranges;
294    $range_start=$range_start->range_start;
295  my ($range_end)=sort sort_largest_range_end_first
296    map { $_->[$#{$_}] } @$ranges;
297    $range_end=$range_end->range_end;
298
299  foreach my $ref (@$ranges) {
300    my $first_range=$ref->[0];
301    my $last_range=$ref->[$#{$ref}];
302
303    if($first_range->helper_cb(
304      'cmp_values'
305      ,$first_range->range_start
306      ,$range_start
307      )!=0) {
308      my $new_range=new($class,
309          $helper
310          ,$range_start
311          ,$first_range->previous_range_end
312      );
313      unshift @$ref,$new_range;
314      $new_range->[key_missing]=1;
315      $new_range->[key_generated]=1;
316    }
317
318    if($last_range->helper_cb('cmp_values'
319       ,$last_range->range_end
320       ,$range_end)!=0
321    ) {
322      my $new_range=new($class,
323        $helper
324        ,$last_range->next_range_start
325        ,$range_end
326      );
327      push @$ref,$new_range;
328      $new_range->[key_missing]=1;
329      $new_range->[key_generated]=1;
330    }
331  }
332
333
334  $ranges;
335}
336
337sub range_compare {
338  my ($class,$helper,$list_of_ranges,%args)=@_;
339
340  %args=(consolidate_ranges=>1,%args);
341
342  if($args{consolidate_ranges}) {
343    my $ref=[];
344    while(my $ranges=shift @$list_of_ranges) {
345      $ranges=$class->consolidate_ranges($helper,$ranges);
346      push @$ref,$ranges;
347    }
348    $list_of_ranges=$ref;
349  }
350  my ($row,$column_ids);
351  my $next=1;
352  sub {
353    return () unless $next;
354    if($column_ids) {
355      ($row,$column_ids,$next)=$class->compare_row(
356        $helper
357        ,$list_of_ranges
358        ,$row,$column_ids
359      );
360    } else {
361      ($row,$column_ids,$next)=$class->init_compare_row(
362        $helper
363        ,$list_of_ranges
364      );
365    }
366    @$row;
367  };
368}
369
370sub init_compare_row {
371  my ($class,$helper,$data)=@_;
372
373  my $next=0;
374  my $cols=[];
375  my $row=[];
376
377  my @list=map { $_->[0] } @$data;
378  my ($first)=sort sort_smallest_range_start_first @list;
379
380  for(my $id=0;$id<=$#$data;++$id) {
381    my $range=$data->[$id]->[0];
382    if($range->cmp_range_start($first)==0) {
383      push @$row,$range;
384      $cols->[$id]=0;
385      ++$next if $#{$data->[$id]}>0;
386    } else {
387      $cols->[$id]=-1;
388      push @$row,new($class,
389        $helper
390        ,$first->range_start
391        ,$range->previous_range_end
392        ,1
393        ,1
394      );
395      ++$next;
396    }
397  }
398  return $row,$cols,$next;
399}
400
401sub compare_row {
402  my ($class,$helper,$data,$row,$cols)=@_;
403
404  # if we don't have our column list then we need to build it
405  my ($last)=sort sort_smallest_range_end_first @$row;
406  my ($end)=sort sort_largest_range_end_first
407    map { $_->[$#$_] } @$data;
408
409  my $total=1 + ($#$data);
410  my $ok=$total;
411  my $missing_count=0;
412  for(my $id=0;$id<=$#$data;++$id) {
413    my $range=$row->[$id];
414
415    my $current=$cols->[$id];
416    my $next=1 + $current;
417    if($#{$data->[$id]} < $next) {
418    	$next=undef;
419    }
420
421    if($last->cmp_range_end($range)==0) {
422      if(defined($next)) {
423       my $next_range=$data->[$id]->[$next];
424
425       if($range->contiguous_check($next_range)) {
426        $cols->[$id]=$next;
427	$row->[$id]=$next_range;
428       } else {
429        $row->[$id]=new($class,
430	  $helper
431	  ,$range->next_range_start
432	  ,$next_range->previous_range_end
433	  ,1
434	  ,1
435	 );
436       }
437      } else {
438	$row->[$id]=new($class,
439	 $helper
440	 ,$range->next_range_start
441	 ,$end->range_end
442	 ,1
443	 ,1
444        );
445      }
446    }
447    ++$missing_count if $row->[$id]->missing;
448    --$ok if $row->[$id]->cmp_range_end($end)>=0;
449  }
450  return $class->compare_row($helper,$data,$row,$cols)
451      if $ok and $missing_count==$total;
452  ($row,$cols,$ok)
453}
454
4551;
456