Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

Re: Adding 2 + 2

by I0 (Priest)
on Dec 31, 2000 at 21:36 UTC ( #49110=note: print w/ replies, xml ) Need Help??


in reply to Adding 2 + 2

package Conway; use overload '+' => \&Add, '-' => \&Sub, '*' => \&Mul, '>=' => \&Geq, '<=' => \&Leq, '==' => \&eql, '<=>' => \&Cmp, 'neg' => \&Neg, '++' => \&Succ, '""' => \&Name, '0+' => \&Value, '=' => \&Copy, bool => sub{my $x = shift; return !Eql($x,$zero)}, ; sub Geq{ my($x,$y) = @_; my @xL = @{$x->[0]}; my @xR = @{$x->[1]}; my @yL = @{$y->[0]}; my @yR = @{$y->[1]}; return !(grep{Leq($_,$y)}@xR) && !(grep{Leq($x,$_)}@yL); } sub Leq{ my($x,$y) = @_; return Geq($y,$x); } sub Eql{ my($x,$y) = @_; return Geq($x,$y) && Geq($y,$x) } sub Gtr{ my($x,$y) = @_; return Geq($x,$y) && !Geq($y,$x); } sub Cmp{ my($x,$y) = @_; my $g = Geq($x,$y); my $l = Leq($x,$y); return undef unless $g || $l; return 0 if $g && $l; return 1 if $g && !$l; return -1 if !$g && $l } sub Neg{ my $x = shift; my @xL = @{$x->[0]}; my @xR = @{$x->[1]}; return bless [ [map{Neg($_)}@xR], [map{Neg($_)}@xL] ]; } sub Add{ my($x,$y) = @_; my @xL = @{$x->[0]}; my @xR = @{$x->[1]}; my @yL = @{$y->[0]}; my @yR = @{$y->[1]}; bless[ [ (map{Add($_,$y)} @xL), (map{Add($x,$_)} @yL), ], [ (map{Add($_,$y)} @xR), (map{Add($x,$_)} @yR), ] ]; } sub Sub{ my($x,$y) = @_; Add($x,Neg($y)); } sub dmap(&$$){ my $f = shift; my @a = @{shift @_}; my @b = @{shift @_}; map{ local $a = $_; map{ local $b=$_; &$f } @b; } @a; } sub Mul{ my($x,$y) = @_; my @xL = @{$x->[0]}; my @xR = @{$x->[1]}; my @yL = @{$y->[0]}; my @yR = @{$y->[1]}; bless [ [ (dmap{Sub(Add(Mul($a,$y),Mul($x,$b)),Mul($a,$b))} \@xL,\@yL), (dmap{Sub(Add(Mul($a,$y),Mul($x,$b)),Mul($a,$b))} \@xR,\@yR), ], [ (dmap{Sub(Add(Mul($a,$y),Mul($x,$b)),Mul($a,$b))} \@xL,\@yR), (dmap{Sub(Add(Mul($a,$y),Mul($x,$b)),Mul($a,$b))} \@xR,\@yL), ] ] } sub L{ my $x = shift; return @{$x->[0]}; }; sub R{ my $x = shift; return @{$x->[1]}; } sub normalize{ my($x,$y) = @_; my @xL = map{normalize($_)} @{$x->[0]}; my @xR = map{normalize($_)} @{$x->[1]}; while( @xR > 1 ){ if( Geq(@xR[0],@xR[-1]) ){ shift @xR; }elsif( Geq(@xR[-1],@xR[0]) ){ pop @xR; }else{ warn "NaN"; last; } } while( @xL > 1 ){ if( Geq(@xL[0],@xL[-1]) ){ pop @xL; }elsif( Geq(@xL[-1],@xL[0]) ){ shift @xL; }else{ warn "NaN"; last; } } bless [[@xL],[@xR]]; } sub Succ{ my $x = shift; bless [[$x],[]]; } sub Copy{ my $x = shift; normalize($x); } sub new{ my $class = shift; my ($L, $R) = @_; my $n = [$L,$R]; bless $n,$class; return $n; } sub Name{ my $x = shift; # return 0 if Eql($x,$zero); my @xL = @{$x->[0]}; my @xR = @{$x->[1]}; my $L=join",",map{Name($_)} @xL; my $R=join",",map{Name($_)} @xR; return "{$L|$R}"; } sub Value{ my $x = normalize(shift); my $g = Geq($x,$zero); my $l = Leq($x,$zero); return NaN unless $g || $l; return 0 if $g && $l; return -Value(Neg($x)) if $l && !$g; return 1+Value(Sub($x,$one) ) if( Geq($x,$one)); return Value( Mul($x,$two) )/2; } $zero = new Conway [],[]; $one = $zero->Succ; $two = $one+$one; #print "$one+$one=$two\n"; #print Value($one),"+",Value($one),"=",Value($two),"\n"; $two = normalize($two); #print "$one+$one=$two\n"; #print Value($one),"+",Value($one),"=",Value($two),"\n"; print "$two+$two=",$two+$two,"\n"; print Value($two),"+",Value($two),"=",Value($two+$two),"\n"; #print Value(Mul($two,$two)),"\n"; #print Value([[$zero],[$one]]),"\n"; 1;


Comment on Re: Adding 2 + 2
Download Code
Replies are listed 'Best First'.
Re: Re: Adding 2 + 2
by tilly (Archbishop) on Dec 31, 2000 at 22:38 UTC
    Anyone who doesn't understand this post should go read about Conway's surreal numbers. This is very, very cool! :-)

    UPDATE
    Thanks to coreolyn the link should now work.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://49110]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (12)
As of 2015-07-29 17:30 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (266 votes), past polls