75 lines
2.4 KiB
Racket
75 lines
2.4 KiB
Racket
#lang racket
|
||
|
||
;; Represent a balanced-ternary number as a list of 0's, 1's and -1's.
|
||
;;
|
||
;; e.g. 11 = 3^2 + 3^1 - 3^0 ~ "++-" ~ '(-1 1 1)
|
||
;; 6 = 3^2 - 3^1 ~ "+-0" ~ '(0 -1 1)
|
||
;;
|
||
;; Note: the list-rep starts with the least signifcant tert, while
|
||
;; the string-rep starts with the most significsnt tert.
|
||
|
||
(define (bt->integer t)
|
||
(if (null? t)
|
||
0
|
||
(+ (first t) (* 3 (bt->integer (rest t))))))
|
||
|
||
(define (integer->bt n)
|
||
(letrec ([recur (λ (b r) (cons b (convert (floor (/ r 3)))))]
|
||
[convert (λ (n) (if (zero? n) null
|
||
(case (modulo n 3)
|
||
[(0) (recur 0 n)]
|
||
[(1) (recur 1 n)]
|
||
[(2) (recur -1 (add1 n))])))])
|
||
(convert n)))
|
||
|
||
(define (bt->string t)
|
||
(define (strip-leading-zeroes a)
|
||
(if (or (null? a) (not (= (first a) 0))) a (strip-leading-zeroes (rest a))))
|
||
(string-join (map (λ (u)
|
||
(case u
|
||
[(1) "+"]
|
||
[(-1) "-"]
|
||
[(0) "0"]))
|
||
(strip-leading-zeroes (reverse t))) ""))
|
||
|
||
(define (string->bt s)
|
||
(reverse
|
||
(map (λ (c)
|
||
(case c
|
||
[(#\+) 1]
|
||
[(#\-) -1]
|
||
[(#\0) 0]))
|
||
(string->list s))))
|
||
|
||
(define (bt-negate t)
|
||
(map (λ (u) (- u)) t))
|
||
|
||
(define (bt-add a b [c 0])
|
||
(cond [(and (null? a) (null? b)) (if (zero? c) null (list c))]
|
||
[(null? b) (if (zero? c) a (bt-add a (list c)))]
|
||
[(null? a) (bt-add b a c)]
|
||
[else (let* ([t (+ (first a) (first b) c)]
|
||
[carry (if (> (abs t) 1) (sgn t) 0)]
|
||
[v (case (abs t)
|
||
[(3) 0]
|
||
[(2) (- (sgn t))]
|
||
[else t])])
|
||
(cons v (bt-add (rest a) (rest b) carry)))]))
|
||
|
||
(define (bt-multiply a b)
|
||
(cond [(null? a) null]
|
||
[(null? b) null]
|
||
[else (bt-add (case (first a)
|
||
[(-1) (bt-negate b)]
|
||
[(0) null]
|
||
[(1) b])
|
||
(cons 0 (bt-multiply (rest a) b)))]))
|
||
|
||
; test case
|
||
(let* ([a (string->bt "+-0++0+")]
|
||
[b (integer->bt -436)]
|
||
[c (string->bt "+-++-")]
|
||
[d (bt-multiply a (bt-add b (bt-negate c)))])
|
||
(for ([bt (list a b c d)]
|
||
[description (list 'a 'b 'c "a×(b−c)")])
|
||
(printf "~a = ~a or ~a\n" description (bt->integer bt) (bt->string bt))))
|