many more functions in CCList

core/CCList.ml

@@ -100,6 +100,23 @@ let flatten l = flat_map (fun l -> l) l
 let product f l1 l2 =
   flat_map (fun x -> map (fun y -> f x y) l2) l1
 
+let fold_product f acc l1 l2 =
+  List.fold_left
+    (fun acc x1 ->
+      List.fold_left
+        (fun acc x2 -> f acc x1 x2)
+        acc l2
+    ) acc l1
+
+let diagonal l =
+  let rec gen acc l = match l with
+  | [] -> acc
+  | x::l' ->
+    let acc = List.fold_left (fun acc y -> (x,y) :: acc) acc l' in
+    gen acc l'
+  in
+  gen [] l
+
 let return x = [x]
 
 let (>>=) l f = flat_map f l
@@ -108,31 +125,23 @@ let (<$>) = map
 
 let (<*>) funs l = product (fun f x -> f x) funs l
 
+let sorted_merge ?(cmp=Pervasives.compare) l1 l2 =
+  let rec recurse cmp acc l1 l2 = match l1,l2 with
+    | [], _ -> List.rev_append acc l2
+    | _, [] -> List.rev_append acc l1
+    | x1::l1', x2::l2' ->
+      let c = cmp x1 x2 in
+      if c < 0 then recurse cmp (x1::acc) l1' l2
+      else if c > 0 then recurse cmp (x2::acc) l1 l2'
+      else recurse cmp (x1::x2::acc) l1' l2'
+  in
+  recurse cmp [] l1 l2
+
 (*$T
   List.sort Pervasives.compare ([(( * )2); ((+)1)] <*> [10;100]) \
     = [11; 20; 101; 200]
 *)
 
-let range i j =
-  let rec up i j acc =
-    if i=j then i::acc else up i (j-1) (j::acc)
-  and down i j acc =
-    if i=j then i::acc else down i (j+1) (j::acc)
-  in
-  if i<=j then up i j [] else down i j []
-
-(*$T
-  range 0 5 = [0;1;2;3;4;5]
-  range 0 0 = [0]
-  range 5 2 = [5;4;3;2]
-*)
-
-let (--) = range
-
-(*$T
-  append (range 0 100) (range 101 1000) = range 0 1000
-  append (range 1000 500) (range 499 0) = range 1000 0
-*)
 
 let take n l =
   let rec direct i n l = match l with
@@ -164,6 +173,211 @@ let last n l =
   let len = List.length l in
   if len < n then l else drop (len-n) l
 
+let find p l =
+  let rec search i l = match l with
+  | [] -> None
+  | x::_ when p x -> Some (i, x)
+  | _::xs -> search (i+1) xs
+  in search 0 l
+
+let filter_map f l =
+  let rec recurse acc l = match l with
+  | [] -> List.rev acc
+  | x::l' ->
+    let acc' = match f x with | None -> acc | Some y -> y::acc in
+    recurse acc' l'
+  in recurse [] l
+
+module Set = struct
+  let mem ?(eq=(=)) x l =
+    let rec search eq x l = match l with
+      | [] -> false
+      | y::l' -> eq x y || search eq x l'
+    in search eq x l
+
+  let subset ?(eq=(=)) l1 l2 =
+    List.for_all
+      (fun t -> mem ~eq t l2)
+      l1
+
+  let rec uniq ?(eq=(=)) l = match l with
+    | [] -> []
+    | x::xs when List.exists (eq x) xs -> uniq ~eq xs
+    | x::xs -> x :: uniq ~eq xs
+
+  let rec union ?(eq=(=)) l1 l2 = match l1 with
+    | [] -> l2
+    | x::xs when mem ~eq x l2 -> union ~eq xs l2
+    | x::xs -> x::(union ~eq xs l2)
+
+  let rec inter ?(eq=(=)) l1 l2 = match l1 with
+    | [] -> []
+    | x::xs when mem ~eq x l2 -> x::(inter ~eq xs l2)
+    | _::xs -> inter ~eq xs l2
+end
+
+module Idx = struct
+  let mapi f l =
+    let r = ref 0 in
+    map
+      (fun x ->
+        let y = f !r x in
+        incr r; y
+      ) l
+
+  (*$T
+    Idx.mapi (fun i x -> i*x) [10;10;10] = [0;10;20]
+  *)
+
+  let iteri f l =
+    let rec aux f i l = match l with
+      | [] -> ()
+      | x::l' -> f i x; aux f (i+1) l'
+    in aux f 0 l
+
+  let foldi f acc l =
+    let rec foldi f acc i l = match l with
+    | [] -> acc
+    | x::l' ->
+      let acc = f acc i x in
+      foldi f acc (i+1) l'
+    in
+    foldi f acc 0 l
+
+  let rec get_exn l i = match l with
+    | [] -> raise Not_found
+    | x::_ when i=0 -> x
+    | _::l' -> get_exn l' (i-1)
+
+  let get l i =
+    try Some (get_exn l i)
+    with Not_found -> None
+
+  (*$T
+    Idx.get (range 0 10) 0 = Some 0
+    Idx.get (range 0 10) 5 = Some 5
+    Idx.get (range 0 10) 11 = None
+    Idx.get [] 0 = None
+  *)
+
+  let set l0 i x =
+    let rec aux l acc i = match l with
+      | [] -> l0
+      | _::l' when i=0 -> List.rev_append acc (x::l')
+      | y::l' ->
+          aux l' (y::acc) (i-1)
+    in
+    aux l0 [] i
+
+  (*$T
+    Idx.set [1;2;3] 0 10 = [10;2;3]
+    Idx.set [1;2;3] 4 10 = [1;2;3]
+    Idx.set [1;2;3] 1 10 = [1;10;3]
+   *)
+
+  let insert l i x =
+    let rec aux l acc i x = match l with
+      | [] -> List.rev_append acc [x]
+      | y::l' when i=0 -> List.rev_append acc (x::y::l')
+      | y::l' ->
+          aux l' (y::acc) (i-1) x
+    in
+    aux l [] i x
+
+  (*$T
+    Idx.insert [1;2;3] 0 10 = [10;1;2;3]
+    Idx.insert [1;2;3] 4 10 = [1;2;3;10]
+    Idx.insert [1;2;3] 1 10 = [1;10;2;3]
+   *)
+
+  let rec remove l0 i =
+    let rec aux l acc i = match l with
+      | [] -> l0
+      | _::l' when i=0 -> List.rev_append acc l'
+      | y::l' ->
+          aux l' (y::acc) (i-1)
+    in
+    aux l0 [] i
+
+  (*$T
+    Idx.remove [1;2;3;4] 0 = [2;3;4]
+    Idx.remove [1;2;3;4] 3 = [1;2;3]
+    Idx.remove [1;2;3;4] 5 = [1;2;3;4]
+  *)
+end
+
+let range i j =
+  let rec up i j acc =
+    if i=j then i::acc else up i (j-1) (j::acc)
+  and down i j acc =
+    if i=j then i::acc else down i (j+1) (j::acc)
+  in
+  if i<=j then up i j [] else down i j []
+
+(*$T
+  range 0 5 = [0;1;2;3;4;5]
+  range 0 0 = [0]
+  range 5 2 = [5;4;3;2]
+*)
+
+let (--) = range
+
+(*$T
+  append (range 0 100) (range 101 1000) = range 0 1000
+  append (range 1000 500) (range 499 0) = range 1000 0
+*)
+
+let replicate i x =
+  let rec aux acc i =
+    if i = 0 then acc
+    else aux (x::acc) (i-1)
+  in aux [] i
+
+let repeat i l =
+  let l' = List.rev l in
+  let rec aux acc i =
+    if i = 0 then List.rev acc
+    else aux (List.rev_append l' acc) (i-1)
+  in aux [] i
+
+module Assoc = struct
+  type ('a, 'b) t = ('a*'b) list
+
+  let get_exn ?(eq=(=)) l x =
+    let rec search eq l x = match l with
+      | [] -> raise Not_found
+      | (y,z)::l' ->
+          if eq x y then z else search eq l' x
+    in search eq l x
+
+  let get ?eq l x =
+    try Some (get_exn ?eq l x)
+    with Not_found -> None
+
+  (*$T
+    Assoc.get [1, "1"; 2, "2"] 1 = Some "1"
+    Assoc.get [1, "1"; 2, "2"] 2 = Some "2"
+    Assoc.get [1, "1"; 2, "2"] 3 = None
+    Assoc.get [] 42 = None
+  *)
+
+  let set ?(eq=(=)) l x y =
+    let rec search eq acc l x y = match l with
+      | [] -> (x,y)::acc
+      | (x',y')::l' ->
+          if eq x x' 
+            then (x,y)::List.rev_append acc l'
+            else search eq ((x',y')::acc) l' x y
+    in search eq [] l x y
+
+  (*$T
+    Assoc.set [1,"1"; 2, "2"] 2 "two" |> List.sort Pervasives.compare \
+      = [1, "1"; 2, "two"]
+    Assoc.set [1,"1"; 2, "2"] 3 "3" |> List.sort Pervasives.compare \
+      = [1, "1"; 2, "2"; 3, "3"]
+  *)
+end
+
 (** {2 Conversions} *)
 
 type 'a sequence = ('a -> unit) -> unit

core/CCList.mli

@@ -49,6 +49,13 @@ val flatten : 'a t t -> 'a t
 val product : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
 (** cartesian product of the two lists, with the given combinator *)
 
+val fold_product : ('c -> 'a -> 'b -> 'c) -> 'c -> 'a t -> 'b t -> 'c
+(** Fold on the cartesian product *)
+
+val diagonal : 'a t -> ('a * 'a) t
+(** All pairs of distinct positions of the list. [list_diagonal l] will
+    return the list of [List.nth i l, List.nth j l] if [i < j]. *)
+
 val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
 
 val (<$>) : ('a -> 'b) -> 'a t -> 'b t
@@ -57,13 +64,6 @@ val return : 'a -> 'a t
 
 val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
 
-val range : int -> int -> int t
-(** [range i j] iterates on integers from [i] to [j] included. It works
-    both for decreasing and increasing ranges *)
-
-val (--) : int -> int -> int t
-(** Infix alias for [range] *)
-
 val take : int -> 'a t -> 'a t
 (** take the [n] first elements, drop the rest *)
 
@@ -78,6 +78,95 @@ val last : int -> 'a t -> 'a t
 (** [last n l] takes the last [n] elements of [l] (or less if
     [l] doesn't have that many elements *)
 
+val find : ('a -> bool) -> 'a t -> (int * 'a) option
+(** [find p x] returns [Some (i,x)] where [x] is the [i]-th element of [l],
+    and [p x] holds. Otherwise returns [None] *)
+
+val filter_map : ('a -> 'b option) -> 'a t -> 'b t
+(** Map and remove elements at the same time *)
+
+val sorted_merge : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
+(** merges elements from both sorted list, removing duplicates *)
+
+(** {2 Indices} *)
+
+module Idx : sig
+  val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t
+
+  val iteri : (int -> 'a -> unit) -> 'a t -> unit
+
+  val foldi : ('b -> int -> 'a -> 'b) -> 'b -> 'a t -> 'b
+  (** fold on list, with index *)
+
+  val get : 'a t -> int -> 'a option
+
+  val get_exn : 'a t -> int -> 'a
+  (** get the i-th element, or
+      @raise Not_found if the index is invalid *)
+
+  val set : 'a t -> int -> 'a -> 'a t
+  (** set i-th element (removes the old one), or does nothing if
+      index too high *)
+  
+  val insert : 'a t -> int -> 'a -> 'a t
+  (** insert at i-th position, between the two existing elements. If the
+      index is too high, append at the end of the list *)
+
+  val remove : 'a t -> int -> 'a t
+  (** Remove element at given index. Does nothing if the index is
+      too high. *)
+end
+
+(** {2 Set Operators} *)
+
+module Set : sig
+  val mem : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> bool
+  (** membership to the list *)
+
+  val subset : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+  (** test for inclusion *)
+
+  val uniq : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t
+  (** list uniq: remove duplicates w.r.t the equality predicate *)
+
+  val union : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> 'a t
+  (** list union *)
+
+  val inter : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> 'a t
+  (** list intersection *)
+end
+
+(** {2 Other Constructors} *)
+
+val range : int -> int -> int t
+(** [range i j] iterates on integers from [i] to [j] included. It works
+    both for decreasing and increasing ranges *)
+
+val (--) : int -> int -> int t
+(** Infix alias for [range] *)
+
+val replicate : int -> 'a -> 'a t
+(** replicate the given element [n] times *)
+
+val repeat : int -> 'a t -> 'a t
+(** concatenate the list with itself [n] times *)
+
+(** {2 Association Lists} *)
+
+module Assoc : sig
+  type ('a, 'b) t = ('a*'b) list
+
+  val get : ?eq:('a->'a->bool) -> ('a,'b) t -> 'a -> 'b option
+  (** Find the element *)
+
+  val get_exn : ?eq:('a->'a->bool) -> ('a,'b) t -> 'a -> 'b
+  (** Same as [get]
+      @raise Not_found if the element is not present *)
+
+  val set : ?eq:('a->'a->bool) -> ('a,'b) t -> 'a -> 'b -> ('a,'b) t
+  (** Add the binding into the list (erase it if already present) *)
+end
+
 (** {2 Conversions} *)
 
 type 'a sequence = ('a -> unit) -> unit