Yit Phang Khoo avatar Yit Phang Khoo committed 1b9c58c

Remove an intermediate list from quicksort (~30-50% faster and less memory).

Comments (0)

Files changed (2)

Source/Adapton/SAList.ml

                 | `Nil -> `Nil
             end
 
+        (** Create memoizing constructor and updater that filter a self-adjusting list with a predicate and key. *)
+        let memo_filter_with_key (type a) (module K : Hashtbl.SeededHashedType with type t = a) f =
+            memo2 (module K) (module L) begin fun filter k xs -> match force xs with
+                | `Cons ( x, xs ) -> if f k x then `Cons ( x, filter k xs ) else force (filter k xs)
+                | `Nil -> `Nil
+            end
+
         (** Create memoizing constructor and updater that simultaneously filter and map a self-adjusting list with a predicate/mapping function. *)
         let memo_filter_map (type a) (type b) (module L : Signatures.SAListType.BasicS with type sa = sa and type data = a and type t = b) f =
             memo (module L) begin fun filter xs -> match L.force xs with
         module L = MakeBasic (R)
         include L
 
-        (**/**) (* internal type of quicksort *)
-        module BoolRType = MakeBasic (Types.Tuple2 (Types.Bool) (R))
-        (**/**)
-
         (** Create memoizing constructor and updater to quicksort a self-adjusting list with a comparator. *)
         let memo_quicksort cmp =
-            let lt, _ = BoolRType.memo_map_with_key (module R) (module L) (fun k x -> ( cmp x k < 0, x )) in
-            let filter_left, _ = memo_filter_map (module BoolRType) (fun ( b, x ) -> if b then Some x else None) in
-            let filter_right, _ = memo_filter_map (module BoolRType) (fun ( b, x ) -> if b then None else Some x) in
+            let filter_left, _ = memo_filter_with_key (module R) (fun k x -> cmp x k < 0) in
+            let filter_right, _ = memo_filter_with_key (module R) (fun k x -> cmp x k >= 0) in
             let quicksort, update_quicksort = memo2 (module L) (module L) begin fun quicksort xs rest -> match L.force xs with
                 | `Cons ( x, xs ) ->
-                    let xs = lt x xs in
-                    let left = filter_left xs in
-                    let right = filter_right xs in
+                    let left = filter_left x xs in
+                    let right = filter_right x xs in
                     L.force (quicksort left (const (`Cons ( x, quicksort right rest ))))
                 | `Nil ->
                     L.force rest

Source/Adapton/Signatures.ml

         val pop : t -> data
         val memo_append : (t -> t -> t) * (t -> t -> t -> unit)
         val memo_filter : (data -> bool) -> (t -> t) * (t -> t -> unit)
+        val memo_filter_with_key
+            : (module Hashtbl.SeededHashedType with type t = 'a)
+                -> ('a -> data -> bool) -> ('a -> t -> t) * (t -> 'a -> t -> unit)
         val memo_filter_map
             : (module SAListType.BasicS with type sa = sa and type data = 'a and type t = 'b)
                 -> ('a -> data option) -> ('b -> t) * (t -> 'b -> unit)
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.