Source file list.ml

(*****************************************************************************)
(*                                                                           *)
(* MIT License                                                               *)
(* Copyright (c) 2022 Nomadic Labs <contact@nomadic-labs.com>                *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

include Stdlib.List
module List = Stdlib.List

(* Separate the heads and the tails of a list of list.
   raises if one of the lists is empty *)
let get_heads_and_tails ll =
  let rec aux heads tails = function
    | [] -> (rev heads, rev tails)
    | (h :: t) :: ll -> aux (h :: heads) (t :: tails) ll
    | _ -> raise (Invalid_argument "get_firsts_and_tails: one list is empty")
  in
  aux [] [] ll

(* map for n lists of the same size grouped in ln *)
(* the use of get_firsts_and_tails ensures all lists in ln have the same size *)
let mapn f = function
  | [] -> []
  | ln ->
      let rec aux ln =
        match hd ln with
        | [] -> []
        | _ ->
            let heads, tails = get_heads_and_tails ln in
            f heads :: aux tails
      in
      aux ln

(* List.fold_left2 which stops when end of one of the lists is reached *)
let rec fold_left2_opt f acc l1 l2 =
  match (l1, l2) with
  | [], _ -> acc
  | _, [] -> acc
  | a1 :: l1, a2 :: l2 -> fold_left2_opt f (f acc a1 a2) l1 l2

(* List.fold_left for 3 lists of same size *)
let rec fold_left3 f acc l1 l2 l3 =
  match (l1, l2, l3) with
  | [], [], [] -> acc
  | a1 :: l1, a2 :: l2, a3 :: l3 -> fold_left3 f (f acc a1 a2 a3) l1 l2 l3
  | _ -> raise (Invalid_argument "fold_left3 : lists don’t have the same size.")

(* List.fold_left for 4 lists of same size *)
let rec fold_left4 f acc l1 l2 l3 l4 =
  match (l1, l2, l3, l4) with
  | [], [], [], [] -> acc
  | a1 :: l1, a2 :: l2, a3 :: l3, a4 :: l4 ->
      fold_left4 f (f acc a1 a2 a3 a4) l1 l2 l3 l4
  | _ -> raise (Invalid_argument "fold_left4 : lists don’t have the same size.")

(* List.fold_left for 5 lists of same size *)
let rec fold_left5 f acc l1 l2 l3 l4 l5 =
  match (l1, l2, l3, l4, l5) with
  | [], [], [], [], [] -> acc
  | a1 :: l1, a2 :: l2, a3 :: l3, a4 :: l4, a5 :: l5 ->
      fold_left5 f (f acc a1 a2 a3 a4 a5) l1 l2 l3 l4 l5
  | _ -> raise (Invalid_argument "fold_left5 : lists don’t have the same size.")

(* List.fold_left for 6 lists of same size *)
let rec fold_left6 f acc l1 l2 l3 l4 l5 l6 =
  match (l1, l2, l3, l4, l5, l6) with
  | [], [], [], [], [], [] -> acc
  | a1 :: l1, a2 :: l2, a3 :: l3, a4 :: l4, a5 :: l5, a6 :: l6 ->
      fold_left6 f (f acc a1 a2 a3 a4 a5 a6) l1 l2 l3 l4 l5 l6
  | _ -> raise (Invalid_argument "fold_left6 : lists don’t have the same size.")

let split_n n l =
  let rec aux acc k l =
    if k = n then (List.rev acc, l)
    else
      match l with
      | h :: t -> aux (h :: acc) (k + 1) t
      | [] ->
          raise
            (Invalid_argument
               (Printf.sprintf "split_n: n=%d >= List.length l=%d" n k))
  in
  aux [] 0 l

let split_in_half l =
  let len = List.length l in
  match len mod 2 with
  | 0 -> split_n (len / 2) l
  | _ ->
      raise
        (Invalid_argument
           (Printf.sprintf "split_in_half: length %d not even." len))

let map f l = rev (rev_map f l)

let map2 f l1 l2 = rev (rev_map2 f l1 l2)

let rev_mapi f l =
  let rec rmap_f i accu = function
    | [] -> accu
    | a :: l -> rmap_f (i + 1) (f i a :: accu) l
  in
  rmap_f 0 [] l

let mapi f l = rev (rev_mapi f l)

(* not tail-recursive *)
let rec map2_opt merge l1 l2 =
  match (l1, l2) with
  | [], _ -> l2
  | _, [] -> l1
  | h1 :: t1, h2 :: t2 -> merge h1 h2 :: map2_opt merge t1 t2

(* same as List.combine but allows lists of different sizes *)
let safe_combine l1 l2 =
  let rec aux acc l1 l2 =
    match (l1, l2) with
    | [], _ -> List.rev acc
    | _, [] -> List.rev acc
    | h1 :: t1, h2 :: t2 -> aux ((h1, h2) :: acc) t1 t2
  in
  aux [] l1 l2

exception Internal

(* equivalent to List.rev (List.flatten l) but tail recursive*)
let rev_flatten l =
  let rec aux res l =
    match l with [] -> res | h :: t -> aux (List.rev_append h res) t
  in
  aux [] l

let flatten l = List.rev @@ rev_flatten l

(* applies a random permutation to the elements of the given list *)
let shuffle ?seed l =
  (match seed with None -> () | Some i -> Random.init i) ;
  List.rev_map (fun x -> (Random.bits (), x)) l
  |> List.sort (fun (i, _) (j, _) -> Int.compare i j)
  |> List.rev_map snd

let sub l start len = List.filteri (fun i _ -> start <= i && i < start + len) l

(* Applies the function [f] to the last element of the list [l] ; if [l] is empty, it returns the empty list. *)
let map_end f l =
  let rec aux acc = function
    | [] -> []
    | [x] -> rev (f x :: acc)
    | x :: tl -> aux (x :: acc) tl
  in
  aux [] l