type ('a, 'b) tree =
Leaf of ('a * 'b)
| Node of 'a * ('a,'b) tree * ('a, 'b) tree
let rec fac n = if n <= 1 then 1 else n * (fac (n-1))
(**********************************************************************)
(* Some Generic Helper Functions **************************************)
(**********************************************************************)
let (|>) = fun x f -> f x
let show = fun x -> ()
let rec ffor i j f =
if i < j then (
f i;
ffor (i+1) j f
)
let rec len = function
| x::xs -> 1 + len xs
| [] -> 0
(**********************************************************************)
(* STEP 1: MAP (expand each input into key-value list) ****************)
(**********************************************************************)
let rec expand f xs =
match xs with
| [] -> []
| x::xs' -> (f x) @ (expand f xs')
(**********************************************************************)
(* STEP 2: GROUP (cluster key-value pairs by key) *********************)
(**********************************************************************)
let group kvs =
let t = Hashtbl.create 37 in
List.iter begin fun (k,v) ->
let vs = if Hashtbl.mem t k then Hashtbl.find t k else [] in
Hashtbl.add t k (v::vs)
end kvs;
t
(**********************************************************************)
(* STEP 3: REDUCE (fold over values associated with each key **********)
(**********************************************************************)
let collapse f t =
Hashtbl.fold begin fun k vs acc ->
match vs with
| v::vs' -> (k, List.fold_left f v vs')::acc
| [] -> assert (0=1); assert false (* NON-NULL *)
end t []
(**********************************************************************)
(* Putting it all together ********************************************)
(**********************************************************************)
let map_reduce mapper reducer xs =
xs |> expand mapper
|> group
|> collapse reducer
(**********************************************************************)
(* CLIENT 1: Matrix Multiplication via Map-Reduce ********************)
(* Multiply m x n dimensional matrix (a) ******************************)
(* With n dimensional vector (x) ******************************)
(* to get m dimensional vector (b) ******************************)
(**********************************************************************)
let rec range i j =
if i >= j then [] else i::(range (i+1) j)
let row_multiply n a x i =
let _ = assert (Array.length a.(i) = n) in
range 0 n
|> List.map (fun j -> (i, a.(i).(j) *. x.(j)))
let matrix_multiply m n a x =
assert (Array.length a = m && Array.length x = n && 0 < m);
let b = Array.make m 0.0 in
range 0 m
|> map_reduce (row_multiply n a x) (+.)
|> List.iter (fun (i,v) -> b.(i) <- v)
|> fun _ -> b
(**********************************************************************)
(* CLIENT 2: K-MEANS via Map-Reduce ***********************************)
(**********************************************************************)
let min_index a =
let min = ref 0 in
ffor 0 (Array.length a) (fun i ->
if a.(i) < a.(!min) then (* ARRAY BOUNDS *)
min := i
);
!min
let nearest dist ctra x =
let da = Array.map (dist x) ctra in
[min_index da, (x, 1)]
let centroid plus p1 p2 =
let (x1, sz1) = p1 in
let (x2, sz2) = p2 in
(plus x1 x2, sz1 + sz2)
let kmeans n dist plus div (xs : 'a list) (ctra : 'a array) =
assert (Array.length ctra > 0);
ffor 0 n begin fun _ ->
xs |> map_reduce (nearest dist ctra) (centroid plus)
|> List.map (fun (i, (x, sz)) -> ctra.(i) <- div x sz)
end (* ARRAY BOUNDS, DIVIDE BY ZERO *)
> type XY = (Double, Double)
> shift :: XY -> XY -> XY
> shift (dx,dy) (x,y) = (x + dx, y + dy)
> data CorS =
> Circle (Double, Double, Double)
> | Square (Double, Double, Double)
> deriving (Show)
> c = Circle (1.0, 2.1, 3.0)
> s = Square (2.0, 2.1, 3.0)
> area (Square (_,_,s)) = s * s
> area (Circle (_,_,r)) = pi * r* r
> len [] = 0
> len (x:xs) = 1 + len xs
> data Shape = Rectangle Side Side
> | Polygon [Vertex]
> deriving (Show)
> type Side = Double
> type Vertex = (Double, Double)
> area2 (Rectangle a b) = a * b
> area2 (Polygon (v1:v2:v3:vs)) =
> areaTri v1 v2 v3 + area2 (Polygon (v1:v3:vs))
> where areaTri = error "TO BE DONE..."
> area2 (Polygon _) = 0
> act1 = putStrLn "1: hello"
> act2 = putStrLn "2: world"
> acts = [act1, act2]
> oneBigAction = act1 >> act2
This won’t compile.
main = acts
The error message is quite explicit
rjhala@goto:~/teaching/230/wi11/hakyll/lectures$ ghc -o hello lec1.lhs
lec1.lhs:42:2:
Couldn't match expected type `IO t' against inferred type `[IO ()]'
In the expression: main
When checking the type of the function `main'
Haskell insists that type type of main be a single action IO t and not a list of actions. Instead, the following is fine.
> main = oneBigAction
Thus, we need a way to compose actions, the >> operator suffices, for example, we could do
main = act1 >> act2
A slightly nicer syntax, if you have multiple actions is the do notation.
do act1
act2
act3
...
actn
is exactly the same as
act1 >> act2 >> act3 >> ... >> actn
Thus,
main = do putStrLn "1. hello"
putStrLn "2. world"
binds the top-level main to an action composed of the two individual sub-actions. The nice thing about actions is that with a few simple operators, we can start rolling our own kinds of composition mechanisms. For example, we can stitch together a list of several actions into a single action
> fuseActions :: [IO ()] -> IO ()
> fuseActions [] = return ()
> fuseActions (a1:acts) = do a1
> fuseActions acts