Skip to content

Instantly share code, notes, and snippets.

@thsutton
Last active August 1, 2018 05:55
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save thsutton/5e7d58fbf8cd2bfdfa0a495c1deaa43d to your computer and use it in GitHub Desktop.
Save thsutton/5e7d58fbf8cd2bfdfa0a495c1deaa43d to your computer and use it in GitHub Desktop.
Several approaches to computing the triangle numbers.
#!/usr/bin/env stack
-- stack --resolver lts-12.4 --install-ghc runghc --package QuickCheck
--
-- If you have Haskell Stack installed (brew install haskell-stack) you
-- can execute this script directly:
--
-- $ chmod +x trianglenumbers.hs
-- $ ./trianglenumbers.hs
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BangPatterns #-}
import Test.QuickCheck
import System.Exit
import Data.List
natsum1 :: Int -> Int
natsum1 n | n < 1 = 0
| otherwise = natsum1 (n - 1) + n
-- | $\Sum_{i=0}^{n} n \equiv \frac{n (n + 1)}{2}$
--
-- We do the closed form in unbounded precision `Integer`s to avoid
-- overflow errors.
natsum2 :: Int -> Int
natsum2 n | n < 1 = 0
| otherwise = let m = fromIntegral n
in fromIntegral $ (m * (m + 1)) `div` 2
-- | Use the "worker-wrapper" transformation.
natsum3 :: Int -> Int
natsum3 = go 0
where
go !acc !n | n < 1 = acc
| otherwise = go (acc + n) (n - 1)
-- | Literally $\Sum_{i=0}^{n} n$
natsum4 :: Int -> Int
natsum4 n = foldl' (+) 0 [0..n]
-- * Tests
-- $ Here are property based tests to check that `natsum2` and `natsum3` agree.
-- We have separate properties to check different parts of the domain.
--
-- We'll use `Small` to get some small numbers (positive, negative, and zero)
-- for the cases which we expect to be quick and easy to test. This should give
-- us confidence that we've got the "natural" part right (even though we use
-- `Int`).
--
-- The second tests uses `Positive` and `Large` to get some big numbers. This
-- is where we become confident we've avoided arithmetic overflow errors, etc.
-- This is also where we start to see very long run times, so we'll reduce the
-- number to times we run this tests.
prop_definitionsAgreeOnSmall (Small n) = natsum2 n === natsum3 n
prop_definitionsAgreeOnLarge = withMaxSuccess 30 leTest
where
leTest (Positive (Large n)) = natsum2 n === natsum3 n
-- * Run the tests
return []
runTests = $quickCheckAll
main :: IO ()
main = do
putStrLn "Running tests"
r <- runTests
if r then putStrLn "😀" >> exitSuccess
else putStrLn "💩" >> exitFailure
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment