Beefy Boxes and Bandwidth Generously Provided by pair Networks chromatic writing perl on a camel
"be consistent"
 
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
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 exploiting the Monastery: (7)
As of 2014-04-20 20:18 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (487 votes), past polls