Balanced ternary: Difference between revisions
m (promoted to task) |
m (omissions) |
||
Line 2,172: | Line 2,172: | ||
a*(b-c) = ----0+--0++0 (== -262023) |
a*(b-c) = ----0+--0++0 (== -262023) |
||
</pre> |
</pre> |
||
{{omit from|Brlcad}} |
|||
{{omit from|GUISS}} |
|||
{{omit from|Lilypond}} |
|||
{{omit from|Openscad}} |
|||
{{omit from|TPP}} |
Revision as of 11:50, 22 March 2013
You are encouraged to solve this task according to the task description, using any language you may know.
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 = 32 + 31 − 30, thus can be written as "++−", while 6 = 32 − 31 + 0 × 30, 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.
Note: The pages generalised floating point addition and generalised floating point multiplication have code implementing arbitrary precision floating point balanced ternary.
Ada
Specifications (bt.ads): <lang Ada>with Ada.Finalization;
package BT is
type Balanced_Ternary is private; -- conversions function To_Balanced_Ternary (Num : Integer) return Balanced_Ternary; function To_Balanced_Ternary (Str : String) return Balanced_Ternary; function To_Integer (Num : Balanced_Ternary) return Integer; function To_string (Num : Balanced_Ternary) return String; -- Arithmetics -- unary minus function "-" (Left : in Balanced_Ternary)
return Balanced_Ternary;
-- subtraction function "-" (Left, Right : in Balanced_Ternary)
return Balanced_Ternary;
-- addition function "+" (Left, Right : in Balanced_Ternary)
return Balanced_Ternary;
-- multiplication function "*" (Left, Right : in Balanced_Ternary)
return Balanced_Ternary;
private
-- a balanced ternary number is a unconstrained array of (1,0,-1) -- dinamically allocated, least significant trit leftmost type Trit is range -1..1; type Trit_Array is array (Positive range <>) of Trit; pragma Pack(Trit_Array); type Trit_Access is access Trit_Array; type Balanced_Ternary is new Ada.Finalization.Controlled with record
Ref : Trit_access;
end record; procedure Initialize (Object : in out Balanced_Ternary); procedure Adjust (Object : in out Balanced_Ternary); procedure Finalize (Object : in out Balanced_Ternary);
end BT;</lang>
Implementation (bt.adb): <lang Ada>with Ada.Unchecked_Deallocation;
package body BT is
procedure Free is new Ada.Unchecked_Deallocation (Trit_Array, Trit_Access);
-- Conversions -- String to BT function To_Balanced_Ternary (Str: String) return Balanced_Ternary is J : Positive := 1; Tmp : Trit_Access; begin Tmp := new Trit_Array (1..Str'Last); for I in reverse Str'Range loop
case Str(I) is when '+' => Tmp (J) := 1; when '-' => Tmp (J) := -1; when '0' => Tmp (J) := 0; when others => raise Constraint_Error; end case; J := J + 1;
end loop; return (Ada.Finalization.Controlled with Ref => Tmp); end To_Balanced_Ternary; -- Integer to BT function To_Balanced_Ternary (Num: Integer) return Balanced_Ternary is K : Integer := 0; D : Integer; Value : Integer := Num; Tmp : Trit_Array(1..19); -- 19 trits is enough to contain -- a 32 bits signed integer begin loop
D := (Value mod 3**(K+1))/3**K; if D = 2 then D := -1; end if; Value := Value - D*3**K; K := K + 1; Tmp(K) := Trit(D); exit when Value = 0;
end loop; return (Ada.Finalization.Controlled
with Ref => new Trit_Array'(Tmp(1..K)));
end To_Balanced_Ternary;
-- BT to Integer -- -- If the BT number is too large Ada will raise CONSTRAINT ERROR function To_Integer (Num : Balanced_Ternary) return Integer is Value : Integer := 0; Pos : Integer := 1; begin for I in Num.Ref.all'Range loop
Value := Value + Integer(Num.Ref(I)) * Pos; Pos := Pos * 3;
end loop; return Value; end To_Integer;
-- BT to String -- function To_String (Num : Balanced_Ternary) return String is I : constant Integer := Num.Ref.all'Last; Result : String (1..I); begin for J in Result'Range loop
case Num.Ref(I-J+1) is when 0 => Result(J) := '0'; when -1 => Result(J) := '-'; when 1 => Result(J) := '+'; end case;
end loop; return Result; end To_String;
-- unary minus -- function "-" (Left : in Balanced_Ternary)
return Balanced_Ternary is
Result : constant Balanced_Ternary := Left; begin for I in Result.Ref.all'Range loop
Result.Ref(I) := - Result.Ref(I);
end loop; return Result; end "-";
-- addition -- Carry : Trit; function Add (Left, Right : in Trit)
return Trit is
begin if Left /= Right then
Carry := 0; return Left + Right;
else
Carry := Left; return -Right;
end if; end Add; pragma Inline (Add); function "+" (Left, Right : in Trit_Array)
return Balanced_Ternary is
Max_Size : constant Integer :=
Integer'Max(Left'Last, Right'Last);
Tmp_Left, Tmp_Right : Trit_Array(1..Max_Size) := (others => 0); Result : Trit_Array(1..Max_Size+1) := (others => 0); begin Tmp_Left (1..Left'Last) := Left; Tmp_Right(1..Right'Last) := Right; for I in Tmp_Left'Range loop
Result(I) := Add (Result(I), Tmp_Left(I)); Result(I+1) := Carry; Result(I) := Add(Result(I), Tmp_Right(I)); Result(I+1) := Add(Result(I+1), Carry);
end loop; -- remove trailing zeros for I in reverse Result'Range loop
if Result(I) /= 0 then return (Ada.Finalization.Controlled with Ref => new Trit_Array'(Result(1..I))); end if;
end loop; return (Ada.Finalization.Controlled
with Ref => new Trit_Array'(1 => 0));
end "+"; function "+" (Left, Right : in Balanced_Ternary)
return Balanced_Ternary is
begin return Left.Ref.all + Right.Ref.all; end "+"; -- Subtraction function "-" (Left, Right : in Balanced_Ternary)
return Balanced_Ternary is
begin return Left + (-Right); end "-";
-- multiplication function "*" (Left, Right : in Balanced_Ternary)
return Balanced_Ternary is
A, B : Trit_Access; Result : Balanced_Ternary; begin if Left.Ref.all'Length > Right.Ref.all'Length then
A := Right.Ref; B := Left.Ref;
else
B := Right.Ref; A := Left.Ref;
end if; for I in A.all'Range loop
if A(I) /= 0 then declare Tmp_Result : Trit_Array (1..I+B.all'Length-1) := (others => 0); begin for J in B.all'Range loop Tmp_Result(I+J-1) := B(J) * A(I); end loop; Result := Result.Ref.all + Tmp_Result; end; end if;
end loop; return Result; end "*";
procedure Adjust (Object : in out Balanced_Ternary) is begin Object.Ref := new Trit_Array'(Object.Ref.all); end Adjust;
procedure Finalize (Object : in out Balanced_Ternary) is begin Free (Object.Ref); end Finalize;
procedure Initialize (Object : in out Balanced_Ternary) is begin Object.Ref := new Trit_Array'(1 => 0); end Initialize;
end BT;</lang>
Test task requirements (testbt.adb): <lang Ada>with Ada.Text_Io; use Ada.Text_Io; with Ada.Integer_Text_Io; use Ada.Integer_Text_Io; with BT; use BT;
procedure TestBT is
Result, A, B, C : Balanced_Ternary;
begin
A := To_Balanced_Ternary("+-0++0+"); B := To_Balanced_Ternary(-436); C := To_Balanced_Ternary("+-++-"); Result := A * (B - C); Put("a = "); Put(To_integer(A), 4); New_Line; Put("b = "); Put(To_integer(B), 4); New_Line; Put("c = "); Put(To_integer(C), 4); New_Line; Put("a * (b - c) = "); Put(To_integer(Result), 4); Put_Line (" " & To_String(Result));
end TestBT;</lang> Output:
a = 523 b = -436 c = 65 a * (b - c) = -262023 ----0+--0++0
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>
D
<lang d>import std.stdio, std.bigint, std.range, std.algorithm, std.array,
std.conv, std.exception;
struct BalancedTernary {
enum Dig : byte { N=-1, Z=0, P=+1 } // digits Dig[] digits; // Represented as a list of 0, 1 or -1s, // with least significant digit first.
static string dig2str = "-0+";
const static Dig[dchar] str2dig; // = ['+': Dig.P, ...]; static this() { str2dig = ['+': Dig.P, '-': Dig.N, '0': Dig.Z]; }
immutable static Dig[2][] table = [[Dig.Z, Dig.N], [Dig.P, Dig.N], [Dig.N, Dig.Z], [Dig.Z, Dig.Z], [Dig.P, Dig.Z], [Dig.N, Dig.P], [Dig.Z, Dig.P]];
this(string inp) { this.digits = map!(c => cast()str2dig[c])(retro(inp)).array(); }
this(long inp) { this.digits = _bint2ternary(BigInt(inp)); }
this(BigInt inp) { this.digits = _bint2ternary(inp); }
this(BalancedTernary inp) { // no need to dup, they are virtually immutable this.digits = inp.digits; }
private this(Dig[] inp) { this.digits = inp; }
static Dig[] _bint2ternary(/*in*/ BigInt n) { static py_div(T1, T2)(T1 a, T2 b) { if (a < 0) if (b < 0) return -a / -b; else return -(-a / b) - (-a % b != 0 ? 1 : 0); else if (b < 0) return -(a / -b) - (a % -b != 0 ? 1 : 0); else return a / b; }
if (n == 0) return []; switch (((n % 3) + 3) % 3) { // (n % 3) is the remainder case 0: return Dig.Z ~ _bint2ternary(py_div(n, 3)); case 1: return Dig.P ~ _bint2ternary(py_div(n, 3)); case 2: return Dig.N ~ _bint2ternary(py_div(n + 1, 3)); default: assert(0, "Can't happen"); } }
@property BigInt toBint() const { return reduce!((y,x) => x + 3 * y)(BigInt(0), retro(digits)); }
string toString() const { if (digits.empty) return "0"; //return map!(d => dig2str[d + 1])(retro(digits)).array(); auto r = map!(d => cast()dig2str[d+1])(retro(digits)).array(); return assumeUnique(r); /// }
static Dig[] neg_(Dig[] digs) { return map!(d => -d)(digs).array(); }
BalancedTernary opUnary(string op:"-")() { return BalancedTernary(neg_(this.digits)); }
static Dig[] add_(Dig[] a, Dig[] b, Dig c=Dig.Z) { auto a_or_b = a.length ? a : b; if (a.empty || b.empty) { if (c == Dig.Z) return a_or_b; else return BalancedTernary.add_([c], a_or_b); } else { // (const d, c) = table[...]; const dc = table[3 + (a.length ? a[0] : 0) + (b.length ? b[0] : 0) + c]; auto res = add_(a[1 .. $], b[1 .. $], dc[1]); // trim leading zeros if (res.length || dc[0] != Dig.Z) return [dc[0]] ~ res; else return res; } }
BalancedTernary opBinary(string op:"+")(BalancedTernary b) { return BalancedTernary(add_(this.digits, b.digits)); }
BalancedTernary opBinary(string op:"-")(BalancedTernary b) { return this + (-b); }
static Dig[] mul_(in Dig[] a, /*in*/ Dig[] b) { if (a.empty || b.empty) { return []; } else { Dig[] y = Dig.Z ~ mul_(a[1 .. $], b); final switch (a[0]) { case Dig.N: return add_(neg_(b), y); case Dig.Z: return add_([], y); case Dig.P: return add_(b, y); } } }
BalancedTernary opBinary(string op:"*")(BalancedTernary b) { return BalancedTernary(mul_(this.digits, b.digits)); }
}
void main() {
auto a = BalancedTernary("+-0++0+"); writeln("a: ", a.toBint, " ", a);
auto b = BalancedTernary(-436); writeln("b: ", b.toBint, " ", b);
auto c = BalancedTernary("+-++-"); writeln("c: ", c.toBint, " ", c);
auto r = a * (b - c); writeln("a * (b - c): ", r.toBint, " ", r);
}</lang>
- Output:
a: 523 +-0++0+ b: -436 -++-0-- c: 65 +-++- a * (b - c): -262023 ----0+--0++0
Erlang
<lang erlang> -module(ternary). -compile(export_all).
test() ->
AS = "+-0++0+", AT = from_string(AS), A = from_ternary(AT), B = -436, BT = to_ternary(B), BS = to_string(BT), CS = "+-++-", CT = from_string(CS), C = from_ternary(CT), RT = mul(AT,sub(BT,CT)), R = from_ternary(RT), RS = to_string(RT), io:fwrite("A = ~s -> ~b~n",[AS, A]), io:fwrite("B = ~s -> ~b~n",[BS, B]), io:fwrite("C = ~s -> ~b~n",[CS, C]), io:fwrite("A x (B - C) = ~s -> ~b~n", [RS, R]).
to_string(T) -> [to_char(X) || X <- T].
from_string(S) -> [from_char(X) || X <- S].
to_char(-1) -> $-; to_char(0) -> $0; to_char(1) -> $+.
from_char($-) -> -1; from_char($0) -> 0; from_char($+) -> 1.
to_ternary(N) when N > 0 ->
to_ternary(N,[]);
to_ternary(N) ->
neg(to_ternary(-N)).
to_ternary(0,Acc) ->
Acc;
to_ternary(N,Acc) when N rem 3 == 0 ->
to_ternary(N div 3, [0|Acc]);
to_ternary(N,Acc) when N rem 3 == 1 ->
to_ternary(N div 3, [1|Acc]);
to_ternary(N,Acc) ->
to_ternary((N+1) div 3, [-1|Acc]).
from_ternary(T) -> from_ternary(T,0).
from_ternary([],Acc) ->
Acc;
from_ternary([H|T],Acc) ->
from_ternary(T,Acc*3 + H).
mul(A,B) -> mul(B,A,[]).
mul(_,[],Acc) ->
Acc;
mul(B,[A|As],Acc) ->
BP = case A of -1 -> neg(B); 0 -> [0]; 1 -> B end, A1 = Acc++[0], A2=add(BP,A1), mul(B,As,A2).
neg(T) -> [ -H || H <- T].
sub(A,B) -> add(A,neg(B)).
add(A,B) when length(A) < length(B) ->
add(lists:duplicate(length(B)-length(A),0)++A,B);
add(A,B) when length(A) > length(B) ->
add(B,A);
add(A,B) ->
add(lists:reverse(A),lists:reverse(B),0,[]).
add([],[],0,Acc) ->
Acc;
add([],[],C,Acc) ->
[C|Acc];
add([A|As],[B|Bs],C,Acc) ->
[C1,D] = add_util(A+B+C), add(As,Bs,C1,[D|Acc]).
add_util(-3) -> [-1,0]; add_util(-2) -> [-1,1]; add_util(-1) -> [0,-1]; add_util(3) -> [1,0]; add_util(2) -> [1,-1]; add_util(1) -> [0,1]; add_util(0) -> [0,0]. </lang> Output <lang erlang> 234> ternary:test(). A = +-0++0+ -> 523 B = -++-0-- -> -436 C = +-++- -> 65 A x (B - C) = 0----0+--0++0 -> -262023 ok </lang>
Glagol
ОТДЕЛ Сетунь+; ИСПОЛЬЗУЕТ Параметр ИЗ "...\Отделы\Обмен\", Текст ИЗ "...\Отделы\Числа\", Вывод ИЗ "...\Отделы\Обмен\"; ПЕР зч: РЯД 10 ИЗ ЗНАК; счпоз: ЦЕЛ; число: ЦЕЛ; память: ДОСТУП К НАБОР ячейки: РЯД 20 ИЗ ЦЕЛ; размер: УЗКЦЕЛ; отрицательное: КЛЮЧ КОН; ЗАДАЧА СоздатьПамять; УКАЗ СОЗДАТЬ(память); память.размер := 0; память.отрицательное := ОТКЛ КОН СоздатьПамять; ЗАДАЧА ДобавитьВПамять(что: ЦЕЛ); УКАЗ память.ячейки[память.размер] := что; УВЕЛИЧИТЬ(память.размер) КОН ДобавитьВПамять; ЗАДАЧА ОбратитьПамять; ПЕР зчсл: ЦЕЛ; сч: ЦЕЛ; УКАЗ ОТ сч := 0 ДО память.размер ДЕЛИТЬ 2 - 1 ВЫП зчсл := память.ячейки[сч]; память.ячейки[сч] := память.ячейки[память.размер-сч-1]; память.ячейки[память.размер-сч-1] := зчсл КОН КОН ОбратитьПамять; ЗАДАЧА ВывестиПамять; ПЕР сч: ЦЕЛ; УКАЗ ОТ сч := 0 ДО память.размер-1 ВЫП ЕСЛИ память.ячейки[сч] < 0 ТО Вывод.Цепь("-") АЕСЛИ память.ячейки[сч] > 0 ТО Вывод.Цепь("+") ИНАЧЕ Вывод.Цепь("0") КОН КОН КОН ВывестиПамять; ЗАДАЧА УдалитьПамять; УКАЗ память := ПУСТО КОН УдалитьПамять; ЗАДАЧА Перевести(число: ЦЕЛ); ПЕР о: ЦЕЛ; з: КЛЮЧ; ЗАДАЧА ВПамять(что: ЦЕЛ); УКАЗ ЕСЛИ память.отрицательное ТО ЕСЛИ что < 0 ТО ДобавитьВПамять(1) АЕСЛИ что > 0 ТО ДобавитьВПамять(-1) ИНАЧЕ ДобавитьВПамять(0) КОН ИНАЧЕ ДобавитьВПамять(что) КОН КОН ВПамять; УКАЗ ЕСЛИ число < 0 ТО память.отрицательное := ВКЛ КОН; число := МОДУЛЬ(число); з := ОТКЛ; ПОКА число > 0 ВЫП о := число ОСТАТОК 3; число := число ДЕЛИТЬ 3; ЕСЛИ з ТО ЕСЛИ о = 2 ТО ВПамять(0) АЕСЛИ о = 1 ТО ВПамять(-1) ИНАЧЕ ВПамять(1); з := ОТКЛ КОН ИНАЧЕ ЕСЛИ о = 2 ТО ВПамять(-1); з := ВКЛ ИНАЧЕ ВПамять(о) КОН КОН КОН; ЕСЛИ з ТО ВПамять(1) КОН; ОбратитьПамять; ВывестиПамять(ВКЛ); КОН Перевести; ЗАДАЧА ВЧисло(): ЦЕЛ; ПЕР сч, мн: ЦЕЛ; результат: ЦЕЛ; УКАЗ результат := 0; мн := 1; ОТ сч := 0 ДО память.размер-1 ВЫП УВЕЛИЧИТЬ(результат, память.ячейки[память.размер-сч-1]*мн); мн := мн * 3 КОН; ВОЗВРАТ результат КОН ВЧисло; УКАЗ Параметр.Текст(1, зч); счпоз := 0; число := Текст.ВЦел(зч, счпоз); СоздатьПамять; Перевести(число); Вывод.ЧЦел(" = %d.", ВЧисло(), 0, 0, 0); УдалитьПамять КОН Сетунь.
A crude English/Pidgin Algol translation of the above Category:Glagol code. <lang algol68>PROGRAM Setun+; USES
Parameter IS "...\Departments\Exchange\" Text IS "...\Departments\Numbers\" Output IS "...\Departments\Exchange\";
VAR
AF: RANGE 10 IS SIGN; mfpos: INT; number: INT; memory ACCESS TO STRUCT cell: RANGE 20 IS INT; size: UZKEL; negative: BOOL END;
PROC Create.Memory; BEGIN
CREATE(memory); memory.size := 0; memory.negative := FALSE
END Create.Memory;
PROC Add.Memory(that: INT) BEGIN
memory.cells[memory.size] := that; ZOOM(memory.size)
END Add.Memory;
PROC Invert.Memory; VAR
zchsl: INT; account: INT;
BEGIN
FOR cq := 0 TO memory.size DIVIDE 2 - 1 DO zchsl := memory.cells[cq]; memory.cells[cq] := memory.cells[memory.size-size-1]; memory.cells[memory.size-MF-1] := zchsl END
END Invert.Memory;
PROC Withdraw.Memory; VAR
account: INT;
BEGIN
FOR cq := 0 TO memory.size-1 DO IF memory.cells[cq] < 0 THEN Output.Append("-") ANDIF memory.cells[cq] > 0 THEN Output.Append("+") ELSE Output.Append("0") END END
END Withdraw.Memory;
PROC Remove.Memory; BEGIN
memory := Empty
END Remove.Memory;
PROC Translate(number: INT) VAR
about: INT; s: BOOL; PROC B.Memory(that: INT) BEGIN IF memory.negative THEN IF that < 0 THEN Add.Memory(1) ANDIF that > 0 THEN Add.Memory(1) ELSE Add.Memory(0) END ELSE Add.Memory(that) END END B.Memory;
BEGIN
IF number < 0 THEN memory.negative := TRUE END; number := UNIT(number) s := FALSE; WHILE number > 0 DO about := number BALANCE 3; number := number DIVIDE 3; IF s THEN IF about = 2 THEN B.Memory(0) ANDIF about = 1 THEN B.Memory(1) ELSE B.Memory(1) s := FALSE END ELSE IF about = 2 THEN B.Memory(-1) s := TRUE ELSE B.Memory(a) END END END; IF s THEN B.Memory(1) END; Invert.Memory; Withdraw.Memory(TRUE)
END Translate;
PROC InNumber(): INT; VAR
MF, MN: INT; result: INT;
BEGIN
result := 0 pl := 1; FOR cq := 0 TO memory.size-1 DO ZOOM(result, memory.Cells[memory.size-cq-1] * mn); pl := pl * 3 END; RETURN result;
END InNumber;
BEGIN
Parameter.Text(1, AF); mfpos := 0; number := Text.Whole(AF, mfpos); Create.Memory; Translate(number); Output.ChTarget(" = %d.", InNumber(), 0, 0, 0); Remove.Memory
END Setun.</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
Haskell
BTs are represented internally as lists of digits in integers from -1 to 1, but displayed as "+-0" strings. <lang haskell>data BalancedTernary = Bt [Int]
zeroTrim a = if null s then [0] else s where s = f [] [] a f x _ [] = x f x y (0:zs) = f x (y++[0]) zs f x y (z:zs) = f (x++y++[z]) [] zs
btList (Bt a) = a
instance Eq BalancedTernary where (==) a b = btList a == btList b
btNormalize = listBt . _carry 0 where _carry c [] = if c == 0 then [] else [c] _carry c (a:as) = r:_carry cc as where (cc, r) = f $ (a+c) `quotRem` 3 where f (x, 2) = (x + 1, -1) f (x, -2) = (x - 1, 1) f x = x
listBt = Bt . zeroTrim
instance Show BalancedTernary where show = reverse . map (\d->case d of -1->'-'; 0->'0'; 1->'+') . btList
strBt = Bt . zeroTrim.reverse.map (\c -> case c of '-' -> -1; '0' -> 0; '+' -> 1)
intBt :: Integral a => a -> BalancedTernary intBt = fromIntegral . toInteger
btInt = f . btList where f [] = 0 f (a:as) = a + 3 * f as
listAdd a b = take (max (length a) (length b)) $ zipWith (+) (a++[0,0..]) (b++[0,0..])
-- mostly for operators, also small stuff to make GHC happy instance Num BalancedTernary where negate = Bt . map negate . btList (+) x y = btNormalize $ listAdd (btList x) (btList y) (*) x y = btNormalize $ mul_ (btList x) (btList y) where mul_ _ [] = [] mul_ [] _ = [] mul_ (a:as) b = listAdd (map (a*) b) (0:mul_ as b) where
-- we don't need to define binary "-" by hand
signum (Bt a) = if a == [0] then 0 else Bt [last a] abs x = if signum x == Bt [-1] then negate x else x
fromInteger = btNormalize . f where f 0 = [] f x = fromInteger (rem x 3) : f (quot x 3)
main = let (a,b,c) = (strBt "+-0++0+", intBt (-436), strBt "+-++-")
r = a * (b - c)
in do
print $ map btInt [a,b,c]
print $ r
print $ btInt r</lang>
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.
fooOf
Bar 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>
Mathematica
<lang mathematica>frombt = FromDigits[StringCases[#, {"+" -> 1, "-" -> -1, "0" -> 0}],
3] &;
tobt = If[Quotient[#, 3, -1] == 0,
"", #0@Quotient[#, 3, -1]] <> (Mod[#, 3, -1] /. {1 -> "+", -1 -> "-", 0 -> "0"}) &;
btnegate = StringReplace[#, {"+" -> "-", "-" -> "+"}] &; btadd = StringReplace[
StringJoin[ Fold[Sort@{#11, Sequence @@ #2} /. {{x_, x_, x_} :> {x, "0" <> #12}, {"-", "+", x_} | {x_, "-", "+"} | {x_, "0", "0"} :> {"0", x <> #12}, {"+", "+", "0"} -> {"+", "-" <> #12}, {"-", "-", "0"} -> {"-", "+" <> #12}} &, {"0", ""}, Reverse@Transpose@PadLeft[Characters /@ {#1, #2}] /. {0 -> "0"}]], StartOfString ~~ "0" .. ~~ x__ :> x] &;
btsubtract = btadd[#1, btnegate@#2] &; btmultiply =
btadd[Switch[StringTake[#2, -1], "0", "0", "+", #1, "-", btnegate@#1], If[StringLength@#2 == 1, "0", #0[#1, StringDrop[#2, -1]] <> "0"]] &;</lang>
Examples: <lang mathematica>frombt[a = "+-0++0+"] b = tobt@-436 frombt[c = "+-++-"] btmultiply[a, btsubtract[b, c]]</lang> Outputs:
523 "-++-0--" 65 "----0+--0++0"
МК-61/52
<lang>П0 ЗН П2 0 П3 П4 1 П5 ИП0 /-/ x<0 78 ИП0 ^ ^ 3 / [x] П0 3 * - П1 ИП3 x#0 52 ИП1 x=0 36 1 ПП 85 0 П3 БП 08 ИП1 1 - x=0 47 1 /-/ ПП 85 БП 08 0 ПП 85 БП 08 ИП1 x=0 60 0 ПП 85 БП 08 ИП1 1 - x=0 70 1 ПП 85 БП 08 1 /-/ ПП 85 1 П3 БП 08 ИП3 x#0 84 1 ПП 85 С/П ИП2 x<0 90 <-> /-/ <-> 8 + ИП5 * ИП4 + П4 ИП5 1 0 * ИП5 В/О</lang>
Note: the "-", "0", "+" denotes by digits, respectively, the "7", "8", "9".
OCaml
<lang ocaml>type btdigit = Pos | Zero | Neg type btern = btdigit list
let to_string n =
String.concat "" (List.rev_map (function Pos -> "+" | Zero -> "0" | Neg -> "-") n)
let from_string s =
let sl = ref [] in let digit = function '+' -> Pos | '-' -> Neg | '0' -> Zero | _ -> failwith "invalid digit" in String.iter (fun c -> sl := (digit c) :: !sl) s; !sl
let rec to_int = function
| [Zero] | [] -> 0 | Pos :: t -> 1 + 3 * to_int t | Neg :: t -> -1 + 3 * to_int t | Zero :: t -> 3 * to_int t
let rec from_int n =
if n = 0 then [] else match n mod 3 with | 0 -> Zero :: from_int (n/3) | 1 | -2 -> Pos :: from_int ((n-1)/3) | 2 | -1 -> Neg :: from_int ((n+1)/3)
let rec (+~) n1 n2 = match (n1,n2) with
| ([], a) | (a,[]) -> a | (Pos::t1, Neg::t2) | (Neg::t1, Pos::t2) | (Zero::t1, Zero::t2) -> let sum = t1 +~ t2 in if sum = [] then [] else Zero :: sum | (Pos::t1, Pos::t2) -> Neg :: t1 +~ t2 +~ [Pos] | (Neg::t1, Neg::t2) -> Pos :: t1 +~ t2 +~ [Neg] | (Zero::t1, h::t2) | (h::t1, Zero::t2) -> h :: t1 +~ t2
let neg = List.map (function Pos -> Neg | Neg -> Pos | Zero -> Zero) let (-~) a b = a +~ (neg b)
let rec ( *~) n1 = function
| [] -> [] | [Pos] -> n1 | [Neg] -> neg n1 | Pos::t -> (Zero :: t *~ n1) +~ n1 | Neg::t -> (Zero :: t *~ n1) -~ n1 | Zero::t -> Zero :: t *~ n1
let a = from_string "+-0++0+" let b = from_int (-436) let c = from_string "+-++-" let d = a *~ (b -~ c) let _ =
Printf.printf "a = %d\nb = %d\nc = %d\na * (b - c) = %s = %d\n" (to_int a) (to_int b) (to_int c) (to_string d) (to_int d);</lang>
Output:
a = 523 b = -436 c = 65 a * (b - c) = ----0+--0++0 = -262023
Perl 6
<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) {
my ($b,$a) = sort +*.coeff, $x, $y; BT.new: coeff => carry $a.coeff Z+ $b.coeff, 0 xx *;
}
multi infix:<-> (BT $x, BT $y) { $x + $y.neg }
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 .
Python
<lang python>class BalancedTernary:
# Represented as a list of 0, 1 or -1s, with least significant digit first.
str2dig = {'+': 1, '-': -1, '0': 0} # immutable dig2str = {1: '+', -1: '-', 0: '0'} # immutable table = ((0, -1), (1, -1), (-1, 0), (0, 0), (1, 0), (-1, 1), (0, 1)) # immutable
def __init__(self, inp): if isinstance(inp, str): self.digits = [BalancedTernary.str2dig[c] for c in reversed(inp)] elif isinstance(inp, int): self.digits = self._int2ternary(inp) elif isinstance(inp, BalancedTernary): self.digits = list(inp.digits) elif isinstance(inp, list): if all(d in (0, 1, -1) for d in inp): self.digits = list(inp) else: raise ValueError("BalancedTernary: Wrong input digits.") else: raise TypeError("BalancedTernary: Wrong constructor input.")
@staticmethod def _int2ternary(n): if n == 0: return [] if (n % 3) == 0: return [0] + BalancedTernary._int2ternary(n // 3) if (n % 3) == 1: return [1] + BalancedTernary._int2ternary(n // 3) if (n % 3) == 2: return [-1] + BalancedTernary._int2ternary((n + 1) // 3)
def to_int(self): return reduce(lambda y,x: x + 3 * y, reversed(self.digits), 0)
def __repr__(self): if not self.digits: return "0" return "".join(BalancedTernary.dig2str[d] for d in reversed(self.digits))
@staticmethod def _neg(digs): return [-d for d in digs]
def __neg__(self): return BalancedTernary(BalancedTernary._neg(self.digits))
@staticmethod def _add(a, b, c=0): if not (a and b): if c == 0: return a or b else: return BalancedTernary._add([c], a or b) else: (d, c) = BalancedTernary.table[3 + (a[0] if a else 0) + (b[0] if b else 0) + c] res = BalancedTernary._add(a[1:], b[1:], c) # trim leading zeros if res or d != 0: return [d] + res else: return res
def __add__(self, b): return BalancedTernary(BalancedTernary._add(self.digits, b.digits))
def __sub__(self, b): return self + (-b)
@staticmethod def _mul(a, b): if not (a and b): return [] else: if a[0] == -1: x = BalancedTernary._neg(b) elif a[0] == 0: x = [] elif a[0] == 1: x = b else: assert False y = [0] + BalancedTernary._mul(a[1:], b) return BalancedTernary._add(x, y)
def __mul__(self, b): return BalancedTernary(BalancedTernary._mul(self.digits, b.digits))
def main():
a = BalancedTernary("+-0++0+") print "a:", a.to_int(), a
b = BalancedTernary(-436) print "b:", b.to_int(), b
c = BalancedTernary("+-++-") print "c:", c.to_int(), c
r = a * (b - c) print "a * (b - c):", r.to_int(), r
main()</lang>
- Output:
a: 523 +-0++0+ b: -436 -++-0-- c: 65 +-++- a * (b - c): -262023 ----0+--0++0
REXX
The REXX program could be optimized by using EXPOSE and having the $. and @. variables set only once. <lang rexx>/*REXX pgm converts decimal ◄───► balanced ternary; also performs arith.*/ numeric digits 10000 /*handle almost any size numbers.*/ Ao = '+-0++0+' ; Abt = Ao /* [↓] 2 literals used by sub.*/ Bo = '-436' ; Bbt = d2bt(Bo) ; @ = '(decimal)' Co = '+-++-' ; Cbt = Co ; @@ = 'balanced ternary ='
call btShow '[a]', Abt call btShow '[b]', Bbt call btShow '[c]', Cbt say; $bt = btMul(Abt,btSub(Bbt,Cbt)) call btshow '[a*(b-c)]', $bt
exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────BT2D subroutine─────────────────────*/ d2bt: procedure; parse arg x 1; p=0; $.='-'; $.1='+'; $.0=0; #= x=x/1
do until x==0; _=(x//(3**(p+1)))%3**p if _==2 then _=-1; if _=-2 then _=1 x=x-_*(3**p); p=p+1; #=$._ || # end /*until*/
return # /*──────────────────────────────────BT2D subroutine─────────────────────*/ bt2d: procedure; parse arg x; r=reverse(x); #=0; $.=-1; $.0=0; _='+'; $._=1
do j=1 for length(x); _=substr(r,j,1); #=#+$._*3**(j-1); end
return # /*──────────────────────────────────BTADD subroutine────────────────────*/ btAdd: procedure; parse arg x,y; rx=reverse(x); ry=reverse(y); carry=0 $.='-'; $.0=0; $.1='+'; @.=0; _='-'; @._=-1; _="+"; @._=1; #=
do j=1 for max(length(x),length(y)) x_=substr(rx,j,1); xn=@.x_ y_=substr(ry,j,1); yn=@.y_ s=xn+yn+carry ; carry=0 if s== 2 then do; s=-1; carry= 1; end if s== 3 then do; s= 0; carry= 1; end if s==-2 then do; s= 1; carry=-1; end #=$.s || # end /*j*/
if carry\==0 then #=$.carry || #; return btNorm(#) /*──────────────────────────────────BTMUL subroutine────────────────────*/ btMul: procedure; parse arg x,y; if x==0 | y==0 then return 0; S=1 x=btNorm(x); y=btNorm(y) /*handle: 0-xxx values.*/ if left(x,1)=='-' then do; x=btNeg(x); S=-S; end /*positate.*/ if left(y,1)=='-' then do; y=btNeg(y); S=-S; end /*positate.*/ if length(y)>length(x) then parse value x y with y x /*optimize.*/ P=0
do until y==0 /*keep adding 'til done*/ P=btAdd(P,x) /*multiple the hard way*/ y=btSub(y,'+') /*subtract 1 from Y. */ end /*until*/
if S==-1 then P=btNeg(P) /*adjust product sign. */ return P /*return the product P.*/ /*───────────────────────────────one-line subroutines───────────────────*/ btNeg: return translate(arg(1), '-+', "+-") /*negate the bal_tern #*/ btNorm: _=strip(arg(1),'L',0); if _== then _=0; return _ /*normalize*/ btSub: return btAdd(arg(1), btNeg(arg(2))) /*subtract two BT args.*/ btShow: say center(arg(1),9) right(arg(2),20) @@ right(bt2d(arg(2)),9) @; return</lang> output
[a] +-0++0+ balanced ternary = 523 (decimal) [b] -++-0-- balanced ternary = -436 (decimal) [c] +-++- balanced ternary = 65 (decimal) [a*(b-c)] ----0+--0++0 balanced ternary = -262023 (decimal)
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 ++ ++]]"
set a "+-0++0+" set b [int-bt -436] set c "+-++-" puts "a = [bt-int $a], b = [bt-int $b], c = [bt-int $c]" set abc [bt-mul $a [bt-sub $b $c]] puts "a*(b-c) = $abc (== [bt-int $abc])"</lang> Output:
0 = 0 1 = + 2 = +- 3 = +0 4 = ++ 5 = +-- 6 = +-0 7 = +-+ 8 = +0- 9 = +00 10 = +0+ '+-+'+'+--' = ++0 = 12 '++'*'++' = +--+ = 16 a = 523, b = -436, c = 65 a*(b-c) = ----0+--0++0 (== -262023)