Number/Ternary.bruijn

# MIT License, Copyright (c) 2022 Marvin Borner
# inspiration from T.Æ. Mogensen and Douglas W. Jones (see refs in README)
# → refer to std/Math for more advanced functions

:import std/Box B
:import std/Combinator .
:import std/Logic .
:import std/Pair .

# negative trit indicating coefficient of (-1)
t⁻ [[[2]]] ⧗ Trit

# positive trit indicating coefficient of (+1)
t⁺ [[[1]]] ⧗ Trit

# zero trit indicating coefficient of 0
t⁰ [[[0]]] ⧗ Trit

# returns true if a trit is negative
t⁻? [0 true false false] ⧗ Trit → Boolean

:test (t⁻? t⁻) (true)
:test (t⁻? t⁺) (false)
:test (t⁻? t⁰) (false)

# returns true if a trit is positive
t⁺? [0 false true false] ⧗ Trit → Boolean

:test (t⁺? t⁻) (false)
:test (t⁺? t⁺) (true)
:test (t⁺? t⁰) (false)

# returns true if a trit is zero
t⁰? [0 false false true] ⧗ Trit → Boolean

:test (t⁰? t⁻) (false)
:test (t⁰? t⁺) (false)
:test (t⁰? t⁰) (true)

# lshifts a negative trit into a balanced ternary number
↑⁻‣ [[[[[2 (4 3 2 1 0)]]]]] ⧗ Number → Number

:test (↑⁻(+0)) ((-1))
:test (↑⁻(-1)) ((-4))
:test (↑⁻(+42)) ((+125))

# lshifts a positive trit into a balanced ternary number
↑⁺‣ [[[[[1 (4 3 2 1 0)]]]]] ⧗ Number → Number

:test (↑⁺(+0)) ((+1))
:test (↑⁺(-1)) ((-2))
:test (↑⁺(+42)) ((+127))

# lshifts a zero trit into a balanced ternary number
↑⁰‣ [[[[[0 (4 3 2 1 0)]]]]] ⧗ Number → Number

:test (↑⁰(+0)) ([[[[0 3]]]])
:test (↑⁰(+1)) ((+3))
:test (↑⁰(+42)) ((+126))

# lshifts a specified trit into a balanced ternary number
…↑… [[[[[[5 2 1 0 (4 3 2 1 0)]]]]]] ⧗ Trit → Number → Number

:test (t⁻ ↑ (+42)) (↑⁻(+42))
:test (t⁺ ↑ (+42)) (↑⁺(+42))
:test (t⁰ ↑ (+42)) (↑⁰(+42))

# lshifts balanced ternary number without pushing new trit
# basically removes mst or leading 0
←‣ [^(0 z a⁻ a⁺ a⁰)] ⧗ Number → Number
	z (+0) : true
	a⁻ &[[(0 (+0) ↑⁻1) : false]]
	a⁺ &[[(0 (+0) ↑⁺1) : false]]
	a⁰ &[[(0 (+0) ↑⁰1) : false]]

:test (←(+3)) ([[[[0 3]]]])
:test (←(+5)) ([[[[2 (2 3)]]]])

# rshifts a zero trit into a balanced ternary number (pad)
→⁰‣ [[[[[4 (0 3) 2 1 0]]]]] ⧗ Number → Number

# rshifts least significant trit of a balanced ternary number
# WARNING: Not necessarily equivalent to (/ (+3)): e.g. /³(+5) == (+2)!
div³ [~(0 z a⁻ a⁺ a⁰)] ⧗ Number → Number
	z (+0) : (+0)
	a⁻ &[[↑⁻1 : 1]]
	a⁺ &[[↑⁺1 : 1]]
	a⁰ &[[↑⁰1 : 1]]

/³‣ div³

:test (/³(+6)) ((+2))
:test (/³(-6)) ((-2))
:test (/³(+5)) ((+2))

# extracts least significant trit from a balanced ternary number
lst [0 t⁰ [t⁻] [t⁺] [t⁰]] ⧗ Number → Trit

:test (lst (-1)) (t⁻)
:test (lst (+0)) (t⁰)
:test (lst (+1)) (t⁺)
:test (lst (+42)) (t⁰)

# extracts most significant trit from a balanced ternary number
mst* [B.get t⁰ (0 z a⁻ a⁺ a⁰)] ⧗ Number → Trit
	z B.empty
	a⁻ \B.store! t⁻
	a⁺ \B.store! t⁺
	a⁰ \B.store! t⁰

:test (mst* (-1)) (t⁻)
:test (mst* (+0)) (t⁰)
:test (mst* (+1)) (t⁺)
:test (mst* (+42)) (t⁺)
:test (mst* [[[[(0 (1 (0 3)))]]]]) (t⁰)

# extracts most significant trit from a balanced ternary number
# ignores leading 0s
mst [B.get t⁰ (0 z a⁻ a⁺ a⁰)] ⧗ Number → Trit
	z B.empty
	a⁻ \B.store! t⁻
	a⁺ \B.store! t⁺
	a⁰ [0]

:test (mst (-1)) (t⁻)
:test (mst (+0)) (t⁰)
:test (mst (+1)) (t⁺)
:test (mst (+42)) (t⁺)

# returns true if balanced ternary number is zero
zero? [0 true [false] [false] i] ⧗ Number → Boolean

=?‣ zero?

:test (=?(+0)) (true)
:test (=?(-1)) (false)
:test (=?(+1)) (false)
:test (=?(+42)) (false)

# returns true if the number is even (remainder mod 2 == 0)
# TODO: faster solution (using tupling?)
even? z [[rec]] ⧗ Number → Boolean
	rec =?0 case-end case-rec
		case-rec t⁰? (lst 0) (1 /³0) ¬(1 /³0)
		case-end true

=²?‣ even?

:test (=²?(+0)) (true)
:test (=²?(+1)) (false)
:test (=²?(+41)) (false)
:test (=²?(+42)) (true)

# converts the normal balanced ternary representation into abstract
# infinity can't be abstracted in finite time
# → the abstract representation is used in eq?/add/sub/mul
abstract! [0 z a⁻ a⁺ a⁰] ⧗ Number → AbstractNumber
	z (+0)
	a⁻ [[[[[2 4]]]]]
	a⁺ [[[[[1 4]]]]]
	a⁰ [[[[[0 4]]]]]

→^‣ abstract!

:test (→^(-3)) ([[[[0 [[[[2 [[[[3]]]]]]]]]]]])
:test (→^(+0)) ([[[[3]]]])
:test (→^(+3)) ([[[[0 [[[[1 [[[[3]]]]]]]]]]]])

# converts the abstracted balanced ternary representation back to normal
normal! y [[0 z a⁻ a⁺ a⁰]] ⧗ AbstractNumber → Number
	z (+0)
	a⁻ [↑⁻(2 0)]
	a⁺ [↑⁺(2 0)]
	a⁰ [↑⁰(2 0)]

→_‣ normal!

:test (→_[[[[3]]]]) ((+0))
:test (→_(→^(+42))) ((+42))
:test (→_(→^(-42))) ((-42))

# returns true if two balanced ternary numbers are equal
# → ignores leading 0s!
eq? [[abs 1 →^0]] ⧗ Number → Number → Boolean
	abs [0 z a⁻ a⁺ a⁰]
		z [=?(→_0)]
		a⁻ [[0 false [2 0] [false] [false]]]
		a⁺ [[0 false [false] [2 0] [false]]]
		a⁰ [[0 (1 0) [false] [false] [2 0]]]

…=?… eq?

# adds (+1) to a balanced ternary number (can introduce leading 0s)
inc [~(0 z a⁻ a⁺ a⁰)] ⧗ Number → Number
	z (+0) : (+1)
	a⁻ &[[↑⁻1 : ↑⁰1]]
	a⁺ &[[↑⁺1 : ↑⁻0]]
	a⁰ &[[↑⁰1 : ↑⁺1]]

++‣ inc

:test (++(-42) =? (-41)) (true)
:test (++(-1) =? (+0)) (true)
:test (++(+0) =? (+1)) (true)
:test (++(++(++(++(++(+0))))) =? (+5)) (true)
:test (++(+42) =? (+43)) (true)

# subtracts (+1) from a balanced ternary number (can introduce leading 0s)
dec [~(0 z a⁻ a⁺ a⁰)] ⧗ Number → Number
	z (+0) : (-1)
	a⁻ &[[↑⁻1 : ↑⁺0]]
	a⁺ &[[↑⁺1 : ↑⁰1]]
	a⁰ &[[↑⁰1 : ↑⁻1]]

--‣ dec

:test (--(-42) =? (-43)) (true)
:test (--(+0) =? (-1)) (true)
:test (--(--(--(--(--(+5))))) =? (+0)) (true)
:test (--(+1) =? (+0)) (true)
:test (--(+42) =? (+41)) (true)

# adds two balanced ternary numbers (can introduce leading 0s)
add [[abs 1 →^0]] ⧗ Number → Number → Number
	abs [c (0 z a⁻ a⁺ a⁰)]
		b⁻ [1 ↑⁺(3 0 t⁻) ↑⁰(3 0 t⁰) ↑⁻(3 0 t⁰)]
		b⁰ [1 ↑ (3 0 t⁰)]
		b⁺ [1 ↑⁰(3 0 t⁰) ↑⁻(3 0 t⁺) ↑⁺(3 0 t⁰)]
		a⁻ [[[1 (b⁻ 1) b⁻' b⁰ b⁻]]]
			b⁻' [1 ↑⁰(3 0 t⁻) ↑⁻(3 0 t⁰) ↑⁺(3 0 t⁻)]
		a⁺ [[[1 (b⁺ 1) b⁰ b⁺' b⁺]]]
			b⁺' [1 ↑⁺(3 0 t⁰) ↑⁰(3 0 t⁺) ↑⁻(3 0 t⁺)]
		a⁰ [[[1 (b⁰ 1) b⁻ b⁺ b⁰]]]
		z [[0 --(→_1) ++(→_1) →_1]]
		c [[1 0 t⁰]]

…+… add

:test ((-42) + (-1) =? (-43)) (true)
:test ((-5) + (+6) =? (+1)) (true)
:test ((-1) + (+0) =? (-1)) (true)
:test ((+0) + (+0) =? (+0)) (true)
:test ((+1) + (+2) =? (+3)) (true)
:test ((+42) + (+1) =? (+43)) (true)

# returns true if balanced ternary number is negative
negative? t⁻? ∘ mst ⧗ Number → Boolean

<?‣ negative?

:test (<?(+0)) (false)
:test (<?(-1)) (true)
:test (<?(+1)) (false)
:test (<?(+42)) (false)

# returns true if balanced ternary number is positive
positive? t⁺? ∘ mst ⧗ Number → Boolean

>?‣ positive?

:test (>?(+0)) (false)
:test (>?(-1)) (false)
:test (>?(+1)) (true)
:test (>?(+42)) (true)

# negates a balanced ternary number
negate [[[[[4 3 1 2 0]]]]] ⧗ Number → Number

-‣ negate

:test (-(+0)) ((+0))
:test (-(-1)) ((+1))
:test (-(+42)) ((-42))

# subtracts two numbers
sub [[1 + -0]] ⧗ Number → Number → Number

…-… sub

# returns true if number is greater than other number
gt? positive? ∘∘ sub ⧗ Number → Number → Boolean

…>?… gt?

:test ((+1) >? (+2)) (false)
:test ((+2) >? (+2)) (false)
:test ((+3) >? (+2)) (true)

# returns eq, gt, lt depending on comparison of two numbers
compare-case [[[[[go (1 - 0)]]]]] ⧗ a → b → c → Number → Number → d
	go [=?0 5 (>?0 4 3)]

# ============================================================================ #
# most relevant functions are defined - we can now derive from Generic/Number! #
# ============================================================================ #

:input std/Generic/Number

# converts a balanced ternary number to a list of trits
number→trits [0 z a⁻ a⁺ a⁰] ⧗ Number → (List Trit)
	z [[0]]
	a⁻ pair t⁻
	a⁺ pair t⁺
	a⁰ pair t⁰

:test (number→trits (+0)) ([[0]])
:test (number→trits (+5)) (t⁻ : (t⁻ : (t⁺ : [[0]])))

# strips leading 0s from a balanced ternary number
strip [^(0 z a⁻ a⁺ a⁰)] ⧗ Number → Number
	z (+0) : true
	a⁻ &[[↑⁻1 : false]]
	a⁺ &[[↑⁺1 : false]]
	a⁰ &[[(0 (+0) ↑⁰1) : 0]]

%‣ strip

:test (%[[[[0 3]]]]) ((+0))
:test (%[[[[2 (0 (0 (0 (0 3))))]]]]) ((-1))
:test (%(+42)) ((+42))

# negates a balanced ternary number if <0
abs [<?0 -0 0] ⧗ Number → Number

|‣ abs

:test (|(+0)) ((+0))
:test (|(-1)) ((+1))
:test (|(+42)) ((+42))

# applies a function n times to a value
# ~> substitute church numbers
apply z [[[rec]]] ⧗ Number → (a → a) → a → a
	rec =?1 case-end case-apply
		case-apply 0 ∘ (2 --1 0)
		case-end i

:test (apply (+5) ++‣ (+3)) ((+8))

# multplies two balanced ternary numbers (can introduce leading 0s)
mul [[1 z a⁻ a⁺ a⁰]] ⧗ Number → Number → Number
	z (+0)
	a⁻ [↑⁰0 - 1]
	a⁺ [↑⁰0 + 1]
	a⁰ [↑⁰0]

…⋅… mul

:test ((+42) ⋅ (+0) =? (+0)) (true)
:test ((-1) ⋅ (+42) =? (-42)) (true)
:test ((+3) ⋅ (+11) =? (+33)) (true)
:test ((+42) ⋅ (-4) =? (-168)) (true)

# divs a balanced ternary number by two (binary >>1)
div² [z [[[[rec]]]] (+0) 0 0] ⧗ Number → Number
	rec =?1 case-end case-div
		case-div 3 /³(2 + 0) /³1 0
		case-end 2

/²‣ div²

:test (/²(+6) =? (+3)) (true)
:test (/²(-6) =? (-3)) (true)
:test (/²(+5) =? (+2)) (true)

# divs a balanced ternary number by three by fixing rshift
/³*‣ [fix /³0]
	fix [/²(1 - 0)]

:test (/³*(+6) =? (+2)) (true)
:test (/³*(-6) =? (-2)) (true)
:test (/³*(+5) =? (+1)) (true)

# ceiled integer log₃ by counting number of trits
# also counts leading 0s
log₃* [0 (+0) inc inc inc] ⧗ Number → Number

# ceiled integer log₃ by counting number of trits
log₃ log₃* ∘ strip ⧗ Number → Number

:test (log₃ (+0)) ((+0))
:test (log₃ (+5)) ((+3))
:test (log₃ (+42)) ((+5))

# amount of non-zero trits
hamming-weight [0 (+0) inc inc [0]] ⧗ Number → Number

:test ((hamming-weight (+5)) =? (+3)) (true)
:test ((hamming-weight (+6)) =? (+2)) (true)

# returns the smallest number in a range such that a predicate is true
binary-search z [[[[rec]]]] ⧗ (Number → Boolean) → Number → Number → Number
	rec (0 =? 1) case-end case-search
		case-search go /²(0 + 1)
			go [3 0 (4 3 2 0) (4 3 ++0 1)]
		case-end 0

:test (binary-search [(0 ⋅ 0) >? (+150)] (+0) (+100)) ((+13))

# returns the maximum of a unimodal function in a specified domain
ternary-search z [[[[rec]]]] ⧗ (Number → Number) → Number → Number → Number
	rec (1 =? 0) case-end case-search
		case-search go (1 + /³*(0 - 1)) (0 - /³*(0 - 1))
			call [=?0 (6 5 ++2 --1) (>?0 (6 5 4 --1) (6 5 ++2 3))]
			go [[call ((4 1) - (4 0))]]
		case-end 0

:test ((ternary-search [-((0 - (+3)) ⋅ (0 - (+3)))] (+0) (+5)) =? (+3)) (true)

# pads a ternary number with 0s until it's as long a another ternary number
pad y [[[(log₃* 0) <? (log₃* 1) (2 1 →⁰0) 0]]] ⧗ Number → Number → Number

# forces number to be exactly n trits long (either pad/trim)
force [[[0 <? 2 pad trim] (log₃* 0)]] ⧗ Number → Number
	pad z [[[=?1 0 (2 --1 →⁰0)]]] (2 - 0) 1
	trim z [[[=?1 0 (2 --1 ←0)]]] (0 - 2) 1

# lshifts after concat, given trit count
# TODO: reduce force
double-shift [[[[[left : right]] (force 2 1) (force 2 0)]]]
	left force 4 ((mst* 0) ↑ (+0) + (↑⁰1))
	right force 4 ↑⁰0

# "efficient" quotient/remainder implementation for balanced ternary
# technique by Douglas W. Jones
# algorithm originally intended for fixed-width numbers (=> ugly hacks with force+log₃)
# TODO: remove the final `huh` correction step (probably some off-by-one bug?)
# TODO: not actually that efficient right now
quot-rem [[[[[z [[[[rec]]]] 1 (+0) 4]]] <?0 (max (log₃ 1) (log₃ 0)) 0]] ⧗ Number → Number → (Pair Number Number)
	rec =?2 huh (double-shift 5 1 0 [[compare-case eq gt lt 1 (+0)]])
		huh (>?1 ⋀? 6) ⋁? (<?1 ⋀? \6) (--0 : (1 + 7)) (0 : 1)
		eq 5 --4 1 0
		gt [-0 <? 2 ⋁? (-0 =? 2 ⋀? >?1) fix (6 --5 2 1)] (8 add sub 1 6)
			fix 6 --5 0 (9 dec inc 1)
		lt [-0 >? 2 ⋁? (-0 =? 2 ⋀? <?1) fix (6 --5 2 1)] (8 sub add 1 6)
			fix 6 --5 0 (9 inc dec 1)

# finds quotient and remainder using binary search
# TODO: fix for numbers <=1 (case analysis, q,r<0)
quot-rem* [[go --(binary-search [0 ⋅ 1 >? 2] (+0) 1)]] ⧗ Number → Number → (Pair Number Number)
	go [0 : (2 - (1 ⋅ 0))]

# divs two balanced ternary numbers
div ^‣ ∘∘ quot-rem ⧗ Number → Number → Number

…/… div

:test ((+42) / (+4) =? (+10)) (true)
:test ((+5) / (+3) =? (+1)) (true)
:test ((-5) / (-3) =? (+1)) (true)
:test ((-5) / (+3) =? (-2)) (true)
:test ((+5) / (-3) =? (-2)) (true)

# bad mod implementation using repeated subtraction
mod* z [[[rec]]] ⧗ Number → Number → Number
	rec [=?0 0 (<?0 2 (3 0 1))] (1 - 0)

# returns remainder of integer division
mod ~‣ ∘∘ quot-rem ⧗ Number → Number → Number

…%… mod

:test ((+42) % (+4) =? (+2)) (true)
:test ((+7) % (+3) =? (+1)) (true)
:test ((+8) % (+2) =? (+0)) (true)
:test ((+5) % (+3) =? (+2)) (true)
:test ((-5) % (-3) =? (-2)) (true)
:test ((-5) % (+3) =? (+1)) (true)
:test ((+5) % (-3) =? (-1)) (true)