Hackerrank: Xoring Ninja Solution in Ocaml

Problem Statement
https://www.hackerrank.com/challenges/xoring-ninja

Given a list containing N integers, calculate the XOR_SUM of all the non-empty subsets of the list and print the value of sum % (109 + 7).

XOR operation on a list (or a subset of the list) is defined as the XOR of all the elements present in it.
E.g. XOR of list containing elements {A,B,C} = ((A^B)^C), where ^ represents XOR.

E.g. XOR_SUM of list A having three elements {X1, X2, X3} can be given as follows.
All non-empty subsets will be {X1, X2, X3, (X1,X2), (X2,X3), (X1,X3), (X1,X2,X3)}

XOR_SUM(A) = X1 + X2 + X3 + X1^X2 + X2^X3 + X1^X3 + ((X1^X2)^X3)

Input Format

An integer T, denoting the number of testcases. 2T lines follow.
Each testcase contains two lines, first line will contains an integer N followed by second line containing N integers separated by a single space.

Output Format

T lines, ith line containing the output of the ith testcase.

Constraints

1 <= T <= 5
1 <= N <= 105
0 <= A[i] <= 109

let large_number = 1000000007 ;;

let compute n k =
  if k = 0 then
    0
  else
    let result = ref 1 in
    for i = 1 to (n - 1) do
      result := (!result lsl 1) mod large_number
    done;
    !result
;;

let process arr length =
  let max_elem = ref (-1) in
  for i = 0 to (length - 1 ) do
    if (arr.(i) > !max_elem) then
      max_elem := arr.(i)
  done;
  let level = ref 0
  and result = ref 0 in
  while !max_elem > 0 do

    let count = ref 0 in
    for i = 0 to (length - 1) do
      count := !count + (1 land arr.(i));
      arr.(i) <- (arr.(i) lsr 1)
    done;
    (* Printf.printf "max_elem: %d, level: %d, result: %d, count: %d\n" !max_elem !level !result !count; *)
    let res = compute length !count in
    result := (!result + (res lsl !level) ) mod large_number;
    level := !level + 1 ;
    max_elem := !max_elem lsr 1 ;
  done;
  !result
;;


(* main *)

let num_case = read_int () ;;

for i = 1 to num_case do
  let n = read_int () in
  let line = read_line () in
  let lst_string = Str.split (Str.regexp " ") line in
  let lst_int = List.map int_of_string lst_string in
  let arr = Array.of_list lst_int in
  let result = process arr n in
  Printf.printf "%d\n" result
done ;;

Hackerrank: AND Product Solution in Ocaml

AND product

Problem Statement

You will be given two intergers A and B. You are required to compute the bitwise AND amongst all natural numbers lying between A and B, both inclusive.

Input Format

First line of the input contains T, the number of testcases to follow.
Each testcase in a newline contains A and B separated by a single space.

Constraints

1 <= T <= 200
0 <= A <= B <= 2^32

Output Format

Output one line per test case with the required bitwise AND

let read_line_int () =
  let line = read_line () in
  let lst = Str.split (Str.regexp " ") line in
  let lst_int = List.map int_of_string lst in
  let arr = Array.of_list lst_int in
  arr
;;


let number_of_bits n =
  let rec num_of_bits count n =
    match n with
    | 0 -> count
    | n -> num_of_bits (count + 1) (n lsr 1)
  in
    num_of_bits 0 n ;;


let rec process result a b =
  let n_bits_a = number_of_bits a
  and n_bits_b = number_of_bits b in
  match n_bits_a = n_bits_b with
  | false -> result
  | true ->
    let m = 1 lsl (n_bits_a - 1) in
    process (result + m) (a - m) (b - m)
;;

let process_main a b =
  process 0 a b ;;



(* main part *)

let num_case = read_int () ;;

for i = 1 to num_case do
  let arr = read_line_int () in
  let result = process_main arr.(0) arr.(1) in
  Printf.printf "%d\n" result
done;;

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 ;;

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;;
   

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
;;




                            

Generate Permutation in Ocaml

let insert_all n lst =
 let rec insert_all_rec result part = function 
  | []  -> (List.rev (n::part))::result 
  | (h::t) as lst -> 
     let new_lst =  (List.rev (n::part)) @ lst in
     insert_all_rec (new_lst :: result) (h::part) t 
 in 
   insert_all_rec [] [] lst ;;

val insert_all : 'a -> 'a list -> 'a list list = <fun>

let rec generate_permutation n =
 match n with
 | 0 -> []
 | 1 -> [[1]]
 | n -> let list_perm = generate_permutation (n-1) in
      let list_list_perm = List.map (insert_all n) list_perm in
       List.flatten list_list_perm ;;

val generate_permutation : int -> int list list = <fun>


generate_permutation 1 ;;
generate_permutation 2 ;;
generate_permutation 3 ;;
generate_permutation 4 ;;

Simple Implementation of Binary Search Tree in Ocaml

type 'a tree = 
 | Node of 'a * 'a tree * 'a tree
 | Leaf;;

let empty = Leaf ;;

let rec mem x = function
 | Leaf -> false
 | Node (key, left, right) ->
  key = x || (x < key && mem x left) || (x > key && mem x right) ;;


(* insert function will ignore the key which has already existed *)
let rec insert x = function
 | Leaf -> Node (x, Leaf, Leaf)
 | Node (k, left, right) as node-> 
    if x < k then
    Node (k, insert x left, right)
   else if x > k then
    Node (k, left, insert x right)
   else
    node ;;


let rec tree_of_list = function
 | [] -> empty
 | h::t -> insert h (tree_of_list t) ;;


let rec insert x = function
 | Leaf -> Node (x, Leaf, Leaf)
 | Node (k, left, right) as node-> 
    if x < k then
    Node (k, insert x left, right)
   else if x > k then
    Node (k, left, insert x right)
   else
    node ;;


let my_tree = tree_of_list [2;3;4;1;7;6;4;8] ;;

let rec in_order_walk = function
 | Leaf -> ()
 | Node (k,left,right) ->
  in_order_walk left;
  let () = print_int k in
    print_newline ();
  in_order_walk right;;

let rec pre_order_walk = function
 | Leaf -> ()
 | Node (k, left, right) ->
  let () = print_int k in
   print_newline ();
  pre_order_walk left;
  pre_order_walk right ;;

let rec post_order_walk = function
 | Leaf -> ()
 | Node (k, left, right) ->
  post_order_walk left;
  post_order_walk right;
  let () = print_int k in
   print_newline () ;;
  
let rec height = function
 | Leaf -> 0
 | Node (k, left, right) ->
   1 + max (height left) (height right) ;;