David Tran’s blog

import EX_7_8 hiding (channel, transmit)

channel :: [Bit] -> [Bit]
channel = tail

-- need to redefine transmit to force it use this new verion of channel
transmit :: String -> String
transmit = decode . channel . encode

main = do 
       putStrLn $ transmit "Haskell is fun!"

{-
$> ghci
GHCi, version 6.8.2: http://www.haskell.org/ghc/  :? for help
Loading package base ... linking ... done.
Prelude> :l ex.7.9  ex.7.8
[1 of 2] Compiling EX_7_8           ( ex.7.8.hs, interpreted )
[2 of 2] Compiling Main             ( ex.7.9.hs, interpreted )
Ok, modules loaded: EX_7_8, Main.
*Main> main
*** Exception: Parity checking fail.
*Main>
-}

module EX_7_8 where

import Data.Char

type Bit = Int

bin2int :: [Bit] -> Int
bin2int = foldr (\x y -> x + 2 * y) 0

int2bin :: Int -> [Bit]
int2bin 0 = []
int2bin n = n `mod` 2 : int2bin (n `div` 2)

make8 :: [Bit] -> [Bit]
make8 bits = take 8 (bits ++ repeat 0)

addParityBit :: [Bit] -> [Bit]
addParityBit bits = bits ++ [parity]
                    where parity = length (filter (==1) bits) `mod` 2

checkParityBit :: [Bit] -> [Bit]
checkParityBit bits =
  if last bits == length (filter (==1) (init bits)) `mod` 2
  then init bits
  else error "Parity checking fail."

encode :: String -> [Bit]
encode = concat . map (addParityBit . make8 . int2bin . ord)

chop :: Int -> [Bit] -> [[Bit]]
chop _ []   = []
chop n bits = take n bits : chop n (drop n bits)

decode :: [Bit] -> String
decode = map (chr . bin2int . checkParityBit) . (chop 9)

transmit :: String -> String
transmit = decode . channel . encode

channel :: [Bit] -> [Bit]
channel = id

import Prelude hiding(map, iterate)

unfold :: (t -> Bool) -> (t -> a) -> (t -> t) -> t -> [a]
unfold p h t x | p x        = []
               | otherwise  = h x : unfold p h t (t x)


--~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- chop8 :: [a] -> [[a]]
-- chop8 [] = []
-- chop8 xs = take 8 xs : chop8 (drop 8 xs)

chop8 = unfold null (take 8) (drop 8)

--~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- map :: (a -> b) -> ([a] -> [b])
-- map f xs = [ f x1, f x2, ... f xn ]

map f = unfold null (f.head) tail

--~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- iterate :: (a -> a) -> a -> [a]
-- iterate f x = [ x, f x, f (fx), ... ]

iterate f = unfold (\_ -> False) id f

import Prelude hiding (curry, uncurry)

curry ::  ((a,b) -> c) -> (a -> b -> c)
curry f = \x y -> f (x, y)

uncurry ::  (a -> b -> c) -> ((a, b) -> c)
uncurry f = \(x,y) -> f x y


{-
 -
Prelude definition:

curry f x y = f (x,y)
-- uncurry f (x, y) = f x y
uncurry f p = f (fst p) (snd p)


Like PIH page#68 f.g = \x -> f (g x)  instead of (f.g) x = f (g x)
I prefer use lambd expression to define curry/uncurry.

-}

sumsqreven = compose [ sum, map (^2), filter even ]
is invalid because:
all elements on the list must have the same type.
( For example: [a] is type of list, where all element are the type a ).

map (^2) :: (Num a) => [a] -> [a]
filter even :: (Integral a) => [a] -> [a]
sum :: (Num a) => [a] -> a

So, (map (^2)) and (filter even) are type like [a] -> [a];
the result is type list, but the result of sum is not type list.

dec2int :: Num a => [a] -> a
-- dec2int xs = foldl (\x y -> x * 10 + y) 0 xs
dec2int = foldl ((+).(*10)) 0

map f xs = f x1 : f x2 : ... : f xn : []
         = ( x1 # ( x2 # ... (xn # []) ... ))
           where (#) x xs = f x : xs

==> map f xs = foldr (x xs -> f x : xs) [] xs
==> map f = foldr (x xs -> f x : xs) []
==> map f = foldr (x -> (:) (f x)) []
==> map f = foldr ((:).f) []

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

filter p xs = filter p (x1 : x2 ... : xn : [])
  = (x1 # ( x2 # ... (xn # []) ... ))
  = ( (if p x1 then [x1] else []) ++ ... ((if p xn then [xn] else []) ++ []) ... )

==> (#) x xs = (if p x then [x] else []) ++ xs
==> filter p = foldr (x -> (++) (if p x then [x] else [])) []

or  (#) x xs = if p x then (x:xs) else xs
==> filter p = foldr (x xs -> if p x then (x:xs) else xs) []

import Prelude hiding (all, any, takeWhile, dropWhile)

all :: (a -> Bool) -> [a] -> Bool
-- all p xs = and (map p xs)
all = (and.).map

all', all'' :: (a -> Bool) -> [a] -> Bool
-- all' p xs = foldl (\v x -> v && p x) True xs
all'  p = foldl (\v x -> v && p x) True
all'' p = foldr (\x v -> p x && v) True


-- Note:
-- all  (<3) [0..]  = False
-- all' (<3) [0..]  ==> calculate till out of memory


all''' :: (a -> Bool) -> [a] -> Bool
all''' p [] = True
all''' p (x:xs) = p x && all''' p xs

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

any :: (a -> Bool) -> [a] -> Bool
-- any p xs = not (all p xs)
any = (not.).all

takeWhile :: (a -> Bool) -> [a] -> [a]
takeWhile p []                  = []
takeWhile p (x:xs) | p x        = x : takeWhile p xs
                   | otherwise  = []

dropWhile :: (a -> Bool) -> [a] -> [a]
dropWhile p []                      = []
dropWhile p xxs@(x:xs) | p x        = dropWhile p xs
                       | otherwise  = xxs

[ f x | x <- xs, p x ]
==
map f (filter p xs)

> import Prelude hiding (sum, take, last)

step 1: define the type
sum :: [Int] -> Int

step 2: enumerate the cases
sum [] =
sum (n:ns) =

step 3: define the simple cases
sum [] = 0
sum (n:ns) =

step 4: define the other cases
sum [] = 0
sum (n:ns) = n + sum ns

step 5: generalise and simplify

> sum :: Num a => [a] -> a
> sum [] = 0
> sum (n:ns) = n + sum ns
> -- sum = foldr (+) 1

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

step 1: define the type
take :: Int -> [a] -> [a]

step 2: enumerate the cases
take 0 []          =
take 0 (x:xs)      =
take (n+1) []      =
take (n+1) (x:xs)  =

step 3: define the simple cases
take 0 []          = []
take 0 (x:xs)      = []
take (n+1) []      => error 
take (n+1) (x:xs)  =

step 4: define the other cases
take 0 []          = []
take 0 (x:xs)      = []
take (n+1) []      => error 
take (n+1) (x:xs)  = x : take n xs

step 5: generalise and simplify

> take :: Integral a => a -> [b] -> [b]
> take 0 _          = []
> take (n+1) (x:xs) = x : take n xs

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

step 1: define the type
last :: [a] -> a

step 2: enumerate the cases
last []     =
last [x]    =
last (x:xs) =

step 3: define the simple cases
last []     => error
last [x]    = x
last (x:xs) =

step 4: define the other cases
last []     => error
last [x]    = x
last (x:xs) = last xs

step 5: generalise and simplify

> last :: [a] -> a
> last [x]    = x
> last (x:xs) = last xs