Just another update
This commit is contained in:
Ingy döt Net
parent
a25938f123
commit
00a190b0a6
6591 changed files with 94363 additions and 23227 deletions
213
Task/Balanced-ternary/ATS/balanced-ternary.ats
Normal file
213
Task/Balanced-ternary/ATS/balanced-ternary.ats
Normal file
|
|
@ -0,0 +1,213 @@
|
|||
(*
|
||||
** This one is
|
||||
** translated into ATS from the Ocaml entry
|
||||
*)
|
||||
|
||||
(* ****** ****** *)
|
||||
//
|
||||
// How to compile:
|
||||
// patscc -DATS_MEMALLOC_LIBC -o bternary bternary.dats
|
||||
//
|
||||
(* ****** ****** *)
|
||||
|
||||
#include
|
||||
"share/atspre_staload.hats"
|
||||
|
||||
(* ****** ****** *)
|
||||
|
||||
datatype btd = P | Z | N; typedef btern = List0(btd)
|
||||
|
||||
(* ****** ****** *)
|
||||
|
||||
fun
|
||||
btd2int (d: btd): int =
|
||||
(case+ d of P() => 1 | Z() => 0 | N() => ~1)
|
||||
|
||||
(* ****** ****** *)
|
||||
|
||||
fun
|
||||
btd2string (d:btd): string =
|
||||
(
|
||||
case+ d of P() => "+" | Z() => "0" | N() => "-"
|
||||
)
|
||||
|
||||
(* ****** ****** *)
|
||||
|
||||
fun
|
||||
btern2string
|
||||
(
|
||||
ds: btern
|
||||
) : string =
|
||||
strptr2string(res) where
|
||||
{
|
||||
val xs = list_map_cloref (ds, lam d => btd2string(d))
|
||||
val xs = list_vt_reverse (xs)
|
||||
val res = stringlst_concat($UNSAFE.castvwtp1{List(string)}(xs))
|
||||
val () = list_vt_free<string> (xs)
|
||||
}
|
||||
|
||||
(* ****** ****** *)
|
||||
|
||||
fun
|
||||
from_string
|
||||
(inp: string): btern = let
|
||||
//
|
||||
fun
|
||||
loop{n:nat}
|
||||
(
|
||||
inp: string(n), ds: btern
|
||||
) : btern =
|
||||
(
|
||||
//
|
||||
if isneqz(inp)
|
||||
then let
|
||||
val c = inp.head
|
||||
val d =
|
||||
(case- c of '+' => P | '0' => Z | '-' => N): btd
|
||||
// end of [val]
|
||||
in
|
||||
loop (inp.tail, list_cons(d, ds))
|
||||
end // end of [then]
|
||||
else ds // end of [else]
|
||||
//
|
||||
) (* end of [loop] *)
|
||||
//
|
||||
in
|
||||
loop (g1ofg0(inp), list_nil)
|
||||
end // end of [from_string]
|
||||
|
||||
(* ****** ****** *)
|
||||
|
||||
fun
|
||||
to_int (ds: btern): int =
|
||||
(
|
||||
case+ ds of
|
||||
| list_nil () => 0
|
||||
| list_cons (d, ds) => 3*to_int(ds) + btd2int(d)
|
||||
) (* end of [to_int] *)
|
||||
|
||||
fun
|
||||
from_int (n: int): btern =
|
||||
(
|
||||
if
|
||||
n = 0
|
||||
then list_nil
|
||||
else let
|
||||
val r = n mod 3
|
||||
in
|
||||
if r = 0
|
||||
then list_cons (Z, from_int (n/3))
|
||||
else if (r = 1 || r = ~2)
|
||||
then list_cons (P, from_int ((n-1)/3))
|
||||
else list_cons (N, from_int ((n+1)/3))
|
||||
end // end of [else]
|
||||
) (* end of [from_int] *)
|
||||
|
||||
(* ****** ****** *)
|
||||
|
||||
fun
|
||||
neg_btern
|
||||
(ds: btern): btern =
|
||||
list_vt2t
|
||||
(
|
||||
list_map_cloref<btd><btd>
|
||||
(ds, lam d => case+ d of P() => N() | Z() => Z() | N() => P())
|
||||
) (* end of [neg_btern] *)
|
||||
|
||||
overload ~ with neg_btern
|
||||
|
||||
(* ****** ****** *)
|
||||
//
|
||||
extern
|
||||
fun
|
||||
add_btern_btern: (btern, btern) -> btern
|
||||
and
|
||||
sub_btern_btern: (btern, btern) -> btern
|
||||
overload + with add_btern_btern of 100
|
||||
overload - with sub_btern_btern of 100
|
||||
//
|
||||
extern
|
||||
fun
|
||||
mul_btern_btern: (btern, btern) -> btern
|
||||
overload * with mul_btern_btern of 110
|
||||
//
|
||||
(* ****** ****** *)
|
||||
|
||||
#define :: list_cons
|
||||
|
||||
(* ****** ****** *)
|
||||
|
||||
local
|
||||
|
||||
fun aux0 (ds: btern): btern =
|
||||
(
|
||||
case+ ds of nil() => ds | _ => Z()::ds
|
||||
)
|
||||
|
||||
fun succ(ds:btern) = ds+list_sing(P())
|
||||
fun pred(ds:btern) = ds+list_sing(N())
|
||||
|
||||
in (* in-of-local *)
|
||||
|
||||
implement
|
||||
add_btern_btern
|
||||
(ds1, ds2) =
|
||||
(
|
||||
case+ (ds1, ds2) of
|
||||
| (nil(), _) => ds2
|
||||
| (_, nil()) => ds1
|
||||
| (P()::ds1, N()::ds2) => aux0 (ds1+ds2)
|
||||
| (Z()::ds1, Z()::ds2) => aux0 (ds1+ds2)
|
||||
| (N()::ds1, P()::ds2) => aux0 (ds1+ds2)
|
||||
| (P()::ds1, P()::ds2) => N() :: succ(ds1 + ds2)
|
||||
| (N()::ds1, N()::ds2) => P() :: pred(ds1 + ds2)
|
||||
| (Z()::ds1, btd::ds2) => btd :: (ds1 + ds2)
|
||||
| (btd::ds1, Z()::ds2) => btd :: (ds1 + ds2)
|
||||
)
|
||||
|
||||
implement
|
||||
sub_btern_btern (ds1, ds2) = ds1 + (~ds2)
|
||||
|
||||
implement
|
||||
mul_btern_btern (ds1, ds2) =
|
||||
(
|
||||
case+ ds2 of
|
||||
| nil() => nil()
|
||||
| Z()::ds2 => aux0 (ds1 * ds2)
|
||||
| P()::ds2 => aux0 (ds1 * ds2) + ds1
|
||||
| N()::ds2 => aux0 (ds1 * ds2) - ds1
|
||||
)
|
||||
|
||||
end // end of [local]
|
||||
|
||||
(* ****** ****** *)
|
||||
|
||||
typedef charptr = $extype"char*"
|
||||
|
||||
(* ****** ****** *)
|
||||
|
||||
implement main0 () =
|
||||
{
|
||||
//
|
||||
val a =
|
||||
from_string "+-0++0+"
|
||||
//
|
||||
val b = from_int (~436)
|
||||
val c = from_string "+-++-"
|
||||
//
|
||||
val d = a * (b - c)
|
||||
//
|
||||
val () =
|
||||
$extfcall
|
||||
(
|
||||
void
|
||||
, "printf"
|
||||
, "a = %d\nb = %d\nc = %d\na * (b - c) = %s = %d\n"
|
||||
, to_int(a)
|
||||
, to_int(b)
|
||||
, to_int(c)
|
||||
, $UNSAFE.cast{charptr}(btern2string(d))
|
||||
, to_int(d)
|
||||
) (* end of [val] *)
|
||||
//
|
||||
} (* end of [main0] *)
|
||||
|
|
@ -23,11 +23,11 @@ struct BalancedTernary {
|
|||
this.digits = inp.retro.map!(c => str2dig[c]).array;
|
||||
}
|
||||
|
||||
this(in long inp) const pure /*nothrow*/ {
|
||||
this(in long inp) const pure nothrow {
|
||||
this.digits = _bint2ternary(inp.BigInt);
|
||||
}
|
||||
|
||||
this(in BigInt inp) const pure /*nothrow*/ {
|
||||
this(in BigInt inp) const pure nothrow {
|
||||
this.digits = _bint2ternary(inp);
|
||||
}
|
||||
|
||||
|
|
@ -36,12 +36,12 @@ struct BalancedTernary {
|
|||
this.digits = inp.digits;
|
||||
}
|
||||
|
||||
private this(in Dig[] inp) /*inout*/ pure nothrow {
|
||||
private this(in Dig[] inp) pure nothrow {
|
||||
this.digits = inp;
|
||||
}
|
||||
|
||||
static Dig[] _bint2ternary(in BigInt n) pure /*nothrow*/ {
|
||||
static py_div(T1, T2)(in T1 a, in T2 b) pure /*nothrow*/ {
|
||||
static Dig[] _bint2ternary(in BigInt n) pure nothrow {
|
||||
static py_div(T1, T2)(in T1 a, in T2 b) pure nothrow {
|
||||
if (a < 0) {
|
||||
return (b < 0) ?
|
||||
-a / -b :
|
||||
|
|
@ -62,7 +62,7 @@ struct BalancedTernary {
|
|||
}
|
||||
}
|
||||
|
||||
@property BigInt toBint() const pure /*nothrow*/ {
|
||||
@property BigInt toBint() const pure nothrow {
|
||||
return reduce!((y, x) => x + 3 * y)(0.BigInt, digits.retro);
|
||||
}
|
||||
|
||||
|
|
@ -139,6 +139,6 @@ void main() {
|
|||
immutable c = BalancedTernary("+-++-");
|
||||
writeln("c: ", c.toBint, ' ', c);
|
||||
|
||||
immutable r = a * (b - c);
|
||||
const /*immutable*/ r = a * (b - c);
|
||||
writeln("a * (b - c): ", r.toBint, ' ', r);
|
||||
}
|
||||
|
|
|
|||
90
Task/Balanced-ternary/Icon/balanced-ternary.icon
Normal file
90
Task/Balanced-ternary/Icon/balanced-ternary.icon
Normal file
|
|
@ -0,0 +1,90 @@
|
|||
procedure main()
|
||||
a := "+-0++0+"
|
||||
write("a = +-0++0+"," = ",cvtFromBT("+-0++0+"))
|
||||
write("b = -436 = ",b := cvtToBT(-436))
|
||||
c := "+-++-"
|
||||
write("c = +-++- = ",cvtFromBT("+-++-"))
|
||||
d := mul(a,sub(b,c))
|
||||
write("a(b-c) = ",d," = ",cvtFromBT(d))
|
||||
end
|
||||
|
||||
procedure bTrim(s)
|
||||
return s[upto('+-',s):0] | "0"
|
||||
end
|
||||
|
||||
procedure cvtToBT(n)
|
||||
if n=0 then return "0"
|
||||
if n<0 then return map(cvtToBT(-n),"+-","-+")
|
||||
return bTrim(case n%3 of {
|
||||
0: cvtToBT(n/3)||"0"
|
||||
1: cvtToBT(n/3)||"+"
|
||||
2: cvtToBT((n+1)/3)||"-"
|
||||
})
|
||||
end
|
||||
|
||||
procedure cvtFromBT(n)
|
||||
sum := 0
|
||||
i := -1
|
||||
every c := !reverse(n) do {
|
||||
sum +:= case c of {
|
||||
"+" : 1
|
||||
"-" : -1
|
||||
"0" : 0
|
||||
}*(3^(i+:=1))
|
||||
}
|
||||
return sum
|
||||
end
|
||||
|
||||
procedure neg(n)
|
||||
return map(n,"+-","-+")
|
||||
end
|
||||
|
||||
procedure add(a,b)
|
||||
if *b > *a then a :=: b
|
||||
b := repl("0",*a-*b)||b
|
||||
c := "0"
|
||||
sum := ""
|
||||
every place := 1 to *a do {
|
||||
ds := addDigits(a[-place],b[-place],c)
|
||||
c := if *ds > 1 then c := ds[1] else "0"
|
||||
sum := ds[-1]||sum
|
||||
}
|
||||
return bTrim(c||sum)
|
||||
end
|
||||
|
||||
procedure addDigits(a,b,c)
|
||||
sum1 := addDigit(a,b)
|
||||
sum2 := addDigit(sum1[-1],c)
|
||||
if *sum1 = 1 then return sum2
|
||||
if *sum2 = 1 then return sum1[1]||sum2
|
||||
return sum1[1]
|
||||
end
|
||||
|
||||
procedure addDigit(a,b)
|
||||
return case(a||b) of {
|
||||
"00"|"0+"|"0-": b
|
||||
"+0"|"-0" : a
|
||||
"++" : "+-"
|
||||
"+-"|"-+" : "0"
|
||||
"--" : "-+"
|
||||
}
|
||||
end
|
||||
|
||||
procedure sub(a,b)
|
||||
return add(a,neg(b))
|
||||
end
|
||||
|
||||
procedure mul(a,b)
|
||||
if b[1] == "-" then {
|
||||
b := neg(b)
|
||||
negate := "yes"
|
||||
}
|
||||
b := cvtFromBT(b)
|
||||
i := "+"
|
||||
mul := "0"
|
||||
while cvtFromBT(i) <= b do {
|
||||
mul := add(mul,a)
|
||||
i := add(i,"+")
|
||||
}
|
||||
return (\negate,map(mul,"+-","-+")) | mul
|
||||
end
|
||||
122
Task/Balanced-ternary/PicoLisp/balanced-ternary.l
Normal file
122
Task/Balanced-ternary/PicoLisp/balanced-ternary.l
Normal file
|
|
@ -0,0 +1,122 @@
|
|||
(seed (in "/dev/urandom" (rd 8)))
|
||||
|
||||
(setq *G '((0 -1) (1 -1) (-1 0) (0 0) (1 0) (-1 1) (0 1)))
|
||||
|
||||
# For humans
|
||||
(de negh (L)
|
||||
(mapcar
|
||||
'((I)
|
||||
(case I
|
||||
(- '+)
|
||||
(+ '-)
|
||||
(T 0) ) )
|
||||
L ) )
|
||||
|
||||
(de trih (X)
|
||||
(if (num? X)
|
||||
(let (S (lt0 X) X (abs X) R NIL)
|
||||
(if (=0 X)
|
||||
(push 'R 0)
|
||||
(until (=0 X)
|
||||
(push 'R
|
||||
(case (% X 3)
|
||||
(0 0)
|
||||
(1 '+)
|
||||
(2 (inc 'X) '-) ) )
|
||||
(setq X (/ X 3)) ) )
|
||||
(if S (pack (negh R)) (pack R)) )
|
||||
(let M 1
|
||||
(sum
|
||||
'((C)
|
||||
(prog1
|
||||
(unless (= C "0") ((intern C) M))
|
||||
(setq M (* 3 M)) ) )
|
||||
(flip (chop X)) ) ) ) )
|
||||
|
||||
# For robots
|
||||
(de neg (L)
|
||||
(mapcar
|
||||
'((I)
|
||||
(case I (-1 1) (1 -1) (T 0)) )
|
||||
L ) )
|
||||
|
||||
(de tri (X)
|
||||
(if (num? X)
|
||||
(let (S (lt0 X) X (abs X) R NIL)
|
||||
(if (=0 X)
|
||||
(push 'R 0)
|
||||
(until (=0 X)
|
||||
(push 'R
|
||||
(case (% X 3)
|
||||
(0 0)
|
||||
(1 1)
|
||||
(2 (inc 'X) (- 1)) ) )
|
||||
(setq X (/ X 3)) ) )
|
||||
(flip (if S (neg R) R)) )
|
||||
(let M 1
|
||||
(sum
|
||||
'((C)
|
||||
(prog1 (* C M) (setq M (* 3 M))) )
|
||||
X ) ) ) )
|
||||
|
||||
(de add (D1 D2)
|
||||
(let
|
||||
(L (max (length D1) (length D2))
|
||||
D1 (need (- L) D1 0)
|
||||
D2 (need (- L) D2 0)
|
||||
C 0 )
|
||||
(mapcon
|
||||
'((L1 L2)
|
||||
(let R
|
||||
(get
|
||||
*G
|
||||
(+ 4 (+ (car L1) (car L2) C)) )
|
||||
(ifn (cdr L1)
|
||||
R
|
||||
(setq C (cadr R))
|
||||
(cons (car R)) ) ) )
|
||||
D1
|
||||
D2 ) ) )
|
||||
|
||||
(de mul (D1 D2)
|
||||
(ifn (and D1 D2)
|
||||
0
|
||||
(add
|
||||
(case (car D1)
|
||||
(0 0)
|
||||
(1 D2)
|
||||
(-1 (neg D2)) )
|
||||
(cons 0 (mul (cdr D1) D2) ) ) ) )
|
||||
|
||||
(de sub (D1 D2)
|
||||
(add D1 (neg D2)) )
|
||||
|
||||
# Random testing
|
||||
(let (X 0 Y 0 C 2048)
|
||||
(do C
|
||||
(setq
|
||||
X (rand (- C) C)
|
||||
Y (rand (- C) C) )
|
||||
(test X (trih (trih X)))
|
||||
(test X (tri (tri X)))
|
||||
(test
|
||||
(+ X Y)
|
||||
(tri (add (tri X) (tri Y))) )
|
||||
(test
|
||||
(- X Y)
|
||||
(tri (sub (tri X) (tri Y))) )
|
||||
(test
|
||||
(* X Y)
|
||||
(tri (mul (tri X) (tri Y))) ) ) )
|
||||
|
||||
(println 'A (trih 523) (trih "+-0++0+"))
|
||||
(println 'B (trih -436) (trih "-++-0--"))
|
||||
(println 'C (trih 65) (trih "+-++-"))
|
||||
(let R
|
||||
(tri
|
||||
(mul
|
||||
(tri (trih "+-0++0+"))
|
||||
(sub (tri -436) (tri (trih "+-++-"))) ) )
|
||||
(println 'R (trih R) R) )
|
||||
|
||||
(bye)
|
||||
Loading…
Add table
Add a link
Reference in a new issue