factorization

lib.hs

module Lib (factor, intLog) where
import Data.Map
import Debug.Trace

divides bottom top = (mod top bottom) == 0

intDivide bottom top = fst $ divMod top bottom

intLog base total = go base total 0
  where go base total count = if (divides base total)
                                then go base (intDivide base total) (count + 1)
                                else count

factor x = go 2 (fromList []) x
  where
  go divisor sofar x
     | divisor > x = sofar
     | thepower > 0 =  go
                         (divisor + 1)
                         (insert divisor thepower sofar)
                         (intDivide (divisor ^ thepower) x)
     | otherwise = go
                     (divisor + 1)
                     sofar
                     x
     where thepower = intLog divisor x

spec.hs

import Test.HUnit
import Lib
import Data.Map
import Test.QuickCheck


factor_3 = TestCase $
  assertEqual
  "3 just gives 3"
  (fromList [(3,1)])
  (factor 3)


factor_7 = TestCase $
  assertEqual
  "7 just gives 7"
  (fromList [(7,1)])
  (factor 7)

factor_4 = TestCase $
  assertEqual
  "4 gives 2 * 2"
  (fromList [(2,2)])
  (factor 4)

factor_40 = TestCase $
  assertEqual
  "40 gives 8 * 5"
  (fromList [(2,3), (5,1)])
  (factor 40)

tests = TestList [ factor_3, factor_7, factor_4, factor_40 ]

factorizationProperty :: (Positive Int) -> Bool
factorizationProperty (Positive n) =
  let
    factorized = factor n
    product = foldrWithKey (\k v total -> total * (k ^ v)) 1 factorized
  in
    product == n


main :: IO ()
main = do
  runTestTT tests
  quickCheck factorizationProperty
  return ()