Addition Chains as Polymorphic Higher-order Functions

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
`Natural`s 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^{255} - 19 - 2. It's also instructive to
actually look at the number in hexadecimal and binary notation.