Pathologically Eclectic Rubbish Lister PerlMonks

### Comment on

 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;

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

• Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
• Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
• Read Where should I post X? if you're not absolutely sure you're posting in the right place.
• Posts may use any of the Perl Monks Approved HTML tags:
a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
• You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
 For: Use: & & < < > > [ [ ] ]
• Link using PerlMonks shortcuts! What shortcuts can I use for linking?

Create A New User
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (4)
As of 2018-02-25 10:43 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
When it is dark outside I am happiest to see ...

Results (312 votes). Check out past polls.

Notices?