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 ControlData.ArrowBifunctor ((&&&), (***)bimap)
import Data.Char (isSpace)
import Data.Monoid ((<>))
import Data.Bool (bool)
 
-- FAULHABER ----------------------- FAULHABER ------------------------
faulhaber :: [[Rational]]
faulhaber =
Line 952:
[]
[0 ..]
-- TEST -------------------------- TEST --------------------------
main :: IO ()
main = (putStrLn . unlines . expressionTable . take 10) polynomials</lang>
 
-- EXPRESSION STRINGS -------------------------------------
-- EXPRESSION STRINGS ------------------- EXPRESSION STRINGS -------------------
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 ->
(fmap (bimap (justifyLeft lw ' ') *** (justifyLeft 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 &&&<*> denominator) nd
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
9,655

edits