How to resolve the algorithm Balanced ternary step by step in the Factor programming language

Published on 12 May 2024 09:40 PM
#Factor

How to resolve the algorithm Balanced ternary step by step in the Factor programming language

Table of Contents

Problem Statement

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.

Decimal 11 = 32 + 31 − 30, thus it can be written as "++−" Decimal 6 = 32 − 31 + 0 × 30, thus it can be written as "+−0"

Implement balanced ternary representation of integers with the following:

Test case With balanced ternaries a from string "+-0++0+", b from native integer -436, c "+-++-":

Note: The pages generalised floating point addition and generalised floating point multiplication have code implementing arbitrary precision floating point balanced ternary.

Let's start with the solution:

Step by Step solution about How to resolve the algorithm Balanced ternary step by step in the Factor programming language

Source code in the factor programming language

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
]


a: 523, +-0++0+
b: -436, -++-0--
c: 65, +-++-
a*(b-c): -262023, ----0+--0++0

You may also check:How to resolve the algorithm Fractran step by step in the Perl programming language
You may also check:How to resolve the algorithm Square but not cube step by step in the JavaScript programming language
You may also check:How to resolve the algorithm Sum and product of an array step by step in the Tcl programming language
You may also check:How to resolve the algorithm Date format step by step in the AutoIt programming language
You may also check:How to resolve the algorithm Image noise step by step in the Java programming language