module List2D = type 't list2d = | A of 't list2d * 't list2d //above structure | B of 't list2d * 't list2d //beside structure | E of 't //container | Empty //empty list with /// /// list2d transpose: swap A and B /// member this.transpose = let rec loop = function | A(x, Empty) | A(Empty,x) | B(x, Empty) | B(Empty,x) -> loop x | A(a,b) -> B(loop a,loop b) | B(a,b) -> A(loop a,loop b) | a -> a loop this /// /// list2d height: number of A /// member this.height = let rec loop = function | E(_) -> 1 | Empty -> 0 | A(x,y) -> (loop x) + (loop y) | B(x,_) -> (loop x) loop this /// /// list2d width: number of B /// member this.width = let rec loop = function | E(_) -> 1 | Empty -> 0 | A(x,_) -> (loop x) | B(x,y) -> (loop x) + (loop y) loop this /// /// list2d area /// member this.area = this.height * this.width /// /// list2d map: apply transformation to each element of list2d /// /// transformation let rec map f = function //| A(x,Empty) | A(Empty,x) //strip Empty element if you don't really need it //| B(x,Empty) | B(Empty,x) -> map f x | E x -> E(f x) | A(x,y) -> A(map f x, map f y) | B(x,y) -> B(map f x, map f y) | Empty -> Empty /// /// list2d reduce: replace "above" and "beside" operators /// /// replacement for above /// replacement for beside let rec reduce Af Bf = function | E(x) -> x | A(x,Empty) | A(Empty, x) | B(x,Empty) | B(Empty, x) -> reduce Af Bf x | A(x,y) -> Af (reduce Af Bf x) (reduce Af Bf y) | B(x,y) -> Bf (reduce Af Bf x) (reduce Af Bf y) | Empty -> failwith "Empty list2d" /// /// list2d sum: matrix total /// let sum = reduce (+) (+) /// /// Left operator /// /// returned parameter /// omitted parameter let inline (<<|) (a:'t) (_b:'t) = a /// /// Right operator /// /// omitted parameter /// returned parameter let inline (|>>) (_a:'t) (b:'t) = b /// /// Most top left element of list2d /// /// list2d let topleft M = reduce (<<|) (<<|) M /// /// Most top right element of list2d /// /// list2d let topright M = reduce (<<|) (|>>) M /// /// Most bottom left element of list2d /// /// list2d let bottomleft M = reduce (|>>) (<<|) M /// /// Most bottom right element of list2d /// /// list2d let bottomright M = reduce (|>>) (|>>) M /// /// Place one element above another element /// /// element /// element let above x y = A(x, y) /// /// Place one element beside another element /// /// element /// element let beside x y = B(x, y) /// /// Place element /// /// element let place x = E x /// /// Extract value /// let the = function | E x -> x | _ -> failwith "Not a singleton list2d" let rec topreduce f = function | E x -> E x | Empty -> Empty | A(x,E y) | A(E y, x) -> let b = the (topreduce f x) in E(f b y) | A(x,Empty) | A(Empty,x) -> topreduce f x | B(x,Empty) | B(Empty,x) -> topreduce f x | B(x, y) -> B(topreduce f x,topreduce f y) | a -> failwith (sprintf "%A" a) /// /// list2d zip with f: makes pairwise zipping of two list2d /// /// zip operator /// first list2d /// second list2d let zip f (M1:'t list2d) (M2:'t list2d) = let rec loop a b = match a,b with | Empty,Empty -> Empty | E(x),E(y) -> E(f x y) | A(x,y),A(u,v) -> A(loop x u,loop y v) | B(x,y),B(u,v) -> B(loop x u,loop y v) | _ -> failwith "Dimensions mismatch" loop M1 M2 /// /// list2d rows. Return list2d of rows /// /// list2d let rows M = M |> (map (place >> place) >> reduce above (zip beside)) /// /// list2d columns. Return list2d of columns /// /// list2d let columns M = M |> (map (place >> place) >> reduce (zip above) beside) let rec stripAB M = match M with | A(E x, E y) | B(E x, E y) -> [x; y] | A(E x, y) | B(E x, y) -> x::(stripAB y) | _ -> failwith "Incorrect constructor" /// /// List of list2d rows /// /// list2d let listrows M = M |> (map (List.singleton >> place) >> reduce above (zip (@)) >> stripAB) /// /// List of list2d columns /// /// list2d let listcols M = M |> map (List.singleton >> place) |> reduce (zip (@)) beside|> stripAB //Examples let a = Array2D.zeroCreate 5 5 let mutable k = 0 for i in 0..4 do for j in 0..4 do a.[i, j] <- k k <- k + 1 let toRow (a:'t array) = a.[0..] |> Array.rev |> Array.fold (fun acc el -> List2D.B(List2D.E(el),acc)) List2D.Empty let toMatrix (a:'t [,]) = let s = seq{for i in [(Array2D.length2 a)-1..-1..0] do yield a.[i,*] |> toRow } s |> Seq.fold (fun acc r -> List2D.A(r, acc)) List2D.Empty let b = a |> toMatrix |> List2D.map (fun e -> e*2) b |> List2D.listrows b.width b |> List2D.sum