REVISED: Friday, October 10, 2025
1. OCAML GENERIC MLP MODULE
(*
============================================================
ocaml C:\AI2025\generic.ml
Generic MLP Module in OCaml
============================================================
Objective:
- Create a reusable MLP module for arbitrary datasets.
- Include forward pass, backpropagation, training, and accuracy.
*)
(* -----------------------------
1. Vector and Matrix Utilities
----------------------------- *)
module Math = struct
type vector = float list
type matrix = float list list
let vector_add v1 v2 = List.map2 (+.) v1 v2
let vector_sub v1 v2 = List.map2 (-.) v1 v2
let vector_map f v = List.map f v
let scalar_vector_mul s v = List.map (fun x -> s *. x) v
let dot_product v1 v2 = List.fold_left (+.) 0.0 (List.map2 ( *. ) v1 v2)
let mat_vec_mul m v = List.map (fun row -> dot_product row v) m
let transpose m =
let rec transpose_aux m acc =
match List.hd m with
| [] -> List.rev acc
| _ ->
let heads = List.map List.hd m in
let tails = List.map List.tl m in
transpose_aux tails (heads :: acc)
in transpose_aux m []
let outer_product v1 v2 =
List.map (fun x -> List.map (fun y -> x *. y) v2) v1
let matrix_add m1 m2 = List.map2 vector_add m1 m2
let matrix_sub m1 m2 = List.map2 vector_sub m1 m2
let scalar_matrix_mul s m = List.map (scalar_vector_mul s) m
end
(* -----------------------------
2. Activation Functions
----------------------------- *)
module Activations = struct
let relu x = if x > 0. then x else 0.
let relu_derivative x = if x > 0. then 1. else 0.
let softmax v =
let max_v = List.fold_left max neg_infinity v in
let exps = List.map (fun x -> exp (x -. max_v)) v in
let sum_exps = List.fold_left (+.) 0.0 exps in
List.map (fun x -> x /. sum_exps) exps
end
(* -----------------------------
3. Helper: fold_lefti replacement
----------------------------- *)
(* OCaml's Stdlib lacks List.fold_lefti, so we define it manually *)
let fold_lefti f init lst =
let rec aux i acc = function
| [] -> acc
| x::xs -> aux (i+1) (f acc i x) xs
in aux 0 init lst
(* Added this helper to replace List.fold_lefti safely. *)
(* -----------------------------
4. MLP Class
----------------------------- *)
class mlp (layer_sizes : int list)
(activations : (float -> float) list)
(activation_derivs : (float -> float) list)
(learning_rate : float) =
object (self)
val mutable weights =
let rand_matrix rows cols =
let rnd () = (Random.float 2. -. 1.) *. 0.5 in
List.init rows (fun _ -> List.init cols (fun _ -> rnd ()))
in
let rec build ws ls =
match ls with
| [] | [_] -> ws
| n1::n2::rest -> build (ws @ [rand_matrix n2 n1]) (n2::rest)
in build [] layer_sizes
val mutable biases : Math.vector list =
List.map (fun n -> List.init n (fun _ -> 0.0)) (List.tl layer_sizes)
method forward (input : Math.vector) : Math.vector list * Math.vector list =
(* Modified to handle both scalar and vector activations *)
let rec f a zs ws bs acts =
match ws, bs, acts with
| [], [], [] -> (List.rev a, List.rev zs)
| w::wt, b::bt, act::at ->
let z = Math.vector_add (Math.mat_vec_mul w (List.hd a)) b in
(* Detect if activation is softmax or scalar *)
let a_next =
if act == (fun x -> x) then z (* placeholder, never used *)
else if List.length wt = 0 then (* last layer: use softmax vector form *)
Activations.softmax z
else
List.map act z
in
f (a_next::a) (z::zs) wt bt at
| _ -> failwith "Mismatched layers/activations"
in f [input] [] weights biases activations
method backprop (input : Math.vector) (target : Math.vector) =
let (a_list, z_list) = self#forward input in
let a_last = List.hd a_list in
let delta_output =
List.map2 ( -. ) a_last target
in
let rec propagate ws bs acts deltas grads =
match ws, bs, acts, deltas with
| [], [], [], _ -> List.rev grads
| w::wt, b::bt, act::at, delta::dt ->
let a_prev = List.nth a_list (List.length grads) in
let w_grad = Math.outer_product delta a_prev in
let b_grad = delta in
let w_t = Math.transpose w in
let delta_prev_pre = Math.mat_vec_mul w_t delta in
let delta_prev =
List.map2 ( *. ) delta_prev_pre (List.map act (List.hd z_list))
in
propagate wt bt at (delta_prev::dt) ((w_grad,b_grad)::grads)
| _ -> failwith "Mismatch in backprop"
in propagate (List.rev weights) (List.rev biases)
(List.rev activation_derivs) [delta_output] []
method update_weights grads =
let ws', bs' = List.split grads in
weights <- List.map2 (fun w dw -> Math.matrix_sub w (Math.scalar_matrix_mul learning_rate dw)) weights ws';
biases <- List.map2 (fun b db -> Math.vector_sub b (Math.scalar_vector_mul learning_rate db)) biases bs'
method train_batch (inputs : Math.vector list) (targets : Math.vector list) =
List.iter2 (fun x y ->
let grads = self#backprop x y in
self#update_weights grads
) inputs targets
method predict (input : Math.vector) =
let (activations, _) = self#forward input in
List.hd (List.rev activations)
method accuracy (inputs : Math.vector list) (targets : Math.vector list) =
let correct = ref 0 in
List.iter2 (fun x y ->
let pred = self#predict x in
(* Replace List.fold_lefti with our custom fold_lefti *)
let max_idx l =
fold_lefti (fun idx_acc i v -> if v > List.nth l idx_acc then i else idx_acc) 0 l
in
if max_idx pred = max_idx y then incr correct
) inputs targets;
(float !correct) /. (float (List.length inputs))
end
(* -----------------------------
5. Example Usage (XOR)
----------------------------- *)
let () =
Random.self_init ();
let inputs = [[0.;0.]; [0.;1.]; [1.;0.]; [1.;1.]] in
let targets = [[0.;1.]; [1.;0.]; [1.;0.]; [0.;1.]] in
(* We still specify softmax as the last activation,
but it will now be handled correctly in the forward pass. *)
let mlp1 = new mlp [2;2;2] [Activations.relu; (fun x -> x)]
[Activations.relu_derivative; (fun _ -> 1.0)] 0.1 in
for epoch = 1 to 500 do
mlp1#train_batch inputs targets;
if epoch mod 50 = 0 then (
Printf.printf "Epoch %d - Accuracy: %.2f\n" epoch (mlp1#accuracy inputs targets);
let predictions = List.map mlp1#predict inputs in
List.iter (fun v ->
Printf.printf "[%s] " (String.concat "; " (List.map (Printf.sprintf "%.2f") v))
) predictions;
print_newline ()
)
done
2. CONCLUSION
Windows PowerShell
Copyright (C) Microsoft Corporation. All rights reserved.
Install the latest PowerShell for new features and improvements! https://aka.ms/PSWindows
OCaml version: The OCaml toplevel, version 5.3.0
Coq-LSP version: 0.2.3
Loading personal and system profiles took 5415ms.
PS C:\Users\User> ocaml C:\AI2025\generic.ml
Epoch 50 - Accuracy: 0.25
[0.50; 0.50] [0.50; 0.50] [0.48; 0.52] [0.50; 0.50]
Epoch 100 - Accuracy: 0.75
[0.50; 0.50] [0.50; 0.50] [0.48; 0.52] [0.50; 0.50]
Epoch 150 - Accuracy: 0.75
[0.50; 0.50] [0.50; 0.50] [0.48; 0.52] [0.50; 0.50]
Epoch 200 - Accuracy: 0.75
[0.50; 0.50] [0.50; 0.50] [0.48; 0.52] [0.50; 0.50]
Epoch 250 - Accuracy: 0.75
[0.49; 0.51] [0.50; 0.50] [0.48; 0.52] [0.49; 0.51]
Epoch 300 - Accuracy: 0.75
[0.49; 0.51] [0.50; 0.50] [0.47; 0.53] [0.49; 0.51]
Epoch 350 - Accuracy: 0.50
[0.48; 0.52] [0.50; 0.50] [0.46; 0.54] [0.48; 0.52]
Epoch 400 - Accuracy: 0.50
[0.46; 0.54] [0.50; 0.50] [0.44; 0.56] [0.46; 0.54]
Epoch 450 - Accuracy: 0.50
[0.44; 0.56] [0.49; 0.51] [0.42; 0.58] [0.44; 0.56]
Epoch 500 - Accuracy: 0.50
[0.41; 0.59] [0.48; 0.52] [0.39; 0.61] [0.41; 0.59]
PS C:\Users\User>
3. REFERENCES
Bird, R. (2015). Thinking Functionally with Haskell. Cambridge, England: Cambridge University Press.
Davie, A. (1992). Introduction to Functional Programming Systems Using Haskell. Cambridge, England: Cambridge University Press.
Goerzen, J. & O'Sullivan, B. & Stewart, D. (2008). Real World Haskell. Sebastopol, CA: O'Reilly Media, Inc.
Hutton, G. (2007). Programming in Haskell. New York: Cambridge University Press.
Lipovača, M. (2011). Learn You a Haskell for Great Good!: A Beginner's Guide. San Francisco, CA: No Starch Press, Inc.
Thompson, S. (2011). The Craft of Functional Programming. Edinburgh Gate, Harlow, England: Pearson Education Limited.