perl
Here's my take, in perl. I thought this was a code-golfing post at first, so you may see some vestiges of that in the code. Anyway, I went to some effort to make the code as "tight" as possible, probably a little tighter than I otherwise would have. But I didn't go too far over the deep-end. Also note that I left in the prototypes on public functions (despite them being considered bad practice), because it made the test cases much less tedious to code up.
As for time and space, I left notation of the runtimes in the source at the heading of each subroutine, but I didn't take the time to prove them or anything, just to convince myself. Space is the more serious consideration of course - this implementation uses O(n) space to store an integer n, which is pretty bad. I wasn't sure exactly what I could get away with in terms of chars or encoding counts in inheritance patterns and such so I figured I'd do it the "canonical" (if slower) way. This has other effects too, for example, it takes O(n+m) time to ask if n equals m.
All that said, here's nat.pm, a complete (I believe) implementation in perl:
#!/usr/bin/perl
use strict;
use warnings;
package nat;
sub prev() { $_[0]->{prev}; }
sub next() { $_[0]->{next}; }
sub zero() { bless { prev => undef, next => undef } }
sub inc($) {
bless defined $_[0]->next ?
{ prev => undef, next => $_[0]->next->next } :
{ prev => $_[0], next => undef }
}
sub dec($) {
bless defined $_[0]->prev ?
{ prev => $_[0]->prev->prev, next => undef } :
{ prev => undef, next => $_[0] }
}
sub is_zero($) { !defined $_[0]->prev && !defined $_[0]->next };
sub is_negative($) { defined $_[0]->next };
sub is_positive($) { defined $_[0]->prev };
sub from_native($) {
my ($n) = @_;
my $x = zero;
$n--, $x = inc($x) while $n > 0;
$n++, $x = dec($x) while $n < 0;
return $x;
}
sub to_native($) {
my ($x) = @_;
my $n = 0;
--$n, $x = $x->next while defined $x->next;
++$n, $x = $x->prev while defined $x->prev;
return $n;
}
# returns 1 if x has greater magnitude than y
# returns -1 if x has lesser magnitude than y
# returns 0 if x and y have the same magnitude
sub _equal_depth { # O(x+y)
my ($x, $y, $c) = @_;
while( defined $x->{$c} ) {
return 1 if !defined $y->{$c};
$x = $x->{$c};
$y = $y->{$c};
}
return defined $y->{$c} ? -1 : 0;
}
# x<y => -1, x>y => 1, x==y => 0
sub spaceship($$) { # O(x+y)
my ($x, $y) = @_;
if( is_positive( $x ) ) {
return is_positive( $y ) ? _equal_depth($x, $y, 'prev') : 1;
} elsif( is_negative( $x ) ) {
return is_negative( $y ) ? _equal_depth($y, $x, 'next') : -1;
} else {
return is_zero( $y ) ? 0 : is_positive( $y ) ? -1 : 1;
}
}
# the below are all O(x+y) as a result of spaceship()
#sub is_lt($$) { my ($x, $y) = @_; return spaceship($x, $y) == -1 }
#sub is_gt($$) { my ($x, $y) = @_; return spaceship($x, $y) == 1 }
#sub is_le($$) { my ($x, $y) = @_; return spaceship($x, $y) != 1 }
#sub is_ge($$) { my ($x, $y) = @_; return spaceship($x, $y) != -1 }
sub equals($$) { my ($x, $y) = @_; return spaceship($x, $y) == 0 }
sub clone($) { # O(x)
my ($x) = @_;
my $r = zero;
if( is_positive($x) ) {
$x = $x->prev, $r = inc($r) while defined $x->prev;
} elsif( is_negative($x) ) {
$x = $x->next, $r = dec($r) while defined $x->next;
}
return $r;
}
sub _add_sub { # O(x+y)
my $is_sub = pop;
my ($x, $y) = map { clone($_) } @_;
while( 1 ) {
if( is_positive( $y ) ) {
$y = dec( $y );
$x = $is_sub ? dec( $x ) : inc( $x );
} elsif( is_negative( $y ) ) {
$y = inc( $y );
$x = $is_sub ? inc( $x ) : dec( $x );
} else {
last;
}
}
return $x;
}
sub add($$) { # O(x+y)
return _add_sub(@_, 0);
}
sub minus($$) { # O(x+y)
return _add_sub(@_, 1);
}
sub negate($) {
my ($x) = @_;
return minus( zero, $x );
}
sub magnitude($) {
my ($x) = @_;
return is_negative($x) ? negate($x) : $x;
}
sub mult($$) { # O(x*y)
my ($x, $y) = map { clone($_) } @_;
my $r = zero;
$x = negate($x), $y = negate($y) if is_negative($y);
while( !is_zero( $y ) ) {
$r = add($r, $x);
$y = dec( $y );
}
return $r;
}
sub _div { # O(x*y)
my $is_mod = pop;
my ($x, $y) = map { clone($_) } @_;
die "tried to divide by zero" if is_zero( $y );
if($is_mod && (is_negative($x) || is_negative($y))) {
if('nat.t' ne (caller(1))[1]) {
warn "warning: modular arithmetic with negative operands not well defined!\n";
}
}
my $is_neg = ( is_negative($x) xor is_negative($y) );
$x = magnitude($x);
$y = magnitude($y);
# count up from zero by one until we get to $x
# whenever we get to a multiple, increment the result by one and zero the remainder
my $q = zero;
my $r = zero;
while( !is_zero( $x ) ) {
$r = inc( $r );
if( equals( $y, $r ) ) {
$r = zero;
$q = inc( $q );
}
$x = dec( $x );
}
$r = negate($r), $q = negate($q) if $is_neg;
return $is_mod ? $r : $q;
}
sub divi($$) {
return _div(@_, 0);
}
sub mod($$) {
return _div(@_, 1);
}
# export
no strict 'refs';
*{scalar(caller)."::$_"} = \&$_ for grep { !/^[A-Z_]/ } keys %nat::;
1;
... and here is the test script I used when building it:
#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use nat;
my $x;
my $zero = zero;
ok( $zero );
ok( 0 == to_native $zero );
ok( is_zero $zero );
ok( !is_negative $zero );
ok( !is_positive $zero );
my $pos1 = inc $zero;
ok( $pos1 );
ok( 1 == to_native $pos1 );
ok( 0 == to_native dec $pos1 );
ok( !is_zero $pos1 );
ok( !is_negative $pos1 );
ok( is_positive $pos1 );
my $neg1 = dec $zero;
ok( $neg1 );
ok( -1 == to_native $neg1 );
ok( 0 == to_native inc $neg1 );
ok( !is_zero $neg1 );
ok( is_negative $neg1 );
ok( !is_positive $neg1 );
my $pos2 = inc $pos1;
ok( $pos2 );
ok( 2 == to_native $pos2 );
ok( 3 == to_native inc $pos2 );
ok( 1 == to_native dec $pos2 );
ok( !is_zero $pos2 );
ok( !is_negative $pos2 );
ok( is_positive $pos2 );
my $neg3 = dec dec $neg1;
ok( $neg3 );
ok( -3 == to_native $neg3 );
ok( -2 == to_native inc $neg3 );
ok( -4 == to_native dec $neg3 );
ok( !is_zero $neg3 );
ok( is_negative $neg3 );
ok( !is_positive $neg3 );
# make sure inc/dec can go "across" zero
ok( 1 == to_native inc inc inc dec dec zero );
ok( -1 == to_native dec dec dec inc inc zero );
ok( equals $zero, $zero );
ok( !equals $zero, $pos1 );
ok( !equals $zero, $neg1 );
ok( !equals $pos1, $neg1 );
ok( !equals $pos1, $pos2 );
ok( equals $pos1, $pos1 );
ok( equals $pos2, $pos2 );
ok( !equals $neg1, $neg3 );
ok( equals $neg1, $neg1 );
ok( equals $neg3, $neg3 );
ok( 0 == spaceship $neg3, $neg3 );
ok( 0 == spaceship $neg3, $neg3 );
ok( -1 == spaceship $neg3, $neg1 );
ok( 1 == spaceship $neg1, $neg3 );
ok( -1 == spaceship $neg3, $zero );
ok( 1 == spaceship $zero, $neg3 );
ok( -1 == spaceship $neg3, $pos1 );
ok( 1 == spaceship $pos1, $neg3 );
ok( -1 == spaceship $neg3, $pos2 );
ok( 1 == spaceship $pos2, $neg3 );
ok( 0 == spaceship $neg1, $neg1 );
ok( 0 == spaceship $neg1, $neg1 );
ok( -1 == spaceship $neg1, $zero );
ok( 1 == spaceship $zero, $neg1 );
ok( -1 == spaceship $neg1, $pos1 );
ok( 1 == spaceship $pos1, $neg1 );
ok( -1 == spaceship $neg1, $pos2 );
ok( 1 == spaceship $pos2, $neg1 );
ok( 0 == spaceship $zero, $zero );
ok( 0 == spaceship $zero, $zero );
ok( -1 == spaceship $zero, $pos1 );
ok( 1 == spaceship $pos1, $zero );
ok( -1 == spaceship $zero, $pos2 );
ok( 1 == spaceship $pos2, $zero );
ok( 0 == spaceship $pos1, $pos1 );
ok( 0 == spaceship $pos1, $pos1 );
ok( -1 == spaceship $pos1, $pos2 );
ok( 1 == spaceship $pos2, $pos1 );
ok( 0 == spaceship $pos2, $pos2 );
ok( 0 == spaceship $pos2, $pos2 );
#ok( is_lt $neg3, $neg1 );
#ok( !is_lt $neg3, $neg3 );
#ok( is_le $neg3, $neg1 );
#ok( is_le $neg1, $neg1 );
#ok( !is_gt $neg3, $neg1 );
#ok( !is_gt $neg3, $neg3 );
#ok( !is_ge $neg3, $neg1 );
#ok( is_ge $neg1, $neg1 );
ok( equals( inc inc inc inc inc inc zero, from_native 6 ) );
ok( equals( dec dec dec dec dec dec dec zero, from_native -7 ) );
$x = clone $pos2;
ok( equals $pos2, $x );
ok( 2 == to_native $x );
$x = clone $neg3;
ok( equals $neg3, $x );
ok( -3 == to_native $x );
ok( 2 == to_native add $zero, $pos2 );
ok( 1 == to_native add $zero, $pos1 );
ok( 1 == to_native add $pos1, $zero );
ok( 2 == to_native add $pos1, $pos1 );
ok( 3 == to_native add $pos1, $pos2 );
ok( 3 == to_native add $pos2, $pos1 );
ok( 4 == to_native add $pos2, $pos2 );
ok( -3 == to_native add $zero, $neg3 );
ok( -1 == to_native add $zero, $neg1 );
ok( -1 == to_native add $neg1, $zero );
ok( -2 == to_native add $neg1, $neg1 );
ok( -4 == to_native add $neg1, $neg3 );
ok( -4 == to_native add $neg3, $neg1 );
ok( -6 == to_native add $neg3, $neg3 );
ok( -2 == to_native add $neg3, $pos1 );
ok( -1 == to_native add $neg3, $pos2 );
ok( 0 == to_native add $neg1, $pos1 );
ok( 1 == to_native add $neg1, $pos2 );
ok( -2 == to_native minus $neg3, $neg1 );
ok( 2 == to_native minus $neg1, $neg3 );
ok( -3 == to_native minus $neg3, $zero );
ok( 3 == to_native minus $zero, $neg3 );
ok( -4 == to_native minus $neg3, $pos1 );
ok( 4 == to_native minus $pos1, $neg3 );
ok( -5 == to_native minus $neg3, $pos2 );
ok( 5 == to_native minus $pos2, $neg3 );
ok( -1 == to_native minus $neg1, $zero );
ok( 1 == to_native minus $zero, $neg1 );
ok( -2 == to_native minus $neg1, $pos1 );
ok( 2 == to_native minus $pos1, $neg1 );
ok( -3 == to_native minus $neg1, $pos2 );
ok( 3 == to_native minus $pos2, $neg1 );
ok( -1 == to_native minus $zero, $pos1 );
ok( 1 == to_native minus $pos1, $zero );
ok( -2 == to_native minus $zero, $pos2 );
ok( 2 == to_native minus $pos2, $zero );
ok( -1 == to_native minus $pos1, $pos2 );
ok( 1 == to_native minus $pos2, $pos1 );
ok( equals $pos1, negate($neg1) );
ok( equals $neg1, negate($pos1) );
ok( 3 == to_native negate $neg3 );
ok( 1 == to_native negate $neg1 );
ok( 0 == to_native negate $zero );
ok( -1 == to_native negate $pos1 );
ok( -2 == to_native negate $pos2 );
ok( equals magnitude($pos1), magnitude($neg1) );
ok( equals magnitude($neg1), magnitude($pos1) );
ok( equals magnitude($pos1), $pos1 );
ok( equals magnitude($neg1), $pos1 );
ok( 3 == to_native magnitude $neg3 );
ok( 1 == to_native magnitude $neg1 );
ok( 0 == to_native magnitude $zero );
ok( 1 == to_native magnitude $pos1 );
ok( 2 == to_native magnitude $pos2 );
ok( 3 == to_native mult $neg3, $neg1 );
ok( 0 == to_native mult $neg3, $zero );
ok( -3 == to_native mult $neg3, $pos1 );
ok( -6 == to_native mult $neg3, $pos2 );
ok( 1 == to_native mult $neg1, $neg1 );
ok( 0 == to_native mult $neg1, $zero );
ok( -1 == to_native mult $neg1, $pos1 );
ok( -2 == to_native mult $neg1, $pos2 );
ok( 0 == to_native mult $zero, $zero );
ok( 0 == to_native mult $zero, $pos1 );
ok( 0 == to_native mult $zero, $pos2 );
ok( 1 == to_native mult $pos1, $pos1 );
ok( 2 == to_native mult $pos1, $pos2 );
ok( 4 == to_native mult $pos2, $pos2 );
ok( 3 == to_native divi $neg3, $neg1 );
ok( 0 == to_native divi $neg1, $neg3 );
eval { to_native divi $neg3, $zero }; ok($@);
ok( 0 == to_native divi $zero, $neg3 );
ok( -3 == to_native divi $neg3, $pos1 );
ok( 0 == to_native divi $pos1, $neg3 );
ok( -1 == to_native divi $neg3, $pos2 );
ok( 0 == to_native divi $pos2, $neg3 );
eval { to_native divi $neg1, $zero }; ok($@);
ok( 0 == to_native divi $zero, $neg1 );
ok( -1 == to_native divi $neg1, $pos1 );
ok( -1 == to_native divi $pos1, $neg1 );
ok( 0 == to_native divi $neg1, $pos2 );
ok( -2 == to_native divi $pos2, $neg1 );
ok( 0 == to_native divi $zero, $pos1 );
eval { to_native divi $pos1, $zero }; ok($@);
ok( 0 == to_native divi $zero, $pos2 );
eval { to_native divi $pos2, $zero }; ok($@);
ok( 0 == to_native divi $pos1, $pos2 );
ok( 2 == to_native divi $pos2, $pos1 );
ok( 0 == to_native divi from_native(0), from_native(3) );
ok( 0 == to_native mod from_native(0), from_native(3) );
ok( 0 == to_native divi from_native(1), from_native(3) );
ok( 1 == to_native mod from_native(1), from_native(3) );
ok( 0 == to_native divi from_native(2), from_native(3) );
ok( 2 == to_native mod from_native(2), from_native(3) );
ok( 1 == to_native divi from_native(3), from_native(3) );
ok( 0 == to_native mod from_native(3), from_native(3) );
ok( 1 == to_native divi from_native(4), from_native(3) );
ok( 1 == to_native mod from_native(4), from_native(3) );
ok( 1 == to_native divi from_native(5), from_native(3) );
ok( 2 == to_native mod from_native(5), from_native(3) );
ok( 2 == to_native divi from_native(6), from_native(3) );
ok( 0 == to_native mod from_native(6), from_native(3) );
ok( 2 == to_native divi from_native(7), from_native(3) );
ok( 1 == to_native mod from_native(7), from_native(3) );
ok( 0 == to_native divi from_native(-1), from_native(3) );
ok( -1 == to_native mod from_native(-1), from_native(3) );
ok( 0 == to_native divi from_native(-2), from_native(3) );
ok( -2 == to_native mod from_native(-2), from_native(3) );
ok( -1 == to_native divi from_native(-3), from_native(3) );
ok( 0 == to_native mod from_native(-3), from_native(3) );
ok( -1 == to_native divi from_native(-4), from_native(3) );
ok( -1 == to_native mod from_native(-4), from_native(3) );
done_testing();
