use strict;
use warnings;

my @d = qw( 0 + - );
my @v = qw( 0 1 -1 );

sub to_bt {
  my $n = shift;
  my $b = '';
  while( $n ) {
    my $r = $n%3;
    $b .= $d[$r];
    $n -= $v[$r];
    $n /= 3;
  }
  return scalar reverse $b;
}

sub from_bt {
  my $n = 0;
  for( split //, shift ) { # Horner
    $n *= 3;
    $n += "${_}1" if $_;
  }
  return $n;
}

my %addtable = (
                '-0' => [ '-', '' ],
                '+0' => [ '+', '' ],
                '+-' => [ '0', '' ],
                '00' => [ '0', '' ],
                '--' => [ '+', '-' ],
                '++' => [ '-', '+' ],
               );

sub add {
  my ($b1, $b2) = @_;
  return ($b1 or $b2 ) unless ($b1 and $b2);
  my $d = $addtable{ join '', sort substr( $b1, -1, 1, '' ), substr( $b2, -1, 1, '' ) };
  return add( add($b1, $d->[1]), $b2 ).$d->[0];
}

sub unary_minus {
  my $b = shift;
  $b =~ tr/-+/+-/;
  return $b;
}

sub subtract {
  my ($b1, $b2) = @_;
  return add( $b1, unary_minus $b2 );
}

sub mult {
  my ($b1, $b2) = @_;
  my $r = '0';
  for( reverse split //, $b2 ){
    $r = add $r, $b1      if $_ eq '+';
    $r = subtract $r, $b1 if $_ eq '-';
    $b1 .= '0';
  }
  $r =~ s/^0+//;
  return $r;
}

my $a = "+-0++0+";
my $b = to_bt( -436 );
my $c = "+-++-";
my $d = mult( $a, subtract( $b, $c ) );
printf "      a: %14s %10d\n", $a, from_bt( $a );
printf "      b: %14s %10d\n", $b, from_bt( $b );
printf "      c: %14s %10d\n", $c, from_bt( $c );
printf "a*(b-c): %14s %10d\n", $d, from_bt( $d );