langs a-z

Task/Balanced-ternary/OCaml/balanced-ternary.ocaml

@@ -0,0 +1,52 @@
+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);

Task/Balanced-ternary/Perl-6/balanced-ternary.pl6

@@ -0,0 +1,63 @@
+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;