{-|

Module      : Multiply
Description : Multiplication algorithms
Copyright   : © Frank Jung, 2021
License     : GPL-3

Haskell implementations of multiplication algorithms as described by
<https://play.google.com/store/books/details?pcampaignid=books_read_action&id=UqxYBQAAQBAJ From Mathematics to Generic Programming>.

-}

module Multiply ( multiply0
                , multiply1
                , multiply2
                , multiply3
                , multiply4
                , double
                , doubles
                , half
                , halves
                , oddHalvesBinary
                ) where

import           Data.List (foldl')

-- | The <https://en.wikipedia.org/wiki/Ancient_Egyptian_multiplication Egyptian multiplication>
-- as described by Ahmes.
multiply0 :: Word -> Word -> Word
multiply0 :: Word -> Word -> Word
multiply0 Word
0 Word
_ = Word
0
multiply0 Word
_ Word
0 = Word
0
multiply0 Word
a Word
b = if Word
a forall a. Ord a => a -> a -> Bool
<= Word
1 then Word
b else Word
b forall a. Num a => a -> a -> a
+ Word -> Word -> Word
multiply0 (Word
a forall a. Num a => a -> a -> a
- Word
1) Word
b

-- | Improved Ahmes algorithm.
multiply1 :: Word -> Word -> Word
multiply1 :: Word -> Word -> Word
multiply1 Word
0 Word
_ = Word
0
multiply1 Word
_ Word
0 = Word
0
multiply1 Word
a Word
b
  | Word
a forall a. Ord a => a -> a -> Bool
<= Word
1    = Word
b
  | forall a. Integral a => a -> Bool
odd Word
a     = Word
s forall a. Num a => a -> a -> a
+ Word
b
  | Bool
otherwise = Word
s
  where s :: Word
s = Word -> Word -> Word
multiply1 (Word -> Word
half Word
a) (Word -> Word
double Word
b)

-- | Improved Ahmes algorithm using an accumulator.
multiply2 :: Word -> Word -> Word
multiply2 :: Word -> Word -> Word
multiply2 Word
0 Word
_ = Word
0
multiply2 Word
_ Word
0 = Word
0
multiply2 Word
a Word
b
  | Word
a forall a. Ord a => a -> a -> Bool
<= Word
1    = Word
b
  | Bool
otherwise = Word -> Word -> Word -> Word
multiplyacc Word
b (Word
a forall a. Num a => a -> a -> a
- Word
1) Word
b
  where
    multiplyacc :: Word -> Word -> Word -> Word
    multiplyacc :: Word -> Word -> Word -> Word
multiplyacc Word
s Word
x Word
y
      | Word
x forall a. Ord a => a -> a -> Bool
<= Word
1    = Word
s forall a. Num a => a -> a -> a
+ Word
y
      | forall a. Integral a => a -> Bool
odd Word
x     = Word -> Word -> Word -> Word
multiplyacc (Word
s forall a. Num a => a -> a -> a
+ Word
y) (Word -> Word
half Word
x) (Word -> Word
double Word
y)
      | Bool
otherwise = Word -> Word -> Word -> Word
multiplyacc Word
s (Word -> Word
half Word
x) (Word -> Word
double Word
y)

-- | Non-recursive version of Egyptian multiplication.
-- Based on
-- <http://www.mathnstuff.com/math/spoken/here/2class/60/egyptm.htm MathnStuff Egyptian multiplication>.
multiply3 :: Word -> Word -> Word
multiply3 :: Word -> Word -> Word
multiply3 Word
a Word
b = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Num a => a -> a -> a
(+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) Word
0 forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Integral a => a -> Bool
odd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (Word -> [Word]
halves Word
a) (Word -> [Word]
doubles Word
b)

-- | Non-recursive version of Egyptian multiplication
-- by <https://mathspp.com/blog/egyptian-multiplication#comment-5257985406 Rodrigo Girão Serrão>
multiply4 :: Word -> Word -> Word
multiply4 :: Word -> Word -> Word
multiply4 Word
a Word
b = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Word
s (Word, Word)
p -> Word
s forall a. Num a => a -> a -> a
+ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Num a => a -> a -> a
(*) (Word, Word)
p) Word
0 [(Word, Word)]
pairs
  where pairs :: [(Word, Word)]
pairs = forall a b. [a] -> [b] -> [(a, b)]
zip (Word -> [Word]
oddHalvesBinary Word
a) (Word -> [Word]
doubles Word
b)

-- | Double the current value.
double :: Word -> Word
double :: Word -> Word
double Word
a = Word
a forall a. Num a => a -> a -> a
+ Word
a

-- | Continuously double value.
doubles :: Word -> [Word]
doubles :: Word -> [Word]
doubles = forall a. (a -> a) -> a -> [a]
iterate Word -> Word
double

-- | Half the current value.
half :: Word -> Word
half :: Word -> Word
half = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Integral a => a -> a -> a
div Word
2

-- | List of halves until 1.
halves :: Word -> [Word]
halves :: Word -> [Word]
halves Word
a = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Ord a => a -> a -> Bool
>Word
0) (forall a. (a -> a) -> a -> [a]
iterate Word -> Word
half Word
a)

-- | Repeatadly half the given integer until 1
-- then replace even entries with 0 and odd entries with 1.
oddHalvesBinary :: Word -> [Word]
oddHalvesBinary :: Word -> [Word]
oddHalvesBinary Word
a = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Integral a => a -> a -> a
mod Word
2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> [Word]
halves Word
a