P is for Practical PerlMonks

### Re: Adding 2 + 2

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

```package Conway;
'-'     => \&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]
];
}
my(\$x,\$y) = @_;
my @xL = @{\$x->[0]};
my @xR = @{\$x->[1]};
my @yL = @{\$y->[0]};
my @yR = @{\$y->[1]};
bless[
[
],
[
]
];
}
sub Sub{
my(\$x,\$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 [
[
],
[
]
]
}
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;

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.

Create A New User
Node Status?
node history
Node Type: note [id://49110]
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others scrutinizing the Monastery: (2)
As of 2018-04-22 23:12 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
My travels bear the most uncanny semblance to ...

Results (84 votes). Check out past polls.

Notices?