Ethiopian multiplication: Difference between revisions
Content added Content deleted
(→Haskell :: Fold after unfold: Tidied and retitled) |
|||
| Line 2,117: | Line 2,117: | ||
Logging the stages of the '''unfoldr''' and '''foldr''' applications: |
Logging the stages of the '''unfoldr''' and '''foldr''' applications: |
||
<lang haskell>import Data. |
<lang haskell>import Data.List (inits, intercalate, unfoldr) |
||
import Data.List (intercalate, unfoldr) |
|||
import Data.Tuple (swap) |
import Data.Tuple (swap) |
||
import Debug.Trace (trace) |
import Debug.Trace (trace) |
||
| Line 2,126: | Line 2,125: | ||
ethMult :: Int -> Int -> Int |
ethMult :: Int -> Int -> Int |
||
ethMult n m = |
ethMult n m = |
||
trace |
|||
let addedWhereOdd (d, x) a |
|||
(showDoubles pairs <> " = " <> show v <> "\n") |
|||
| ⚫ | |||
| ⚫ | |||
where |
|||
halved h |
|||
pairs = zip (unfoldr halved n) (iterate doubled m) |
|||
doubled x = x + x |
|||
halved h |
|||
| 0 < h = |
|||
Just $ |
|||
trace |
|||
(showHalf h) |
|||
(swap $ quotRem h 2) |
|||
| ⚫ | |||
in ( let x = foldr addedWhereOdd 0 pairs |
|||
v = foldr addedWhereOdd 0 pairs |
|||
addedWhereOdd (d, x) a |
|||
| 0 < d = (+) a x |
|||
| otherwise = a |
|||
<> "\n" |
|||
) |
|||
x |
|||
| ⚫ | |||
---------------------- TRACE DISPLAY --------------------- |
---------------------- TRACE DISPLAY --------------------- |
||
showHalf :: Int -> String |
showHalf :: Int -> String |
||
showHalf x = "halve: " <> rjust 6 ' ' (show (quotRem x 2)) |
showHalf x = "halve: " <> rjust 6 ' ' (show (quotRem x 2)) |
||
| Line 2,155: | Line 2,151: | ||
showDoubles xs = |
showDoubles xs = |
||
"double:\n" |
"double:\n" |
||
<> unlines |
<> unlines (go <$> xs) |
||
( |
<> intercalate " + " (xs >>= f) |
||
where |
|||
( \x -> |
|||
go x |
|||
| 0 < fst x = "-> " <> rjust 3 ' ' (show $ snd x) |
|||
| otherwise = rjust 6 ' ' $ show $ snd x |
|||
f (r, q) |
|||
| 0 < r = [show q] |
|||
| otherwise = [] |
|||
) |
|||
<> intercalate |
|||
" + " |
|||
(xs >>= (\(r, q) -> bool [] [show q] (0 < r))) |
|||
rjust :: Int -> Char -> String -> String |
rjust :: Int -> Char -> String -> String |
||
rjust n c s = drop (length s) (replicate n c <> s) |
rjust n c s = drop (length s) (replicate n c <> s) |
||
--------------------------- TEST ------------------------- |
--------------------------- TEST ------------------------- |
||