Summary: There's no real reason not to use `Core` lists in this module. Changed the interface to be more `Core`-like. Changed the `*_changed` functions to use a ref to track changes instead of passing the changed state around. Reviewed By: mbouaziz Differential Revision: D7123211 fbshipit-source-id: b27791amaster
Jules Villard
7 years ago
committed by
Facebook Github Bot
parent
7efb5cb549
commit
1f04a5eda0
@ -0,0 +1,123 @@
|
||||
(*
|
||||
* Copyright (c) 2015 - present Facebook, Inc.
|
||||
* All rights reserved.
|
||||
*
|
||||
* This source code is licensed under the BSD style license found in the
|
||||
* LICENSE file in the root directory of this source tree. An additional grant
|
||||
* of patent rights can be found in the PATENTS file in the same directory.
|
||||
*)
|
||||
|
||||
open! IStd
|
||||
|
||||
let rec take_append n ~tail l =
|
||||
if n <= 0 then tail
|
||||
else match l with [] -> tail | x :: tl -> take_append (n - 1) ~tail:(x :: tail) tl
|
||||
|
||||
|
||||
(** like map, but returns the original list if unchanged *)
|
||||
let map_changed ~equal ~f l =
|
||||
let rec aux unchanged_prefix_length = function
|
||||
| [] ->
|
||||
l
|
||||
| x :: tl ->
|
||||
let x' = f x in
|
||||
if not (equal x x') then take_append unchanged_prefix_length ~tail:(x' :: List.map ~f tl) l
|
||||
else aux (unchanged_prefix_length + 1) tl
|
||||
in
|
||||
aux 0 l
|
||||
|
||||
|
||||
(** like filter, but returns the original list if unchanged *)
|
||||
let filter_changed ~f l =
|
||||
let res_rev, changed =
|
||||
List.fold_left l ~init:([], false) ~f:(fun (l, changed) x ->
|
||||
if f x then (x :: l, changed) else (l, true) )
|
||||
in
|
||||
if changed then List.rev res_rev else l
|
||||
|
||||
|
||||
(** Remove consecutive equal irrelevant elements from a list (according to the given comparison and
|
||||
relevance functions) *)
|
||||
let remove_irrelevant_duplicates ~equal ~f l =
|
||||
let rec remove acc = function
|
||||
| [] ->
|
||||
List.rev acc
|
||||
| [x] ->
|
||||
List.rev (x :: acc)
|
||||
| x :: (y :: l'' as l') ->
|
||||
if equal x y then
|
||||
match (f x, f y) with
|
||||
| false, _ ->
|
||||
remove acc l'
|
||||
| true, false ->
|
||||
remove acc (x :: l'')
|
||||
| true, true ->
|
||||
remove (x :: acc) l'
|
||||
else remove (x :: acc) l'
|
||||
in
|
||||
remove [] l
|
||||
|
||||
|
||||
(** The function works on sorted lists without duplicates, and keeps only one copy of elements that
|
||||
appear in both lists. *)
|
||||
let rec merge_sorted_nodup ~cmp ~res xs1 xs2 =
|
||||
match (xs1, xs2) with
|
||||
| [], _ ->
|
||||
List.rev_append res xs2
|
||||
| _, [] ->
|
||||
List.rev_append res xs1
|
||||
| x1 :: xs1', x2 :: xs2' ->
|
||||
let n = cmp x1 x2 in
|
||||
if Int.equal n 0 then merge_sorted_nodup ~cmp ~res:(x1 :: res) xs1' xs2'
|
||||
else if n < 0 then merge_sorted_nodup ~cmp ~res:(x1 :: res) xs1' xs2
|
||||
else merge_sorted_nodup ~cmp ~res:(x2 :: res) xs1 xs2'
|
||||
|
||||
|
||||
let inter ~cmp xs ys =
|
||||
let rev_sort xs = List.sort ~cmp:(fun x y -> cmp y x) xs in
|
||||
let rev_xs = rev_sort xs in
|
||||
let rev_ys = rev_sort ys in
|
||||
let rec inter_ is rev_xxs rev_yys =
|
||||
match (rev_xxs, rev_yys) with
|
||||
| [], _ | _, [] ->
|
||||
is
|
||||
| x :: rev_xs, y :: rev_ys ->
|
||||
let c = cmp x y in
|
||||
if Int.equal c 0 then inter_ (x :: is) rev_xs rev_ys
|
||||
else if c < 0 then inter_ is rev_xs rev_yys
|
||||
else inter_ is rev_xxs rev_ys
|
||||
in
|
||||
inter_ [] rev_xs rev_ys
|
||||
|
||||
|
||||
(** like fold, but apply [f_last] to the last element *)
|
||||
let rec fold_last l ~init ~f ~f_last =
|
||||
match l with
|
||||
| [] ->
|
||||
init
|
||||
| [last] ->
|
||||
f_last init last
|
||||
| hd :: tl ->
|
||||
fold_last tl ~init:(f init hd) ~f ~f_last
|
||||
|
||||
|
||||
let append_no_duplicates (type a) ~(cmp: a -> a -> int) =
|
||||
(* roughly based on [Core.List.stable_dedup_staged] but also takes care of the append and takes
|
||||
into account the invariant that [list1] and [list2] do not contain duplicates individually *)
|
||||
let module Set = Set.Make (struct
|
||||
type t = a
|
||||
|
||||
let compare = cmp
|
||||
|
||||
(* we never calls these *)
|
||||
let t_of_sexp _ = assert false
|
||||
|
||||
let sexp_of_t _ = assert false
|
||||
end) in
|
||||
Staged.stage (fun (list1: a list) (list2: a list) ->
|
||||
let set1 = Set.of_list list1 in
|
||||
let res_rev =
|
||||
List.fold_left list2 ~init:(List.rev list1) ~f:(fun res_rev x ->
|
||||
if Set.mem set1 x then res_rev else x :: res_rev )
|
||||
in
|
||||
List.rev res_rev )
|
||||
@ -0,0 +1,35 @@
|
||||
(*
|
||||
* Copyright (c) 2015 - present Facebook, Inc.
|
||||
* All rights reserved.
|
||||
*
|
||||
* This source code is licensed under the BSD style license found in the
|
||||
* LICENSE file in the root directory of this source tree. An additional grant
|
||||
* of patent rights can be found in the PATENTS file in the same directory.
|
||||
*)
|
||||
|
||||
open! IStd
|
||||
|
||||
val map_changed : equal:('a -> 'a -> bool) -> f:('a -> 'a) -> 'a list -> 'a list
|
||||
(** like map, but returns the original list if unchanged *)
|
||||
|
||||
val filter_changed : f:('a -> bool) -> 'a list -> 'a list
|
||||
(** like filter, but returns the original list if unchanged *)
|
||||
|
||||
val remove_irrelevant_duplicates : equal:('a -> 'a -> bool) -> f:('a -> bool) -> 'a list -> 'a list
|
||||
(** Remove consecutive equal irrelevant elements from a list (according to the given comparison and
|
||||
relevance functions) *)
|
||||
|
||||
val merge_sorted_nodup : cmp:('a -> 'a -> int) -> res:'a list -> 'a list -> 'a list -> 'a list
|
||||
(** The function works on sorted lists without duplicates, and keeps only one copy of elements that
|
||||
appear in both lists. *)
|
||||
|
||||
val inter : cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
|
||||
(** [inter cmp xs ys] are the elements in both [xs] and [ys], sorted according to [cmp]. *)
|
||||
|
||||
val fold_last : 'a list -> init:'b -> f:('b -> 'a -> 'b) -> f_last:('b -> 'a -> 'b) -> 'b
|
||||
(** like fold, but apply f_last to the last element *)
|
||||
|
||||
val append_no_duplicates : cmp:('a -> 'a -> int) -> ('a list -> 'a list -> 'a list) Staged.t
|
||||
(** [append_no_duplicates list1 list2], assuming that list1 and list2 have no duplicates on their
|
||||
own, it computes list1 @ (filtered list2), so it keeps the order of both lists and has no
|
||||
duplicates. *)
|
||||
@ -1,100 +0,0 @@
|
||||
(*
|
||||
* Copyright (c) 2015 - present Facebook, Inc.
|
||||
* All rights reserved.
|
||||
*
|
||||
* This source code is licensed under the BSD style license found in the
|
||||
* LICENSE file in the root directory of this source tree. An additional grant
|
||||
* of patent rights can be found in the PATENTS file in the same directory.
|
||||
*)
|
||||
|
||||
(** like map, but returns the original list if unchanged *)
|
||||
let map_changed (f: 'a -> 'a) l =
|
||||
let l', changed =
|
||||
List.fold_left
|
||||
(fun (l_acc, changed) e ->
|
||||
let e' = f e in
|
||||
(e' :: l_acc, changed || e' != e) )
|
||||
([], false) l
|
||||
in
|
||||
if changed then List.rev l' else l
|
||||
|
||||
|
||||
(** like filter, but returns the original list if unchanged *)
|
||||
let filter_changed (f: 'a -> bool) l =
|
||||
let l', changed =
|
||||
List.fold_left
|
||||
(fun (l_acc, changed) e -> if f e then (e :: l_acc, changed) else (l_acc, true))
|
||||
([], false) l
|
||||
in
|
||||
if changed then List.rev l' else l
|
||||
|
||||
|
||||
(** Remove consecutive equal irrelevant elements from a list
|
||||
(according to the given comparison and relevance functions) *)
|
||||
let remove_irrelevant_duplicates compare relevant l =
|
||||
let rec remove compare acc = function
|
||||
| [] ->
|
||||
List.rev acc
|
||||
| [x] ->
|
||||
List.rev (x :: acc)
|
||||
| x :: (y :: l'' as l') ->
|
||||
if compare x y = 0 then
|
||||
match (relevant x, relevant y) with
|
||||
| false, _ ->
|
||||
remove compare acc l'
|
||||
| true, false ->
|
||||
remove compare acc (x :: l'')
|
||||
| true, true ->
|
||||
remove compare (x :: acc) l'
|
||||
else remove compare (x :: acc) l'
|
||||
in
|
||||
remove compare [] l
|
||||
|
||||
|
||||
(** The function works on sorted lists without duplicates *)
|
||||
let rec merge_sorted_nodup compare res xs1 xs2 =
|
||||
match (xs1, xs2) with
|
||||
| [], _ ->
|
||||
List.rev_append res xs2
|
||||
| _, [] ->
|
||||
List.rev_append res xs1
|
||||
| x1 :: xs1', x2 :: xs2' ->
|
||||
let n = compare x1 x2 in
|
||||
if n = 0 then merge_sorted_nodup compare (x1 :: res) xs1' xs2'
|
||||
else if n < 0 then merge_sorted_nodup compare (x1 :: res) xs1' xs2
|
||||
else merge_sorted_nodup compare (x2 :: res) xs1 xs2'
|
||||
|
||||
|
||||
let inter compare xs ys =
|
||||
let rev_sort xs = List.sort (fun x y -> compare y x) xs in
|
||||
let rev_xs = rev_sort xs in
|
||||
let rev_ys = rev_sort ys in
|
||||
let rec inter_ is rev_xxs rev_yys =
|
||||
match (rev_xxs, rev_yys) with
|
||||
| [], _ | _, [] ->
|
||||
is
|
||||
| x :: rev_xs, y :: rev_ys ->
|
||||
let c = compare x y in
|
||||
if c = 0 then inter_ (x :: is) rev_xs rev_ys
|
||||
else if c < 0 then inter_ is rev_xs rev_yys
|
||||
else inter_ is rev_xxs rev_ys
|
||||
in
|
||||
inter_ [] rev_xs rev_ys
|
||||
|
||||
|
||||
(** like fold, but apply f_last to the last element *)
|
||||
let rec fold_last l ~init ~f ~f_last =
|
||||
match l with
|
||||
| [] ->
|
||||
init
|
||||
| [last] ->
|
||||
f_last init last
|
||||
| hd :: tl ->
|
||||
fold_last tl ~init:(f init hd) ~f ~f_last
|
||||
|
||||
|
||||
let uncons_exn = function [] -> failwith "uncons_exn" | hd :: tl -> (hd, tl)
|
||||
|
||||
let append_no_duplicates eq list1 list2 =
|
||||
let list2_no_dup = List.filter (fun x2 -> List.for_all (fun x1 -> not (eq x2 x1)) list1) list2 in
|
||||
list1 @ list2_no_dup
|
||||
@ -1,34 +0,0 @@
|
||||
(*
|
||||
* Copyright (c) 2015 - present Facebook, Inc.
|
||||
* All rights reserved.
|
||||
*
|
||||
* This source code is licensed under the BSD style license found in the
|
||||
* LICENSE file in the root directory of this source tree. An additional grant
|
||||
* of patent rights can be found in the PATENTS file in the same directory.
|
||||
*)
|
||||
|
||||
val map_changed : ('a -> 'a) -> 'a list -> 'a list
|
||||
(** like map, but returns the original list if unchanged *)
|
||||
|
||||
val filter_changed : ('a -> bool) -> 'a list -> 'a list
|
||||
(** like filter, but returns the original list if unchanged *)
|
||||
|
||||
val remove_irrelevant_duplicates : ('a -> 'a -> int) -> ('a -> bool) -> 'a list -> 'a list
|
||||
(** Remove consecutive equal irrelevant elements from a list (according to the given comparison and relevance functions) *)
|
||||
|
||||
val merge_sorted_nodup : ('a -> 'a -> int) -> 'a list -> 'a list -> 'a list -> 'a list
|
||||
(** The function works on sorted lists without duplicates *)
|
||||
|
||||
val inter : ('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
|
||||
(** [inter cmp xs ys] are the elements in both [xs] and [ys], sorted according to [cmp]. *)
|
||||
|
||||
val fold_last : 'a list -> init:'b -> f:('b -> 'a -> 'b) -> f_last:('b -> 'a -> 'b) -> 'b
|
||||
(** like fold, but apply f_last to the last element *)
|
||||
|
||||
val uncons_exn : 'a list -> 'a * 'a list
|
||||
(** deconstruct a list, like hd_exn and tl_exn *)
|
||||
|
||||
val append_no_duplicates : ('a -> 'a -> bool) -> 'a list -> 'a list -> 'a list
|
||||
(** [append_no_duplicates list1 list2], assuming that list1 and list2 have no duplicates on their own,
|
||||
it computes list1 @ (filtered list2), so it keeps the order of both lists and has no duplicates.
|
||||
However, the complexity is O(n^2), don't use for big lists! *)
|
||||
Loading…
Reference in new issue