real world haskell(1)[Exercise3]

real world haskellを買ったので読んでいる。exercise3をやってみた。grahum-scanはもう少しきれいに書けそうな気がする。

import Data.List
-- http://book.realworldhaskell.org/read/defining-types-streamlining-functions.html 

---Exercise 3.1
length1 [] = 0
length1 (_:xs) = 1 + (length1 xs)

--tail recursion(末尾再帰を最適化しないっけ？)
length2 xs = length' xs 0
    where
      length' [] n = n
      length' (_:xs) n = length' xs (n + 1)

--foldl
length3 = foldl (\ n _ -> n + 1) 0

---Exercise 3.2
type Weight = Double
type Height = Double
type Name = String
data Info = Human Name Height Weight  deriving (Show)
-- :type Human -- => Human :: Name -> Height -> Weight -> Info
bmi :: Info -> (String, Double)
bmi (Human name h w) = (name, w / (h * h) )
-- bmi (Human "foo" 1.6 50.0) -- => ("foo",19.531249999999996)

---Exercise 3.3
mean xs = fromIntegral (sum xs) / fromIntegral (length xs)

---Exercise 3.4
parindrome xs = xs ++ (reverse xs)

---Exercise 3.5
is_parindrome xs = left == reverse right
    where len = length xs
          hulf = len `div` 2
          (left,right) = if odd len
                         then let (l,r) = splitAt hulf xs in (l ,tail r)
                         else splitAt hulf xs
---Exercise 3.6
sortByLength = sortBy (\x y -> compare (length x) (length y))

---Exercise 3.7
intersperse1 delim [xs] = [xs]
intersperse1 delim (x:xr) = x : delim : (intersperse1 delim xr)
intersperse2 = Data.List.intersperse

---Exercise 3.8
data Tree a = Node a (Tree a) (Tree a) 
            | Empty
              deriving (Show)

---Exercise 3.9
treeHeight Empty = 0
treeHeight (Node _ l r) = 1 + max (treeHeight l) (treeHeight r)

---Exercise 3.10
data Direction = LeftTurn | Straight | RightTurn deriving (Show)

---Exercise 3.11
calcAngle a b c = (abx * acy) - (aby * acx)
    where size (x0,y0) (x1,y1) = (x1-x0, y1-y0) 
          ((abx,aby), (acx,acy)) = (size a b , size a c) 

calcDirection a b c = direction $ calcAngle a b c
    where direction 0 = Straight
          direction x | x > 0 = LeftTurn
                      | otherwise = RightTurn

---Exercise 3.12
mapTriple fn [a,b,c] = [fn a b c]
mapTriple fn (a:rest@(b:c:_)) = (fn a b c) : mapTriple fn rest
   
calcDirections = mapTriple calcDirection 

---Exercise 3.13
findSmallest ps = minimumBy compare' ps
    where
      compare' (ax,ay) (bx,by) = 
          case (compare ay by) of
            EQ -> compare ax bx
            ord -> ord

grahumScan ps@(_:_:_:_) = collect [a,smallest] ps'
    where
      smallest = findSmallest ps
      (a:ps') = sortBy (compare' calcAngle') ps 
          where
            smallest2 = let(x,y) = smallest in (x+1,y) 
            compare' fn x y = compare (fn x) (fn y)
            calcAngle' = calcAngle smallest smallest2
      collect acc [] = reverse acc
      collect acc@[b,a] ps@(c:pr) =
          case (calcDirection a b c) of
            LeftTurn -> collect (c : acc) pr
            _ -> collect [b,a] pr
      collect acc@(b:rest@(a:_)) ps@(c:pr) =
          case (calcDirection a b c) of
            LeftTurn -> collect (c : acc) pr
            _ -> collect rest ps
grahumScan ps = ps