Created
August 26, 2010 01:47
-
-
Save colomon/550633 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
our sub _HELPER_generate-series(@lhs, $rhs , :$exclude-limit) { | |
my sub get-series-params (@lhs, $limit? ) { | |
fail "Need something on the LHS" unless @lhs.elems; | |
fail "Need more than one item on the LHS" if @lhs.elems == 1 && $limit ~~ Code; | |
fail "Need more items on the LHS" if @lhs[*-1] ~~ Code && @lhs[*-1].count != Inf && @lhs.elems < @lhs[*-1].count; | |
my $limit-reached; | |
given $limit { | |
when Code { $limit-reached = $limit; } | |
when .defined { | |
$limit-reached = sub ($previous , $current) { | |
my $current_cmp = $limit cmp $current ; | |
return $current_cmp == 0 unless $previous.defined; | |
my $previous_cmp = $limit cmp $previous; | |
return ($current_cmp == 0 #We reached the limit exactly | |
|| $previous_cmp != $current_cmp) ; #We went past the limit | |
} | |
} | |
$limit-reached = Mu; | |
} | |
#BEWARE: Here be ugliness | |
return ( 'code' , @lhs[*-1] , $limit-reached) if @lhs[* - 1] ~~ Code ; # case: (a,b,c,{code}) ... * | |
return ( 'stag' , { $_ } , $limit-reached) if @lhs.elems > 1 && @lhs[*-1] cmp @lhs[*-2] == 0 ; # case: (a , a) ... * | |
if @lhs[*-1] ~~ Str || $limit ~~ Str { | |
if @lhs[*-1].chars == 1 && $limit.defined && $limit.chars == 1 { | |
return ( 'char-succ' , { $_.ord.succ.chr } , $limit-reached) if @lhs[*-1] lt $limit;# case (... , non-number) ... limit | |
return ( 'char-pred' , { $_.ord.pred.chr } , $limit-reached) if @lhs[*-1] gt $limit;# case (... , non-number) ... limit | |
} | |
return ( 'text-succ' , { $_.succ } , $limit-reached) if $limit.defined && @lhs[*-1] lt $limit;# case (... , non-number) ... limit | |
return ( 'text-pred' , { $_.pred } , $limit-reached) if $limit.defined && @lhs[*-1] gt $limit;# case (... , non-number) ... limit | |
return ( 'text-pred' , { $_.pred } , $limit-reached) if @lhs.elems > 1 && @lhs[*-2] gt @lhs[*-1];# case (non-number , another-smaller-non-number) ... * | |
return ( 'text-succ' , { $_.succ } , $limit-reached) ;# case (non-number , another-non-number) ... * | |
} | |
return ( 'pred' , { $_.pred } , $limit-reached) if @lhs.elems == 1 && $limit.defined && $limit before @lhs[* - 1]; # case: (a) ... b where b before a | |
return ( 'succ' , { $_.succ } , $limit-reached) if @lhs.elems == 1 ; # case: (a) ... * | |
my $diff = @lhs[*-1] - @lhs[*-2]; | |
return ('arithmetic' , { $_ + $diff } , $limit-reached) if @lhs.elems == 2 || @lhs[*-2] - @lhs[*-3] == $diff ; #Case Arithmetic series | |
if @lhs[*-2] / @lhs[*-3] == @lhs[*-1] / @lhs[*-2] { #Case geometric series | |
my $factor = @lhs[*-2] / @lhs[*-3]; | |
if $factor ~~ ::Rat && $factor.denominator == 1 { | |
$factor = $factor.Int; | |
} | |
if ($factor < 0) { | |
return ( 'geometric-switching-sign' , { $_ * $factor } , -> $a, $b { $limit-reached.($a.abs, $b.abs) }); | |
} else { | |
return ( 'geometric-same-sign' , { $_ * $factor } , $limit-reached); | |
} | |
} | |
fail "Unable to figure out pattern of series"; | |
} | |
my sub is-on-the-wrong-side($type , $get-value-to-compare, $limit , @lhs ) { | |
my $first = @lhs[*-3] // @lhs[0]; | |
return if $limit ~~ Code; | |
if $type eq 'arithmetic' | 'geometric-switching-sign' | 'geometric-same-sign' { | |
($get-value-to-compare(@lhs[*-2]) >= $get-value-to-compare(@lhs[*-1]) && $get-value-to-compare($limit) > $get-value-to-compare($first) ) | |
|| | |
($get-value-to-compare(@lhs[*-2]) <= $get-value-to-compare(@lhs[*-1]) && $get-value-to-compare($limit) < $get-value-to-compare($first) ); | |
} | |
} | |
my sub infinite-series (@lhs, $next , $type) { | |
gather { | |
for 0..^(@lhs.elems - 1) -> $i { take @lhs[$i]; } | |
take @lhs[*-1] unless $type eq 'code'; | |
my $arity = $next.count; | |
my @args=@lhs; | |
pop @args if $type eq 'code'; | |
@args.munch( @args.elems - $arity ); #We make sure there are $arity + 1 elems | |
loop { #Then we extrapolate using $next and the $args | |
my $current = $next.(|@args) // last; | |
take $current ; | |
if $arity { | |
@args.push($current) ; | |
@args.munch(1) if @args.elems > $arity | |
} | |
} | |
} | |
} | |
my $limit = ($rhs ~~ Whatever ?? Any !! $rhs); | |
fail('Limit must be a literal') if $exclude-limit && (!$limit.defined || $limit ~~ Code); | |
my ($type , $next , $limit-reached) = get-series-params(@lhs , $limit ); | |
return infinite-series(@lhs , $next , $type) unless $limit.defined; #Infinite series | |
my $series = infinite-series(@lhs , $next , $type); | |
my $get-value-to-compare = $type eq 'geometric-switching-sign' ?? { $_.abs; } !! { $_; }; | |
return Nil if @lhs.elems > 1 && is-on-the-wrong-side($type , $get-value-to-compare, $limit , @lhs); | |
my $arity = $limit-reached.count; | |
my @args; | |
gather { | |
while $series { | |
my $val = $series.shift(); | |
@args.push: $val; | |
@args.munch( @args.elems - $arity ); #We make sure there are $arity + 1 elems | |
if $limit-reached.(!@args) { | |
take $val if $get-value-to-compare($val) cmp $get-value-to-compare($limit) == 0 && !$exclude-limit; | |
last ; | |
}; | |
take $val; | |
} | |
} | |
} | |
our multi sub infix:<...>(@lhs, $limit) { | |
_HELPER_generate-series(@lhs, $limit ) | |
} | |
our multi sub infix:<...^>(@lhs, $limit) { | |
_HELPER_generate-series(@lhs, $limit , :exclude-limit) | |
} | |
our multi sub infix:<...^>($lhs , $limit) { | |
$lhs.list ...^ $limit; | |
} | |
our multi sub infix:<...^>(@lhs, @rhs) { | |
fail "Need something on RHS" if !@rhs; | |
(@lhs ...^ @rhs.shift), @rhs | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment