Addition Chains as Polymorphic Higher-order Functions

May 25th, 2017

Previously in An Introduction & Supplement to Knuth's Introduction to Addition Chains we developed the AdditionChainConstruction module. Now we're going to develop the AdditionChainComputation module, which does the same things, but differently. AdditionChainConstruction requires us to construct explicit tree structures that then must be traversed by functions to calculate results. Yet an addition chain itself is a sort of a traversal. The structure of an addition chain can be encoded as a polymorphic function that acts as a fold over the doubles and (non-doubling) adds in the chain.

The new code is the module AdditionChainComputation in the file AdditionChainComputation.lhs. Once again, we'll avoid any language extensions (that aren't enabled by default in GHCi 8.0.1) and we'll only use library functions from the base package. If you compare this code to the previous code, you'll see that it is even simpler in that it doesn't even (directly) use type classes. This code is also more efficient; the denote function in this new module can easily handle large inputs that cause AdditionChainConstruction to choke.

module AdditionChainComputation(
  AdditionChain,
  _45,
  denote,
  r, d, f,
  λ, lambda, v,
  bitString, hexString,
  nth, andThen,
  bigNumber,
) where
import Data.Bits(popCount)
import Data.Char(intToDigit)
import Data.List(nub)
import Numeric(showHex, showIntAtBase)
import Numeric.Natural

We define an AdditionChain to be a function that, given double and add functions as arguments, along with a representation of the value one, evaluates double and add according to the structure of the addition chain, starting with the value one. All details of the concrete representation of values are completely abstracted away.

type AdditionChain a = (a -> a)      -- double
                    -> (a -> a -> a) -- add
                    -> a             -- one
                    -> a

Let's use this to create an efficient representation of 45:

_45 double add one =
  let
    __1 = one             --   given 1: 1
    __2 = double  __1     --  append 0: 10
    __4 = double  __2     --  append 0: 100
    __5 = add     __4 __1 --     add 1: 101
    _10 = double  __5     --  append 0: 1010
    _20 = double  _10     --  append 0: 10100
    _40 = double  _20     --  append 0: 101000
    _45 = add     _40 __5 -- add 0b101: 101101
  in
    _45                   --    45 == 0b101101

As before, we can verify that _45 really represents 45 by checking denote _45 == 45, given this definition of denote:

-- |The (positive) natural number that the addition chain `n` represents.
denote :: AdditionChain Natural -> Natural
denote n = n denote_double denote_add denote_one

denote_double a   = a + a
denote_add    a b = a + b
denote_one        = 1

Similarly, we'll measure addition chains with functions r, d, and f.

type Count = Int

-- |The number of additions of either sort in an addition chain; r == d + f.
r :: AdditionChain Measurements -> Count
r n = length (df n)

-- |The number of doubles in the addition chain; d == r - f.
d :: AdditionChain Measurements -> Count
d n = length [1 | (a, b, _) <- df n, a == b]

-- |The number of non-doubling adds in the addition chain; f == r - d.
f :: AdditionChain Measurements -> Count
f n = length [1 | (a, b, _) <- df n, a /= b]

-- A measurement is a tuple `(a, b, c)` where `a + b == c`.
type Measurements = [(Natural, Natural, Natural)]

df :: AdditionChain Measurements -> Measurements
df n = nub [entry | entry@(_, _, x) <- df' n, x /= 1]
  where
  df' :: AdditionChain Measurements -> Measurements
  df' n = n (\xs@((_, _, x):_) -> (x, x, denote_double x):xs) -- double
            (\xs@((_, _, x):_)
              ys@((_, _, y):_) -> (x, y, denote_add x y):(xs ++ ys)) -- add
            [(undefined, undefined, denote_one)] -- one

Measuring addition chains in AdditionChainComputation is as tedious as it is in AdditionChainConstruction. Here, df constructs a list of (a, b, x) tuples where a + b == x. Then it filters out any and all duplicates. We'll come back to the topic of how awkward this is in a bit. Before that, let's define the remaining functions.

λ (a.k.a. lambda), v, and bitString are defined similarly to their counterparts in AdditionChainConstruction, but they they'll be defined on Naturals only. This means we'll have to write λ (denote n), v (denote n), and bitString (denote n) where previously we wrote λ n, v n, and bitString n, respectively. We'll add a hexString function that wasn't in the previous module to make up for the decreased convenience.

-- |The length in bits of the given number; aliased as 'lambda'.
λ :: Natural -> Count
λ n = floor (logBase 2 (fromIntegral n)) -- Internet copy-pasta.

-- |The length in bits of the given number; an easy-to-type alias for 'λ'.
lambda :: Natural -> Count
lambda = λ

-- |The number of set bits in the given number; its binary Hamming weight.
v :: Natural -> Count
v n = popCount n

-- |A string of the binary representation of 'a'. For example,
-- `bitString 42 == "101010"`.
bitString :: Natural -> String
bitString n = showBin n ""
  where
  showBin x s = showIntAtBase 2 intToDigit x s -- Internet copy-pasta.

-- |A string of the hex representation of 'a'. For example,
-- `hexString 42 == "2a"`.
hexString :: Natural -> String
hexString n = showHex n ""

Let's go back to the awkwardness of the df function. The way in which we encounter an entry in an addition chain multiple times and have to filter out the duplicates is counter to the whole point of addition chains, which is to compute/visit each value in the chain once, in order, efficiently. Basically addition chains memoize computations, yet we're not memoizing anything. That means that this new way of dealing with addition chains doesn't really model their essence.

AdditionChainConstruction's denote function can't handle addition chains for very large values due to this lack of memoization (AFAICT). Its counting functions (d, f, r, etc.) don't have such trouble. When I wrote that code I had expected its denote to work more like those other functions. The new AdditionChainComputation module's denote can handle long addition chains, as can all of its other functions, so we can defer the work of implementing memoization to another day.

Let's make it easier to construct long addition chains:

-- |Given a `double` function, calculates `x` doubled `n` times. i.e.
-- `nth double n x = 2^n * x`. (Actually, it is much more general than this.)
nth :: (a -> a) -> Count -> (a -> a)
nth double 1 a = double a
nth double n a = double (nth double (n - 1) a)

-- (f `andThen` g) x == (g . f) x == g (f x). (>>>) from Control.Arrow is a
-- generalization of this.
andThen :: (a -> b) -> (b -> c) -> (a -> c)
f `andThen` g = (g . f)

Let's try it all out with a big number:

-- 2^255 - 19 - 2
bigNumber :: AdditionChain a
bigNumber double add one =
  let
    b___1 = one
    b__10 = (double_n   1                    ) b___1
    b1001 = (double_n   2 `andThen` add b___1) b__10
    b1011 = (                       add b__10) b1001
    x__5  = (double_n   1 `andThen` add b1001) b1011
    x_10  = (double_n   5 `andThen` add  x__5)  x__5
    x_20  = (double_n  10 `andThen` add  x_10)  x_10
    x_40  = (double_n  20 `andThen` add  x_20)  x_20
    x_50  = (double_n  10 `andThen` add  x_10)  x_40
    x100  = (double_n  50 `andThen` add  x_50)  x_50
    x200  = (double_n 100 `andThen` add  x100)  x100
    x250  = (double_n  50 `andThen` add  x_50)  x200
    q_minus_2
          = (double_n   5 `andThen` add b1011)  x250
  in
    q_minus_2
  where
    -- `x` doubled `n` times. i.e. `double_n n x = 2^n * x`.
    double_n n x = nth double n x

As we did with smaller values before, we can check denote bigNumber == 2^255 - 19 - 2 to verify that this addition chain really represents 2²⁵⁵ - 19 - 2. It's also instructive to actually look at the number in hexadecimal and binary notation.

hexString (denote bigNumber):: 7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffeb₁₆
bitString (denote bigNumber):: 111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111101011₂

Measurement	Value	Haskell Code
Bit Length	255	`λ (denote bigNumber)`
# of Set Bits	253	`v (denote bigNumber)`
Doubles	254	`d bigNumber`
Adds	11	`f bigNumber`
Length	265	`r bigNumber`