Sunday, November 15, 2015

I've got 99 Problems - and OCaml is all of them (List operations)

Problemset

I am new to OCaml & Functional languages. I am NOT new to programming. Let's get up to speed.

Write a function last : 'a list -> 'a option that returns the last element of a list. (easy)

let rec last x = match x with | [] -> None | [hd] -> Some hd | hd :: tail -> last tail;;

Find the last but one (last and penultimate) elements of a list. (easy)

let rec last_two lis =
match lis with
| [] | [_] -> None
| [h1; h2] -> Some (h1, h2)
| _ :: t -> last_two t;;

Find the k'th element of a list. (easy)

let rec at n lis =
if n = 1 then
    match lis with
    | hd :: _ -> Some hd
    | [] -> None
else
    match lis with
    | _ :: t -> at (n-1) t
    | [] -> None;

Find the number of elements of a list. (easy)

let rec length ?(count=0) lis =
match lis with
| [] -> count
| _ :: t -> length ~count:(count+1) t;;

Reverse a list. (easy)

let rec rev lis =
match lis with
| [] -> []
| hd :: tl -> rev tl @ [hd];;

^ NO good! It's O(N^2)!

let rev lis =
let aux acc rem =
match rem with
| [] -> acc
| hd :: tl -> aux (hd :: acc) tl in
aux [] lis;;

Find out whether a list is a palindrome. (easy)


let is_palindrome lis =
if (rev lis) = lis then true else false;;

Flatten a nested list structure. (medium)


# (* There is no nested list type in OCaml, so we need to define one
     first. A node of a nested list is either an element, or a list of
     nodes. *)
  type 'a node =
    | One of 'a 
    | Many of 'a node list;;
type 'a node = One of 'a | Many of 'a node list
let rec flatten lis =
match lis with
| [] -> []
| One x :: tl -> x :: flatten tl
| Many x :: tl -> (flatten x) @ (flatten tl);;

Eliminate consecutive duplicates of list elements. (medium)


let rec compress lis =
let rec aux acc rem hd =
match rem with
| [] -> hd :: acc
| h :: t when h = hd -> aux acc t hd
| h :: t -> aux (hd :: acc) t h in
match lis with
| [] -> []
| hd :: tl -> List.rev (aux [] tl hd);;

Pack consecutive duplicates of list elements into sublists. (medium)


let pack lis =
let rec aux res acc rem v =
match rem with
| [] -> acc :: res
| hd :: tl when hd = v -> aux res (hd :: acc) tl v
| hd :: tl -> aux (acc :: res) [hd] tl hd
in
match lis with
| [] -> []
| hd :: tl -> List.rev (aux [] [hd] tl hd)
;;

Run-length encoding of a list. (easy)


let encode list =
let rec aux current acc = function
| [] -> []
| [hd] -> (current + 1, hd) :: acc
| a :: (b :: _ as tl) when a = b -> aux (current + 1) acc tl
| a :: (b :: _ as tl) -> aux 0 ((current+1, a) :: acc) tl
in
List.rev (aux 0 [] list)
;;


Modified run-length encoding. (easy)

Modify the result of the previous problem in such a way that if an element has no duplicates it is simply copied into the result list. Only elements with duplicates are transferred as (N E) lists.
Since OCaml lists are homogeneous, one needs to define a type to hold both single elements and sub-lists.
# type 'a rle =
    | One of 'a
    | Many of int * 'a;;
type 'a rle = One of 'a | Many of int * 'a
let encode list =
let rec aux current acc = function
| [] -> []
| [hd] -> if current = 0 then (One hd) :: acc else (Many (current+1, hd)) :: acc
| a :: (b :: _ as tl) when a = b -> aux (current + 1) acc tl
| a :: (b :: _ as tl) -> if current = 0 then aux 0 ((One a) :: acc) tl else aux 0 (Many (current+1, a) :: acc) tl
in
List.rev (aux 0 [] list)
;;

Decode a run-length encoded list. (medium)


let decode list =
let rec aux acc = function
| [] -> acc
| (One x) :: tl -> aux (x :: acc) tl
| (Many (n, v)) :: tl -> if n = 0 then aux acc tl else aux (v :: acc) ((Many ((n-1), v)) :: tl)
in
List.rev (aux [] list)
;;

Run-length encoding of a list (direct solution). (medium)


let rec encode ?(cur=0) ?(acc=[]) = function
| [] -> []
| [hd] -> if cur = 0 then (One hd) :: acc else (Many (cur + 1, hd)) :: acc
| a :: (b :: _ as t) when a = b -> encode ~cur:(cur+1) ~acc:acc t
| a :: (b :: _ as t) -> if cur = 0 then encode ~cur:0 ~acc:(One a :: acc) t else encode ~cur:0 ~acc:(Many (cur+1, a) :: acc) t;;

Duplicate the elements of a list. (easy)


let duplicate list =
let rec aux acc = function
| [] -> acc
| hd :: tl -> aux (hd :: hd :: acc) tl
in
List.rev (aux [] list);;

Replicate the elements of a list a given number of times. (medium)


let replicate list n =
let rec aux acc tn = function
| [] -> acc
| hd :: tl as orig -> if tn = 0 then aux (hd :: acc) (n-1) tl else aux (hd :: acc) (tn-1) orig in
List.rev (aux [] (n-1) list);;

Drop every N'th element from a list. (medium)


let drop list n =
let rec aux acc tn = function
| [] -> acc
| hd :: tl -> if tn = 0 then aux acc (n-1) tl else aux (hd :: acc) (tn-1) tl in
List.rev (aux [] (n-1) list);;

Split a list into two parts; the length of the first part is given. (easy)


let split list n =
let rec aux first n = function
| [] -> (List.rev first, [])
| hd :: tl -> if n = 0 then (List.rev first, hd::tl) else aux (hd :: first) (n-1) tl in
aux [] n list;;

Extract a slice from a list. (medium)


let slice list i k =
let rec aux acc i k j = function
| [] -> acc
| hd :: tl -> if j > k then acc else if j >= i then aux (hd :: acc) i k (j+1) tl else aux [] i k (j+1) tl in
List.rev (aux [] i k 0 list);;

Rotate a list N places to the left. (medium)


let rotate list n =
let rot = ((n mod (List.length list)) + List.length list) mod (List.length list) in
let rec aux left n = function
| [] -> (List.rev left)
| hd :: tl -> if n = 0 then (hd :: tl @ (List.rev left)) else aux (hd :: left) (n-1) tl in
aux [] rot list;;

Remove the K'th element from a list. (easy)


let remove_at n list =
let rec aux lhs n = function
| [] -> List.rev lhs
| hd :: tl -> if n = 0 then List.rev lhs @ tl else aux (hd :: lhs) (n-1) tl in
aux [] n list;;

From now on I will abandon tail recursion just for style change

Insert an element at a given position into a list. (easy)


let rec insert_at v n = function
| [] -> if n = 0 then [v] else []
| hd :: tl -> if n = 0 then v :: hd :: tl else hd :: insert_at v (n-1) tl;;

Create a list containing all integers within a given range. (easy)


let rec range s f =
if s = f then [s] else
if s < f then s :: (range (s+1) f) else
s :: range (s-1) f;;

Extract a given number of randomly selected elements from a list. (medium)


let rand_select list n =
let rec pop_at pos def = function
| [] -> (def, [])
| hd :: tl -> if pos = 0 then (hd, tl) else
    let (v, rem) = (pop_at (pos-1) def tl) in
    (v, hd :: rem)
in
let rec aux n acc = function
| [] -> acc
| hd :: tl as lis -> if n = 0 then acc else let (v, rem) = pop_at (Random.int (List.length tl + 1)) hd lis in aux (n-1) (v :: acc) rem in
aux n [] list;;

Lotto: Draw N different random numbers from the set 1..M. (easy)


let lotto_select n f =
rand_select (range 1 f) n;;

Generate a random permutation of the elements of a list. (easy)


let permutation list = rand_select list (List.length list);;

Generate the combinations of K distinct objects chosen from the N elements of a list. (medium)


let extract n lis =
let rec cross lis = function
| [] -> []
| hd :: tl -> (lis :: hd) :: cross lis tl in
let rec aux n = function
| [] -> if n = 0 then [[]] else []
| hd :: tl -> if n = 0 then [[]] else (cross hd (aux (n-1) tl)) @ aux n tl in
aux n lis;;

Sol 2:

let extract n lis =
let rec aux suffix n = function
| [] -> if n = 0 then [suffix] else []
| hd :: tl -> if n = 0 then [suffix] else aux (hd :: suffix) (n-1) tl @ aux suffix n tl in
aux [] n lis;;

Sol 3:

let extract n lis =
let rec aux suffix n acc = function
| [] -> acc
| h :: t -> if n = 1 then aux suffix n ((h :: suffix) :: acc) t else aux (h :: suffix) (n-1) (aux suffix n acc t) t in
aux [] n [] lis;;

Sol 4:

let extract n lis =
let rec aux suffix n acc = function
| [] -> if n = 0 then (suffix :: acc) else acc
| h :: t -> if n = 0 then (suffix :: acc) else aux (h :: suffix) (n-1) (aux suffix n acc t) t in
aux [] n [] lis;;

Group the elements of a set into disjoint subsets. (medium)


let group list sizes =
let rec aux acc cur pre sizes lhs = function
| [] -> acc
| h :: t -> match sizes with
    | [] -> acc
    | sd :: st -> if sd = 1 then
         if st = [] then
             aux (((h :: pre) :: cur) :: acc) cur pre sizes lhs t
         else
             aux (aux acc cur pre sizes (h :: lhs) t) ((h :: pre) :: cur) [] st [] (lhs @ t)
      else
          aux (aux acc cur pre sizes (h :: lhs) t) cur (h :: pre) ((sd - 1) :: st) lhs t
in
aux [] [] [] sizes [] (List.rev list);;

Sorting a list of lists according to length of sublists. (medium)

  1. We suppose that a list contains elements that are lists themselves. The objective is to sort the elements of this list according to their length. E.g. short lists first, longer lists later, or vice versa.

let length_sort lis =
let rec merge comp a b =
    match a with | [] -> b
    | ah :: at -> match b with | [] -> a
        | bh :: bt -> if comp ah bh < 0 then (ah :: merge comp at b)
                      else (bh :: merge comp a bt)
in
let rec mergesort comp lis = match lis with
| [] | [_] as l -> l
| _ -> merge comp (mergesort comp (slice lis 0 ((List.length lis) / 2 - 1))) (mergesort comp (slice lis ((List.length lis) / 2) (List.length lis -1)))
in
let enumerated = List.map ~f:(fun a -> (List.length a, a)) lis in
List.map ~f:(fun (a, b) -> b) (mergesort (fun x y -> if x < y then -1 else 1) enumerated);;

2. Again, we suppose that a list contains elements that are lists themselves. But this time the objective is to sort the elements of this list according to their length frequency; i.e., in the default, where sorting is done ascendingly, lists with rare lengths are placed first, others with a more frequent length come later.

let frequency_sort lis =
let rec merge comp a b =
    match a with | [] -> b
    | ah :: at -> match b with | [] -> a
        | bh :: bt -> if comp ah bh < 0 then (ah :: merge comp at b)
                      else (bh :: merge comp a bt)
in
let rec mergesort comp lis = match lis with
| [] | [_] as l -> l
| _ -> merge comp (mergesort comp (slice lis 0 ((List.length lis) / 2 - 1))) (mergesort comp (slice lis ((List.length lis) / 2) (List.length lis -1)))
in
let lengths = List.map ~f:(fun a -> List.length a) lis in
let sortedlengths = mergesort (fun x y -> if x < y then -1 else 1) lengths in

let encode list =
let rec aux current acc = function
| [] -> []
| [hd] -> (current + 1, hd) :: acc
| a :: (b :: _ as tl) when a = b -> aux (current + 1) acc tl
| a :: (b :: _ as tl) -> aux 0 ((current+1, a) :: acc) tl
in
List.rev (aux 0 [] list) in

let encodedlengths = List.map ~f:(fun (x, y) -> (y, x)) (encode sortedlengths) in

let rec findfirst v def = function
| [] -> def
| (a, b) :: t -> if v = a then b else findfirst v def t in

let enumerated = List.map ~f:(fun a -> (findfirst (List.length a) (-1) encodedlengths , a)) lis in
List.map ~f:(fun (a, b) -> b) (mergesort (fun x y -> if x < y then -1 else 1) enumerated);;

No comments:

Post a Comment