Challenge: https://rosettacode.org/wiki/Balanced_ternary
Translating: https://rosettacode.org/wiki/Balanced_ternary#Ruby
USING: kernel combinators locals formatting lint literals
sequences assocs strings arrays
math math.functions math.order ;
IN: rosetta-code.bt
CONSTANT: addlookup {
{ 0 CHAR: 0 }
{ 1 CHAR: + }
{ -1 CHAR: - }
}
<PRIVATE
: bt-add-digits ( a b c -- d e )
+ + 3 +
{ { 0 -1 } { 1 -1 } { -1 0 } { 0 0 } { 1 0 } { -1 1 } { 0 1 } }
nth first2
;
PRIVATE>
! Conversion
: bt>integer ( seq -- x ) 0 [ swap 3 * + ] reduce ;
: integer>bt ( x -- x ) [ dup zero? not ] [
dup 3 rem {
{ 0 [ 3 / 0 ] }
{ 1 [ 3 / round 1 ] }
{ 2 [ 1 + 3 / round -1 ] }
} case
] produce nip reverse
;
: bt>string ( seq -- str ) [ addlookup at ] map >string ;
: string>bt ( str -- seq ) [ addlookup value-at ] { } map-as ;
! Arithmetic
: bt-neg ( a -- -a ) [ neg ] map ;
:: bt-add ( u v -- w )
u v max-length :> maxl
u v [ maxl 0 pad-head reverse ] bi@ :> ( u v )
0 :> carry!
u v { } [ carry bt-add-digits carry! prefix ] 2reduce
carry prefix [ zero? ] trim-head
;
: bt-sub ( u v -- w ) bt-neg bt-add ;
:: bt-mul ( u v -- w ) u { } [
{
{ -1 [ v bt-neg ] }
{ 0 [ { } ] }
{ 1 [ v ] }
} case bt-add 0 suffix
] reduce
1 head*
;
[let
"+-0++0+" string>bt :> a
-436 integer>bt :> b
"+-++-" string>bt :> c
b c bt-sub a bt-mul :> d
"a" a bt>integer a bt>string "%s: %d, %s\n" printf
"b" b bt>integer b bt>string "%s: %d, %s\n" printf
"c" c bt>integer c bt>string "%s: %d, %s\n" printf
"a*(b-c)" d bt>integer d bt>string "%s: %d, %s\n" printf
]
! Use vocabulary tools.testest for testing.
! See https://github.com/codewars/testest
USING: rosetta-code.bt tools.testest ;
IN: rosetta-code.bt.tests
: run-tests ( -- )
"Conversion" describe#{
"bt>integer" it#{
<{ { 1 1 -1 } bt>integer -> 11 }>
<{ { 1 -1 0 } bt>integer -> 6 }>
}#
"integer>bt" it#{
<{ 11 integer>bt -> { 1 1 -1 } }>
<{ 6 integer>bt -> { 1 -1 0 } }>
}#
"bt>string" it#{
<{ { 1 1 -1 } bt>string -> "++-" }>
<{ { 1 -1 0 } bt>string -> "+-0" }>
}#
}#
"Arithmetic" describe#{
"addition" it#{
<{ { 1 -1 -1 } { 1 -1 0 } bt-add -> { 1 1 -1 } }>
}#
"subtraction" it#{
<{ { 1 -1 0 } { 1 -1 -1 } bt-sub -> { 1 } }>
}#
"multiplication" it#{
<{ { 1 -1 0 } { 1 -1 -1 } bt-mul -> { 1 0 1 0 } }>
}#
}#
;
MAIN: run-tests