Generate Partitions

let rec generate start n =
  if start = 0 then
    match n with
    | 0 -> raise (Invalid_argument "n")
    | 1 -> [[1]]
    | k -> let result = generate 1 k in [k]::result
  else if start < n then
        (let result = ref [] in
          for i = start to n - start do
            let tmp_result = generate i (n - i) in
            let tmp_result_i = List.map (fun lst -> i :: lst) tmp_result in
            let tmp_result2 = tmp_result_i @ !result in
            result := tmp_result2
          done;
          !result ;)
  else
    [[n]];;


let generate_partitions n =
  generate 0 n ;;


generate_partitions 1 ;;
generate_partitions 2 ;;
generate_partitions 3 ;;

Generate All Subsets of N

(* In this scripte, we will write a function to generate all the subset of {1,2,...,n} 
 * The basic idea is to use the bit array of 1, 2, ..., n to represent the subset.
 *)

let rec int_power x n =
  let xf = float_of_int x
  and nf = float_of_int n in
  int_of_float (xf ** nf) ;;


let generate_subset n =
  let arr = Array.init n (fun x -> x + 1)in
  let rec generate_set result index k =
    match k with
    | 0 -> result
    | k ->
      if k land 1 = 1 then
        let elem = arr.(index) in
        generate_set (elem::result) (index + 1) (k lsr 1)
      else
        generate_set result (index + 1) (k lsr 1)
  in
    let rec generate_allset result k limit =
      match k < limit with
      | false -> result
      | true ->
        let res = generate_set [] 0 k in
        generate_allset (res::result) (k + 1) limit
    in
    let num_iter = int_power 2 n in
    let final_result = generate_allset [] 0 num_iter in
    final_result ;;


generate_subset 1 ;;
generate_subset 2 ;;
generate_subset 3 ;;
generate_subset 4 ;;

Implement max heap in Ocaml

(* In this script, we will implement the max heap.
 * In this implementation, we use the first element in
 * the array to store the number of elements in the heap.
 * This number has type of int, it follows that the heap
 * is of type int array.
 *)


let parent i = i / 2 ;;
let left i = 2 * i ;;
let right i = 2 * i + 1 ;;


(* the function heapify maintains the heap property of the sub-heap
 * rooted at k
 *)

let rec heapify heap k = 
  let count = heap.(0) in 
  if k < 1 then
    raise (Invalid_argument "heap")
  else if k < count then
    match left k <= count, right k <= count with
    |(true, true) ->
        let elem = heap.(k) 
        and elem_left = heap.(left k) 
        and elem_right = heap.(right k) in
        (match elem < elem_left, elem < elem_right with
        | (false, false ) -> ()
        | (_,_) ->
            if elem_left < elem_right then
                (heap.(k) <- elem_right; heap.(right k) <- elem; heapify heap (right k))
            else
                (heap.(k) <- elem_left; heap.(left k) <- elem; heapify heap (left k)))
    |(true, false) -> 
        let elem_left = heap.(left k) and elem = heap.(k) in
        if elem <elem_left then
          (heap.(left k) <- elem ; heap.(k) <- elem_left)
    |(false, _)  -> () ;;



(* the function heapify_all will call function heapify on every node in the heap *)

let heapify_all  heap = 
  let count = heap.(0) in
  for i = count downto 1 do
    heapify heap i
  done;;

(* add function will add a new element to the heap *)
let add heap elem = 
  let count = heap.(0) in
  if count = Array.length heap then
    raise (Failure "The heap is full. Cannot add new element.")
  else
    (heap.(0) <- count + 1;
     let p = ref heap.(0) in
     while !p / 2  > 0 && heap.(!p) > heap.(!p / 2)  do
       p := !p / 2;
       heapify heap !p
     done);;


(* max_heap return the maximum value of the heap but not remove it from the heap
 * *)
let max_heap heap =
  if heap.(0) = 0 then
    raise (Failure "The heap is empty.")
  else
    heap.(1) ;;

(* pop function returns the maximum value of the heap and remove it from the
 * heap *)

let pop heap = 
  let count = heap.(0) in
  if count  = 0 then
    raise (Failure "The heap is empty.")
  else
    let elem = heap.(1) in    
    heap.(1) <- heap.(count);
    heap.(0) <- count - 1;
    heapify heap 1;
    elem;;
   

Simple Implementation of Double Linked List in Ocaml

In this script, we will give a simple implementation of double linked list in OCaml. We can find more details in the book Introduction to Objective Caml, page 65.

type 'a elem =
  | Nil
  | Elem of 'a * 'a elem ref * 'a elem ref
;;

let nil_elem = Nil ;;   (* create a Nil element *)

let create_element x = Elem (x, ref Nil, ref Nil) ;;

let get = function
  | Elem (x, _, _) -> x
  | Nil -> raise (Invalid_argument "get") ;;

let prev_elem = function
  | Elem (_, prev, _) -> !prev
  | Nil -> raise (Invalid_argument "prev_elem") ;;



(* implement the doubly-linked list, the list itself can be just
 * a reference ot the first element. 
 *)

type 'a dlist = 'a elem ref ;;

let create () = ref Nil ;;

let insert list elem =
  match elem, !list with
  | Elem (_, prev, next), Nil ->
      prev := Nil;
      next := Nil;
      list := elem
  | Elem (_, prev1, next1) , (Elem (_, prev2, _) as head) ->
      prev1 := Nil;
      next1 := head;
      prev2 := elem;
      list  := elem
  | Nil, _ ->
      raise (Invalid_argument "insert")
;;

let remove list elem =
  match elem with
  | Elem (_, prev, next) ->
      (match !prev with
       | Elem (_, _, prev_next) -> prev_next := !next
       | Nil -> list := !next) ;
      (match !next with
       | Elem (_,next_prev, _) -> next_prev := !prev
       | Nil -> ())
  | Nil ->
      raise (Invalid_argument "remove")
;;

Rotate a one-dimensional array of N elements left by k positions

We can find the discussion of this problem in Bentley's book Programming Pears, Column 2.

First Solution

First observation is that we can decompose a rotation into several swap. This idea will lead us to find the recursive structure of the problem. Here is the implementation

let rec rotate arr is ie k i0 j0 =
  let kk = k mod (ie-is+1) in
  if is < ie && kk <> 0 then
    let condition_i0 = i0 < kk
    and condition_j0 = (is+j0) < ie in
    if condition_i0 then
      let tmp = arr.(is+i0) in
      arr.(is+i0) <- arr.(is+j0);
      arr.(is+j0) <- tmp;
      match condition_j0 with
      | true -> rotate arr is ie kk (i0+1) (j0+1)
      | false ->  let kk2 = kk - i0 - 1 in rotate arr (is+i0+1) ie kk2 0 kk2
    else
      rotate arr (is+kk) ie kk 0 kk
;;

Second Solution

We can also look at this problem from another point of view. We can decompose the rotation into several sub-rotation.

0  <- k <- 2k <- 3k ...
1 <- k+1 < 2k+1 <- 3k+1 <- ...

This idea leas to another solution.

let rec gcd a b =
  let x = min a b and y = max a b in
  if x = 0 then y
  else
    gcd x (y mod x ) ;;

let rotate2 arr k =
  let length = Array.length arr in
  let kk = k mod length in
  let n_loop = gcd kk length in
  let n_loop_j = length / n_loop in
  for i = 0 to n_loop - 1 do
    let tmp = arr.(i) in
    for j = 0 to n_loop_j - 2 do
      arr.((i+ j * kk) mod length) <- arr.((i + (j+1) * kk) mod length )
    done ;
    arr.((i + (n_loop_j-1) * kk) mod length) <- tmp
  done ;;

Third Solution

In the book we can find a third solution and it is very elegant.

rotate(n,k) = {reverse(n,0,k-1);
                       reverse(n,k,n-1);
                       reverse(n,0,n-1);}

Simple Implementation of Hash Table in OCaml

(* In this script, we will implement a simple hash table.                       
 * In our implementation, the keys are strings and the table has                
 * polymorphic values.                                                          
 *                                                                              
 * Part of the implementation can be found in the book Introduction to Objective Caml by Jason Hickey. P92      
 *)                                                                             
                                                                                
                                                                                
(* create an array of random numbers *)                                       
                                                                                
let random_numbers = Array.init 37 (fun x -> Random.int 100 + 1) ;;                                                                                       
let random_length = Array.length random_numbers ;;                              
          
type hash_info =                                                                
  { mutable hash_index : int;                                                   
    mutable hash_value : int;                                                   
  };;                                                                           
                                                                                
let hash_char info c =                                                          
  let i = Char.code c in                                                      
  let index = (info.hash_index + i + 1) mod random_length in                    
  info.hash_value <- (info.hash_value * 3 ) lxor random_numbers.(index);        
  info.hash_index <- index                                                      
;;                                                                              
                                                                                
                                                                                
let hash s =  (* compute the hash of a string *)                                
  let info = { hash_index = 0; hash_value = 0 } in                              
  for i = 0 to String.length s - 1 do                                           
    hash_char info s.[i]                                                        
  done;                                                                         
  info.hash_value                                                               
;;                       


type 'a hash_entry = { key : string; value : 'a };;                             
type 'a hash_table = 'a hash_entry list array ;;                                
                                                                                
let create () =                                                                 
  Array.make 101 [] ;;                                                        
                                                     
(* add functino adds {key ;value} to the hash table. however
 * it does not check if the key has already existed. One of the
 * consequences is we may have multiple values corresponding to
 * the same key 
 *)

             
let add table key value =                                                       
  let index = (hash key) mod (Array.length table) in                            
  table.(index) <- {key = key; value = value} :: table.(index) ;;   


(* find function will find the corresponding value of the given key.
 * In case of multiple values, it returns the first one when it 
 * walks through the chain. If the key does not exist, it raises
 * Not_found
 *)


let find table key =                                                            
  let index = (hash key) mod (Array.length table) in                            
  find_entry key table.(index) ;; 
                                              
let rec find_entry (key :string) = function                                     
    {key = key' ; value = value } ::_ when key' = key -> value                  
  | _ :: entries -> find_entry key entries                                      
  | [] -> raise Not_found 
;;

   

(* delete function will remove the key from the hash table. In the case that
 * there are multiple values corresponding to the same key, the function removes
 * the first value when it walks through the chain. 
 *)

let delete table key  =                                                    
  let index = (hash key) mod (Array.length table) in                            
  let entries = table.(index) in                                                
  let rec del part = function                                                   
    | [] -> ([], false)                                                         
    | ({key = key'; value = value} as hd) :: tl ->                                
        if key = key' then                                                      
          (List.rev part @ tl, true)                                         
        else                                                                    
          del (hd::part) tl                                                     
  in                                                                            
    let (res_lst, flag) = del [] entries in                                     
    match flag with                                                             
    | false -> print_string "key does not exist. No change occurs"                                
    | true -> table.(index) <- res_lst                                     
;;        

(* replace function will update the value of a given key. In the case that
 * there are multiple values corresponding to the same key, the function updates
 * the first value when it walks through the chain. If the key does not exist
 * the function will raise Not_found.
 *)

let replace table key value = 
 let index = (hash key) mod (Array.length table) in
 let entries = table.(index) in
 let rec rep part = function 
  | [] -> ([], false)
  | {key = key'} as hd :: tl ->
    if key = key' then
      let new_entry = {key;value} in
        (List.rev (new_entry::part) @ tl, true)
    else
      rep (hd::part) tl
 in
  let (res_lst, flag) = rep [] entries in
  match flag with 
  | false -> raise Not_found
  | true -> table.(index) <- res_lst
;;




                            

List directories in Bash

Here we present tree methods to list directories in Bash

List sub-directories in the current directory

ls -d */

List all the sub-directories in the current directory

ls -Rl | grep "^d"

List all the sub-directories including hidden directories in the current directory

find ./ -type d