afp

1-2. reduce for natural number (0,((+) 1)).

// PRELIMINARY
let rec redn v f = function
  | 0 -> v
  | n -> f (redn v f (n-1));;

//redn (0,[]) (fun (x,xs)->(x+1,x::xs)) 10;;

Sample use:

let enum n m = 
  let _,r = redn (m,[]) (fun (x,xs)->(x-1,x::xs)) (m-n+1)
  r;;
let (<>) = enum;;

reduce for lists ([],(::)):

// STD LISTS' OPERATIONS
let rec red v f = function
  | []    -> v
  | x::xs -> f x (red v f xs);;

Sample use: catenation and map:

let (@) xs ys = red ys (fun x xs->x::xs) xs;;
// (1<>2)@(3<>4);;
let map f = red [] (fun x xs->(f x)::xs);;
// map ((+) 1) [1..4];;

Transform binary into n-ary operators (eg. (+) and (@))

let sum = red 0 (+);;
// sum [1..4];;
let len xs = red 0 (fun x xs->1+xs) xs;;
// len [1..4];;
let join xss = red [] (@) xss;;

"Monad" concept

let ret x = [x];;
let fail  = [];;

let (>>=) xs f = join (map f xs);;
// all sub intervals
[1..4] >>= fun i ->
[1..4] >>= fun j ->
if (i<=j) then ret [i..j] else fail;;

Nb. Defining the filter function:

let filter p xs = 
  let q x = if (p x) then ret x else fail
  join (map q xs);; // xs >>= q
//filter (fun x->(x%2)=0) [1..4];;

// SETS' OPERATIONS
let elem  x  xs = (List.length (List.filter ((=) x) xs))=1;;
let inter xs ys = List.filter (fun x->elem x xs) ys;;
let diff  xs ys = List.filter (fun x->not (elem x ys)) xs;;
let union xs ys = (diff xs ys)@ys;;
let bigUnion xss = red [] union xss;;
let disjoin xs ys = (inter xs ys)=[];;
let included xs ys = red true (&&) (List.map (fun x->elem x ys) xs);;
// included [2..3] [1..4];;
let equal xs ys = (included xs ys)&&(included ys xs);;
//equal [1;3;2] [2;1;3];;
// all disjoin
let allDisjoin xss = 
  let check = 
    xss >>= fun x ->
    xss >>= fun y ->
    ret ((equal x y)||(disjoin x y))
  red true (&&) check;;

// POWERSET
let rec power = function
  | []    -> [[]]
  | x::xs -> let xs' = power xs
             let xs''= List.map (fun xs''->x::xs'') xs'
             xs'@xs'';;
// power [1..4];;
let xss = filter (fun xs->(List.len xs)>0) (power [1..4]);;

10-11.

// MAP
let weights = [(1,0.3);(2,0.7);(3,0.4);(4,0.5)];;
let rec weight i = function
  | (k,v)::kvs -> if (k=i) then v else weight i kvs;;
// weight 2 weights;;

Packages' builder program:

let max      = 1.0;;
let total xs = List.sum (List.map (fun i->weight i weights) xs);;
let sets = List.filter (fun xs->(total xs)<max) xss;;
let yss  = List.filter (fun xs->(List.length xs)>0) (power sets);;

// SYNTHESIS
let zss = filter (fun ys->(allDisjoin ys)&&(equal (bigUnion ys) (1<>4))) yss;; 

// CHOOSE BEST CONFIG (= MIN SIZE): sorting
let rec red1 f = function
  | [v]   -> v
  | x::xs -> f x (red1 f xs);;

red1 (fun xs ys->if ((len xs)<(len ys)) then xs else ys) zss;;

Advanced Functional Prog.