2. Numbers

-- using readIO
is_integer s = catch (do readIO s :: IO Int
                         putStrLn "is an integer")
                     (\_ -> putStrLn "is not")

-- using regexp
is_integer = isJust . matchRegex (mkRegex "^[+-]?[0-9]+$")

-- using reads
read_maybe s = case reads s of
                 [ (v, "") ] -> Just v
                 _ -> Nothing

is_integer s = isJust (read_maybe s :: Maybe Int)
is_float s = isJust (read_maybe s :: Maybe Double)

-- equal_num num1 num2 accuracy : returns true if num1 and num2 are
--   equal to accuracy number of decimal places
equal_num n1 n2 accuracy = abs (n1 - n2) < 10 ^^ (-accuracy)

wage = 536          -- $5.36/hour
week = 40 * wage    -- $214.40
weekwage :: String
weekwage = printf "One week's wage is: $%.2f\n" (week / 100 :: Double)

rounded = round unrounded

a = 0.255 :: Double
b = printf "%.2f" a
t = do putStrLn ("Unrounded: " ++ show a ++ "\nRounded: " ++ b)
       printf "Unrounded: %f\nRounded: %.2f\n" a a
-- Unrounded: 0.255
-- Rounded: 0.26
-- Unrounded: 0.255
-- Rounded: 0.26


a = [3.3, 3.5, 3.7, -3.3]
t = let l = map (\n -> printf "%.1f\t%d\t%d\t%d" (n :: Double) (truncate n :: Int)
                                                 (floor n :: Int) (ceiling n :: Int)) a in
    putStrLn (unlines $ "number\ttrncate\tfloor\tceiling" : l)

-- nb: to have a better looking output, use %4.1f and %2d instead of %.1f and %d

bin2dec :: String -> Integer
bin2dec = foldr (\c s -> s * 2 + c) 0 . reverse . map c2i
    where c2i c = if c == '0' then 0 else 1
-- bin2dec "0110110" == 54

dec2bin = map i2c . reverse . unfoldr decomp
    where decomp n = if n == 0 then Nothing else Just(n `mod` 2, n `div` 2)
          i2c i = if i == 0 then '0' else '1'
-- dec2bin 54 == "110110"

{-
import Test.QuickCheck
property_bindec n = n >= 0 ==> (bin2dec . dec2bin) n == n
verif = quickCheck property_bindec
-}

-- clean & pure way:
m1 = putStrLn $ "Infancy is: " ++ unwords (map show [0..2])
-- Infancy is: 0 1 2 

-- imperative way:
m2 = do putStr "Infancy is: "
        mapM_ (printf "%d ") [0 :: Int .. 2]
        putStrLn ""

-- imperative way':
m2' = do putStr "Infancy is: "
         mapM_ (\n -> putStr $ show n ++ " ") [0 :: Int .. 2]
         putStrLn ""

-- [0,2..8] == [0,2,4,6,8]

roman n = concat $ reverse $ snd $ mapAccumL transform n sets
    where
      transform n set = (n `div` 10, roman set (n `mod` 10))
      roman (i,v,x) n = l !! n
          where l = [ [], [i], [i,i], [i,i,i], [i,v], [v], [v,i], [v,i,i], [v,i,i,i], [i,x] ]
      sets = [('I','V','X'), ('X','L','C'), ('C','D','M'), ('M',too_big,too_big)] 
      too_big = error "roman: number greater than 3999"

arabic = sum . snd . mapAccumL set_sign 0 . map c2i . reverse
    where
      -- if the roman digit is smaller than biggest digit so far, substract it (eg: I is -1 in IV)
      set_sign max i = if i >= max then (i, i) else (max, -i)
      c2i c = case toUpper c of 
                'I' -> 1; 'V' -> 5; 'X' -> 10; 'L' -> 50 
                'C' -> 100; 'D' -> 500; 'M' -> 1000

roman_fifteen = roman 15 -- "XV"
s1 = "Roman for fifteen is " ++ roman_fifteen
arabic_fifteen = arabic roman_fifteen
s2 = "Converted back, " ++ roman_fifteen ++ " is " ++ show arabic_fifteen

{-
property_roman_arabic n = n >= 0 && n < 4000 ==> (arabic . roman) n == n
verif = quickCheck property_roman_arabic
-}

import Random
import Control.Monad (replicateM)

rand :: Int -> Int -> IO Int
rand low high = getStdRandom (randomR (low, high))

n = rand 25 75 -- [25,75]

random_elt l = do i <- rand 0 (length l - 1)
                  return (l !! i)

password = replicateM 8 (random_elt chars)
    where chars = concat [ ['A'..'Z'], ['a'..'z'], ['0'..'9'], "!@$%^&*" ]


-- random_elt can be also be written
random_elt' l = fmap (l !!) (rand 0 $ length l - 1)

srand = setStdGen . mkStdGen

randfixed = do srand 2
               rand 1 10

-- you can provide your own random generator by playing with the StdGen type

std_rand :: IO Double
std_rand = getStdRandom (randomR (0,1))

gaussian_rand = 
    do r1 <- std_rand
       r2 <- std_rand
       let u1 = 2*r1 - 1
       let u2 = 2*r2 - 1
       let w  = u1*u1 + u2*u2 -- variance
       if w >= 1 
         then gaussian_rand
         else let w2 = sqrt ((-2 * log w) / w) in 
              return (u2*w2, u1*w2) -- gaussian-distributed numbers

mean = 25
sdev = 2
t = do (r, _) <- gaussian_rand 
       let salary = r * sdev + mean
       printf "You have been hired at $%.2f\n" salary

deg2rad d = d * pi / 180
rad2deg r = r * 180 / pi

degree_sine = sin . deg2rad

asin_val = asin 1
acos_val = acos 1

v = log 10

log10 = logBase 10

t = putStrLn $ "log10(10,000)=" ++ log10 10000
-- log10(10,000) = 4

-- no standard matrix function in haskell library
-- here is a simple implementation
-- see also http://darcs.haskell.org/hugs98/demos/Matrix.hs
--       or http://darcs.haskell.org/nofib/ghc/matrix/Matrix.hs

sum_product :: Num a => [a] -> [a] -> a
sum_product u v = sum (zipWith (*) u v)

matrix_zipWith f a b = [zipWith f ak bk | (ak,bk) <- zip a b]

add_matrices a b = matrix_zipWith (+)

inner_product :: Num a => [[a]] -> [[a]] -> [[a]]
inner_product a b = mult a (transpose b)
    where mult [] _ = []
          mult (a_x:a_xs) b = [sum_product a_x bi | bi <- b] : mult a_xs b

a = [ [3, 2, 3]
    , [5, 9, 8] ]
b = [ [4, 7]
    , [9, 3]
    , [8, 1] ]
c = inner_product a b

import Complex

a = 3 :+ 5    -- 3 + 5i
b = 2 :+ (-2) -- 2 - 2i
c = a * b     -- 16 + 4i

t1 = (realPart c, imagPart c, conjugate c) --  16, 4, 16-4i

d = 3 :+ 4
t2 = sqrt d  -- 2 + i

-- "read" handles both octal and hexadecimal when prefixed with 0x or 0o
-- here are versions adding the prefix and calling "read"
hex s = read ("0x" ++ s) :: Integer
oct s = read ("0o" ++ s) :: Integer

-- hex "45" == 69
-- oct "45" == 37
-- hex "45foo" => Exception: Prelude.read: no parse

-- calling explicitly readHex or readOct:
hex = fst . head . Numeric.readHex
oct = fst . head . Numeric.readOct

-- one need to flush between putStr and getLine,
--   it would not be needed if we had printer a newline
-- the other solution is to disable buffering with hSetBuffering
putStr_getLine s = do putStr s
                      hFlush stdout
                      getLine

t = do s <- putStr_getLine "Gimme a number in decimal, octal, or hex: "
       let n = read s :: Integer
       printf "%d %x %o\n" n n n

t' = do permissions <- putStr_getLine "Enter file permission in octal: "
        putStrLn $ "The decimal value is " ++ show (oct permissions)

import Data.List
-- (using groupNelem from "Helpers")
commify = reverse . intercalate "," . groupNelem 3 . reverse
-- commify "-1740525205" == "-1,740,525,205"

-- a version handling decimal numbers (using subRegexOnceWith from "Helpers")
commify' = subRegexOnceWith (mkRegex "[0-9]+") commify
-- commify' "-1740525205.000001" == "-1,740,525,205.000001"

hours = 2
s = "It took " ++ show hours ++ " hour" ++ if hours == 1 then "" else "s"

s2 = printf fmt (hours :: Int) :: String
    where fmt = if hours == 1 then "%d hour is enough.\n" else "%d hours are enough.\n"


-- subRegex doesn't return wether it succeeded or not
-- calling matchRegex first
subRegexMaybe :: Regex -> String -> String -> Maybe String
subRegexMaybe re s repla = do matchRegex re s -- discard the result
                              Just (subRegex re s repla)

subRegexMany :: [(String, String)] -> String -> Maybe String
subRegexMany regexps s = msum (map try_one regexps)
    where try_one (re, repla) = subRegexMaybe (mkRegex re) s repla
-- note the use of msum to take the first (Just _) in the list
-- here msum is used with type [Maybe a] -> Maybe a

noun_plural s = fromMaybe (error "can't get here") (subRegexMany regexps s)
    where regexps = [ ("ss$", "sses")
                    , ("([psc]h)$", "\\1es")
                    , ("z$", "zes")
                    , ("ff$", "ffs")
                    , ("f$", "ves")
                    , ("ey$", "eys")
                    , ("y$", "ies")
                    , ("ix$", "ices")
                    , ("([sx])$", "\\1es")
                    , ("(.)$", "\\1s") -- note that subRegex is unsafe if the regexp matches an empty strings, cf documentation
                    ]

s = unlines $ map (\s -> "One " ++ s ++ ", two " ++ noun_plural s ++ ".") $ words test_words
    where test_words = "fish fly ox \
                       \species genus phylum \
                       \cherub radius jockey \
                       \index matrix mythos \
                       \phenomenon formula"

#!/usr/bin/runghc

import List
import System
import Text.Printf

-- from http://haskell.org/haskellwiki/99_questions/31_to_41#Problem_36
encode :: Eq a => [a] -> [(a, Int)]
encode = map (\x -> (head x, length x)) . group

primeFactors n = factor n primes
  where factor n (p:ps) | p*p > n = [n]
                        | n `mod` p /= 0 = factor n ps
                        | otherwise = p : factor (n `div` p) (p:ps)
        primes = 2 : filter ((==1) . length . primeFactors) [3,5..]

main = getArgs >>= mapM_ do_one
    where do_one n = printf "%-10s %s\n" n (to_string $ encode $ primeFactors $ read n)
          to_string [(_, 1)] = "PRIME"
          to_string l = unwords $ map (\(n,power) -> show n ++ to_string_power power) l
          to_string_power p = if p == 1 then "" else "**" ++ show p

{-
% bigfact  8 9 96 2178
8          2**3
9          3**2
96         2**5 3
2178       2 3**2 11**2
% bigfact 239322000000000000000000
239322000000000000000000 2**19 3 5**18 39887
% bigfact 25000000000000000000000000
25000000000000000000000000 2**24 5**26
-}