From 79942515cd39b53bbe1eac2e7f841950b237531f Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 9 Mar 2013 20:35:45 +0100 Subject: [PATCH] added a functional Queue implementation --- containers.mllib | 1 + fQueue.ml | 85 ++++++++++++++++++++++++++++++++++++++++++++ fQueue.mli | 61 +++++++++++++++++++++++++++++++ tests/test_fQueue.ml | 44 +++++++++++++++++++++++ tests/tests.ml | 1 + 5 files changed, 192 insertions(+) create mode 100644 fQueue.ml create mode 100644 fQueue.mli create mode 100644 tests/test_fQueue.ml diff --git a/containers.mllib b/containers.mllib index 5808a266..9f0c8e14 100644 --- a/containers.mllib +++ b/containers.mllib @@ -3,6 +3,7 @@ Deque Graph Cache FlatHashtbl +FQueue SplayTree PHashtbl Heap diff --git a/fQueue.ml b/fQueue.ml new file mode 100644 index 00000000..85bb177a --- /dev/null +++ b/fQueue.ml @@ -0,0 +1,85 @@ +(* +Copyright (c) 2013, Simon Cruanes +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +Redistributions of source code must retain the above copyright notice, this +list of conditions and the following disclaimer. Redistributions in binary +form must reproduce the above copyright notice, this list of conditions and the +following disclaimer in the documentation and/or other materials provided with +the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(** {1 Functional queues (fifo)} *) + +type 'a t = { + hd : 'a list; + tl : 'a list; +} (** Queue containing elements of type 'a *) + +let empty = { + hd = []; + tl = []; +} + +let is_empty q = q.hd = [] && q.tl = [] + +let push q x = {q with tl = x :: q.tl; } + +let rec list_last l = match l with + | [] -> assert false + | [x] -> x + | _::l' -> list_last l' + +let peek q = + match q.hd, q.tl with + | [], [] -> raise (Invalid_argument "Queue.peek") + | [], _::_ -> + list_last q.tl + | x::_, _ -> x + +(* pop first element of the queue *) +let pop q = + match q.hd, q.tl with + | [], [] -> raise (Invalid_argument "Queue.peek") + | [], _::_ -> + (match List.rev q.tl with + | x::hd -> x, { hd; tl=[]; } + | [] -> assert false) + | x::_, _ -> + let q' = {hd=List.tl q.hd; tl=q.tl; } in + x, q' + +let junk q = snd (pop q) + +(** Append two queues. Elements from the second one come + after elements of the first one *) +let append q1 q2 = + { hd=q1.hd; + tl=q2.tl @ (List.rev_append q2.hd q1.tl); + } + +let size q = List.length q.hd + List.length q.tl + +let fold f acc q = + let acc' = List.fold_left f acc q.hd in + List.fold_right (fun x acc -> f acc x) q.tl acc' + +let iter f q = fold (fun () x -> f x) () q + +let to_seq q = fun k -> iter k q + +let of_seq seq = Sequence.fold push empty seq diff --git a/fQueue.mli b/fQueue.mli new file mode 100644 index 00000000..6ed53d4f --- /dev/null +++ b/fQueue.mli @@ -0,0 +1,61 @@ +(* +Copyright (c) 2013, Simon Cruanes +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +Redistributions of source code must retain the above copyright notice, this +list of conditions and the following disclaimer. Redistributions in binary +form must reproduce the above copyright notice, this list of conditions and the +following disclaimer in the documentation and/or other materials provided with +the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(** {1 Functional queues (fifo)} *) + +type 'a t + (** Queue containing elements of type 'a *) + +val empty : 'a t + +val is_empty : 'a t -> bool + +val push : 'a t -> 'a -> 'a t + (** Push element at the end of the queue *) + +val peek : 'a t -> 'a + (** Get first element, or raise Invalid_argument *) + +val pop : 'a t -> 'a * 'a t + (** Get and remove the first element, or raise Invalid_argument *) + +val junk : 'a t -> 'a t + (** Remove first element. If queue is empty, do nothing. *) + +val append : 'a t -> 'a t -> 'a t + (** Append two queues. Elements from the second one come + after elements of the first one *) + +val size : 'a t -> int + (** Number of elements in the queue (linear in time) *) + +val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b + +val iter : ('a -> unit) -> 'a t -> unit + +val to_seq : 'a t -> 'a Sequence.t + +val of_seq : 'a Sequence.t -> 'a t + diff --git a/tests/test_fQueue.ml b/tests/test_fQueue.ml new file mode 100644 index 00000000..c64cd5cb --- /dev/null +++ b/tests/test_fQueue.ml @@ -0,0 +1,44 @@ + +open OUnit + +let test_empty () = + let q = FQueue.empty in + OUnit.assert_bool "is_empty" (FQueue.is_empty q) + +let test_push () = + let q = List.fold_left FQueue.push FQueue.empty [1;2;3;4;5] in + let q = FQueue.junk q in + let q = List.fold_left FQueue.push q [6;7;8] in + let l = Sequence.to_list (FQueue.to_seq q) in + OUnit.assert_equal [2;3;4;5;6;7;8] l + +let test_pop () = + let q = FQueue.of_seq (Sequence.of_list [1;2;3;4]) in + let x, q = FQueue.pop q in + OUnit.assert_equal 1 x; + let q = List.fold_left FQueue.push q [5;6;7] in + OUnit.assert_equal 2 (FQueue.peek q); + let x, q = FQueue.pop q in + OUnit.assert_equal 2 x; + () + +let test_append () = + let q1 = FQueue.of_seq (Sequence.of_list [1;2;3;4]) in + let q2 = FQueue.of_seq (Sequence.of_list [5;6;7;8]) in + let q = FQueue.append q1 q2 in + let l = Sequence.to_list (FQueue.to_seq q) in + OUnit.assert_equal [1;2;3;4;5;6;7;8] l + +let test_fold () = + let q = FQueue.of_seq (Sequence.of_list [1;2;3;4]) in + let n = FQueue.fold (+) 0 q in + OUnit.assert_equal 10 n; + () + +let suite = + "test_pQueue" >::: + [ "test_empty" >:: test_empty; + "test_push" >:: test_push; + "test_pop" >:: test_pop; + "test_fold" >:: test_fold; + ] diff --git a/tests/tests.ml b/tests/tests.ml index f0e738fa..a4ff0022 100644 --- a/tests/tests.ml +++ b/tests/tests.ml @@ -6,6 +6,7 @@ let suite = "all_tests" >::: [ Test_pHashtbl.suite; Test_fHashtbl.suite; + Test_fQueue.suite; Test_flatHashtbl.suite; Test_heap.suite; Test_graph.suite;