Balanced ternary

Balanced ternary is a way of representing numbers. Unlike the prevailing binary representation, a balanced ternary integer is in base 3, and each digit can have the values 1, 0, or −1. For example, decimal 11 = 3² + 3¹ − 3⁰, thus can be written as "++−", while 6 = 3² − 3¹ + 0 × 3⁰, i.e., "+−0".

For this task, implement balanced ternary representation of integers with the following

Requirements

Support arbitrarily large integers, both positive and negative;
Provide ways to convert to and from text strings, using digits '+', '-' and '0' (unless you are already using strings to represent balanced ternary; but see requirement 5).
Provide ways to convert to and from native integer type (unless, improbably, your platform's native integer type is balanced ternary). If your native integers can't support arbitrary length, overflows during conversion must be indicated.
Provide ways to perform addition, negation and multiplication directly on balanced ternary integers; do not convert to native integers first.
Make your implementation efficient, with a reasonable definition of "effcient" (and with a reasonable definition of "reasonable").

Test case With balanced ternaries a from string "+-0++0+", b from native integer -436, c "+-++-":

write out a, b and c in decimal notation;
calculate a × (b − c), write out the result in both ternary and decimal notations.

Common Lisp

<lang lisp>;;; balanced ternary

represented as a list of 0, 1 or -1s, with least significant digit first

convert ternary to integer

(defun bt-integer (b)

 (reduce (lambda (x y) (+ x (* 3 y))) b :from-end t :initial-value 0))

convert integer to ternary

(defun integer-bt (n)

 (if (zerop n) nil
   (case (mod n 3)
     (0 (cons  0 (integer-bt (/ n 3))))
     (1 (cons  1 (integer-bt (floor n 3))))
     (2 (cons -1 (integer-bt (floor (1+ n) 3)))))))

convert string to ternary

(defun string-bt (s)

 (loop with o = nil for c across s do

(setf o (cons (case c (#\+ 1) (#\- -1) (#\0 0)) o)) finally (return o)))

convert ternary to string

(defun bt-string (bt)

 (if (not bt) "0"
   (let* ((l (length bt))

(s (make-array l :element-type 'character)))

     (mapc (lambda (b)

(setf (aref s (decf l)) (case b (-1 #\-) (0 #\0) (1 #\+)))) bt)

     s)))

arithmetics

(defun bt-neg (a) (map 'list #'- a)) (defun bt-sub (a b) (bt-add a (bt-neg b)))

(let ((tbl #((0 -1) (1 -1) (-1 0) (0 0) (1 0) (-1 1) (0 1))))

 (defun bt-add-digits (a b c)
   (values-list (aref tbl (+ 3 a b c)))))

(defun bt-add (a b &optional (c 0))

 (if (not (and a b))
   (if (zerop c) (or a b)
     (bt-add (list c) (or a b)))
   (multiple-value-bind (d c)
     (bt-add-digits (if a (car a) 0) (if b (car b) 0) c)
     (let ((res (bt-add (cdr a) (cdr b) c)))

;; trim leading zeros (if (or res (not (zerop d))) (cons d res))))))

(defun bt-mul (a b)

 (if (not (and a b))
   nil
   (bt-add (case (car a)

(-1 (bt-neg b)) ( 0 nil) ( 1 b)) (cons 0 (bt-mul (cdr a) b)))))

division with quotient/remainder, for completeness

(defun bt-truncate (a b)

 (let ((n (- (length a) (length b)))

(d (car (last b))))

   (if (minusp n)
     (values nil a)
     (labels ((recur (a b x)

(multiple-value-bind (quo rem) (if (plusp x) (recur a (cons 0 b) (1- x)) (values nil a))

(loop with g = (car (last rem)) with quo = (cons 0 quo) while (= (length rem) (length b)) do (cond ((= g d) (setf rem (bt-sub rem b) quo (bt-add '(1) quo))) ((= g (- d)) (setf rem (bt-add rem b) quo (bt-add '(-1) quo)))) (setf x (car (last rem))) finally (return (values quo rem))))))

(recur a b n)))))

test case

(let* ((a (string-bt "+-0++0+"))

      (b (integer-bt -436))
      (c (string-bt "+-++-"))
      (d (bt-mul a (bt-sub b c))))
 (format t "a~5d~8t~a~%b~5d~8t~a~%c~5d~8t~a~%a × (b − c) = ~d ~a~%"

(bt-integer a) (bt-string a) (bt-integer b) (bt-string b) (bt-integer c) (bt-string c) (bt-integer d) (bt-string d)))</lang>output<lang>a 523 +-0++0+ b -436 -++-0-- c 65 +-++- a × (b − c) = -262023 ----0+--0++0</lang>

Go

<lang go>package main

import (

   "fmt"
   "strings"

)

// R1: representation is a slice of int8 digits of -1, 0, or 1. // digit at index 0 is least significant. zero value of type is // representation of the number 0. type bt []int8

// R2: string conversion:

// btString is a constructor. valid input is a string of any length // consisting of only '+', '-', and '0' characters. // leading zeros are allowed but are trimmed and not represented. // false return means input was invalid. func btString(s string) (*bt, bool) {

   s = strings.TrimLeft(s, "0")
   b := make(bt, len(s))
   for i, last := 0, len(s)-1; i < len(s); i++ {
       switch s[i] {
       case '-':
           b[last-i] = -1
       case '0':
           b[last-i] = 0
       case '+':
           b[last-i] = 1
       default:
           return nil, false
       }
   }
   return &b, true

}

// String method converts the other direction, returning a string of // '+', '-', and '0' characters representing the number. func (b bt) String() string {

   if len(b) == 0 {
       return "0"
   }
   last := len(b) - 1
   r := make([]byte, len(b))
   for i, d := range b {
       r[last-i] = "-0+"[d+1]
   }
   return string(r)

}

// R3: integer conversion // int chosen as "native integer"

// btInt is a constructor like btString. func btInt(i int) *bt {

   if i == 0 {
       return new(bt)
   }
   var b bt
   var btDigit func(int)
   btDigit = func(digit int) {
       m := int8(i % 3)
       i /= 3
       switch m {
       case 2:
           m = -1
           i++
       case -2:
           m = 1
           i--
       }
       if i == 0 {
           b = make(bt, digit+1)
       } else {
           btDigit(digit + 1)
       }
       b[digit] = m
   }
   btDigit(0)
   return &b

}

// Int method converts the other way, returning the value as an int type. // !ok means overflow occurred during conversion, not necessarily that the // value is not representable as an int. (Of course there are other ways // of doing it but this was chosen as "reasonable.") func (b bt) Int() (r int, ok bool) {

   pt := 1
   for _, d := range b {
       dp := int(d) * pt
       neg := r < 0
       r += dp
       if neg {
           if r > dp {
               return 0, false
           }
       } else {
           if r < dp {
               return 0, false
           }
       }
       pt *= 3
   }
   return r, true

}

// R4: negation, addition, and multiplication

func (z *bt) Neg(b *bt) *bt {

   if z != b {
       if cap(*z) < len(*b) {
           *z = make(bt, len(*b))
       } else {
           *z = (*z)[:len(*b)]
       } 
   }
   for i, d := range *b {
       (*z)[i] = -d
   }
   return z

}

func (z *bt) Add(a, b *bt) *bt {

   if len(*a) < len(*b) {
       a, b = b, a
   }
   r := *z
   r = r[:cap(r)]
   var carry int8 
   for i, da := range *a {
       if i == len(r) {
           n := make(bt, len(*a)+4)
           copy(n, r)
           r = n
       }
       sum := da + carry
       if i < len(*b) {
           sum += (*b)[i]
       }
       carry = sum / 3
       sum %= 3
       switch {
       case sum > 1:
           sum -= 3
           carry++
       case sum < -1:
           sum += 3
           carry--
       } 
       r[i] = sum 
   }
   last := len(*a)
   if carry != 0 {
       if len(r) == last {
           n := make(bt, last+4)
           copy(n, r)
           r = n
       }
       r[last] = carry
       *z = r[:last+1]
       return z
   }
   for {
       if last == 0 {
           *z = nil
           break
       }
       last--
       if r[last] != 0 {
           *z = r[:last+1]
           break
       }
   }
   return z

}

func (z *bt) Mul(a, b *bt) *bt {

   if len(*a) < len(*b) {
       a, b = b, a
   }
   var na bt
   for _, d := range *b {
       if d == -1 {
           na.Neg(a)
           break
       }
   }
   r := make(bt, len(*a)+len(*b))
   for i := len(*b) - 1; i >= 0; i-- {
       switch (*b)[i] {
       case 1:
           p := r[i:]
           p.Add(&p, a)
       case -1:
           p := r[i:]
           p.Add(&p, &na)
       }
   }
   i := len(r)
   for i > 0 && r[i-1] == 0 {
       i--
   }
   *z = r[:i]
   return z

}

func main() {

   a, _ := btString("+-0++0+")
   b := btInt(-436)
   c, _ := btString("+-++-")
   show("a:", a) 
   show("b:", b)
   show("c:", c)
   show("a(b-c):", a.Mul(a, b.Add(b, c.Neg(c))))

}

func show(label string, b *bt) {

   fmt.Printf("%7s %12v ", label, b)
   if i, ok := b.Int(); ok {
       fmt.Printf("%7d\n", i)
   } else {
       fmt.Println("int overflow")
   }

}</lang>

Output:

     a:      +-0++0+     523
     b:      -++-0--    -436
     c:        +-++-      65
a(b-c): ----0+--0++0 -262023

J

Implementation:

<lang j>trigits=: 1+3 <.@^. 2 * 1&>.@| trinOfN=: |.@((_1 + ] #: #.&1@] + [) #&3@trigits) :. nOfTrin nOfTrin=: p.&3 :. trinOfN trinOfStr=: 0 1 _1 {~ '0+-'&i.@|. :. strOfTrin strOfTrin=: {&'0+-'@|. :. trinOfStr

carry=: +//.@:(trinOfN"0)^:_ trimLead0=: (}.~ i.&1@:~:&0)&.|.

add=: carry@(+/@,:) neg=: - mul=: trimLead0@carry@(+//.@(*/))</lang>

trinary numbers are represented as a sequence of polynomial coefficients. The coefficient values are limited to 1, 0, and -1. The polynomial's "variable" will always be 3 (which happens to illustrate an interesting absurdity in the terminology we use to describe polynomials -- one which might be an obstacle for learning, for some people).

trigits computes the number of trinary "digits" (that is, the number of polynomial coefficients) needed to represent an integer. pseudocode: 1+floor(log3(2*max(1,abs(n))). Note that floating point inaccuracies combined with comparison tolerance may lead to a [harmless] leading zero when converting incredibly large numbers.

fooOfBar converts a bar into a foo. These functions are all invertable (so we can map from one domain to another, perform an operation, and map back using J's under). This aspect is not needed for this task and the definitions could be made simpler by removing it (removing the :. obverse clauses), but it made testing and debugging easier.

carry performs carry propagation. (Intermediate results will have overflowed trinary representation and become regular integers, so we convert them back into trinary and then perform a polynomial sum, repeating until the result is the same as the argument.)

trimLead0 removes leading zeros from a sequence of polynomial coefficients.

add adds these polynomials. neg negates these polynomials. Note that it's just a name for J's - mul multiplies these polynomials.

Definitions for example:

<lang j>a=: trinOfStr '+-0++0+' b=: trinOfN -436 c=: trinOfStr '+-++-'</lang>

Required example:

<lang j> nOfTrin&> a;b;c 523 _436 65

  strOfTrin a mul b (add -) c

0+--0++0

  nOfTrin   a mul b (add -) c

_262023</lang>

Perl 6

Works with: rakudo version 2012-03-10

<lang perl6>class BT {

   has @.coeff;

   my %co2bt = '-1' => '-', '0' => '0', '1' => '+';
   my %bt2co = %co2bt.invert;

   multi method new (Str $s) {

self.bless(*, coeff => %bt2co{$s.flip.comb});

   }
   multi method new (Int $i where $i >= 0) {

self.bless(*, coeff => carry $i.base(3).comb.reverse);

   }
   multi method new (Int $i where $i < 0) {

self.new(-$i).neg;

   method Str () { %co2bt{@!coeff}.join.flip }
   method Int () { [+] @!coeff Z* (1,3,9...*) }

   multi method neg () {

self.new: coeff => carry self.coeff X* -1;

}

sub carry (*@digits is copy) {

   loop (my $i = 0; $i < @digits; $i++) {

while @digits[$i] < -1 { @digits[$i] += 3; @digits[$i+1]--; } while @digits[$i] > 1 { @digits[$i] -= 3; @digits[$i+1]++; }

   }
   pop @digits while @digits and not @digits[*-1];
   @digits;

}

multi prefix:<-> (BT $x) { $x.neg }

multi infix:<-> (BT $x, BT $y) {

   BT.new: coeff => carry

$x.coeff > $y.coeff ?? ($x.coeff Z+ $y.neg.coeff, 0 xx *) !! ($y.neg.coeff Z+ $x.coeff, 0 xx *); }

multi infix:<+> (BT $x, BT $y) {

   BT.new: coeff => carry

$x.coeff > $y.coeff ?? ($x.coeff Z+ $y.coeff, 0 xx *) !! ($y.coeff Z+ $x.coeff, 0 xx *); }

multi infix:<*> (BT $x, BT $y) {

   my @x = $x.coeff;
   my @y = $y.coeff;
   my @z = 0 xx @x+@y-1;
   my @safe;
   for @x -> $xd {

@z = @z Z+ (@y X* $xd), 0 xx *; @safe.push: @z.shift;

   }
   BT.new: coeff => carry @safe, @z;

}

my $a = BT.new: "+-0++0+"; my $b = BT.new: -436; my $c = BT.new: "+-++-"; my $x = $a * ( $b - $c );

say 'a == ', $a.Int; say 'b == ', $b.Int; say 'c == ', $c.Int; say "a × (b − c) == ", ~$x, ' == ', $x.Int;</lang>

Output:

a == 523
b == -436
c == 65
a × (b − c) == ----0+--0++0 == -262023

Prolog

Works with SWI-Prolog and library clpfd written by Markus Triska.
Three modules, one for the conversion, one for the addition and one for the multiplication.

The conversion.
Library clpfd is used so that bt_convert works in both ways Decimal => Ternary and Ternary ==> Decimal. <lang Prolog>:- module('bt_convert.pl', [bt_convert/2, op(950, xfx, btconv), btconv/2]).

- use_module(library(clpfd)).

- op(950, xfx, btconv).

X btconv Y :- bt_convert(X, Y).

% bt_convert(?X, ?L) bt_convert(X, L) :- ( (nonvar(L), \+is_list(L)) ->string_to_list(L, L1); L1 = L), convert(X, L1), ( var(L) -> string_to_list(L, L1); true).

% map numbers toward digits +, - 0 plus_moins( 1, 43). plus_moins(-1, 45). plus_moins( 0, 48).

convert(X, [48| L]) :- var(X), ( L \= [] -> convert(X, L); X = 0, !).

convert(0, L) :- var(L), !, string_to_list(L, [48]).

convert(X, L) :- ( (nonvar(X), X > 0) ; (var(X), X #> 0, L = [43|_], maplist(plus_moins, L1, L))), !, convert(X, 0, [], L1), ( nonvar(X) -> maplist(plus_moins, L1, LL), string_to_list(L, LL) ; true).

convert(X, L) :- ( nonvar(X) -> Y is -X ; X #< 0, maplist(plus_moins, L2, L), maplist(mult(-1), L2, L1)), convert(Y, 0, [], L1), ( nonvar(X) -> maplist(mult(-1), L1, L2), maplist(plus_moins, L2, LL),

           string_to_list(L, LL)

; X #= -Y).

mult(X, Y, Z) :- Z #= X * Y.

convert(0, 0, L, L) :- !.

convert(0, 1, L, [1 | L]) :- !.

convert(N, C, LC, LF) :- R #= N mod 3 + C, R #> 1 #<==> C1, N1 #= N / 3, R1 #= R - 3 * C1, % C1 #= 1, convert(N1, C1, [R1 | LC], LF). </lang>
The addition.
The same predicate is used for addition and substraction. <lang Prolog>:- module('bt_add.pl', [bt_add/3, bt_add1/3, op(900, xfx, btplus), op(900, xfx, btmoins), btplus/2, btmoins/2, strip_nombre/3 ]).

- op(900, xfx, btplus).

- op(900, xfx, btmoins).

% define operator btplus A is X btplus Y :- bt_add(X, Y, A).

% define operator btmoins % no need to define a predicate for the substraction A is X btmoins Y :-

      X is Y btplus A.

% bt_add(?X, ?Y, ?R) % R is X + Y % X, Y, R are strings % At least 2 args must be instantiated bt_add(X, Y, R) :- ( nonvar(X) -> string_to_list(X, X1); true), ( nonvar(Y) -> string_to_list(Y, Y1); true), ( nonvar(R) -> string_to_list(R, R1); true), bt_add1(X1, Y1, R1), ( var(X) -> string_to_list(X, X1); true), ( var(Y) -> string_to_list(Y, Y1); true), ( var(R) -> string_to_list(R, R1); true).

% bt_add1(?X, ?Y, ?R) % R is X + Y % X, Y, R are lists bt_add1(X, Y, R) :- % initialisation : X and Y must have the same length % we add zeros at the beginning of the shortest list ( nonvar(X) -> length(X, LX); length(R, LR)), ( nonvar(Y) -> length(Y, LY); length(R, LR)), ( var(X) -> LX is max(LY, LR) , length(X1, LX), Y1 = Y ; X1 = X), ( var(Y) -> LY is max(LX, LR) , length(Y1, LY), X1 = X ; Y1 = Y),

Delta is abs(LX - LY), ( LX < LY -> normalise(Delta, X1, X2), Y1 = Y2 ; LY < LX -> normalise(Delta, Y1, Y2), X1 = X2 ; X1 = X2, Y1 = Y2),

% if R is instancied, it must have, at least, the same length than X or Y Max is max(LX, LY), ( (nonvar(R), length(R, LR), LR < Max) -> Delta1 is Max - LR, normalise(Delta1, R, R2) ; nonvar(R) -> R = R2 ; true),

bt_add(X2, Y2, C, R2),

( C = 48 -> strip_nombre(R2, R, []), ( var(X) -> strip_nombre(X2, X, []) ; true), ( var(Y) -> strip_nombre(Y2, Y, []) ; true) ; var(R) -> strip_nombre([C|R2], R, []) ; ( select(C, [45,43], [Ca]), ( var(X) -> strip_nombre([Ca | X2], X, []) ; strip_nombre([Ca | Y2], Y, [])))).

% here we actually compute the sum bt_add([], [], 48, []).

bt_add([H1|T1], [H2|T2], C3, [R2 | L]) :- bt_add(T1, T2, C, L), % add HH1 and H2 ternary_sum(H1, H2, R1, C1), % add first carry, ternary_sum(R1, C, R2, C2), % add second carry ternary_sum(C1, C2, C3, _).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % ternary_sum % @arg1 : V1 % @arg2 : V2 % @arg3 : R is V1 + V2 % @arg4 : Carry ternary_sum(43, 43, 45, 43).

ternary_sum(43, 45, 48, 48).

ternary_sum(45, 43, 48, 48).

ternary_sum(45, 45, 43, 45).

ternary_sum(X, 48, X, 48).

ternary_sum(48, X, X, 48).

% if L has a length smaller than N, complete L with 0 (code 48) normalise(0, L, L) :- !. normalise(N, L1, L) :- N1 is N - 1, normalise(N1, [48 | L1], L).

% contrary of normalise % remove leading zeros. % special case of number 0 ! strip_nombre([48]) --> {!}, "0".

% enlève les zéros inutiles strip_nombre([48 | L]) --> strip_nombre(L).

strip_nombre(L) --> L. </lang> The multiplication.
We give a predicate euclide(?A, +B, ?Q, ?R) which computes both the multiplication and the division, but it is very inefficient.
The predicates multiplication(+B, +Q, -A) and division(+A, +B, -Q, -R) are much more efficient. <lang Prolog>:- module('bt_mult.pl', [op(850, xfx, btmult), btmult/2, multiplication/3 ]).

- use_module('bt_add.pl').

- op(850, xfx, btmult).

A is B btmult C :- multiplication(B, C, A).

neg(A, B) :- maplist(opp, A, B).

opp(48, 48). opp(45, 43). opp(43, 45).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % the multiplication (efficient) % multiplication(+BIn, +QIn, -AOut) % Aout is BIn * QIn % BIn, QIn, AOut are strings multiplication(BIn, QIn, AOut) :- string_to_list(BIn, B), string_to_list(QIn, Q),

% We work with positive numbers ( B = [45 | _] -> Pos0 = false, neg(B,BP) ; BP = B, Pos0 = true), ( Q = [45 | _] -> neg(Q, QP), select(Pos0, [true, false], [Pos1]); QP = Q, Pos1 = Pos0),

multiplication_(BP, QP, [48], A), ( Pos1 = false -> neg(A, A1); A1 = A), string_to_list(AOut, A1).

multiplication_(_B, [], A, A).

multiplication_(B, [H | T], A, AF) :- multiplication_1(B, H, B1), append(A, [48], A1), bt_add1(B1, A1, A2), multiplication_(B, T, A2, AF).

% by 1 (digit '+' code 43) multiplication_1(B, 43, B).

% by 0 (digit '0' code 48) multiplication_1(_, 48, [48]).

% by -1 (digit '-' code 45) multiplication_1(B, 45, B1) :- neg(B, B1).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % the division (efficient) % division(+AIn, +BIn, -QOut, -ROut) % division(AIn, BIn, QOut, ROut) :- string_to_list(AIn, A), string_to_list(BIn, B), length(B, LB), length(A, LA), Len is LA - LB, ( Len < 0 -> Q = [48], R = A ; neg(B, NegB), division_(A, B, NegB, LB, Len, [], Q, R)), string_to_list(QOut, Q), string_to_list(ROut, R).

division_(A, B, NegB, LenB, LenA, QC, QF, R) :- % if the remainder R is negative (last number A), we must decrease the quotient Q, annd add B to R ( LenA = -1 -> (A = [45 | _] -> positive(A, B, QC, QF, R) ; QF = QC, A = R) ; extract(LenA, _, A, AR, AF), length(AR, LR),

( LR >= LenB -> ( AR = [43 | _] -> bt_add1(AR, NegB, S), Q0 = [43], % special case : R has the same length than B % and his first digit is + (1) % we must do another one substraction ( (length(S, LenB), S = [43|_]) -> bt_add1(S, NegB, S1), bt_add1(QC, [43], QC1), Q00 = [45] ; S1 = S, QC1 = QC, Q00 = Q0)

; bt_add1(AR, B, S1), Q00 = [45], QC1 = QC), append(QC1, Q00, Q1), append(S1, AF, A1), strip_nombre(A1, A2, []), LenA1 is LenA - 1, division_(A2, B, NegB, LenB, LenA1, Q1, QF, R)

; append(QC, [48], Q1), LenA1 is LenA - 1, division_(A, B, NegB, LenB, LenA1, Q1, QF, R))).

% extract(+Len, ?N1, +L, -Head, -Tail) % remove last N digits from the list L % put them in Tail. extract(Len, Len, [], [], []).

extract(Len, N1, [H|T], AR1, AF1) :- extract(Len, N, T, AR, AF), N1 is N-1, ( N > 0 -> AR = AR1, AF1 = [H | AF]; AR1 = [H | AR], AF1 = AF).

positive(R, _, Q, Q, R) :- R = [43 | _].

positive(S, B, Q, QF, R ) :- bt_add1(S, B, S1), bt_add1(Q, [45], Q1), positive(S1, B, Q1, QF, R).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % "euclidian" division (inefficient) % euclide(?A, +BIn, ?Q, ?R) % A = B * Q + R euclide(A, B, Q, R) :- mult(A, B, Q, R).

mult(AIn, BIn, QIn, RIn) :- ( nonvar(AIn) -> string_to_list(AIn, A); A = AIn), ( nonvar(BIn) -> string_to_list(BIn, B); B = BIn), ( nonvar(QIn) -> string_to_list(QIn, Q); Q = QIn), ( nonvar(RIn) -> string_to_list(RIn, R); R = RIn),

% we use positive numbers ( B = [45 | _] -> Pos0 = false, neg(B,BP) ; BP = B, Pos0 = true), ( (nonvar(Q), Q = [45 | _]) -> neg(Q, QP), select(Pos0, [true, false], [Pos1]) ; nonvar(Q) -> Q = QP , Pos1 = Pos0 ; Pos1 = Pos0), ( (nonvar(A), A = [45 | _]) -> neg(A, AP) ; nonvar(A) -> AP = A ; true),

% is R instancied ? ( nonvar(R) -> R1 = R; true), % multiplication ? we add B to A and substract 1 (digit '-') to Q ( nonvar(Q) -> BC = BP, Ajout = [45], ( nonvar(R) -> bt_add1(BC, R, AP) ; AP = BC) % division ? we substract B to A and add 1 (digit '+') to Q ; neg(BP, BC), Ajout = [43], QP = [48]),

% do the real job mult_(BC, QP, AP, R1, Resultat, Ajout),

( var(QIn) -> (Pos1 = false -> neg(Resultat, QT); Resultat = QT), string_to_list(QIn, QT) ; true), ( var(AIn) -> (Pos1 = false -> neg(Resultat, AT); Resultat = AT), string_to_list(AIn, AT) ; true), ( var(RIn) -> string_to_list(RIn, R1); true).

% @arg1 : divisor % @arg2 : quotient % @arg3 : dividend % @arg4 : remainder % @arg5 : Result : receive either the dividend A % either the quotient Q mult_(B, Q, A, R, Resultat, Ajout) :- bt_add1(Q, Ajout, Q1), bt_add1(A, B, A1), ( Q1 = [48] -> Resultat = A % a multiplication ; ( A1 = [45 | _], Ajout = [43]) -> Resultat = Q, R = A % a division ; mult_(B, Q1, A1, R, Resultat, Ajout)) .

</lang> Example of output :

 ?- A btconv "+-0++0+".
A = 523.

 ?- -436 btconv B.
B = "-++-0--".

 ?- C btconv "+-++-".
C = 65.

 ?- X is "-++-0--" btmoins "+-++-", Y is "+-0++0+" btmult X, Z btconv Y.
X = "-+0-++0",
Y = "----0+--0++0",
Z = -262023 .

Ruby

<lang ruby>class BalancedTernary

 def initialize(str = "")
   if str !~ /^[-+0]+$/
     raise ArgumentError, "invalid BalancedTernary number: #{str}"
   end
   @digits = trim0(str)
 end

 def self.from_int(value)
   n = value
   digits = ""
   while n != 0
     quo, rem = n.divmod(3)
     case rem
     when 0
       digits = "0" + digits
       n = quo
     when 1
       digits = "+" + digits
       n = quo
     when 2
       digits = "-" + digits
       n = quo + 1
     end
   end
   new(digits)
 end

 def to_int
   @digits.chars.inject(0) do |sum, char|
     sum *= 3
     case char
     when "+"
       sum += 1
     when "-"
       sum -= 1
     end
     sum
   end
 end
 alias :to_i :to_int

 def to_s
   @digits
 end
 alias :inspect :to_s

 ADDITION_TABLE = {
   "-" => {"-" => ["-","+"], "0" => ["0","-"], "+" => ["0","0"]},
   "0" => {"-" => ["0","-"], "0" => ["0","0"], "+" => ["0","+"]},
   "+" => {"-" => ["0","0"], "0" => ["0","+"], "+" => ["+","-"]},
 }

 def +(other)
   maxl = [to_s, other.to_s].collect {|s| s.length}.max
   a = pad0(to_s, maxl)
   b = pad0(other.to_s, maxl)
   carry = "0"
   sum = a.reverse.chars.zip( b.reverse.chars ).inject("") do |sum, (c1, c2)|
     carry1, digit1 = ADDITION_TABLE[c1][c2]
     carry2, digit2 = ADDITION_TABLE[carry][digit1]
     sum = digit2 + sum
     carry = ADDITION_TABLE[carry1][carry2][1]
     sum
   end
   self.class.new(carry + sum)
 end

 MULTIPLICATION_TABLE = {
   "-" => "+0-",
   "0" => "000",
   "+" => "-0+",
 }

 def *(other)
   product = self.class.new("0")
   other.to_s.each_char do |bdigit|
     row = to_s.tr("-0+", MULTIPLICATION_TABLE[bdigit])
     product += self.class.new(row)
     product << 1
   end
   product >> 1
 end

 # negation
 def -@()
   self * BalancedTernary.new("-")
 end

 # subtraction
 def -(other)
   self + (-other)
 end

 # shift left
 def <<(count)
   @digits = trim0(@digits + "0"*count)
   self
 end

 # shift right
 def >>(count)
   @digits[-count..-1] = "" if count > 0
   @digits = trim0(@digits)
   self
 end

 private

 def trim0(str)
   str = str.sub(/^0+/, "")
   str = "0" if str.empty?
   str
 end

 def pad0(str, len)
   str.rjust(len, "0")
 end

end

a = BalancedTernary.new("+-0++0+") b = BalancedTernary.from_int(-436) c = BalancedTernary.new("+-++-") calc = a * (b - c) puts "%s\t%d\t%s\n" % ['a', a.to_i, a] puts "%s\t%d\t%s\n" % ['b', b.to_i, b] puts "%s\t%d\t%s\n" % ['c', c.to_i, c] puts "%s\t%d\t%s\n" % ['a*(b-c)', calc.to_i, calc]</lang>

output

a       523     +-0++0+
b       -436    -++-0--
c       65      +-++-
a*(b-c) -262023 ----0+--0++0

Tcl

This directly uses the printable representation of the balanced ternary numbers, as Tcl's string operations are reasonably efficient. <lang tcl>package require Tcl 8.5

proc bt-int b {

   set n 0
   foreach c [split $b ""] {

set n [expr {$n * 3}] switch -- $c { + { incr n 1 } - { incr n -1 } }

   }
   return $n

} proc int-bt n {

   if {$n == 0} {

return "0"

   }
   while {$n != 0} {

lappend result [lindex {0 + -} [expr {$n % 3}]] set n [expr {$n / 3 + ($n%3 == 2)}]

   }
   return [join [lreverse $result] ""]

}

proc bt-neg b {

   string map {+ - - +} $b

} proc bt-sub {a b} {

   bt-add $a [bt-neg $b]

} proc bt-add-digits {a b c} {

   if {$a eq ""} {set a 0}
   if {$b eq ""} {set b 0}
   if {$a ne 0} {append a 1}
   if {$b ne 0} {append b 1}
   lindex {{0 -1} {+ -1} {- 0} {0 0} {+ 0} {- 1} {0 1}} [expr {$a+$b+$c+3}]

} proc bt-add {a b} {

   set c 0
   set result {}
   foreach ca [lreverse [split $a ""]] cb [lreverse [split $b ""]] {

lassign [bt-add-digits $ca $cb $c] d c lappend result $d

   }
   if {$c ne "0"} {lappend result [lindex {0 + -} $c]}
   if {![llength $result]} {return "0"}
   string trimleft [join [lreverse $result] ""] 0

} proc bt-mul {a b} {

   if {$a eq "0" || $a eq "" || $b eq "0"} {return "0"}
   set sub [bt-mul [string range $a 0 end-1] $b]0
   switch -- [string index $a end] {

0 { return $sub } + { return [bt-add $sub $b] } - { return [bt-sub $sub $b] }

}</lang> Demonstration code: <lang tcl>for {set i 0} {$i<=10} {incr i} {puts "$i = [int-bt $i]"} puts "'+-+'+'+--' = [bt-add +-+ +--] = [bt-int [bt-add +-+ +--]]" puts "'++'*'++' = [bt-mul ++ ++] = [bt-int [bt-mul ++ ++]]"</lang> Output:

0 = 0
1 = +
2 = +-
3 = +0
4 = ++
5 = +--
6 = +-0
7 = +-+
8 = +0-
9 = +00
10 = +0+
'+-+'+'+--' = ++0 = 12
'++'*'++' = +--+ = 16