From ff3280287f37d0294e685e7134ad8758872adc40 Mon Sep 17 00:00:00 2001 From: Packit Date: Sep 16 2020 15:48:49 +0000 Subject: perl-Set-Infinite-0.65 base --- diff --git a/Changes b/Changes new file mode 100644 index 0000000..8f2ccb5 --- /dev/null +++ b/Changes @@ -0,0 +1,635 @@ +Revision history for Perl extension Set::Infinite. + +0.65 2010-04-26 +- documentation fix + +0.64 2010-04-26 +- s/simmetric/symmetric/ + reported by Richard Jelinek + +0.63 2008-07-21 +- minor tweak in union(); added tests + +0.62 2008-07-20 +- fixed a problem in union() that caused first() to return a wrong result. + reported by David Gang + +0.61 2004-11-03 +- some optimization of intersected_spans() +- bugfix: complement of the universal set is the empty set + +0.60 2004-10-28 +- _cleanup() / _no_cleanup() are obsolete +- easier syntax to iterate() + +0.59 2004-07-01 +- added experimental argument "backtrack_callback" to + iterate() + +0.58 2004-06-14 +- intersected_spans was wrong when intersecting with + an open set. bug report & tests by Peter Oliver + +0.57 2004-04-03 +- CPAN update + +0.5602 2004-03-25 +- fixed a test in t/select.t - Reported by David Dyck. +- simplified "offset"; fixed "fixtype" +- added "separators" test in t/infinite.t +- is_proper_subset / is_disjoint may return 'undef' +- variables $a, $b renamed + +0.5601 2004-03-20 +- iterate() first/last can deal with multiple spans +- removed todo: "provide a constructor to build open sets" + because this is already documented in new(). +- fixed "separators" OO +- New methods: + is_span + is_singleton + is_subset + is_proper_subset + is_disjoint + universal_set + empty_set + minus / difference (same as "complement") + simmetric_difference + +0.56 2004-03-17 +- New method: clone (same as "copy") +- More tests & fixes: intersected_spans + +0.5503 2004-03-15 +- New method: intersected_spans + Suggested by Reinhold May + Name suggested by Dave Rolsky +- bugfix: first/last() of a union will try harder not to split spans. + +0.5502 2004-03-14 +- New methods: start_set / end_set + These are the inverse of the "until" method. + Suggested by Reinhold May + +0.5501 + refactored _backtrack method + +0.55 2003-11-16 + - bug fix: $set = Set::Infinite->new( -10, 0 ); + created a set with "-10" instead of [-10..0] + - documents that the parameters to new() must be sorted. + Reported by Jim Cromie + +0.5401 2003-10-21 + specifying start > end in a constructor is a fatal error. + +0.54 +0.5308 2003-10-16 + clears mod_perl warnings - change the order of modules and constants. + Patch by Dan Kubb + +0.5307 + backtracking "iterate" uses a larger span + +0.5306 + fix bug in test "inf" -> "$inf". Thanks Kingpin + +0.5305 + %_first and %_last are declared with 'use vars' + +0.5304 + added more tests: intersects/until/select + optimized select() + refactored quantize() + +0.5303 + removed Set::Infinite::Date + removed /_eg directory + simplified README + +0.5302 + select( freq => $n ) is removed. + - breaks Date::Set 0.28 (Date::Set 0.29 is ok) + select( by => [] ) default is changed to 'All'. + - in order to have the same behaviour as when 'freq' was omitted. + +0.5301 + refactored methods: min, max, first, last, until, iterate, offset + removed obsolete method: compact + renamed internal methods with _underline + removed obsolete 'date' docs + +0.53 2003-09-05 + fixes a test that fails under 5.00503 + does not export 'new' + +0.52 2003-09-04 + change tests to run under (a broken) Perl 5.9.0 + - infinity string contains spaces + +0.51 2003-09-02 + passes all tests under 5.00503. + - changed ' $var=\@_ ' to ' $var=[@_] ' + compiles under Perl 5.00503. Patch by Mathieu Arnold. + +0.50 + count() + fixed: size() does not try to add 'zero' to object. + tests for count() and size() + +0.49 + fixed: "first/last" of intersection between recurrences + +0.48 + fixed: backtracking on a partially defined set. + fixed: first of a union with an empty set. + +0.47 + until allows start_set == end_set + +0.46_01 + upload to perl-date-time CVS + +0.46 + more docs + +0.45 + last works, but not for union/quantize/select/offset +0.44_03 + last() can union/intersect/complement/offset +0.44_02 + last() can iterate/complement +0.44_01 + first(n) deprecated + S::I::Basic::last() enabled + +0.44 + CPAN release + +0.43_01 + 'iterate' generates 'first' code + +0.43 + CPAN release + implemented max() of 'iterate' + +0.42_05 + implemented min() of 'iterate' + fixed complex union with empty set + +0.42_04 + finished removing 'our' + +0.42_03 / 0.42_02 + (idem) + +0.42_01 + more methods inherited from Set::Infinite::Basic + +0.42_00 + Set::Infinite.pm refactored into Set::Infinite::Basic + Set::Infinite::_Simple removed. + +0.41_03 + can intersects() to an object (it checks the reference type) + +0.41_02 + fixed copy() - copying array refs + +0.41_01 + Fixed type() inheritance problems + as a side effect, type() must be called with '->' syntax + Fixed eg/recurring.pl + +0.41 + 'todo' directory renamed to _todo for Win* compatibility + (clashes with TODO) + +0.40 + LICENSE file + +0.39_05 + fixed 'until' test warnings (caused by malformed offset() output) + +0.39_04 + 'until' works with empty sets + 'until' has first() + +0.39_03 + 'until' backtracks (slowly) + left a hack in max() - might remove it when last() works... + +0.39_02 + 'offset' has 'first' + 'until' has '_quantize_span' + +0.39_01 + new method 'until' -- makes it possible to join RRULEs in Date::Set::Timezone + hacked a fix a problem when offset-begin backtracks (offset-begin reduces + a set to a single element, which backtracks wrongly if the set were + quantized) + better handling of backtrack-offset values + fixed spaceship (again) + contains works better for unbounded sets + +0.39 + fixed a bug in spaceship() that affected Date::Set::Timezone + +0.38 - changes to 0.37: + new method first() + min() and max() improved + fixed some bugs: intersection -inf with (-inf..15); "<=>"; more tests + new $PRETTY_PRINT global option; better TRACE + about 20% faster than 0.37; uses less memoization + +0.37_71 + trace works on a copy of the variables, so that autovivification + and cleanups don't interfere with the program. + +0.37_69 + new method _quantize_span helps some internal calculations + +0.37_68 + fixed a bug in intersection -inf with (-inf..15) + +0.37_67 + t/first.t passes all tests + first-select is leaking + +0.37_63 + last-quantize started + +0.37_62 + all tests pass + fixed Element_Inf dependency in Set::Infinite::Date.pm + +0.37_61 + tests pass + select should use count=> to bound set + +0.37_60 + first/unknown/union recursion fixed + +0.37_59 + first() has a cache + +0.37_57 + new $PRETTY_PRINT global option + +0.37_54 + quantize() is 'first-compatible' + +0.37_51 + min is 'more exact' + first-intersection uses limited recursion + +0.37_49 + trace() has 'tab-levels' - trace_open/trace_close + +0.37_48 + first complement/intersection works + last() removed + +0.37_47 + started last() + started first/last + complement + new t/first.t + +0.37_44 + fixed a bug in <=> + +0.37_43 + first/intersection code started (commented out) + +0.37_42 + allows inherited methods to use first() + +0.37_41 + passes tests + +0.37_40 + select/first works with freq+count or count + (some tests fail) + +0.37_38 + first works for union/select/quantize + +0.37_37 + first for union() + +0.37_36 + select() freq default is 1 if we have a count + +0.37_35 + first/tail works for quantize(), select(by[]) + +0.37_26 + compact() is a no-op + +0.37_23 + quantize() is no longer tied; no longer generates 'undef' + subset values. + 3 tests didn't pass; removed! (expected null subset values) + Quantize_Date.pm removed + Function.pm removed + +0.37_19 + removed global-cache in quantize (access was too difficult, + took too much time). + +0.37_18 + removed cacheing in Set::Infinite::Date (problems with 'mode' + internal variable). + +0.37_16 + quantize 'weekyears' internal indexes fixed + new tests added + +0.37_11 + Set::Infinite::Arithmetic docs revised + +0.37_10 + select() is no longer "tied" + lib\Set\Infinite\Select.pm removed. + offset doesn't use gmtime if doesn't have to. + +0.37_06 + Backtracks on complement() + EXCLUDE_EXT string/array correction in Makefile.PL + (thanks Mark Veltzer for pointing this out) + +0.37_05 + Offset.pm moved into Arithmetic.pm + +0.37_04 + removed eg/ical.pl + (thanks Mike Castle for pointing these out) + changed obsolete 'add' method to 'union' in eg/*.pl + removed null() docs + +0.37_03 + faster Offset.pm + +0.37 +0.36_50 + use warnings in Set::Infinite::_Simple + +0.36_49 + remove module Set::Infinite::Element_Inf + +0.36_48 + uses native "Infinity" stringification + +0.36_47 + fixed some warnings + +0.36_46 + size return correct value for open integer sets + intersects/contains return undef if too_complex + +0.36_45 + min/max are cached + min/max work with union/intersection + select(), complement() not implemented (should carp!) + +0.36_43 + integer/real/tolerance are functions + min/max work with integer() + +0.36_42 + min/max work for offset(); + +0.36_41 + min/max fixed for quantize() + t/backtrack.t tests 2,3 fixed; more tests + new methods (undocumented): + min_a(), max_a() return a list: (value, open-state) + +0.36_40 + internal inf == Perl Inf + +0.36_36 + complement backtracks, although not it might fail for some sets + (not tested at all!) + min/max/span/size are estimated for complex sets + might work for select() too. + list(), <=> carp for unbounded sets + +0.36_11 + backtrack method call is cleaner + +0.36_10 + _simple_intersection removed. + _simple_complement with parameter removed. + +0.36_09 + offset strict option removed. Was never used. + +0.36_08 + Set::Infinite::ICalset and S::I::ICal removed. use Date::Set instead. + +0.36_07 + Simple class renamed to _Simple; creates methods inside Set::Infinite + $self->new() creates an empty set, and copies private variables + from $self. This makes new() inheritance easier. + +0.36 + added 'copy' in order to allow 'subroutine-style' programming + instead of only 'functional' programming + added 'is_too_complex' + obsoleted modules: Set::Infinite::Date, Set::Infinite::ICal, Set::Infinite::ICalSet + use Date::Set instead. + added make_htmldoc.pl and make_readme.pl + +0.34 + added 'weekdays' option to 'offset' + +0.31-0.33 + some optimizations + offset is no longer 'tied' in order to try to make it faster + offset now *always* return an ordered set + quantize has better memoization control + +0.30 + optimized 'is_null' - avoids converting data to string + fixed examples - foreach needs ->list + fixed tests - thanks CPAN testers! + move 'type', 'tolerance', 'real', 'integer' from Simple.pm to Set::Infinite.pm + simpler 'contains' + removed tie code from Infinite.pm and Infinite::Simple.pm + +0.29 + new method 'compact' + offset option 'mode=>circle' + new method 'list' + new method 'no_cleanup' + + offset can handle months, years + offset value must be array with even number of elements + + select 'freq' default is set-size instead of 1. + + removed internal 'compact_array' + + join (" ", $a) no longer works. use join (" ", $a->list) instead. + + quantize(10) no longer works. use quantize(quant=>10) instead. + ical_2: BYMONTHDAY did not instantiate in ical_2 unless 'print' + -- offset can't return array. + +0.28 + 'strict' option in offset, select. + 'strict=>0' option in quantize. + + offset can handle 'negative counts from end' + +0.27 + offset 'value' can handle multiple value-pairs + optimized $class->new() instead of $class->new($self) in select, offset, quantize. + +0.26 + lots of problems due to $a->{list}->[$ia]->{a} + -- used a temp variable to split in smaller parts + + new eg/ical.pl oo demo + + marked 'select{interval}' option to be deleted in next release + select now properly handles negative by[]; checks parent index boundaries + masked errors in select by using a dummy variable. + + cache Quantize_Date::FETCH (local to object) + user can 'push' new methods into 'quantize' + + new 'iterate' method + + better oo in Infinite.pm - most methods can now be overriden + array syntax corrected in Infinite.pm + new TRACE/trace and DEBUG_BT to help debug + +0.25 + backtracking fully implemented in: intersection, intersects, union, offset. + backtracking partially implemented in: quantize, select + backtracking is NOT implemented in: complement, size, span, max, min + See: backtrack.t + + 'epoch' support in core module. Doesn't need Date or ICal. + + intersection was missing 'my $b;' + + Date::sub propagates {mode} + + use hash-subs to initialize quantize units + 'quantize_date' uses 'one' as default unit + doesn't use Quantize.pm anymore, since Quantize_Date.pm is a superset. + doesn't need 'quantizer, selector, offsetter' either. + + remove 'cmp' (thanks Martijn) + internal cache for Date and ICal object + +0.24 + offset has 'unit' parameter + 'epoch' removed. use 0+ instead. + Quantize_Date is an extension of Quantize. + quantize, select, offset return a compact array of Set::Infinite instead of a sparse array of Set::Infinite::Simple + - no longer needs to test for null elements. + +0.23 + changed localtime to gmtime everywhere + new object type: ICal. Requires Date::ICal; marked as experimental + This module will not be tested if it can't find Date::ICal + new date method: epoch + +0.22.05 + doesn't need HTTP::Date + offset supports hours, in 'Date' type + + put "eg/recurring.pl" in distribution. (should be there since 0.21) + new "Function.pm" base class for functions. + Used Funtion.pm for "Select.pm" and "Offset.pm" + Much better algorithm for "Select.pm" + stricter language for "quantize" - only hash allowed. + reduced "Simple.pm" - may be deprecated someday + + Faster cleanup, max, min + Cleaner (faster?) union + +0.21 + new methods: "select" and "offset". + syntax changed: "quantize": + quantize( 1 ); # old syntax, still works + quantize( quant => 1 ); + quantize( 'months', 1 ); # old syntax for quantize_date, still works + quantize( unit => 'seconds', quant => 1 ); # quantize_date + internal: quantize parameter order is different. + fixed: Quantize_Date returned Set::Infinite instead of Set::Infinite::Simple + fixed: Date::Add lost format + new: Set::Infinite::Date::day_size() + added: recursive test for quantize + changed: empty return value for quantize is "null" instead of ""; then + changed "null" name to "" :) + +0.20 + local "type" + +0.18, 0.19 + Set::Infinite::Element not used anymore. + 2.3x speed improvement in tests over version 0.14. + +0.17 + Correction in Simple.pm line-ending, and TODO filename on Windows + Element_Inf and Date.pm test for undefined parameters on OpenBSD + +0.16 + 40% speed improvement in tests over version 0.14. + +0.15 + 20% speed improvement in tests over version 0.14. + bigint.t fails; moved to 'todo' directory. + `Date' fails in OpenBSD. Doesn't fail in linux or Windows. + +0.14 + Problems with Bigfloat tests - can't fix them. Moved to `todo' directory. + Fixed Bigint tests and warnings in other tests. + +0.13 + Simple.pm and Element.pm: + Corrected many warnings related to testing undef values on hash + + Quantize.pm and Quantize_Date.pm + work on real sized chunks too - don't use `%' integer module operation. + + Infinite.pm + quantize returns tied array. It can be used directly with `foreach'. + Pod and tests corrected. + + Infinite.pm + Accepts slices as input. There are syntax problems - see "CAVEATS" in pod. + tests added. + + Simple.pm + Will not cleanup if acessed as tied array, until both a and b are defined or a method is called, + so that we can set a, then b. + +0.12 + Correction in Set::Infinite::Simple::intersection + [5..5) is null + + New function: quantize + +0.11 + Set::Infinite + Copyright message + + Set::Infinite Line 8: + # use AutoLoader qw(AUTOLOAD); + + Deep recursion on subroutine "Set::Infinite::add" at h:/util/Perl/site/lib/Set/Infinite.pm line 318. + Deep recursion on subroutine "Set::Infinite::Simple::new" at h:/util/Perl/site/lib/Set/Infinite.pm line 184. + solution: + Set::Infinite::Element->type and + Set::Infinite::Date->date_format + use `pop' instead of `shift', or read parameters + +0.01 Mon May 14 14:43:09 2001 + - made Makefile.PL; v.0.010 + diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..9d0305b --- /dev/null +++ b/LICENSE @@ -0,0 +1,383 @@ +Terms of Perl itself + +a) the GNU General Public License as published by the Free + Software Foundation; either version 1, or (at your option) any + later version, or +b) the "Artistic License" + +--------------------------------------------------------------------------- + +The General Public License (GPL) +Version 2, June 1991 + +Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave, +Cambridge, MA 02139, USA. Everyone is permitted to copy and distribute +verbatim copies of this license document, but changing it is not allowed. + +Preamble + +The licenses for most software are designed to take away your freedom to share +and change it. By contrast, the GNU General Public License is intended to +guarantee your freedom to share and change free software--to make sure the +software is free for all its users. This General Public License applies to most of +the Free Software Foundation's software and to any other program whose +authors commit to using it. (Some other Free Software Foundation software is +covered by the GNU Library General Public License instead.) You can apply it to +your programs, too. + +When we speak of free software, we are referring to freedom, not price. Our +General Public Licenses are designed to make sure that you have the freedom +to distribute copies of free software (and charge for this service if you wish), that +you receive source code or can get it if you want it, that you can change the +software or use pieces of it in new free programs; and that you know you can do +these things. + +To protect your rights, we need to make restrictions that forbid anyone to deny +you these rights or to ask you to surrender the rights. These restrictions +translate to certain responsibilities for you if you distribute copies of the +software, or if you modify it. + +For example, if you distribute copies of such a program, whether gratis or for a +fee, you must give the recipients all the rights that you have. You must make +sure that they, too, receive or can get the source code. And you must show +them these terms so they know their rights. + +We protect your rights with two steps: (1) copyright the software, and (2) offer +you this license which gives you legal permission to copy, distribute and/or +modify the software. + +Also, for each author's protection and ours, we want to make certain that +everyone understands that there is no warranty for this free software. If the +software is modified by someone else and passed on, we want its recipients to +know that what they have is not the original, so that any problems introduced by +others will not reflect on the original authors' reputations. + +Finally, any free program is threatened constantly by software patents. We wish +to avoid the danger that redistributors of a free program will individually obtain +patent licenses, in effect making the program proprietary. To prevent this, we +have made it clear that any patent must be licensed for everyone's free use or +not licensed at all. + +The precise terms and conditions for copying, distribution and modification +follow. + +GNU GENERAL PUBLIC LICENSE +TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND +MODIFICATION + +0. This License applies to any program or other work which contains a notice +placed by the copyright holder saying it may be distributed under the terms of +this General Public License. The "Program", below, refers to any such program +or work, and a "work based on the Program" means either the Program or any +derivative work under copyright law: that is to say, a work containing the +Program or a portion of it, either verbatim or with modifications and/or translated +into another language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not covered by +this License; they are outside its scope. The act of running the Program is not +restricted, and the output from the Program is covered only if its contents +constitute a work based on the Program (independent of having been made by +running the Program). Whether that is true depends on what the Program does. + +1. You may copy and distribute verbatim copies of the Program's source code as +you receive it, in any medium, provided that you conspicuously and appropriately +publish on each copy an appropriate copyright notice and disclaimer of warranty; +keep intact all the notices that refer to this License and to the absence of any +warranty; and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and you may at +your option offer warranty protection in exchange for a fee. + +2. You may modify your copy or copies of the Program or any portion of it, thus +forming a work based on the Program, and copy and distribute such +modifications or work under the terms of Section 1 above, provided that you also +meet all of these conditions: + +a) You must cause the modified files to carry prominent notices stating that you +changed the files and the date of any change. + +b) You must cause any work that you distribute or publish, that in whole or in +part contains or is derived from the Program or any part thereof, to be licensed +as a whole at no charge to all third parties under the terms of this License. + +c) If the modified program normally reads commands interactively when run, you +must cause it, when started running for such interactive use in the most ordinary +way, to print or display an announcement including an appropriate copyright +notice and a notice that there is no warranty (or else, saying that you provide a +warranty) and that users may redistribute the program under these conditions, +and telling the user how to view a copy of this License. (Exception: if the +Program itself is interactive but does not normally print such an announcement, +your work based on the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If identifiable +sections of that work are not derived from the Program, and can be reasonably +considered independent and separate works in themselves, then this License, +and its terms, do not apply to those sections when you distribute them as +separate works. But when you distribute the same sections as part of a whole +which is a work based on the Program, the distribution of the whole must be on +the terms of this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest your rights to +work written entirely by you; rather, the intent is to exercise the right to control +the distribution of derivative or collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program with the +Program (or with a work based on the Program) on a volume of a storage or +distribution medium does not bring the other work under the scope of this +License. + +3. You may copy and distribute the Program (or a work based on it, under +Section 2) in object code or executable form under the terms of Sections 1 and 2 +above provided that you also do one of the following: + +a) Accompany it with the complete corresponding machine-readable source +code, which must be distributed under the terms of Sections 1 and 2 above on a +medium customarily used for software interchange; or, + +b) Accompany it with a written offer, valid for at least three years, to give any +third party, for a charge no more than your cost of physically performing source +distribution, a complete machine-readable copy of the corresponding source +code, to be distributed under the terms of Sections 1 and 2 above on a medium +customarily used for software interchange; or, + +c) Accompany it with the information you received as to the offer to distribute +corresponding source code. (This alternative is allowed only for noncommercial +distribution and only if you received the program in object code or executable +form with such an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for making +modifications to it. For an executable work, complete source code means all the +source code for all modules it contains, plus any associated interface definition +files, plus the scripts used to control compilation and installation of the +executable. However, as a special exception, the source code distributed need +not include anything that is normally distributed (in either source or binary form) +with the major components (compiler, kernel, and so on) of the operating system +on which the executable runs, unless that component itself accompanies the +executable. + +If distribution of executable or object code is made by offering access to copy +from a designated place, then offering equivalent access to copy the source +code from the same place counts as distribution of the source code, even though +third parties are not compelled to copy the source along with the object code. + +4. You may not copy, modify, sublicense, or distribute the Program except as +expressly provided under this License. Any attempt otherwise to copy, modify, +sublicense or distribute the Program is void, and will automatically terminate +your rights under this License. However, parties who have received copies, or +rights, from you under this License will not have their licenses terminated so long +as such parties remain in full compliance. + +5. You are not required to accept this License, since you have not signed it. +However, nothing else grants you permission to modify or distribute the Program +or its derivative works. These actions are prohibited by law if you do not accept +this License. Therefore, by modifying or distributing the Program (or any work +based on the Program), you indicate your acceptance of this License to do so, +and all its terms and conditions for copying, distributing or modifying the +Program or works based on it. + +6. Each time you redistribute the Program (or any work based on the Program), +the recipient automatically receives a license from the original licensor to copy, +distribute or modify the Program subject to these terms and conditions. You +may not impose any further restrictions on the recipients' exercise of the rights +granted herein. You are not responsible for enforcing compliance by third parties +to this License. + +7. If, as a consequence of a court judgment or allegation of patent infringement +or for any other reason (not limited to patent issues), conditions are imposed on +you (whether by court order, agreement or otherwise) that contradict the +conditions of this License, they do not excuse you from the conditions of this +License. If you cannot distribute so as to satisfy simultaneously your obligations +under this License and any other pertinent obligations, then as a consequence +you may not distribute the Program at all. For example, if a patent license would +not permit royalty-free redistribution of the Program by all those who receive +copies directly or indirectly through you, then the only way you could satisfy +both it and this License would be to refrain entirely from distribution of the +Program. + +If any portion of this section is held invalid or unenforceable under any particular +circumstance, the balance of the section is intended to apply and the section as +a whole is intended to apply in other circumstances. + +It is not the purpose of this section to induce you to infringe any patents or other +property right claims or to contest validity of any such claims; this section has +the sole purpose of protecting the integrity of the free software distribution +system, which is implemented by public license practices. Many people have +made generous contributions to the wide range of software distributed through +that system in reliance on consistent application of that system; it is up to the +author/donor to decide if he or she is willing to distribute software through any +other system and a licensee cannot impose that choice. + +This section is intended to make thoroughly clear what is believed to be a +consequence of the rest of this License. + +8. If the distribution and/or use of the Program is restricted in certain countries +either by patents or by copyrighted interfaces, the original copyright holder who +places the Program under this License may add an explicit geographical +distribution limitation excluding those countries, so that distribution is permitted +only in or among countries not thus excluded. In such case, this License +incorporates the limitation as if written in the body of this License. + +9. The Free Software Foundation may publish revised and/or new versions of the +General Public License from time to time. Such new versions will be similar in +spirit to the present version, but may differ in detail to address new problems or +concerns. + +Each version is given a distinguishing version number. If the Program specifies a +version number of this License which applies to it and "any later version", you +have the option of following the terms and conditions either of that version or of +any later version published by the Free Software Foundation. If the Program does +not specify a version number of this License, you may choose any version ever +published by the Free Software Foundation. + +10. If you wish to incorporate parts of the Program into other free programs +whose distribution conditions are different, write to the author to ask for +permission. For software which is copyrighted by the Free Software Foundation, +write to the Free Software Foundation; we sometimes make exceptions for this. +Our decision will be guided by the two goals of preserving the free status of all +derivatives of our free software and of promoting the sharing and reuse of +software generally. + +NO WARRANTY + +11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS +NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE +COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM +"AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR +IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE +ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE +PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, +YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR +CORRECTION. + +12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED +TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY +WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS +PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES +ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM +(INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING +RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY +OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS +BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. + +END OF TERMS AND CONDITIONS + + +--------------------------------------------------------------------------- + +The Artistic License + +Preamble + +The intent of this document is to state the conditions under which a Package +may be copied, such that the Copyright Holder maintains some semblance of +artistic control over the development of the package, while giving the users of the +package the right to use and distribute the Package in a more-or-less customary +fashion, plus the right to make reasonable modifications. + +Definitions: + +- "Package" refers to the collection of files distributed by the Copyright + Holder, and derivatives of that collection of files created through textual + modification. +- "Standard Version" refers to such a Package if it has not been modified, + or has been modified in accordance with the wishes of the Copyright + Holder. +- "Copyright Holder" is whoever is named in the copyright or copyrights for + the package. +- "You" is you, if you're thinking about copying or distributing this Package. +- "Reasonable copying fee" is whatever you can justify on the basis of + media cost, duplication charges, time of people involved, and so on. (You + will not be required to justify it to the Copyright Holder, but only to the + computing community at large as a market that must bear the fee.) +- "Freely Available" means that no fee is charged for the item itself, though + there may be fees involved in handling the item. It also means that + recipients of the item may redistribute it under the same conditions they + received it. + +1. You may make and give away verbatim copies of the source form of the +Standard Version of this Package without restriction, provided that you duplicate +all of the original copyright notices and associated disclaimers. + +2. You may apply bug fixes, portability fixes and other modifications derived from +the Public Domain or from the Copyright Holder. A Package modified in such a +way shall still be considered the Standard Version. + +3. You may otherwise modify your copy of this Package in any way, provided +that you insert a prominent notice in each changed file stating how and when +you changed that file, and provided that you do at least ONE of the following: + + a) place your modifications in the Public Domain or otherwise + make them Freely Available, such as by posting said modifications + to Usenet or an equivalent medium, or placing the modifications on + a major archive site such as ftp.uu.net, or by allowing the + Copyright Holder to include your modifications in the Standard + Version of the Package. + + b) use the modified Package only within your corporation or + organization. + + c) rename any non-standard executables so the names do not + conflict with standard executables, which must also be provided, + and provide a separate manual page for each non-standard + executable that clearly documents how it differs from the Standard + Version. + + d) make other distribution arrangements with the Copyright Holder. + +4. You may distribute the programs of this Package in object code or executable +form, provided that you do at least ONE of the following: + + a) distribute a Standard Version of the executables and library + files, together with instructions (in the manual page or equivalent) + on where to get the Standard Version. + + b) accompany the distribution with the machine-readable source of + the Package with your modifications. + + c) accompany any non-standard executables with their + corresponding Standard Version executables, giving the + non-standard executables non-standard names, and clearly + documenting the differences in manual pages (or equivalent), + together with instructions on where to get the Standard Version. + + d) make other distribution arrangements with the Copyright Holder. + +5. You may charge a reasonable copying fee for any distribution of this Package. +You may charge any fee you choose for support of this Package. You may not +charge a fee for this Package itself. However, you may distribute this Package in +aggregate with other (possibly commercial) programs as part of a larger +(possibly commercial) software distribution provided that you do not advertise +this Package as a product of your own. + +6. The scripts and library files supplied as input to or produced as output from +the programs of this Package do not automatically fall under the copyright of this +Package, but belong to whomever generated them, and may be sold +commercially, and may be aggregated with this Package. + +7. C or perl subroutines supplied by you and linked into this Package shall not +be considered part of this Package. + +8. Aggregation of this Package with a commercial distribution is always permitted +provided that the use of this Package is embedded; that is, when no overt attempt +is made to make this Package's interfaces visible to the end user of the +commercial distribution. Such use shall not be construed as a distribution of +this Package. + +9. The name of the Copyright Holder may not be used to endorse or promote +products derived from this software without specific prior written permission. + +10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED +WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR +PURPOSE. + +The End + + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..8680849 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,29 @@ +Changes +MANIFEST +MANIFEST.SKIP +LICENSE +README +TODO +Makefile.PL + +lib/Set/Infinite.pm +lib/Set/Infinite/Basic.pm +lib/Set/Infinite/Arithmetic.pm + +_todo/bigfloat.t +_todo/bigint.t + +t/until.t +t/infinite.t +t/first.t +t/last.t +t/backtrack.t +t/quantize.t +t/select.t +t/select_offset.t +t/size.t +t/basic_intersects.t +t/union.t + +META.yml Module meta-data (added by MakeMaker) + diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP new file mode 100644 index 0000000..5fce572 --- /dev/null +++ b/MANIFEST.SKIP @@ -0,0 +1,18 @@ +^blib/ +^Makefile$ +^Makefile\.[a-z]+$ +^pm_to_blib$ +CVS/.* +,v$ +^tmp/ +\.old$ +\.bak$ +~$ +^# +\.shar$ +\.tar$ +\.tgz$ +\.tar\.gz$ +\.zip$ +_uu$ +t/zz.* \ No newline at end of file diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..90e57aa --- /dev/null +++ b/META.yml @@ -0,0 +1,15 @@ +--- #YAML:1.0 +name: Set-Infinite +version: 0.65 +abstract: Infinite Sets math +license: ~ +author: + - Flavio S. Glock +generated_by: ExtUtils::MakeMaker version 6.44 +distribution_type: module +requires: + Test::More: 0 + Time::Local: 0 +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.3.html + version: 1.3 diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..9f674b2 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,18 @@ +#!/bin/perl + +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + 'ABSTRACT' => 'Infinite Sets math', + 'AUTHOR' => 'Flavio S. Glock ', + 'NAME' => 'Set::Infinite', + 'VERSION_FROM' => 'lib/Set/Infinite.pm', + 'EXCLUDE_EXT' => [ qw(Makefile gz LOG x~~) ], + 'PREREQ_PM' => { + 'Time::Local' => 0, + 'Test::More' => 0, + }, + 'dist' => { 'COMPRESS' => 'gzip' }, +); + diff --git a/README b/README new file mode 100644 index 0000000..47c1f7c --- /dev/null +++ b/README @@ -0,0 +1,19 @@ +NAME + Set::Infinite - Sets of intervals + +SYNOPSIS + use Set::Infinite; + + $a = Set::Infinite->new(1,2); # [1..2] + print $a->union(5,6); # [1..2],[5..6] + +INSTALLATION + +To install this module type the following in the distribution +directory: + + perl Makefile.PL + make + make test + make install + diff --git a/TODO b/TODO new file mode 100644 index 0000000..689ffba --- /dev/null +++ b/TODO @@ -0,0 +1,131 @@ +Set::Infinite TODO + +- include "backtrack_callback" in the parameter list for _function() + +- document the "separators" method - use example from t/infinite.t + Find out how to make it more user friendly. + +- quantize() should use "iterate" + (unless this breaks _quantize_span) + Find out how to unify "quantize" and the "_recurrence" module (DT::Set) + +- spaceship should return "undef" if the sets can't be compared. +- "contains" should test the result of "==" for undef. +- count() should return "undef" if the set can't be counted. + +- test new methods + +- methods: + is_infinite + exists( sub ) / any / ... + +- Deprecate min_a() + min() should check "wantarray", instead. + This can generate confusion in some cases - verify this. + +- New methods: map / grep + From a discussion with Andrew Pimlott and Dave Rolsky + Find out how to implement "block" syntax + (" {} " instead of " sub{} ") -- use '&' prototype + - test under 5.005_03 + + update: It looks like this is not possible: + http://www.perlmonks.org/index.pl?node_id=312978 + from perlsub: + "Pretty much the exclusive domain of prototypes is to + make a perl sub act like a builtin. Once you call it + via $subref-> or &subname, you are no longer treating + it as a builtin and prototypes are ignored." + +- Redo POD +- difference between "size" and "count" + +- Change syntax: from Class::method to Class->method + +Old TODO: + + - parser (another module) + + - _quantize_span should only be used inside backtrack() + Implementing quantize() using iterator() should make + _quantize_span() unnecessary. + + - provide a constructor that allow for un-ordered and overlapping spans + + - verify and fix unbalanced trace_open/trace_close + + - move (offset, quantize), or most of Arithmetic.pm, to Date::Set + - refactor "widgets" out of the main code. Maybe create + a Set::Infinite::Widgets directory (offset, quantize). + - give more standard names to Arithmetic.pm variables + - implement "last of quantize" + + - remove _quantize_span() + + - a set with first == inf or last = -inf is an error! + + - tests for "iterate" min/max/first/last + These may fail if "iterate" returns >= 2 elements + - more tests for min/max/span/size on too_complex sets + + - find out how to compare "<=>" unbounded sets + - try using first() in intersects() and "<=>" + - test finding out min/max of integer open sets (see backtrack.t tests 2,3) + + - fix _todo/bigfloat, _todo/bigint + +BACKTRACK + + backtrack.t: + + test backtrack on: + iterate -- returning more than 1 element + compact + tolerance + complement + + backtracking: implement remaining tests in backtrack.t + verify results in backtrack.t + + backtracking: document backtracking resolution + +SYNTAX + + extra: Make a 'strict' option for "quantize" and other filters, + that will intersect + each unit back to the object, that is: + Interval: [************************] + Quantized: [*********)[*********)[*********) + Quantized->Stricted: [*****)[*********)[******] + + think about: "push-pop", "dup", "drop" mechanism + + think about: some "if-else" mechanism + +DOCUMENTATION + + check: POD formatting and contents + + verify, document parameter syntax everywhere + + document: + ??? offset option 'mode=>circle' + new method 'list' + iterate + + document as "internal": + min_a + max_a + backtrack + trace + + ??? document: quantize extensibility through hash-subs + +CACHEING + + cache quantize by month/day/... + -- doesn't work if 'quant' is changed + -- doesn't check 'intersects' + make a 'flush'-cache method. Make a 'cache-registry'. + think about: caching for union, etc + diff --git a/_todo/bigfloat.t b/_todo/bigfloat.t new file mode 100644 index 0000000..864457a --- /dev/null +++ b/_todo/bigfloat.t @@ -0,0 +1,206 @@ +#/bin/perl +# Copyright (c) 2001 Flavio Soibelmann Glock. All rights reserved. +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +# Tests for Set::Infinite +# This is work in progress +# + +BEGIN { $| = 1; print "1..74\n"; } +END {$test++; print "not ok $test\n" unless $loaded;} + +use Set::Infinite; +$loaded = 1; +use Math::BigFloat; + +my $errors = 0; +my $test = 0; + + +sub test { + my ($header, $sub, $expected) = @_; + $test++; + print "\t# $header \n"; + $result = eval $sub; + if ("$expected" eq "$result") { + print "ok $test"; + } + else { + print "not ok $test\n\t# expected \"$expected\" got \"$result\""; + $errors++; + } + print " \n"; +} + +sub stats { + if ($errors) { + print "\n\t# Errors: $errors\n"; + } + else { + print "\n\t# No errors.\n"; + } +} + +Set::Infinite->type('Math::BigFloat'); +Set::Infinite->real; + +print "\t# Add element:\n"; + +$a = Set::Infinite->new(1,2); +$a = $a->union(3,4); +test (" (1,2) (3,4) : ",'$a',"[1...2.],[3...4.]"); + +print "\t# Parameter passing:\n"; +test (" complement : ",'$a->complement',"(-inf..1.),(2...3.),(4...inf)"); +test (" complement (1.5,2.5) : ",'$a->complement(1.5,2.5)',"[1...1.5),[3...4.]"); +test (" union (1.5,2.5) : ",'$a->union(1.5,2.5)',"[1...2.5],[3...4.]"); +test (" intersection (1.5,2.5) : ",'$a->intersection(1.5,2.5)',"[1.5..2.]"); +test (" intersects (1.5,2.5) : ",'$a->intersects(1.5,2.5)',"1"); + +$a = Set::Infinite->new(Set::Infinite->new(1,2)); +$a->add(3, 4); +$a->add(-1, 0); +$b = Set::Infinite->new($a); +$b->cleanup; +test ("Interval: (1,2) (3, 4) (-1, 0) : $b \n"); + +$a = $b; +$a->add(0, 1); +$a->add(7, 8); +$a->add(6, 7.5); +$a->cleanup; +test ("Interval: add (0, 1) (7, 8) (6, 7.5) : $a \n"); + +print "\t# Integer + cleanup:\n"; + +$a->integer; +$a->cleanup; +test ("Interval: integer",'$a',"[-1...4.],[6...8.]"); + +print "\t# Operations on open sets\n"; +$a = Set::Infinite->new(1,'inf'); +test ("set : ", '$a', "[1...inf)"); +$a = $a->complement; +test ("[-inf,1) : ", '$a', "(-inf..1.)"); +$b = $a; +test ("copy : ",'$b',"(-inf..1.)"); +test ("complement : ",$a->complement,""); +test ("union [-1...0] : ", '$a->union(-1,0)', "(-inf..1.)"); +test ("union [0...1] : ", '$a->union(0,1)', "(-inf..1.]"); +test ("union [1...2] : ", '$a->union(1,2)', "(-inf..2.]"); +test ("union [2...3] : ", '$a->union(2,3)', "(-inf..1.),[2...3.]"); +$b = Set::Infinite->new(-inf,1)->complement; +#test ("set : ", '$a, ""); +$c = $a->union($b); +test ("union $b : ", '$c', "(-inf..1.),(1...inf)"); +test (" complement : ", '$c->complement',"1."); +test ("union $c [1...inf) ", '$c->union(1,inf)', "(-inf..inf)"); +test ("union $b [1...inf) ", '$b->union(1,inf)', "[1...inf)"); + +print "\t# Testing 'null' and (0...0)\n"; + +$a = Set::Infinite->new(); +test ("null : ",$a,"null"); + +$a = Set::Infinite->new('null'); +test ("null : ",$a,"null"); + +$a = Set::Infinite->new(undef); +test ("null : ",$a,"null"); + +$a = Set::Infinite->new(); +test ("(0,0) intersects to null : ",$a->intersects(0,0),"0"); +test ("(0,0) intersection to null : ",$a->intersection(0,0),"null"); + +$a = Set::Infinite->new(0,0); +test ("(0,0) intersects to null : ",$a->intersects(),"0"); +test ("(0,0) intersection to null : ",$a->intersection(),"null"); + +test ("(0,0) intersects to 0 : ",$a->intersects(0),"1"); +test ("(0,0) intersection to 0 : ",$a->intersection(0),"0"); + +$a = Set::Infinite->new(); +test ("(0,0) union to null : ",$a->union(0,0),"0"); + +$a = Set::Infinite->new(0,0); +test ("(0,0) union to null : ",$a->union(),"0"); + +$a = Set::Infinite->new(0,0); +test ("(0,0) intersects to (1,1) : ",$a->intersects(1,1),"0"); +test ("(0,0) intersection to (1,1) : ",$a->intersection(1,1)->as_string,"null"); + + +print "\t# New:\n"; + +$a = Set::Infinite->new(1,2); +$b = Set::Infinite->new([4,5],[7,8]); +$x = Set::Infinite->new(10,11); +$c = Set::Infinite->new($x); +# $d = Set::Infinite->new( a => 13, b => 14 ); +#print "\t# a : $a\n b : $b\n c : $c\n"; # d : $d\n"; +$abcd = ' '; +$abcd = Set::Infinite->new([$a],[$b],[$c]); +#print " abcd $abcd\n"; +test ("abcd",'$abcd',"[1...2.],[4...5.],[7...8.],[10...11.]"); + +print "\t# Contains\n"; +$a = Set::Infinite->new([3,6],[12,18]); +test ("set : ", '$a', "[3...6.],[12...18.]"); +test ("contains (4,5) : ", '$a->contains(4,5)', "1"); +test ("contains (3,5) : ", '$a->contains(3,5)', "1"); +test ("contains (2,5) : ", '$a->contains(2,5)', "0"); +test ("contains (4,15) : ", '$a->contains(4,15)', "0"); +test ("contains (15,16) : ", '$a->contains(15,16)', "1"); +test ("contains (4,5),(15,16) : ", '$a->contains([4,5],[15,16])', "1"); +test ("contains (4,5),(15,20) : ", '$a->contains([4,5],[15,20])', "0"); + + + +print "\t# Intersects:\n"; + +$a = Set::Infinite->new(2,1); +test ("Interval:",'$a',"[1...2.]"); +test ("intersects 2.5 : ", '$a->intersects(2.5)', "0"); +test ("intersects 1.5 : ", '$a->intersects(1.5)', "1"); +test ("intersects 0.5 : ", '$a->intersects(0.5)', "0"); +test ("intersects 0.1 ... 0.3 : ", '$a->intersects(Set::Infinite->new(0.1,0.3))', "0"); +test ("intersects 0.1 ... 1.3 : ", '$a->intersects(Set::Infinite->new(0.1,1.3))', "1"); +test ("intersects 1.1 ... 1.3 : ", '$a->intersects(Set::Infinite->new(1.1,1.3))', "1"); +test ("intersects 1.1 ... 2.3 : ", '$a->intersects(Set::Infinite->new(1.1,2.3))', "1"); +test ("intersects 2.1 ... 2.3 : ", '$a->intersects(Set::Infinite->new(2.1,2.3))', "0"); +test ("intersects 0.0 ... 4.0 : ", '$a->intersects(Set::Infinite->new(0.0,4.0))', "1"); + +print "\t# Other:\n"; + +test ("Union 2.0 : ", '$a->union(2.0)', "[1...2.]"); +test ("Union 2.5 ", '$a->union(2.5)', "[1...2.],2.5"); +test ("Union 2.0 ... 2.5 : ", '$a->union(Set::Infinite->new(2.0,2.5))', "[1...2.5]"); +test ("Union 0.5 ... 1.5 : ", '$a->union(Set::Infinite->new(0.5,1.5))', "[.5..2.]"); +test ("Union 3.0 ... 4.0 : ", '$a->union(Set::Infinite->new(3.0,4.0))', "[1...2.],[3...4.]"); +test ("Union 0.0 ... 4.0 5 ... 6 : ", '$a->union(Set::Infinite->new([0.0,4.0],[5.0,6.0]))', "[0...4.],[5...6.]"); + +$a = Set::Infinite->new(2,1); +test ("Interval",'$a',"[1...2.]"); +test ("intersection 2.5 : ", '$a->intersection(2.5)', "null"); +test ("intersection 1.5 : ", '$a->intersection(1.5)', "1.5"); +test ("intersection 0.5 : ", '$a->intersection(0.5)', "null"); +test ("intersection 0.1 ... 0.3 : ", '$a->intersection(Set::Infinite->new(0.1,0.3))', "null"); +test ("intersection 0.1 ... 1.3 : ", '$a->intersection(Set::Infinite->new(0.1,1.3))', "[1...1.3]"); +test ("intersection 1.1 ... 1.3 : ", '$a->intersection(Set::Infinite->new(1.1,1.3))', "[1.1..1.3]"); +test ("intersection 1.1 ... 2.3 : ", '$a->intersection(Set::Infinite->new(1.1,2.3))', "[1.1..2.]"); +test ("intersection 2.1 ... 2.3 : ", '$a->intersection(Set::Infinite->new(2.1,2.3))', "null"); +test ("Union 5.5 : ", '$a->union(5.5)', "[1...2.],5.5"); +test ("intersection 0.0 ... 4.0 5 ... 6 : ", '$a->intersection(Set::Infinite->new([0.0,4.0],[5.0,6.0]))', "[1...2.]"); + +$a = Set::Infinite->new(2,1,4,5); +$b = Set::Infinite->new(2.1,1.1,4.1,5.1); +test ("intersection $a with $b", '$a->intersection($b)', "[1.1..2.],[4.1..5.]"); +test ("size of $b is : ", '$b->size', "2."); +test ("span of $b is : ", '$b->span', "[1.1..5.1]"); + +tie $a, 'Set::Infinite', [1,2], [9,10]; +test ("tied: ",'$a',"[1...2.],[9...10.]"); + +stats; +1; diff --git a/_todo/bigint.t b/_todo/bigint.t new file mode 100644 index 0000000..9a99e07 --- /dev/null +++ b/_todo/bigint.t @@ -0,0 +1,215 @@ +#/bin/perl +# Copyright (c) 2001 Flavio Soibelmann Glock. All rights reserved. +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +# Tests for Set::Infinite +# This is work in progress +# + +use Set::Infinite qw(inf); + +my $errors = 0; +my $test = 0; + +print "1..74\n"; + + +sub test { + my ($header, $sub, $expected) = @_; + $test++; + #print "\t# $header \n"; + $result = eval $sub; + if ("$expected" eq "$result") { + print "ok $test"; + } + else { + print "not ok $test"; + print "\n\t# expected \"$expected\" got \"$result\""; + + # $result = + foreach(0..length($result)) { print substr($expected,$_,1),substr($result,$_,1)," "; } + print "\n"; + + $errors++; + } + print " \n"; +} + +sub stats { + if ($errors) { + #print "\n\t# Errors: $errors\n"; + } + else { + #print "\n\t# No errors.\n"; + } +} + +use Set::Infinite; +Set::Infinite->type('Math::BigInt'); +Set::Infinite->integer; + +# print "Union\n"; + +$a = Set::Infinite->new(1,inf); +$a = $a->complement; +#print " A is ", $a, "\n"; +test ("union A [2..3] : ", '$a->union(2,3)', "(-inf..+1),[+2..+3]"); + +$b = Set::Infinite->new(- inf,1)->complement; +test ("union $b : ", '$a->union($b)', "(-inf..+1),(+1..inf)"); + + +$a = Set::Infinite->new(10, 13); +# print " a is ", $a, "\n"; +test ("$a union (16..17) ", '$a->union(16, 17)', "[+10..+13],[+16..+17]"); +$a = Set::Infinite->new(16, 17); +# print " a is ", $a, "\n"; +test ("$a union (10..13) ", '$a->union(10, 13)', "[+10..+13],[+16..+17]"); + +# print "Operations on open sets\n"; +$a = Set::Infinite->new(1,inf); +test ("set : ", '$a', "[+1..inf)"); +$a = $a->complement; +test ("[-inf,1) : ", '$a', "(-inf..+1)"); +$b = $a; +test ("copy : ", '$b',"(-inf..+1)"); +test ("complement : ", '$a->complement',"[+1..inf)"); +test ("union [-1..0] : ", '$a->union(-1,0)', "(-inf..+1)"); +test ("union [0..1] : ", '$a->union(0,1)', "(-inf..+1]"); +test ("union [1..2] : ", '$a->union(1,2)', "(-inf..+2]"); +test ("union [2..3] : ", '$a->union(2,3)', "(-inf..+1),[+2..+3]"); +$b = Set::Infinite->new(- inf,1)->complement; +#test ("set : ", '$a, ""); +$c = $a->union($b); +test ("union $b : ", '$c', "(-inf..+1),(+1..inf)"); +test (" complement : ", '$c->complement',"+1"); +test ("union $c [1..inf) ", '$c->union(1,inf)', "(-inf..inf)"); +test ("union $b [1..inf) ", '$b->union(1,inf)', "[+1..inf)"); + +# print "Testing 'null' and (0..0)\n"; + +$a = Set::Infinite->new(); +test ("null : ",'$a',"null"); + +$a = Set::Infinite->new('null'); +test ("null : ",'$a',"null"); + +$a = Set::Infinite->new(undef); +test ("null : ",'$a',"null"); + +$a = Set::Infinite->new(); +test ("(0,0) intersects to null : ",'$a->intersects(0,0)',"0"); +test ("(0,0) intersection to null : ",'$a->intersection(0,0)',"null"); + +$a = Set::Infinite->new(0,0); +test ("(0,0) intersects to null : ",'$a->intersects()',"0"); +test ("(0,0) intersection to null : ",'$a->intersection()',"null"); + +test ("(0,0) intersects to 0 : ",'$a->intersects(0)',"1"); +test ("(0,0) intersection to 0 : ",'$a->intersection(0)',"+0"); + +$a = Set::Infinite->new(); +test ("(0,0) union to null : ",'$a->union(0,0)',"+0"); + +$a = Set::Infinite->new(0,0); +test ("(0,0) union to null : ",'$a->union()',"+0"); + +$a = Set::Infinite->new(0,0); +test ("(0,0) intersects to (1,1) : ",'$a->intersects(1,1)',"0"); +test ("(0,0) intersection to (1,1) : ",'$a->intersection(1,1)->as_string',"null"); + + +#print "New:\n"; + +$a = Set::Infinite->new(1,2); +$b = Set::Infinite->new([4,5],[7,8]); +$x = Set::Infinite->new(10,11); +$c = Set::Infinite->new($x); +# $d = Set::Infinite->new( a => 13, b => 14 ); +#print " a : $a\n b : $b\n c : $c\n d : $d\n"; +$abcd = Set::Infinite->new([$a],[$b],[$c]); +#print " abcd $abcd\n"; +test ("abcd",'$abcd',"[+1..+2],[+4..+5],[+7..+8],[+10..+11]"); +$abcd = ''; + +#print "Contains\n"; +$a = Set::Infinite->new([3,6],[12,18]); +test ("set : ", '$a', "[+3..+6],[+12..+18]"); +test ("contains (4,5) : ", '$a->contains(4,5)', "1"); +test ("contains (3,5) : ", '$a->contains(3,5)', "1"); +test ("contains (2,5) : ", '$a->contains(2,5)', "0"); +test ("contains (4,15) : ", '$a->contains(4,15)', "0"); +test ("contains (15,16) : ", '$a->contains(15,16)', "1"); +test ("contains (4,5),(15,16) : ", '$a->contains([4,5],[15,16])', "1"); +test ("contains (4,5),(15,20) : ", '$a->contains([4,5],[15,20])', "0"); + + +#print "Add element:\n"; + +$a = Set::Infinite->new(1,2); +$a->add(3,4); +test (" (1,2) (3,4) : ",'$a',"[+1..+4]"); +#print "Parameter passing:\n"; +test (" complement : ",'$a->complement',"(-inf..+1),(+4..inf)"); +test (" complement (0,3) : ",'$a->complement(0,3)',"(+3..+4]"); +test (" union (0,3) : ",'$a->union(0,3)',"[+0..+4]"); +test (" intersection (0,3) : ",'$a->intersection(0,3)',"[+1..+3]"); +test (" intersects (0,3) : ",'$a->intersects(0,3)',"1"); + +$a = Set::Infinite->new(Set::Infinite->new(1,2)); +$a->add(3, 4); +$a->add(-1, 0); +$b = Set::Infinite->new($a); +$b->cleanup; +test ("Interval: (1,2) (3, 4) (-1, 0) : ",'$b',"[-1..+4]"); + +$a = $b; +$a->add(0, 1); +$a->add(7, 9); +$a->add(6, 8); + + +test ("Interval: integer",'$a',"[-1..+4],[+6..+9]"); + +#print "Intersects:\n"; + +$a = Set::Infinite->new(2,1); +test ("Interval:",'$a',"[+1..+2]"); +test ("intersects 3 : ", '$a->intersects(3)', "0"); +test ("intersects 2 : ", '$a->intersects(2)', "1"); +test ("intersects 1 : ", '$a->intersects(1)', "1"); +test ("intersects 0 : ", '$a->intersects(0)', "0"); +test ("intersects -1..0 : ", '$a->intersects(Set::Infinite->new(-1,0))', "0"); +test ("intersects 0..1 : ", '$a->intersects(Set::Infinite->new(0,1))', "1"); +test ("intersects 1..2 : ", '$a->intersects(Set::Infinite->new(1,2))', "1"); +test ("intersects 1..3 : ", '$a->intersects(Set::Infinite->new(1,3))', "1"); +test ("intersects 2..3 : ", '$a->intersects(Set::Infinite->new(2,3))', "1"); +test ("intersects 0..4 : ", '$a->intersects(Set::Infinite->new(0,4))', "1"); + +#print "Other:\n"; + +test ("Union 2 : ", '$a->union(2)', "[+1..+2]"); +test ("Union 3 ", '$a->union(3)', "[+1..+3]"); +test ("Union 0 .. 1 : ", '$a->union(Set::Infinite->new(0,1))', "[+0..+2]"); +test ("Union 3 .. 4 : ", '$a->union(Set::Infinite->new(3.0,4.0))', "[+1..+4]"); +test ("Union 0 .. 4 5 .. 6 : ", '$a->union(Set::Infinite->new([0.0,4.0],[5.0,6.0]))', "[+0..+6]"); + +$a = Set::Infinite->new(2,1); +test ("Interval",'$a',"[+1..+2]"); +test ("intersection 2 : ", '$a->intersection(2)', "+2"); +test ("intersection 1 : ", '$a->intersection(1)', "+1"); +test ("intersection 0 : ", '$a->intersection(0)', "null"); +test ("intersection 0..0 : ", '$a->intersection(Set::Infinite->new(0,0))', "null"); +test ("intersection 0..1 : ", '$a->intersection(Set::Infinite->new(0,1))', "+1"); +test ("intersection 1..1 : ", '$a->intersection(Set::Infinite->new(1,1))', "+1"); +test ("intersection 1..2 : ", '$a->intersection(Set::Infinite->new(1,2))', "[+1..+2]"); +test ("intersection 2..2 : ", '$a->intersection(Set::Infinite->new(2,2))', "+2"); +test ("Union 5 : ", '$a->union(5)', "[+1..+2],+5"); +test ("intersection 0.0 .. 4.0 5 .. 6 : ", '$a->intersection(Set::Infinite->new([0.0,4.0],[5.0,6.0]))', "[+1..+2]"); + +tie $a, 'Set::Infinite', [1,2], [9,10]; +test ("tied: ",'$a',"[+1..+2],[+9..+10]"); + +stats; +1; diff --git a/lib/Set/Infinite.pm b/lib/Set/Infinite.pm new file mode 100644 index 0000000..72bda52 --- /dev/null +++ b/lib/Set/Infinite.pm @@ -0,0 +1,1921 @@ +package Set::Infinite; + +# Copyright (c) 2001, 2002, 2003, 2004 Flavio Soibelmann Glock. +# All rights reserved. +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. + +use 5.005_03; + +# These methods are inherited from Set::Infinite::Basic "as-is": +# type list fixtype numeric min max integer real new span copy +# start_set end_set universal_set empty_set minus difference +# symmetric_difference is_empty + +use strict; +use base qw(Set::Infinite::Basic Exporter); +use Carp; +use Set::Infinite::Arithmetic; + +use overload + '<=>' => \&spaceship, + '""' => \&as_string; + +use vars qw(@EXPORT_OK $VERSION + $TRACE $DEBUG_BT $PRETTY_PRINT $inf $minus_inf $neg_inf + %_first %_last %_backtrack + $too_complex $backtrack_depth + $max_backtrack_depth $max_intersection_depth + $trace_level %level_title ); + +@EXPORT_OK = qw(inf $inf trace_open trace_close); + +$inf = 100**100**100; +$neg_inf = $minus_inf = -$inf; + + +# obsolete methods - included for backward compatibility +sub inf () { $inf } +sub minus_inf () { $minus_inf } +sub no_cleanup { $_[0] } +*type = \&Set::Infinite::Basic::type; +sub compact { @_ } + + +BEGIN { + $VERSION = "0.65"; + $TRACE = 0; # enable basic trace method execution + $DEBUG_BT = 0; # enable backtrack tracer + $PRETTY_PRINT = 0; # 0 = print 'Too Complex'; 1 = describe functions + $trace_level = 0; # indentation level when debugging + + $too_complex = "Too complex"; + $backtrack_depth = 0; + $max_backtrack_depth = 10; # _backtrack() + $max_intersection_depth = 5; # first() +} + +sub trace { # title=>'aaa' + return $_[0] unless $TRACE; + my ($self, %parm) = @_; + my @caller = caller(1); + # print "self $self ". ref($self). "\n"; + print "" . ( ' | ' x $trace_level ) . + "$parm{title} ". $self->copy . + ( exists $parm{arg} ? " -- " . $parm{arg}->copy : "" ). + " $caller[1]:$caller[2] ]\n" if $TRACE == 1; + return $self; +} + +sub trace_open { + return $_[0] unless $TRACE; + my ($self, %parm) = @_; + my @caller = caller(1); + print "" . ( ' | ' x $trace_level ) . + "\\ $parm{title} ". $self->copy . + ( exists $parm{arg} ? " -- ". $parm{arg}->copy : "" ). + " $caller[1]:$caller[2] ]\n"; + $trace_level++; + $level_title{$trace_level} = $parm{title}; + return $self; +} + +sub trace_close { + return $_[0] unless $TRACE; + my ($self, %parm) = @_; + my @caller = caller(0); + print "" . ( ' | ' x ($trace_level-1) ) . + "\/ $level_title{$trace_level} ". + ( exists $parm{arg} ? + ( + defined $parm{arg} ? + "ret ". ( UNIVERSAL::isa($parm{arg}, __PACKAGE__ ) ? + $parm{arg}->copy : + "<$parm{arg}>" ) : + "undef" + ) : + "" # no arg + ). + " $caller[1]:$caller[2] ]\n"; + $trace_level--; + return $self; +} + + +# creates a 'function' object that can be solved by _backtrack() +sub _function { + my ($self, $method) = (shift, shift); + my $b = $self->empty_set(); + $b->{too_complex} = 1; + $b->{parent} = $self; + $b->{method} = $method; + $b->{param} = [ @_ ]; + return $b; +} + + +# same as _function, but with 2 arguments +sub _function2 { + my ($self, $method, $arg) = (shift, shift, shift); + unless ( $self->{too_complex} || $arg->{too_complex} ) { + return $self->$method($arg, @_); + } + my $b = $self->empty_set(); + $b->{too_complex} = 1; + $b->{parent} = [ $self, $arg ]; + $b->{method} = $method; + $b->{param} = [ @_ ]; + return $b; +} + + +sub quantize { + my $self = shift; + $self->trace_open(title=>"quantize") if $TRACE; + my @min = $self->min_a; + my @max = $self->max_a; + if (($self->{too_complex}) or + (defined $min[0] && $min[0] == $neg_inf) or + (defined $max[0] && $max[0] == $inf)) { + + return $self->_function( 'quantize', @_ ); + } + + my @a; + my %rule = @_; + my $b = $self->empty_set(); + my $parent = $self; + + $rule{unit} = 'one' unless $rule{unit}; + $rule{quant} = 1 unless $rule{quant}; + $rule{parent} = $parent; + $rule{strict} = $parent unless exists $rule{strict}; + $rule{type} = $parent->{type}; + + my ($min, $open_begin) = $parent->min_a; + + unless (defined $min) { + $self->trace_close( arg => $b ) if $TRACE; + return $b; + } + + $rule{fixtype} = 1 unless exists $rule{fixtype}; + $Set::Infinite::Arithmetic::Init_quantizer{$rule{unit}}->(\%rule); + + $rule{sub_unit} = $Set::Infinite::Arithmetic::Offset_to_value{$rule{unit}}; + carp "Quantize unit '".$rule{unit}."' not implemented" unless ref( $rule{sub_unit} ) eq 'CODE'; + + my ($max, $open_end) = $parent->max_a; + $rule{offset} = $Set::Infinite::Arithmetic::Value_to_offset{$rule{unit}}->(\%rule, $min); + my $last_offset = $Set::Infinite::Arithmetic::Value_to_offset{$rule{unit}}->(\%rule, $max); + $rule{size} = $last_offset - $rule{offset} + 1; + my ($index, $tmp, $this, $next); + for $index (0 .. $rule{size} ) { + # ($this, $next) = $rule{sub_unit} (\%rule, $index); + ($this, $next) = $rule{sub_unit}->(\%rule, $index); + unless ( $rule{fixtype} ) { + $tmp = { a => $this , b => $next , + open_begin => 0, open_end => 1 }; + } + else { + $tmp = Set::Infinite::Basic::_simple_new($this,$next, $rule{type} ); + $tmp->{open_end} = 1; + } + next if ( $rule{strict} and not $rule{strict}->intersects($tmp)); + push @a, $tmp; + } + + $b->{list} = \@a; # change data + $self->trace_close( arg => $b ) if $TRACE; + return $b; +} + + +sub _first_n { + my $self = shift; + my $n = shift; + my $tail = $self->copy; + my @result; + my $first; + for ( 1 .. $n ) + { + ( $first, $tail ) = $tail->first if $tail; + push @result, $first; + } + return $tail, @result; +} + +sub _last_n { + my $self = shift; + my $n = shift; + my $tail = $self->copy; + my @result; + my $last; + for ( 1 .. $n ) + { + ( $last, $tail ) = $tail->last if $tail; + unshift @result, $last; + } + return $tail, @result; +} + + +sub select { + my $self = shift; + $self->trace_open(title=>"select") if $TRACE; + + my %param = @_; + die "select() - parameter 'freq' is deprecated" if exists $param{freq}; + + my $res; + my $count; + my @by; + @by = @{ $param{by} } if exists $param{by}; + $count = delete $param{count} || $inf; + # warn "select: count=$count by=[@by]"; + + if ($count <= 0) { + $self->trace_close( arg => $res ) if $TRACE; + return $self->empty_set(); + } + + my @set; + my $tail; + my $first; + my $last; + if ( @by ) + { + my @res; + if ( ! $self->is_too_complex ) + { + $res = $self->new; + @res = @{ $self->{list} }[ @by ] ; + } + else + { + my ( @pos_by, @neg_by ); + for ( @by ) { + ( $_ < 0 ) ? push @neg_by, $_ : + push @pos_by, $_; + } + my @first; + if ( @pos_by ) { + @pos_by = sort { $a <=> $b } @pos_by; + ( $tail, @set ) = $self->_first_n( 1 + $pos_by[-1] ); + @first = @set[ @pos_by ]; + } + my @last; + if ( @neg_by ) { + @neg_by = sort { $a <=> $b } @neg_by; + ( $tail, @set ) = $self->_last_n( - $neg_by[0] ); + @last = @set[ @neg_by ]; + } + @res = map { $_->{list}[0] } ( @first , @last ); + } + + $res = $self->new; + @res = sort { $a->{a} <=> $b->{a} } grep { defined } @res; + my $last; + my @a; + for ( @res ) { + push @a, $_ if ! $last || $last->{a} != $_->{a}; + $last = $_; + } + $res->{list} = \@a; + } + else + { + $res = $self; + } + + return $res if $count == $inf; + my $count_set = $self->empty_set(); + if ( ! $self->is_too_complex ) + { + my @a; + @a = grep { defined } @{ $res->{list} }[ 0 .. $count - 1 ] ; + $count_set->{list} = \@a; + } + else + { + my $last; + while ( $res ) { + ( $first, $res ) = $res->first; + last unless $first; + last if $last && $last->{a} == $first->{list}[0]{a}; + $last = $first->{list}[0]; + push @{$count_set->{list}}, $first->{list}[0]; + $count--; + last if $count <= 0; + } + } + return $count_set; +} + +BEGIN { + + # %_first and %_last hashes are used to backtrack the value + # of first() and last() of an infinite set + + %_first = ( + 'complement' => + sub { + my $self = $_[0]; + my @parent_min = $self->{parent}->first; + unless ( defined $parent_min[0] ) { + return (undef, 0); + } + my $parent_complement; + my $first; + my @next; + my $parent; + if ( $parent_min[0]->min == $neg_inf ) { + my @parent_second = $parent_min[1]->first; + # (-inf..min) (second..?) + # (min..second) = complement + $first = $self->new( $parent_min[0]->complement ); + $first->{list}[0]{b} = $parent_second[0]->{list}[0]{a}; + $first->{list}[0]{open_end} = ! $parent_second[0]->{list}[0]{open_begin}; + @{ $first->{list} } = () if + ( $first->{list}[0]{a} == $first->{list}[0]{b}) && + ( $first->{list}[0]{open_begin} || + $first->{list}[0]{open_end} ); + @next = $parent_second[0]->max_a; + $parent = $parent_second[1]; + } + else { + # (min..?) + # (-inf..min) = complement + $parent_complement = $parent_min[0]->complement; + $first = $self->new( $parent_complement->{list}[0] ); + @next = $parent_min[0]->max_a; + $parent = $parent_min[1]; + } + my @no_tail = $self->new($neg_inf,$next[0]); + $no_tail[0]->{list}[0]{open_end} = $next[1]; + my $tail = $parent->union($no_tail[0])->complement; + return ($first, $tail); + }, # end: first-complement + 'intersection' => + sub { + my $self = $_[0]; + my @parent = @{ $self->{parent} }; + # warn "$method parents @parent"; + my $retry_count = 0; + my (@first, @min, $which, $first1, $intersection); + SEARCH: while ($retry_count++ < $max_intersection_depth) { + return undef unless defined $parent[0]; + return undef unless defined $parent[1]; + @{$first[0]} = $parent[0]->first; + @{$first[1]} = $parent[1]->first; + unless ( defined $first[0][0] ) { + # warn "don't know first of $method"; + $self->trace_close( arg => 'undef' ) if $TRACE; + return undef; + } + unless ( defined $first[1][0] ) { + # warn "don't know first of $method"; + $self->trace_close( arg => 'undef' ) if $TRACE; + return undef; + } + @{$min[0]} = $first[0][0]->min_a; + @{$min[1]} = $first[1][0]->min_a; + unless ( defined $min[0][0] && defined $min[1][0] ) { + return undef; + } + # $which is the index to the bigger "first". + $which = ($min[0][0] < $min[1][0]) ? 1 : 0; + for my $which1 ( $which, 1 - $which ) { + my $tmp_parent = $parent[$which1]; + ($first1, $parent[$which1]) = @{ $first[$which1] }; + if ( $first1->is_empty ) { + # warn "first1 empty! count $retry_count"; + # trace_close; + # return $first1, undef; + $intersection = $first1; + $which = $which1; + last SEARCH; + } + $intersection = $first1->intersection( $parent[1-$which1] ); + # warn "intersection with $first1 is $intersection"; + unless ( $intersection->is_null ) { + # $self->trace( title=>"got an intersection" ); + if ( $intersection->is_too_complex ) { + $parent[$which1] = $tmp_parent; + } + else { + $which = $which1; + last SEARCH; + } + }; + } + } + if ( $#{ $intersection->{list} } > 0 ) { + my $tail; + ($intersection, $tail) = $intersection->first; + $parent[$which] = $parent[$which]->union( $tail ); + } + my $tmp; + if ( defined $parent[$which] and defined $parent[1-$which] ) { + $tmp = $parent[$which]->intersection ( $parent[1-$which] ); + } + return ($intersection, $tmp); + }, # end: first-intersection + 'union' => + sub { + my $self = $_[0]; + my (@first, @min); + my @parent = @{ $self->{parent} }; + @{$first[0]} = $parent[0]->first; + @{$first[1]} = $parent[1]->first; + unless ( defined $first[0][0] ) { + # looks like one set was empty + return @{$first[1]}; + } + @{$min[0]} = $first[0][0]->min_a; + @{$min[1]} = $first[1][0]->min_a; + + # check min1/min2 for undef + unless ( defined $min[0][0] ) { + $self->trace_close( arg => "@{$first[1]}" ) if $TRACE; + return @{$first[1]} + } + unless ( defined $min[1][0] ) { + $self->trace_close( arg => "@{$first[0]}" ) if $TRACE; + return @{$first[0]} + } + + my $which = ($min[0][0] < $min[1][0]) ? 0 : 1; + my $first = $first[$which][0]; + + # find out the tail + my $parent1 = $first[$which][1]; + # warn $self->{parent}[$which]." - $first = $parent1"; + my $parent2 = ($min[0][0] == $min[1][0]) ? + $self->{parent}[1-$which]->complement($first) : + $self->{parent}[1-$which]; + my $tail; + if (( ! defined $parent1 ) || $parent1->is_null) { + # warn "union parent1 tail is null"; + $tail = $parent2; + } + else { + my $method = $self->{method}; + $tail = $parent1->$method( $parent2 ); + } + + if ( $first->intersects( $tail ) ) { + my $first2; + ( $first2, $tail ) = $tail->first; + $first = $first->union( $first2 ); + } + + $self->trace_close( arg => "$first $tail" ) if $TRACE; + return ($first, $tail); + }, # end: first-union + 'iterate' => + sub { + my $self = $_[0]; + my $parent = $self->{parent}; + my ($first, $tail) = $parent->first; + $first = $first->iterate( @{$self->{param}} ) if ref($first); + $tail = $tail->_function( 'iterate', @{$self->{param}} ) if ref($tail); + my $more; + ($first, $more) = $first->first if ref($first); + $tail = $tail->_function2( 'union', $more ) if defined $more; + return ($first, $tail); + }, + 'until' => + sub { + my $self = $_[0]; + my ($a1, $b1) = @{ $self->{parent} }; + $a1->trace( title=>"computing first()" ); + my @first1 = $a1->first; + my @first2 = $b1->first; + my ($first, $tail); + if ( $first2[0] <= $first1[0] ) { + # added ->first because it returns 2 spans if $a1 == $a2 + $first = $a1->empty_set()->until( $first2[0] )->first; + $tail = $a1->_function2( "until", $first2[1] ); + } + else { + $first = $a1->new( $first1[0] )->until( $first2[0] ); + if ( defined $first1[1] ) { + $tail = $first1[1]->_function2( "until", $first2[1] ); + } + else { + $tail = undef; + } + } + return ($first, $tail); + }, + 'offset' => + sub { + my $self = $_[0]; + my ($first, $tail) = $self->{parent}->first; + $first = $first->offset( @{$self->{param}} ); + $tail = $tail->_function( 'offset', @{$self->{param}} ); + my $more; + ($first, $more) = $first->first; + $tail = $tail->_function2( 'union', $more ) if defined $more; + return ($first, $tail); + }, + 'quantize' => + sub { + my $self = $_[0]; + my @min = $self->{parent}->min_a; + if ( $min[0] == $neg_inf || $min[0] == $inf ) { + return ( $self->new( $min[0] ) , $self->copy ); + } + my $first = $self->new( $min[0] )->quantize( @{$self->{param}} ); + return ( $first, + $self->{parent}-> + _function2( 'intersection', $first->complement )-> + _function( 'quantize', @{$self->{param}} ) ); + }, + 'tolerance' => + sub { + my $self = $_[0]; + my ($first, $tail) = $self->{parent}->first; + $first = $first->tolerance( @{$self->{param}} ); + $tail = $tail->tolerance( @{$self->{param}} ); + return ($first, $tail); + }, + ); # %_first + + %_last = ( + 'complement' => + sub { + my $self = $_[0]; + my @parent_max = $self->{parent}->last; + unless ( defined $parent_max[0] ) { + return (undef, 0); + } + my $parent_complement; + my $last; + my @next; + my $parent; + if ( $parent_max[0]->max == $inf ) { + # (inf..min) (second..?) = parent + # (min..second) = complement + my @parent_second = $parent_max[1]->last; + $last = $self->new( $parent_max[0]->complement ); + $last->{list}[0]{a} = $parent_second[0]->{list}[0]{b}; + $last->{list}[0]{open_begin} = ! $parent_second[0]->{list}[0]{open_end}; + @{ $last->{list} } = () if + ( $last->{list}[0]{a} == $last->{list}[0]{b}) && + ( $last->{list}[0]{open_end} || + $last->{list}[0]{open_begin} ); + @next = $parent_second[0]->min_a; + $parent = $parent_second[1]; + } + else { + # (min..?) + # (-inf..min) = complement + $parent_complement = $parent_max[0]->complement; + $last = $self->new( $parent_complement->{list}[-1] ); + @next = $parent_max[0]->min_a; + $parent = $parent_max[1]; + } + my @no_tail = $self->new($next[0], $inf); + $no_tail[0]->{list}[-1]{open_begin} = $next[1]; + my $tail = $parent->union($no_tail[-1])->complement; + return ($last, $tail); + }, + 'intersection' => + sub { + my $self = $_[0]; + my @parent = @{ $self->{parent} }; + # TODO: check max1/max2 for undef + + my $retry_count = 0; + my (@last, @max, $which, $last1, $intersection); + + SEARCH: while ($retry_count++ < $max_intersection_depth) { + return undef unless defined $parent[0]; + return undef unless defined $parent[1]; + + @{$last[0]} = $parent[0]->last; + @{$last[1]} = $parent[1]->last; + unless ( defined $last[0][0] ) { + $self->trace_close( arg => 'undef' ) if $TRACE; + return undef; + } + unless ( defined $last[1][0] ) { + $self->trace_close( arg => 'undef' ) if $TRACE; + return undef; + } + @{$max[0]} = $last[0][0]->max_a; + @{$max[1]} = $last[1][0]->max_a; + unless ( defined $max[0][0] && defined $max[1][0] ) { + $self->trace( title=>"can't find max()" ) if $TRACE; + $self->trace_close( arg => 'undef' ) if $TRACE; + return undef; + } + + # $which is the index to the smaller "last". + $which = ($max[0][0] > $max[1][0]) ? 1 : 0; + + for my $which1 ( $which, 1 - $which ) { + my $tmp_parent = $parent[$which1]; + ($last1, $parent[$which1]) = @{ $last[$which1] }; + if ( $last1->is_null ) { + $which = $which1; + $intersection = $last1; + last SEARCH; + } + $intersection = $last1->intersection( $parent[1-$which1] ); + + unless ( $intersection->is_null ) { + # $self->trace( title=>"got an intersection" ); + if ( $intersection->is_too_complex ) { + $self->trace( title=>"got a too_complex intersection" ) if $TRACE; + # warn "too complex intersection"; + $parent[$which1] = $tmp_parent; + } + else { + $self->trace( title=>"got an intersection" ) if $TRACE; + $which = $which1; + last SEARCH; + } + }; + } + } + $self->trace( title=>"exit loop" ) if $TRACE; + if ( $#{ $intersection->{list} } > 0 ) { + my $tail; + ($intersection, $tail) = $intersection->last; + $parent[$which] = $parent[$which]->union( $tail ); + } + my $tmp; + if ( defined $parent[$which] and defined $parent[1-$which] ) { + $tmp = $parent[$which]->intersection ( $parent[1-$which] ); + } + return ($intersection, $tmp); + }, + 'union' => + sub { + my $self = $_[0]; + my (@last, @max); + my @parent = @{ $self->{parent} }; + @{$last[0]} = $parent[0]->last; + @{$last[1]} = $parent[1]->last; + @{$max[0]} = $last[0][0]->max_a; + @{$max[1]} = $last[1][0]->max_a; + unless ( defined $max[0][0] ) { + return @{$last[1]} + } + unless ( defined $max[1][0] ) { + return @{$last[0]} + } + + my $which = ($max[0][0] > $max[1][0]) ? 0 : 1; + my $last = $last[$which][0]; + # find out the tail + my $parent1 = $last[$which][1]; + # warn $self->{parent}[$which]." - $last = $parent1"; + my $parent2 = ($max[0][0] == $max[1][0]) ? + $self->{parent}[1-$which]->complement($last) : + $self->{parent}[1-$which]; + my $tail; + if (( ! defined $parent1 ) || $parent1->is_null) { + $tail = $parent2; + } + else { + my $method = $self->{method}; + $tail = $parent1->$method( $parent2 ); + } + + if ( $last->intersects( $tail ) ) { + my $last2; + ( $last2, $tail ) = $tail->last; + $last = $last->union( $last2 ); + } + + return ($last, $tail); + }, + 'until' => + sub { + my $self = $_[0]; + my ($a1, $b1) = @{ $self->{parent} }; + $a1->trace( title=>"computing last()" ); + my @last1 = $a1->last; + my @last2 = $b1->last; + my ($last, $tail); + if ( $last2[0] <= $last1[0] ) { + # added ->last because it returns 2 spans if $a1 == $a2 + $last = $last2[0]->until( $a1 )->last; + $tail = $a1->_function2( "until", $last2[1] ); + } + else { + $last = $a1->new( $last1[0] )->until( $last2[0] ); + if ( defined $last1[1] ) { + $tail = $last1[1]->_function2( "until", $last2[1] ); + } + else { + $tail = undef; + } + } + return ($last, $tail); + }, + 'iterate' => + sub { + my $self = $_[0]; + my $parent = $self->{parent}; + my ($last, $tail) = $parent->last; + $last = $last->iterate( @{$self->{param}} ) if ref($last); + $tail = $tail->_function( 'iterate', @{$self->{param}} ) if ref($tail); + my $more; + ($last, $more) = $last->last if ref($last); + $tail = $tail->_function2( 'union', $more ) if defined $more; + return ($last, $tail); + }, + 'offset' => + sub { + my $self = $_[0]; + my ($last, $tail) = $self->{parent}->last; + $last = $last->offset( @{$self->{param}} ); + $tail = $tail->_function( 'offset', @{$self->{param}} ); + my $more; + ($last, $more) = $last->last; + $tail = $tail->_function2( 'union', $more ) if defined $more; + return ($last, $tail); + }, + 'quantize' => + sub { + my $self = $_[0]; + my @max = $self->{parent}->max_a; + if (( $max[0] == $neg_inf ) || ( $max[0] == $inf )) { + return ( $self->new( $max[0] ) , $self->copy ); + } + my $last = $self->new( $max[0] )->quantize( @{$self->{param}} ); + if ($max[1]) { # open_end + if ( $last->min <= $max[0] ) { + $last = $self->new( $last->min - 1e-9 )->quantize( @{$self->{param}} ); + } + } + return ( $last, $self->{parent}-> + _function2( 'intersection', $last->complement )-> + _function( 'quantize', @{$self->{param}} ) ); + }, + 'tolerance' => + sub { + my $self = $_[0]; + my ($last, $tail) = $self->{parent}->last; + $last = $last->tolerance( @{$self->{param}} ); + $tail = $tail->tolerance( @{$self->{param}} ); + return ($last, $tail); + }, + ); # %_last +} # BEGIN + +sub first { + my $self = $_[0]; + unless ( exists $self->{first} ) { + $self->trace_open(title=>"first") if $TRACE; + if ( $self->{too_complex} ) { + my $method = $self->{method}; + # warn "method $method ". ( exists $_first{$method} ? "exists" : "does not exist" ); + if ( exists $_first{$method} ) { + @{$self->{first}} = $_first{$method}->($self); + } + else { + my $redo = $self->{parent}->$method ( @{ $self->{param} } ); + @{$self->{first}} = $redo->first; + } + } + else { + return $self->SUPER::first; + } + } + return wantarray ? @{$self->{first}} : $self->{first}[0]; +} + + +sub last { + my $self = $_[0]; + unless ( exists $self->{last} ) { + $self->trace(title=>"last") if $TRACE; + if ( $self->{too_complex} ) { + my $method = $self->{method}; + if ( exists $_last{$method} ) { + @{$self->{last}} = $_last{$method}->($self); + } + else { + my $redo = $self->{parent}->$method ( @{ $self->{param} } ); + @{$self->{last}} = $redo->last; + } + } + else { + return $self->SUPER::last; + } + } + return wantarray ? @{$self->{last}} : $self->{last}[0]; +} + + +# offset: offsets subsets +sub offset { + my $self = shift; + if ($self->{too_complex}) { + return $self->_function( 'offset', @_ ); + } + $self->trace_open(title=>"offset") if $TRACE; + + my @a; + my %param = @_; + my $b1 = $self->empty_set(); + my ($interval, $ia, $i); + $param{mode} = 'offset' unless $param{mode}; + + unless (ref($param{value}) eq 'ARRAY') { + $param{value} = [0 + $param{value}, 0 + $param{value}]; + } + $param{unit} = 'one' unless $param{unit}; + my $parts = ($#{$param{value}}) / 2; + my $sub_unit = $Set::Infinite::Arithmetic::subs_offset2{$param{unit}}; + my $sub_mode = $Set::Infinite::Arithmetic::_MODE{$param{mode}}; + + carp "unknown unit $param{unit} for offset()" unless defined $sub_unit; + carp "unknown mode $param{mode} for offset()" unless defined $sub_mode; + + my ($j); + my ($cmp, $this, $next, $ib, $part, $open_begin, $open_end, $tmp); + + my @value; + foreach $j (0 .. $parts) { + push @value, [ $param{value}[$j+$j], $param{value}[$j+$j + 1] ]; + } + + foreach $interval ( @{ $self->{list} } ) { + $ia = $interval->{a}; + $ib = $interval->{b}; + $open_begin = $interval->{open_begin}; + $open_end = $interval->{open_end}; + foreach $j (0 .. $parts) { + # print " [ofs($ia,$ib)] "; + ($this, $next) = $sub_mode->( $sub_unit, $ia, $ib, @{$value[$j]} ); + next if ($this > $next); # skip if a > b + if ($this == $next) { + # TODO: fix this + $open_end = $open_begin; + } + push @a, { a => $this , b => $next , + open_begin => $open_begin , open_end => $open_end }; + } # parts + } # self + @a = sort { $a->{a} <=> $b->{a} } @a; + $b1->{list} = \@a; # change data + $self->trace_close( arg => $b1 ) if $TRACE; + $b1 = $b1->fixtype if $self->{fixtype}; + return $b1; +} + + +sub is_null { + $_[0]->{too_complex} ? 0 : $_[0]->SUPER::is_null; +} + + +sub is_too_complex { + $_[0]->{too_complex} ? 1 : 0; +} + + +# shows how a 'compacted' set looks like after quantize +sub _quantize_span { + my $self = shift; + my %param = @_; + $self->trace_open(title=>"_quantize_span") if $TRACE; + my $res; + if ($self->{too_complex}) { + $res = $self->{parent}; + if ($self->{method} ne 'quantize') { + $self->trace( title => "parent is a ". $self->{method} ); + if ( $self->{method} eq 'union' ) { + my $arg0 = $self->{parent}[0]->_quantize_span(%param); + my $arg1 = $self->{parent}[1]->_quantize_span(%param); + $res = $arg0->union( $arg1 ); + } + elsif ( $self->{method} eq 'intersection' ) { + my $arg0 = $self->{parent}[0]->_quantize_span(%param); + my $arg1 = $self->{parent}[1]->_quantize_span(%param); + $res = $arg0->intersection( $arg1 ); + } + + # TODO: other methods + else { + $res = $self; # ->_function( "_quantize_span", %param ); + } + $self->trace_close( arg => $res ) if $TRACE; + return $res; + } + + # $res = $self->{parent}; + if ($res->{too_complex}) { + $res->trace( title => "parent is complex" ); + $res = $res->_quantize_span( %param ); + $res = $res->quantize( @{$self->{param}} )->_quantize_span( %param ); + } + else { + $res = $res->iterate ( + sub { + $_[0]->quantize( @{$self->{param}} )->span; + } + ); + } + } + else { + $res = $self->iterate ( sub { $_[0] } ); + } + $self->trace_close( arg => $res ) if $TRACE; + return $res; +} + + + +BEGIN { + + %_backtrack = ( + + until => sub { + my ($self, $arg) = @_; + my $before = $self->{parent}[0]->intersection( $neg_inf, $arg->min )->max; + $before = $arg->min unless $before; + my $after = $self->{parent}[1]->intersection( $arg->max, $inf )->min; + $after = $arg->max unless $after; + return $arg->new( $before, $after ); + }, + + iterate => sub { + my ($self, $arg) = @_; + + if ( defined $self->{backtrack_callback} ) + { + return $arg = $self->new( $self->{backtrack_callback}->( $arg ) ); + } + + my $before = $self->{parent}->intersection( $neg_inf, $arg->min )->max; + $before = $arg->min unless $before; + my $after = $self->{parent}->intersection( $arg->max, $inf )->min; + $after = $arg->max unless $after; + + return $arg->new( $before, $after ); + }, + + quantize => sub { + my ($self, $arg) = @_; + if ($arg->{too_complex}) { + return $arg; + } + else { + return $arg->quantize( @{$self->{param}} )->_quantize_span; + } + }, + + offset => sub { + my ($self, $arg) = @_; + # offset - apply offset with negative values + my %tmp = @{$self->{param}}; + my @values = sort @{$tmp{value}}; + + my $backtrack_arg2 = $arg->offset( + unit => $tmp{unit}, + mode => $tmp{mode}, + value => [ - $values[-1], - $values[0] ] ); + return $arg->union( $backtrack_arg2 ); # fixes some problems with 'begin' mode + }, + + ); +} + + +sub _backtrack { + my ($self, $method, $arg) = @_; + return $self->$method ($arg) unless $self->{too_complex}; + + $self->trace_open( title => 'backtrack '.$self->{method} ) if $TRACE; + + $backtrack_depth++; + if ( $backtrack_depth > $max_backtrack_depth ) { + carp ( __PACKAGE__ . ": Backtrack too deep " . + "(more than $max_backtrack_depth levels)" ); + } + + if (exists $_backtrack{ $self->{method} } ) { + $arg = $_backtrack{ $self->{method} }->( $self, $arg ); + } + + my $result; + if ( ref($self->{parent}) eq 'ARRAY' ) { + # has 2 parents (intersection, union, until) + + my ( $result1, $result2 ) = @{$self->{parent}}; + $result1 = $result1->_backtrack( $method, $arg ) + if $result1->{too_complex}; + $result2 = $result2->_backtrack( $method, $arg ) + if $result2->{too_complex}; + + $method = $self->{method}; + if ( $result1->{too_complex} || $result2->{too_complex} ) { + $result = $result1->_function2( $method, $result2 ); + } + else { + $result = $result1->$method ($result2); + } + } + else { + # has 1 parent and parameters (offset, select, quantize, iterate) + + $result = $self->{parent}->_backtrack( $method, $arg ); + $method = $self->{method}; + $result = $result->$method ( @{$self->{param}} ); + } + + $backtrack_depth--; + $self->trace_close( arg => $result ) if $TRACE; + return $result; +} + + +sub intersects { + my $a1 = shift; + my $b1 = (ref ($_[0]) eq ref($a1) ) ? shift : $a1->new(@_); + + $a1->trace(title=>"intersects"); + if ($a1->{too_complex}) { + $a1 = $a1->_backtrack('intersection', $b1 ); + } # don't put 'else' here + if ($b1->{too_complex}) { + $b1 = $b1->_backtrack('intersection', $a1); + } + if (($a1->{too_complex}) or ($b1->{too_complex})) { + return undef; # we don't know the answer! + } + return $a1->SUPER::intersects( $b1 ); +} + + +sub iterate { + my $self = shift; + my $callback = shift; + die "First argument to iterate() must be a subroutine reference" + unless ref( $callback ) eq 'CODE'; + my $backtrack_callback; + if ( @_ && $_[0] eq 'backtrack_callback' ) + { + ( undef, $backtrack_callback ) = ( shift, shift ); + } + my $set; + if ($self->{too_complex}) { + $self->trace(title=>"iterate:backtrack") if $TRACE; + $set = $self->_function( 'iterate', $callback, @_ ); + } + else + { + $self->trace(title=>"iterate") if $TRACE; + $set = $self->SUPER::iterate( $callback, @_ ); + } + $set->{backtrack_callback} = $backtrack_callback; + # warn "set backtrack_callback" if defined $backtrack_callback; + return $set; +} + + +sub intersection { + my $a1 = shift; + my $b1 = (ref ($_[0]) eq ref($a1) ) ? shift : $a1->new(@_); + + $a1->trace_open(title=>"intersection", arg => $b1) if $TRACE; + if (($a1->{too_complex}) or ($b1->{too_complex})) { + my $arg0 = $a1->_quantize_span; + my $arg1 = $b1->_quantize_span; + unless (($arg0->{too_complex}) or ($arg1->{too_complex})) { + my $res = $arg0->intersection( $arg1 ); + $a1->trace_close( arg => $res ) if $TRACE; + return $res; + } + } + if ($a1->{too_complex}) { + $a1 = $a1->_backtrack('intersection', $b1) unless $b1->{too_complex}; + } # don't put 'else' here + if ($b1->{too_complex}) { + $b1 = $b1->_backtrack('intersection', $a1) unless $a1->{too_complex}; + } + if ( $a1->{too_complex} || $b1->{too_complex} ) { + $a1->trace_close( ) if $TRACE; + return $a1->_function2( 'intersection', $b1 ); + } + return $a1->SUPER::intersection( $b1 ); +} + + +sub intersected_spans { + my $a1 = shift; + my $b1 = ref ($_[0]) eq ref($a1) ? $_[0] : $a1->new(@_); + + if ($a1->{too_complex}) { + $a1 = $a1->_backtrack('intersection', $b1 ) unless $b1->{too_complex}; + } # don't put 'else' here + if ($b1->{too_complex}) { + $b1 = $b1->_backtrack('intersection', $a1) unless $a1->{too_complex}; + } + + if ( ! $b1->{too_complex} && ! $a1->{too_complex} ) + { + return $a1->SUPER::intersected_spans ( $b1 ); + } + + return $b1->iterate( + sub { + my $tmp = $a1->intersection( $_[0] ); + return $tmp unless defined $tmp->max; + + my $before = $a1->intersection( $neg_inf, $tmp->min )->last; + my $after = $a1->intersection( $tmp->max, $inf )->first; + + $before = $tmp->union( $before )->first; + $after = $tmp->union( $after )->last; + + $tmp = $tmp->union( $before ) + if defined $before && $tmp->intersects( $before ); + $tmp = $tmp->union( $after ) + if defined $after && $tmp->intersects( $after ); + return $tmp; + } + ); + +} + + +sub complement { + my $a1 = shift; + # do we have a parameter? + if (@_) { + my $b1 = (ref ($_[0]) eq ref($a1) ) ? shift : $a1->new(@_); + + $a1->trace_open(title=>"complement", arg => $b1) if $TRACE; + $b1 = $b1->complement; + my $tmp =$a1->intersection($b1); + $a1->trace_close( arg => $tmp ) if $TRACE; + return $tmp; + } + $a1->trace_open(title=>"complement") if $TRACE; + if ($a1->{too_complex}) { + $a1->trace_close( ) if $TRACE; + return $a1->_function( 'complement', @_ ); + } + return $a1->SUPER::complement; +} + + +sub until { + my $a1 = shift; + my $b1 = (ref ($_[0]) eq ref($a1) ) ? shift : $a1->new(@_); + + if (($a1->{too_complex}) or ($b1->{too_complex})) { + return $a1->_function2( 'until', $b1 ); + } + return $a1->SUPER::until( $b1 ); +} + + +sub union { + my $a1 = shift; + my $b1 = (ref ($_[0]) eq ref($a1) ) ? shift : $a1->new(@_); + + $a1->trace_open(title=>"union", arg => $b1) if $TRACE; + if (($a1->{too_complex}) or ($b1->{too_complex})) { + $a1->trace_close( ) if $TRACE; + return $a1 if $b1->is_null; + return $b1 if $a1->is_null; + return $a1->_function2( 'union', $b1); + } + return $a1->SUPER::union( $b1 ); +} + + +# there are some ways to process 'contains': +# A CONTAINS B IF A == ( A UNION B ) +# - faster +# A CONTAINS B IF B == ( A INTERSECTION B ) +# - can backtrack = works for unbounded sets +sub contains { + my $a1 = shift; + $a1->trace_open(title=>"contains") if $TRACE; + if ( $a1->{too_complex} ) { + # we use intersection because it is better for backtracking + my $b0 = (ref $_[0] eq ref $a1) ? shift : $a1->new(@_); + my $b1 = $a1->intersection($b0); + if ( $b1->{too_complex} ) { + $b1->trace_close( arg => 'undef' ) if $TRACE; + return undef; + } + $a1->trace_close( arg => ($b1 == $b0 ? 1 : 0) ) if $TRACE; + return ($b1 == $b0) ? 1 : 0; + } + my $b1 = $a1->union(@_); + if ( $b1->{too_complex} ) { + $b1->trace_close( arg => 'undef' ) if $TRACE; + return undef; + } + $a1->trace_close( arg => ($b1 == $a1 ? 1 : 0) ) if $TRACE; + return ($b1 == $a1) ? 1 : 0; +} + + +sub min_a { + my $self = $_[0]; + return @{$self->{min}} if exists $self->{min}; + if ($self->{too_complex}) { + my @first = $self->first; + return @{$self->{min}} = $first[0]->min_a if defined $first[0]; + return @{$self->{min}} = (undef, 0); + } + return $self->SUPER::min_a; +}; + + +sub max_a { + my $self = $_[0]; + return @{$self->{max}} if exists $self->{max}; + if ($self->{too_complex}) { + my @last = $self->last; + return @{$self->{max}} = $last[0]->max_a if defined $last[0]; + return @{$self->{max}} = (undef, 0); + } + return $self->SUPER::max_a; +}; + + +sub count { + my $self = $_[0]; + # NOTE: subclasses may return "undef" if necessary + return $inf if $self->{too_complex}; + return $self->SUPER::count; +} + + +sub size { + my $self = $_[0]; + if ($self->{too_complex}) { + my @min = $self->min_a; + my @max = $self->max_a; + return undef unless defined $max[0] && defined $min[0]; + return $max[0] - $min[0]; + } + return $self->SUPER::size; +}; + + +sub spaceship { + my ($tmp1, $tmp2, $inverted) = @_; + carp "Can't compare unbounded sets" + if $tmp1->{too_complex} or $tmp2->{too_complex}; + return $tmp1->SUPER::spaceship( $tmp2, $inverted ); +} + + +sub _cleanup { @_ } # this subroutine is obsolete + + +sub tolerance { + my $self = shift; + my $tmp = pop; + if (ref($self)) { + # local + return $self->{tolerance} unless defined $tmp; + if ($self->{too_complex}) { + my $b1 = $self->_function( 'tolerance', $tmp ); + $b1->{tolerance} = $tmp; # for max/min processing + return $b1; + } + return $self->SUPER::tolerance( $tmp ); + } + # class method + __PACKAGE__->SUPER::tolerance( $tmp ) if defined($tmp); + return __PACKAGE__->SUPER::tolerance; +} + + +sub _pretty_print { + my $self = shift; + return "$self" unless $self->{too_complex}; + return $self->{method} . "( " . + ( ref($self->{parent}) eq 'ARRAY' ? + $self->{parent}[0] . ' ; ' . $self->{parent}[1] : + $self->{parent} ) . + " )"; +} + + +sub as_string { + my $self = shift; + return ( $PRETTY_PRINT ? $self->_pretty_print : $too_complex ) + if $self->{too_complex}; + return $self->SUPER::as_string; +} + + +sub DESTROY {} + +1; + +__END__ + + +=head1 NAME + +Set::Infinite - Sets of intervals + + +=head1 SYNOPSIS + + use Set::Infinite; + + $set = Set::Infinite->new(1,2); # [1..2] + print $set->union(5,6); # [1..2],[5..6] + + +=head1 DESCRIPTION + +Set::Infinite is a Set Theory module for infinite sets. + +A set is a collection of objects. +The objects that belong to a set are called its members, or "elements". + +As objects we allow (almost) anything: reals, integers, and objects (such as dates). + +We allow sets to be infinite. + +There is no account for the order of elements. For example, {1,2} = {2,1}. + +There is no account for repetition of elements. For example, {1,2,2} = {1,1,1,2} = {1,2}. + +=head1 CONSTRUCTOR + +=head2 new + +Creates a new set object: + + $set = Set::Infinite->new; # empty set + $set = Set::Infinite->new( 10 ); # single element + $set = Set::Infinite->new( 10, 20 ); # single range + $set = Set::Infinite->new( + [ 10, 20 ], [ 50, 70 ] ); # two ranges + +=over 4 + +=item empty set + + $set = Set::Infinite->new; + +=item set with a single element + + $set = Set::Infinite->new( 10 ); + + $set = Set::Infinite->new( [ 10 ] ); + +=item set with a single span + + $set = Set::Infinite->new( 10, 20 ); + + $set = Set::Infinite->new( [ 10, 20 ] ); + # 10 <= x <= 20 + +=item set with a single, open span + + $set = Set::Infinite->new( + { + a => 10, open_begin => 0, + b => 20, open_end => 1, + } + ); + # 10 <= x < 20 + +=item set with multiple spans + + $set = Set::Infinite->new( 10, 20, 100, 200 ); + + $set = Set::Infinite->new( [ 10, 20 ], [ 100, 200 ] ); + + $set = Set::Infinite->new( + { + a => 10, open_begin => 0, + b => 20, open_end => 0, + }, + { + a => 100, open_begin => 0, + b => 200, open_end => 0, + } + ); + +=back + +The C method expects I parameters. + +If you have unordered ranges, you can build the set using C: + + @ranges = ( [ 10, 20 ], [ -10, 1 ] ); + $set = Set::Infinite->new; + $set = $set->union( @$_ ) for @ranges; + +The data structures passed to C must be I. +So this is not good practice: + + $set = Set::Infinite->new( $object_a, $object_b ); + $object_a->set_value( 10 ); + +This is the recommended way to do it: + + $set = Set::Infinite->new( $object_a->clone, $object_b->clone ); + $object_a->set_value( 10 ); + + +=head2 clone / copy + +Creates a new object, and copy the object data. + +=head2 empty_set + +Creates an empty set. + +If called from an existing set, the empty set inherits +the "type" and "density" characteristics. + +=head2 universal_set + +Creates a set containing "all" possible elements. + +If called from an existing set, the universal set inherits +the "type" and "density" characteristics. + +=head1 SET FUNCTIONS + +=head2 union + + $set = $set->union($b); + +Returns the set of all elements from both sets. + +This function behaves like an "OR" operation. + + $set1 = new Set::Infinite( [ 1, 4 ], [ 8, 12 ] ); + $set2 = new Set::Infinite( [ 7, 20 ] ); + print $set1->union( $set2 ); + # output: [1..4],[7..20] + +=head2 intersection + + $set = $set->intersection($b); + +Returns the set of elements common to both sets. + +This function behaves like an "AND" operation. + + $set1 = new Set::Infinite( [ 1, 4 ], [ 8, 12 ] ); + $set2 = new Set::Infinite( [ 7, 20 ] ); + print $set1->intersection( $set2 ); + # output: [8..12] + +=head2 complement + +=head2 minus + +=head2 difference + + $set = $set->complement; + +Returns the set of all elements that don't belong to the set. + + $set1 = new Set::Infinite( [ 1, 4 ], [ 8, 12 ] ); + print $set1->complement; + # output: (-inf..1),(4..8),(12..inf) + +The complement function might take a parameter: + + $set = $set->minus($b); + +Returns the set-difference, that is, the elements that don't +belong to the given set. + + $set1 = new Set::Infinite( [ 1, 4 ], [ 8, 12 ] ); + $set2 = new Set::Infinite( [ 7, 20 ] ); + print $set1->minus( $set2 ); + # output: [1..4] + +=head2 symmetric_difference + +Returns a set containing elements that are in either set, +but not in both. This is the "set" version of "XOR". + +=head1 DENSITY METHODS + +=head2 real + + $set1 = $set->real; + +Returns a set with density "0". + +=head2 integer + + $set1 = $set->integer; + +Returns a set with density "1". + +=head1 LOGIC FUNCTIONS + +=head2 intersects + + $logic = $set->intersects($b); + +=head2 contains + + $logic = $set->contains($b); + +=head2 is_empty + +=head2 is_null + + $logic = $set->is_null; + +=head2 is_nonempty + +This set that has at least 1 element. + +=head2 is_span + +This set that has a single span or interval. + +=head2 is_singleton + +This set that has a single element. + +=head2 is_subset( $set ) + +Every element of this set is a member of the given set. + +=head2 is_proper_subset( $set ) + +Every element of this set is a member of the given set. +Some members of the given set are not elements of this set. + +=head2 is_disjoint( $set ) + +The given set has no elements in common with this set. + +=head2 is_too_complex + +Sometimes a set might be too complex to enumerate or print. + +This happens with sets that represent infinite recurrences, such as +when you ask for a quantization on a +set bounded by -inf or inf. + +See also: C method. + +=head1 SCALAR FUNCTIONS + +=head2 min + + $i = $set->min; + +=head2 max + + $i = $set->max; + +=head2 size + + $i = $set->size; + +=head2 count + + $i = $set->count; + +=head1 OVERLOADED OPERATORS + +=head2 stringification + + print $set; + + $str = "$set"; + +See also: C. + +=head2 comparison + + sort + + > < == >= <= <=> + +See also: C method. + +=head1 CLASS METHODS + + Set::Infinite->separators(@i) + + chooses the interval separators for stringification. + + default are [ ] ( ) '..' ','. + + inf + + returns an 'Infinity' number. + + minus_inf + + returns '-Infinity' number. + +=head2 type + + type( "My::Class::Name" ) + +Chooses a default object data type. + +Default is none (a normal Perl SCALAR). + + +=head1 SPECIAL SET FUNCTIONS + +=head2 span + + $set1 = $set->span; + +Returns the set span. + +=head2 until + +Extends a set until another: + + 0,5,7 -> until 2,6,10 + +gives + + [0..2), [5..6), [7..10) + +=head2 start_set + +=head2 end_set + +These methods do the inverse of the "until" method. + +Given: + + [0..2), [5..6), [7..10) + +start_set is: + + 0,5,7 + +end_set is: + + 2,6,10 + +=head2 intersected_spans + + $set = $set1->intersected_spans( $set2 ); + +The method returns a new set, +containing all spans that are intersected by the given set. + +Unlike the C method, the spans are not modified. +See diagram below: + + set1 [....] [....] [....] [....] + set2 [................] + + intersection [.] [....] [.] + + intersected_spans [....] [....] [....] + + +=head2 quantize + + quantize( parameters ) + + Makes equal-sized subsets. + + Returns an ordered set of equal-sized subsets. + + Example: + + $set = Set::Infinite->new([1,3]); + print join (" ", $set->quantize( quant => 1 ) ); + + Gives: + + [1..2) [2..3) [3..4) + +=head2 select + + select( parameters ) + +Selects set spans based on their ordered positions + +C