Data commit

Task/Gaussian-elimination/OCaml/gaussian-elimination-1.ocaml

@@ -0,0 +1,28 @@
+module Array = struct
+  include Array
+  (* Computes: f a.(0) + f a.(1) + ... where + is 'g'. *)
+  let foldmap g f a =
+    let n = Array.length a in
+    let rec aux acc i =
+      if i >= n then acc else aux (g acc (f a.(i))) (succ i)
+    in aux (f a.(0)) 1
+
+  (* like the stdlib fold_left, but also provides index to f *)
+  let foldi_left f x a =
+    let r = ref x in
+    for i = 0 to length a - 1 do
+      r := f i !r (unsafe_get a i)
+    done;
+    !r
+end
+
+let foldmap_range g f (a,b) =
+  let rec aux acc n =
+    let n = succ n in
+    if n > b then acc else aux (g acc (f n)) n
+  in aux (f a) a
+
+let fold_range f init (a,b) =
+  let rec aux acc n =
+    if n > b then acc else aux (f acc n) (succ n)
+  in aux init a

Task/Gaussian-elimination/OCaml/gaussian-elimination-2.ocaml

@@ -0,0 +1,38 @@
+(* Some less-general support functions for 'solve'. *)
+let swap_elem m i j = let x = m.(i) in m.(i) <- m.(j); m.(j) <- x
+let maxtup a b = if (snd a) > (snd b) then a else b
+let augmented_matrix m b =
+  Array.(init (length m) ( fun i -> append m.(i) [|b.(i)|] ))
+
+(* Solve Ax=b for x, using gaussian elimination with scaled partial pivot,
+ * and then back-substitution of the resulting row-echelon matrix. *)
+let solve m b =
+  let n = Array.length m in
+  let n' = pred n in (* last index = n-1 *)
+  let s = Array.(map (foldmap max abs_float) m) in  (* scaling vector *)
+  let a = augmented_matrix m b in
+
+  for k = 0 to pred n' do
+    (* Scaled partial pivot, to preserve precision *)
+    let pair i = (i, abs_float a.(i).(k) /. s.(i)) in
+    let i_max,v = foldmap_range maxtup pair (k,n') in
+    if v < epsilon_float then failwith "Matrix is singular.";
+    swap_elem a k i_max;
+    swap_elem s k i_max;
+
+    (* Eliminate one column *)
+    for i = succ k to n' do
+      let tmp = a.(i).(k) /. a.(k).(k) in
+      for j = succ k to n do
+        a.(i).(j) <- a.(i).(j) -. tmp *. a.(k).(j);
+      done
+    done
+  done;
+
+  (* Backward substitution; 'b' is in the 'nth' column of 'a' *)
+  let x = Array.copy b in (* just a fresh array of the right size and type *)
+  for i = n' downto 0 do
+    let minus_dprod t j = t -. x.(j) *. a.(i).(j) in
+    x.(i) <- fold_range minus_dprod a.(i).(n) (i+1,n') /. a.(i).(i);
+  done;
+  x

Task/Gaussian-elimination/OCaml/gaussian-elimination-3.ocaml

@@ -0,0 +1,8 @@
+let a =
+  [| [| 1.00; 0.00; 0.00;  0.00;  0.00; 0.00 |];
+     [| 1.00; 0.63; 0.39;  0.25;  0.16; 0.10 |];
+     [| 1.00; 1.26; 1.58;  1.98;  2.49; 3.13 |];
+     [| 1.00; 1.88; 3.55;  6.70; 12.62; 23.80 |];
+     [| 1.00; 2.51; 6.32; 15.88; 39.90; 100.28 |];
+     [| 1.00; 3.14; 9.87; 31.01; 97.41; 306.02 |] |]
+let b = [| -0.01; 0.61; 0.91; 0.99; 0.60; 0.02 |]

Task/Gaussian-elimination/OCaml/gaussian-elimination-4.ocaml

@@ -0,0 +1,4 @@
+# let x = solve a b;;
+val x : float array =
+[|-0.0100000000000000991; 1.60279039450210536; -1.61320305990553226;
+  1.24549412137140547; -0.490989719584644546; 0.0657606961752301433|]

Task/Gaussian-elimination/OCaml/gaussian-elimination-5.ocaml

@@ -0,0 +1,8 @@
+let mul m v =
+  Array.mapi (fun i u ->
+    Array.foldi_left (fun j sum uj ->
+      sum +. uj *. v.(j)
+    ) 0. u
+  ) m
+
+let sub u v = Array.mapi (fun i e -> e -. v.(i)) u

Task/Gaussian-elimination/OCaml/gaussian-elimination-6.ocaml

@@ -0,0 +1,4 @@
+# let residual = sub b (mul a x);;
+val residual : float array =
+  [|9.8879238130678e-17; 1.11022302462515654e-16; 2.22044604925031308e-16;
+    8.88178419700125232e-16; -5.5511151231257827e-16; 4.26741975090294545e-16|]