平衡三進数

まだまだ途中だけれど、とりあえず公開。 随時追記していきます。

ternary.lhs

> bt x = tail.fromJust.find ((0==).head) $ iterate (\(x:ts) -> div (x + 1) 3 : mod (x + 1) 3 - 1 : ts) [x]

掛け算

0 を掛けると 0 になり、符号の異なる trit を掛け合わせると -1、同符号の trit 同士を掛け合わせると 1 になる。
あるいは 0 を掛ければ 0、 1 を掛けたら符号は保存され、 -1 を掛けたら符号が反転すると考えてもいい。

* -1 0 1
-1 1 0 -1
0 0 0 0
1 -1 0 1

足し算

1 と 1 を足したときと、 -1 と -1 とを足したときが特殊で、それ以外はわかりやすい。
1 + 1 は 10 進数で考えると 2 になる。 しかし平衡三進数での trit は -1, 0, 1 の三つの記号しかなく、 2 は表現できない。 こういう場合、 {... 0, 1, -1, 0, 1, -1 ...} という無限の繰り返しがあると考えて、 1 の次は -1 に戻り、そして繰り上がり (carry) があると考える。 同様に -1 のひとつ前は、上の位から桁借り (borrow) して 1 に戻ると考える。

+ -1 0 1
-1 1b -1 0
0 -1 0 1
1 0 1 -1c

キャリー付き足し算

下の桁からの繰り上がりがある場合の足し算は次のとおり。 足し算の表全体に +1 したのと同じになる。

+c -1 0 1
-1 -1 0 1
0 0 1 -1c
1 1 -1c 0c

ボロウ付き足し算

下の桁から桁借りされていた場合は、足し算の表全体に -1 を加えた表になる。

+b -1 0 1
-1 0b 1b -1
0 1b -1 0
1 -1 0 1

加算器の実装

先の表をもとに haskell で足し算を実装する。

ternary.lhs

> module Ternary  where
> import Maybe

三進数のデータ型 Trit の宣言。
Trit の値 N, Z, P はそれぞれ -1, 0, 1 に相当します。

> data Trit = N | Z | P  deriving (Show, Eq)

足し算をしたときに生じるキャリーとボローをあらわすデータ型 Carry の宣言。
キャリー・ボローともに発生しないこともあるため、計算では Maybe Carry を
使い、キャリーは Just C、ボローは Just B、いずれもなければ Nothing で
表現します。

> data Carry = B | C  deriving Show

半加算器 hadd の定義。
ふたつの Trit を足した値と、キャリー(あるいはボロー)の組を返します。

> hadd N N = (P, Just B)
> hadd P P = (N, Just C)
> hadd Z t = (t, Nothing)
> hadd t Z = (t, Nothing)
> hadd _ _ = (Z, Nothing)

半加算器を使って全加算器を組み立てます。
引数は順に、被加数、加数、そしてキャリー(あるいはボロー)です。

> fadd t u Nothing = hadd t u
> fadd N N (Just C) = (N, Nothing)
> fadd P P (Just C) = (Z, Just C)
> fadd a b (Just C) = hadd P (fst $ hadd a b)
> fadd N N (Just B) = (Z, Just B)
> fadd P P (Just B) = (P, Nothing)
> fadd a b (Just B) = hadd N (fst $ hadd a b)


全加算器をつかって任意桁の加算器を定義します。
下の桁から順に足したいので被加数 ts と加数 us をそれぞれ reverse し、
補助関数 aux をつかって和を計算します。
最後に結果列の上位桁にある連続した Z を rmZ で削除します。

> add ts us = rmZ $ aux (reverse ts) (reverse us) Nothing  where

補助関数 aux は最下位桁から順にキャリーつきで Trit を足していきます。
最下位桁同士を全加算器で足し、値をその桁の Trit に、キャリーは
上位桁の和の計算に渡して再帰的に計算をすすめ、すべての桁がなくなる
までつづけます。途中で片方の桁が不足したら Z を補って計算を続行します。

>  aux [] [] c = return.fst $ fadd Z Z c
>  aux ts [] c = aux ts [Z] c
>  aux [] us c = aux us [Z] c
>  aux (t:ts) (u:us) c = let (v, c') = fadd t u c  in  aux ts us c' ++ [v]

上位桁の連続する Z を取り除く rmZ は…おそらくたぶん、 nub のような
関数で処理できるんでしょうけれど再帰処理で書きくだしました。(手抜き)

>  rmZ [] = []
>  rmZ (Z:ts) = rmZ ts
>  rmZ ts = ts

10進整数と平衡三進数との相互変換

ここで任意の 10 進整数から平衡三進数を求める方法と、その逆変換とを定義してみる。
以下、ソースコードは先の ternary.lhs に続くものとする。

リストで平衡三進数を表現するため、 List モジュールをインポートします。
(import 宣言は Maybe モジュールのインポートの直後に必要です。つづくと言った直後なのに…)

> import List

...

ある整数 z を balanced ternary に変換する式はこう定義できます。

> bt z = snd.fromJust.find ((0==).fst).iterate aux $ (z, [])  where
>  aux (x, ts) = (q, [N,Z,P]!!r : ts)  where (q, r) = (div (x+1) 3, mod (x+1) 3)

また balanced ternary から整数 z への変換はこう定義できます。

> toInt ts = foldl (\z t -> 3 * z + t) 0 (map conv ts)  where
>  conv N = -1
>  conv Z = 0
>  conv P = 1

ghci で ternary モジュールをロードすると、次のように整数から balanced ternary への変換を実験できる。

$ ghci ternary.lhs
*Ternary> bt 326
[P,P,Z,Z,P,N]
*Ternary> bt (-1024)
[N,N,N,P,Z,P,N]
*Ternary>

toInt も期待どおり動いている。

*Ternary> toInt . bt $ 1024
1024
*Ternary> toInt . bt $ (-65536)
-65536
*Ternary> toInt $ add (bt (-5000)) (bt 10000)
5000
*Ternary>

符号の反転

正の数を負の数に、負の数を正の数に変換する negate を定義する。
正と負の数を同じ表現の枠組みで扱えるところが魅力的。

符号を反転させる negate を定義します。

> negate ts = map neg ts  where
>  neg N = P
>  neg Z = Z
>  neg P = N

negate も試してみる。

*Ternary> Ternary.negate [P,Z,N]
[N,Z,P]
*Ternary> toInt . Ternary.negate . bt $ 256
-256
*Ternary>

negate は Prelude にも同名の関数があったため、完全修飾名で指定せねばならず、ちょっと不便。 なにかいい名前、ないかな…。

乗算の実装

掛け算は被乗数を乗数の数だけ繰り返して足す、というのがナイーブな実装だけれど、二進数と同様に平衡三進数でもシフト演算と和で実装できる。
乗数と被乗数の Trit の数を数えて、短い方を乗数に据えた方が計算は少なくてすむけれど、ここでは割愛。

左シフト演算は Trit 列の再右端に Z を追加する操作。
左に 1 Trit 分動かすことで、 Trit 列によって表される数は 3 倍になります。

> shl ts = ts ++ [Z]

乗算は xs を ys を構成する Trit で畳込んでいくことで表現できます。

> mult xs ys = foldl aux [] ys  where
>  aux ts P = add (shl ts) xs
>  aux ts Z = shl ts
>  aux ts N = add (shl ts) (Ternary.negate xs)

例によって ghci で動作確認。

*Ternary> toInt $ mult (bt 128) (bt 2)
256
*Ternary> toInt $ mult (bt 128) (bt 128)
16384
*Ternary> toInt $ mult (bt 256) (bt 256)
65536
*Ternary> toInt $ mult (bt 256) (bt (-256))
-65536

大小比較

大小比較に使う greater を定義する。

一方から他方を引いて、 0 でなく、かつ正の数になっていれば x > y が成り立つ。

> greater xs ys =
>  let ts = add xs (Ternary.negate ys) in (not.null) ts && P == head ts

こちらは少し丁寧に動作検証をしてみる。

*Ternary> :{
*Ternary| null.snd.partition id $
*Ternary|   [(x > y) == greater (bt x) (bt y) | x <- [-100..100], y <- [-100..100]]
*Ternary| :}
True
*Ternary>

これは何をしているかというと、 -100 から 100 までの値をとる x と y のすべての組み合わせについて、整数での大小比較結果 x > y と、平衡三進数での大小比較 greater (bt x) (bt y) の結果が同じであることの確認である。

リストは True か False の真偽値のみを含むことになる。 これを id 関数で partition し *1、その結果の組の二番目、つまり id 関数で False になった側が空列であることを確認しているわけだ。

符号確認

与えられた平衡三進数の符号を確認する関数の定義。

ゼロの符号は、符号なしということで Z を返すこととした。(あとで剰余算を実装するときの都合もある)

> sign [] = Z
> sign (t:_) = t

絶対値

絶対値の計算は、負の値の場合、値を構成する P と N を入れ替えることで実装できる。 値が負でなければもとの値のままでよい。

abs x@(N:_) = negate x
abs x = x

剰余算

まだ整理できていないけれど、とりあえず動くものを掲載。
divide x y は (div x y, mod x y) を返す。
この定義で x と y が、それぞれ正負のいずれの値を取っても計算できる。

> divide _ []  = error "divide by zero"
> divide x [P] = (x, [])
> divide x [N] = (negate x, [])
> divide x y   = qr x y zs
>  where
>   zs = take (length x - length y + 1) (repeat Z)
>   qr x y zs = case (mulT (sign x) (sign y)) of
>                N -> auxN x y zs
>                Z -> ([], [])
>                P -> auxP x y zs
>   auxP x y zs = let
>    y' = (negate y) ++ zs
>    x' = add x y'
>    in if greater (abs y') (abs x)
>    then if null zs then ([], x) else auxP x y (drop 1 zs)
>    else let (q, r) = qr x' y (drop 1 zs) in (add (P:zs) q, r)
>   auxN x y zs = let
>    y' = y ++ zs
>    x' = add x y'
>    in if greater (abs x') (abs y')
>    then if null zs then ([N], x') else auxN x y (drop 1 zs)
>    else let (q, r) = qr x' y (drop 1 zs) in (add (N:zs) q, r)
> mulT P P = P
> mulT P N = N
> mulT N P = N
> mulT N N = P
> mulT _ _ = Z

*1:たとえば partition id [True, False, True] は ([True, True], [False]) になる。