Ethiopian multiplication: Difference between revisions
→Haskell :: Fold after unfold: Tidied and retitled
m (→{{header|Phix}}: added syntax colouring the hard way) |
(→Haskell :: Fold after unfold: Tidied and retitled) |
||
Line 2,113:
===Fold after unfold===
Logging the stages of the '''unfoldr''' and '''foldr''' applications:
<lang haskell>import Data.List (intercalate, unfoldr)▼
<lang haskell>import Data.Bool (bool)
import Data.Tuple (swap)
import
-
ethMult :: Int -> Int -> Int
Line 2,128 ⟶ 2,130:
| otherwise = a
halved h
| 0 < h =
Just $
trace
(showHalf h)
(swap $ quotRem h 2)
| otherwise = Nothing
doubled x = x + x
pairs = zip (unfoldr halved n) (iterate doubled m)
in ( let x = foldr addedWhereOdd 0 pairs
in trace
( showDoubles pairs
<> " = "
-- TRACE DISPLAY -------------------------------------------▼
<> show x
<> "\n"
)
x
)
showHalf :: Int -> String
showHalf x = "halve: "
showDoubles :: [(Int, Int)] -> String
showDoubles xs =
"double:\n"
<> unlines
( fmap
( \x ->
bool
(rjust 6 ' ' $ show $ snd x)
("-> "
(0 < fst x
xs
intercalate " + " (xs >>= (\(r, q) -> bool [] [show q] (0 < r)))▼
)
<> intercalate
" + "
rjust :: Int -> Char -> String -> String
rjust n c s = drop (length s) (replicate n c
-
main :: IO ()
main = do
| |||