Interface to the C-L Prime Construction of the Naturals

CLN.hs

module CLN where

import Data.List

data CLNElem = Dot | Parens [CLNElem]
instance (Show CLNElem) where
    show Dot = "."
    show (Parens clnes) = "(" ++ (concatMap show clnes) ++ ")"
newtype CLN = CLN [CLNElem]
instance (Show CLN) where
    show (CLN clnes) = "CLN " ++ (concatMap show clnes)

isPrime :: Integer -> Bool
isPrime n = not $ any (== 0) [n `mod` x | x <- [2 .. (floor $ sqrt floatN)]]
    where
        floatN = fromIntegral n :: Double

primes :: [Integer]
primes = filter isPrime [1..]

whichPrime :: Integer -> Integer
whichPrime n = (fromIntegral . length) $ takeWhile (< n) primes

nthPrime :: Integer -> Integer
nthPrime n = primes !! (fromIntegral n)

firstDivisors :: Integer -> [Integer]
firstDivisors n = [fD1, fD2]
    where
        fD1 = head $ filter (\fD -> n `mod` fD == 0) [2..]
        fD2 = n `div` fD1

iterateDivisors :: [Integer] -> [Integer]
iterateDivisors ns = concatMap divideIf ns
    where
        divideIf x = if (isPrime x) then [x] else (firstDivisors x)

primeDivisors :: Integer -> [Integer]
primeDivisors n = fix $ iterate iterateDivisors (firstDivisors n)
    where
        fix (x:xs) = if (x == (head xs)) then x else (fix xs)

toCLN :: Integer -> CLN
toCLN 1 = CLN [Dot]
toCLN n = CLN (toCLN' n)
    where
        toCLN' :: Integer -> [CLNElem]
        toCLN' 1 = [Dot]
        toCLN' n = case (isPrime n) of
            True -> [Parens (toCLN' (whichPrime n))]
            False -> concatMap toCLN' $ primeDivisors n

fromCLN :: CLN -> Integer
fromCLN (CLN ns) = foldl (*) 1 $ map fromCLN' ns
    where
        fromCLN' :: CLNElem -> Integer
        fromCLN' Dot = 1
        fromCLN' (Parens xs) = nthPrime $ foldl (*) 1 $ map fromCLN' xs

instance (Monoid CLN) where
    mempty = CLN [Dot]
    mappend (CLN as) (CLN bs) = tNumId $ CLN $ mappend as bs
        where
            tNumId = toCLN . fromCLN

Example interaction:

aearnus@aearnus:~/scripts/CLN$ ghci CLN.hs
GHCi, version 8.0.2: http://www.haskell.org/ghc/  :? for help
[1 of 1] Compiling CLN              ( CLN.hs, interpreted )
Ok, modules loaded: CLN.
*CLN> toCLN 1234
CLN (.)(((.)((.))(((.)))))
*CLN> mapM_ (putStrLn . show . toCLN) [1..10]
CLN .
CLN (.)
CLN ((.))
CLN (.)(.)
CLN (((.)))
CLN (.)((.))
CLN ((.)(.))
CLN (.)(.)(.)
CLN ((.))((.))
CLN (.)(((.)))
*CLN> [1..10000] == (map (fromCLN . toCLN) [1..10000])
True
*CLN> mappend (toCLN 13) (toCLN 55)
CLN (((.)))((((.))))((.)((.)))
*CLN> fromCLN $ mappend (toCLN 13) (toCLN 55)
715
*CLN> fromCLN $ mappend (toCLN 42) mempty
42