Faulhaber's formula: Difference between revisions
→Haskell: Replaced Control.Arrow with bimap and an applicative. Tidied.
(→Haskell: Replaced Control.Arrow with bimap and an applicative. Tidied.) |
|||
Line 937:
<lang Haskell>import Data.Ratio ((%), numerator, denominator)
import Data.List (intercalate, transpose)
import
import Data.Char (isSpace)
import Data.Monoid ((<>))
import Data.Bool (bool)
--
faulhaber :: [[Rational]]
faulhaber =
Line 952:
[]
[0 ..]
main :: IO ()▼
polynomials :: [[(String, String)]]▼
polynomials = fmap ((ratioPower =<<) . reverse . flip zip [1 ..]) faulhaber▼
-- Rows of (Power string, Ratio string) tuples -> Printable lines
Line 967 ⟶ 970:
zipWith
(\(lw, rw) col ->
(colWidths cols)
cols)
▲polynomials :: [[(String, String)]]
▲polynomials = fmap ((ratioPower =<<) . reverse . flip zip [1 ..]) faulhaber
-- Value pair -> String pair (lifted into list for use with >>=)
ratioPower :: (Rational, Integer) -> [(String, String)]
ratioPower (nd, j) =
let (num, den) = ((,) . numerator
sn
| num == 0 = []
Line 986 ⟶ 992:
s = sr <> sn
in bool [(sn, sr)] [] (null s)
-- Rows of uneven length -> All rows padded to length of longest
fullTable :: [[(String, String)]] -> [[(String, String)]]
Line 992 ⟶ 998:
let lng = maximum $ length <$> xs
in (<>) <*> (flip replicate ([], []) . (-) lng . length) <$> xs
justifyLeft :: Int -> Char -> String -> String
justifyLeft n c s = take n (s <> replicate n c)
-- (Row index, Expression pairs) -> String joined by conjunctions
expressionRow :: (Int, [(String, String)]) -> String
Line 1,007 ⟶ 1,013:
(polyTerm <$> row)
]
-- (Power string, Ratio String) -> Combined string with possible '*'
polyTerm :: (String, String) -> String
Line 1,014 ⟶ 1,020:
| head r == '-' = concat ["- ", l, " * ", tail r]
| otherwise = intercalate " * " [l, r]
blank :: String -> Bool
blank = all isSpace
-- Maximum widths of power and ratio elements in each column
colWidths :: [[(String, String)]] -> [(Int, Int)]
Line 1,025 ⟶ 1,031:
(\(ls, rs) (lMax, rMax) -> (max (length ls) lMax, max (length rs) rMax))
(0, 0))
-- Length of string excluding any leading '-'
unsignedLength :: String -> Int
unsignedLength xs =
let l = length xs
in bool (bool l (l - 1) ('-' == head xs)) 0 (0 == l)</lang>
▲-- TEST ---------------------------------------------------
▲main :: IO ()
▲main = (putStrLn . unlines . expressionTable . take 10) polynomials</lang>
{{Out}}
<pre>0 -> n
|