Commit ce05765c authored by Andreas Pfurtscheller's avatar Andreas Pfurtscheller

Add HW10 馃搫

parent 7a2fe798
......@@ -28,7 +28,120 @@ end
(*****************************************************************************)
(* Assignment 10.2 [20 Points] *)
(* todo ... *)
module IntRing : Ring with type t = int = struct
type t = int
let zero = 0
let one = 1
let add a b = a + b
let mul a b = a * b
let compare = Pervasives.compare
let to_string a = Printf.sprintf "%d" a
end
module FloatRing : Ring with type t = float = struct
type t = float
let zero = 0.0
let one = 1.0
let add a b = a +. b
let mul a b = a *. b
let compare = Pervasives.compare
let to_string a = Printf.sprintf "%F" a
end
module type FiniteRing = sig
include Ring
val elems : t list
end
module BoolRing : FiniteRing with type t = bool = struct
type t = bool
let elems = [true;false]
let zero = false
let one = true
let add a b = (a && not b) || (b && not a)
let mul a b = a && b
let compare = Pervasives.compare
let to_string a = Printf.sprintf "%B" a
end
module SetRing (R: FiniteRing) : Ring with type t = R.t list = struct
type t = R.t list
let zero = []
let one = R.elems
let add a b = List.sort_uniq R.compare (a@b)
let mul a b =
let rec is a b = match a with
| [] -> []
| h::tl -> if (List.exists (fun a -> a = h) b) then h::(is tl b) else (is tl b) in
is a b
let compare a b =
let rec cmpl a b = match a,b with
| [], [] -> 0
| [], _ -> -1
| _, [] -> 1
| h1::t1, h2::t2 -> if h1 < h2 then -1 else if h1 > h2 then 1 else (cmpl t1 t2)
in
cmpl (List.sort R.compare a) (List.sort R.compare b)
let to_string a = Printf.sprintf "{%s}" (String.concat "," (List.map (fun a -> R.to_string a) R.elems))
end
module DenseMatrix (R: Ring) : Matrix with type elem = R.t and type t = (R.t list) list = struct
type elem = R.t
type t = (R.t list) list
let create n m = List.map Array.to_list (Array.to_list (Array.make_matrix n m R.zero))
let identity n = List.mapi (fun i r -> (List.mapi (fun j e -> if i = j then R.one else e) r)) (create n n)
let from_rows l = l
let to_string m = String.concat "\n" (List.map (fun r -> String.concat " " (List.map (fun e -> R.to_string e) r)) m)
let set y x v m = List.mapi (fun i r -> (List.mapi (fun j e -> if i = y && j = x then v else e) r)) m
let get y x m = List.nth (List.nth m y) x
let transpose m =
let rec tp m =
if List.mem [] m then []
else (List.map List.hd m)::(tp (List.map List.tl m)) in
tp m
let add a b = List.map2 (fun ra rb -> List.map2 (fun ea eb -> R.add ea eb) ra rb) a b
let mul a b =
let vmul v1 v2 = List.fold_left (fun a v -> R.add a v) R.zero (List.map2 (fun a b -> R.mul a b) v1 v2) in
let mmul v m = List.map (fun r -> (vmul v r)) (transpose m) in
List.map (fun r -> (mmul r b)) a
end
module SparseMatrix (R: Ring) : Matrix with type elem = R.t = struct
type elem = R.t
type t = { n : int; m : int; el : (int * int * R.t) list }
let foldi f n a =
let rec fold f n i a = if (i = 0) then a else (fold f n (i-1) (f (n-i) a)) in
fold f n n a
let comp (i1,j1,_) (i2,j2,_) = if i1 < i2 then -1 else if i1 > i2 then 1 else if j1 < j2 then -1 else if j1 > j2 then 1 else 0
let tval (_,_,e) = e
let create n m = { n = n; m = m; el = [] }
let identity n =
let rec id n = match n with
| 0 -> []
| i -> ((i-1),(i-1),R.one)::(id (i-1)) in
{ n = n; m = n; el = (id n) }
let from_rows l =
let n = List.length l in
let m = if n > 0 then List.length (List.hd l) else 0 in
let el = List.flatten (List.mapi (fun i r -> (List.filter (fun (_,_,e) -> (e <> R.zero)) (List.mapi (fun j e -> (i,j,e)) r))) l) in
{ n = n; m = m; el = el }
let set r c v m = { n = m.n; m = m.m; el = (r,c,v)::(List.filter (fun (i,j,_) -> (i <> r || j <> c)) m.el) }
let get r c m =
try tval (List.find (fun (i,j,_) -> (i = r && j = c)) m.el)
with Not_found -> R.zero
let transpose m = { n = m.m; m = m.n; el = List.map (fun (i,j,e) -> (j,i,e)) m.el }
let to_string m = String.concat "\n" (List.rev (foldi (fun i a1 -> (String.concat " " (List.rev (foldi (fun j a2 -> (R.to_string (get i j m))::a2) m.m [])))::a1) m.n []))
let add a b =
let el = List.flatten (foldi (fun i acc -> List.filter (fun (_,_,e) -> (e <> R.zero)) (foldi (fun j acc -> ((i,j,(R.add (get i j a) (get i j b)))::acc)) a.m [])::acc) a.n []) in
{ n = a.n; m = a.m; el = el }
let mul a b =
let vmul r j = (List.fold_left (fun a v -> R.add a v) R.zero (foldi (fun i acc -> (R.mul (get r i a) (get i j b))::acc) b.n [])) in
let mmul r = (foldi (fun j a -> (r,j,(vmul r j))::a) b.m []) in
let el = List.flatten (foldi (fun i acc -> List.filter (fun (_,_,e) -> (e <> R.zero)) (mmul i)::acc) a.n []) in
{ n = a.n; m = b.m; el = el }
end
(*****************************************************************************)
(**************************** END OF HOMEWORK ********************************)
......@@ -53,7 +166,7 @@ let tests =
* tests for 10.2 (IntRing) :
* NOTE: Comment tests until you have completed your implementation of IntRing
*)
(*
let implementsRingSignature (module M : Ring) = true in
[
__LINE_OF__ (fun () -> implementsRingSignature (module IntRing));
......@@ -61,13 +174,13 @@ let tests =
__LINE_OF__ (fun () -> IntRing.add 10 IntRing.zero = 10);
__LINE_OF__ (fun () -> IntRing.mul 10 IntRing.one = 10);
__LINE_OF__ (fun () -> IntRing.to_string 10 = "10");
] @ *)
] @
(******************************
* tests for 10.2 (FloatRing) :
* NOTE: Comment tests until you have completed your implementation of FloatRing
*)
(*
let implementsRingSignature (module M : Ring) = true in
[
__LINE_OF__ (fun () -> implementsRingSignature (module FloatRing));
......@@ -75,13 +188,13 @@ let tests =
__LINE_OF__ (fun () -> FloatRing.add 10.0 FloatRing.zero = 10.0);
__LINE_OF__ (fun () -> FloatRing.mul 10.0 FloatRing.one = 10.0);
__LINE_OF__ (fun () -> FloatRing.to_string 10.0 = "10.");
] @ *)
] @
(*****************************
* tests for 10.2 (BoolRing) :
* NOTE: Comment tests until you have completed your implementation of BoolRing
*)
(*
let implementsFiniteRingSignature (module M : FiniteRing) = implementsRingSignature (module M) in
[
__LINE_OF__ (fun () -> implementsFiniteRingSignature (module BoolRing));
......@@ -90,13 +203,13 @@ let tests =
__LINE_OF__ (fun () -> BoolRing.mul true BoolRing.one = true && BoolRing.mul false BoolRing.one = false);
__LINE_OF__ (fun () -> BoolRing.to_string true = "true");
__LINE_OF__ (fun () -> BoolRing.elems |= [true;false]);
] @ *)
] @
(****************************
* tests for 10.2 (SetRing) :
* NOTE: Comment tests until you have completed your implementation of SetRing
*)
(*
let module TestRing : FiniteRing with type t = char = struct
let cfrom x = (int_of_char x) - (int_of_char 'a')
let cto x = char_of_int (x mod 4 + int_of_char 'a')
......@@ -121,14 +234,14 @@ let tests =
__LINE_OF__ (fun () -> SR.mul ['a';'b'] ['c';'b'] |= ['b']);
__LINE_OF__ (fun () -> SR.mul ['a';'b'] SR.one |= ['a';'b']);
__LINE_OF__ (fun () -> check_string_representation (SR.to_string SR.one) ["'a'";"'b'";"'c'";"'d'"]);
] @ *)
] @
(********************************
* tests for 10.2 (DenseMatrix) :
* NOTE: Comment tests until you have completed your implementation of DenseMatrix
* NOTE: from_rows and get have to be correct in order for these tests to work correctly!
*)
(*
let module DM = DenseMatrix (IntRing) in
let dm0 = DM.from_rows [[4;-2;1];[0;3;-1]] in
let dm1 = DM.from_rows [[1;2];[-3;4];[3;-1]] in
......@@ -143,14 +256,14 @@ let tests =
__LINE_OF__ (fun () -> check_dense (DM.add dm0 dm0) [[8;-4;2];[0;6;-2]]);
__LINE_OF__ (fun () -> check_dense (DM.mul dm0 dm1) [[13;-1];[-12;13]]);
__LINE_OF__ (fun () -> (DM.to_string dm0) = "4 -2 1\n0 3 -1");
] @ *)
] @
(*********************************
* tests for 10.2 (SparseMatrix) :
* NOTE: Comment tests until you have completed your implementation of SparseMatrix
* NOTE: from_rows and get have to be correct in order for these tests to work correctly!
*)
(*
let module SM = SparseMatrix (IntRing) in
let sm0 = SM.from_rows [[4;-2;1];[0;3;-1]] in
let sm1 = SM.from_rows [[1;2];[-3;4];[3;-1]] in
......@@ -165,7 +278,7 @@ let tests =
__LINE_OF__ (fun () -> check_sparse (SM.add sm0 sm0) [[8;-4;2];[0;6;-2]]);
__LINE_OF__ (fun () -> check_sparse (SM.mul sm0 sm1) [[13;-1];[-12;13]]);
__LINE_OF__ (fun () -> (SM.to_string sm0) = "4 -2 1\n0 3 -1");
] @ *)
] @
[]
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment