ocaml-99s/solutions.ml

[@@@landmark "auto"]

let rec last = function
  | [x] -> Some x
  | [] -> None
  | _ :: t -> last t

let rec last_two = function
  | [x1; x2] -> Some (x1, x2)
  | [_] | [] -> None
  | _ :: t -> last_two t

let rec at n = function
  | [] -> None
  | x :: t -> if n = 0 then Some x else at (n-1) t

let length l =
  let rec lengthT acc =
    function
    | [] -> acc
    | _ :: t -> lengthT (acc + 1) t
  in lengthT 0 l

let rev l =
  let rec revT acc = function
    | h1 :: h2 :: t -> revT (h2 :: h1 :: acc) t
    | [h] -> h :: acc
    | [] -> acc
  in revT [] l

let is_palindrome l =
  let rec compare_up_to n l1 l2 =
    if n = 0 then true
    else match l1, l2 with
         | (x :: xs, y :: ys) -> if (x = y)
                                 then compare_up_to (n-1) xs ys
                                 else false
         | _ -> false
  and rev_l = rev l
  and len_l = length l
  in compare_up_to len_l l rev_l

type 'a node =
   | One of 'a
   | Many of 'a node list

let flatten l =
  let rec flattenT acc = function
    | [] -> acc
    | One h :: t -> flattenT (h :: acc) t
    | Many l :: t -> flattenT acc (l @ t)
  in flattenT [] l |> rev

let compress l =
  let rec compressT acc = function
    | h1 :: h2 :: t -> compressT (if h1 = h2 then acc else (h1 :: acc)) (h2 :: t)
    | [h] -> h :: acc
    | _ -> acc
  in rev l |> compressT []

let pack l =
  let rec packT acc cur l =
    match cur, l with
    | (a :: _, h :: t) -> if a = h
                          then packT acc (h :: cur) t
                          else packT (cur :: acc) [h] t
    | ([], h :: t) -> packT acc [h] t
    | (cur, []) -> cur :: acc
  in packT [] [] l |> rev

let encode l =
  let rec encodeT oacc l =
    match oacc, l with
    | ((n, a) :: acc, h :: t) ->
       encodeT (if a == h
                then ((n+1, a) :: acc)
                else ((1, h) :: oacc)) t
    | ([], h :: t) -> encodeT [(1, h)] t
    | (acc, []) -> acc
  in encodeT [] l |> rev

type 'a rle =
  | One of 'a
  | Many of int * 'a

let pp_rle ppf = function
  | Many (n, x) -> Format.fprintf ppf "Many (%d, %s)" n x
  | One x -> Format.fprintf ppf "One %s" x

let eq_rle a b =
  match a, b with
  | (Many (n1, x1), Many (n2, x2)) -> n1 = n2 && x1 = x2
  | (One n1, One n2) -> n1 = n2
  | _ -> false

let encode' l =
  let touch_acc n a h acc oacc =
    if a == h
    then Many (n+1, a) :: acc
    else One h :: oacc in
  let rec encodeT oacc l =
    match oacc, l with
    | (Many (n, a) :: acc, h :: t) ->
       let nacc = touch_acc n a h acc oacc
       in encodeT nacc t
    | (One a :: acc, h :: t) ->
       let nacc = touch_acc 1 a h acc oacc
       in encodeT nacc t
    | ([], h :: t) -> encodeT [One h] t
    | (acc, []) -> acc
  in encodeT [] l |> rev

let decode l =
  let rec poof c acc = function
    | 2 -> c :: c :: acc
    | n -> poof c (c :: acc) (n - 1)
  in let rec decodeT acc = function
    | Many (n, a) :: t -> decodeT (poof a acc n) t
    | One a :: t -> decodeT (a :: acc) t
    | [] -> acc
  in rev l |> decodeT []

let duplicate l =
  let rec duplicateT acc = function
    | h :: t -> duplicateT (h :: h :: acc) t
    | [] -> acc
  in rev l |> duplicateT []

let replicate l times =
  let rec fill c acc = function
    | 1 -> c :: acc
    | 0 -> []
    | n -> fill c (c :: acc) (n - 1)
  in let rec replicateT acc = function
       | h :: t -> replicateT (fill h acc times) t
       | [] -> acc
     in rev l |> replicateT []

let drop l every =
  let rec dropT acc = function
    | (_, []) -> acc
    | (1, _ :: t) -> dropT acc (every, t)
    | (n, h :: t) -> dropT (h :: acc) (n - 1, t)
  in dropT [] (every, l) |> rev

let split l cut =
  let rec splitT acc = function
    | (0, t) -> (rev acc, t)
    | (_, []) -> (rev acc, [])
    | (n, h :: t) -> splitT (h :: acc) (n - 1, t)
  in splitT [] (cut, l)

let slice l i k =
  let rec drop i l =
    match i, l with
    | (0, t) -> t
    | (n, _ :: t) -> drop (n - 1) t
    | (_, []) -> [] in
  let rec take acc k l =
    match k, l with
    | (_, []) | (0, _) -> acc
    | (n, h :: t) -> take (h :: acc) (n - 1) t
  in drop i l |> take [] (k - 1) |> rev

let rotate l n =
  let rec rotateT acc n l =
    match n, l with
    | (0, t) -> t @ (rev acc)
    | (n, h :: t) -> rotateT (h :: acc) (n - 1) t
    | (_, []) -> rev acc
  in rotateT [] n l

let remove_at n l =
  let rec remove_atT acc n l =
    match n, l with
    | (0, _ :: t) -> acc @ t
    | (n, h :: t) -> remove_atT (h :: acc) (n - 1) t
    | (_, []) -> acc
  in remove_atT [] n l

let insert_at elem n l =
  let b, e = split l n
  in b @ (elem :: e)

let range a b =
  let op n = (if a > b then (+) else (-)) n 1
  in let rec rangeT tail n =
       if n == a
       then n :: tail
       else rangeT (n :: tail) (op n)
     in rangeT [] b