From a8df5a0c4712e2b5f96e2d318dd1ab55dbe374c7 Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Mon, 12 Feb 2018 15:04:21 -0800 Subject: [PATCH 1/7] CatQueue instances --- src/Data/CatQueue.purs | 66 +++++++++++++++++++++++++++++++++++++++++- 1 file changed, 65 insertions(+), 1 deletion(-) diff --git a/src/Data/CatQueue.purs b/src/Data/CatQueue.purs index 8961fce..97424c5 100644 --- a/src/Data/CatQueue.purs +++ b/src/Data/CatQueue.purs @@ -12,16 +12,25 @@ module Data.CatQueue , null , singleton , length + , append , snoc , uncons ) where -import Prelude +import Prelude hiding (append) +import Control.Alt (class Alt) +import Control.Alternative (class Alternative) +import Control.MonadPlus (class MonadPlus) +import Control.MonadZero (class MonadZero) +import Control.Plus (class Plus) +import Data.Foldable (class Foldable, foldMap, foldMapDefaultL, foldl, foldrDefault) import Data.List (List(..), reverse) import Data.List as L import Data.Maybe (Maybe(..)) +import Data.Monoid (class Monoid) import Data.Tuple (Tuple(..)) +import Data.Unfoldable (class Unfoldable) -- | A strict queue representated using a pair of lists. data CatQueue a = CatQueue (List a) (List a) @@ -39,6 +48,13 @@ null :: forall a. CatQueue a -> Boolean null (CatQueue Nil Nil) = true null _ = false +-- | Append all elements of a queue to the end of another +-- | queue, creating a new queue. +-- | +-- | Running time: `O(n) in the length of the second queue` +append :: forall a. CatQueue a -> CatQueue a -> CatQueue a +append cq = foldl snoc cq + -- | Create a queue containing a single element. -- | -- | Running time: `O(1)` @@ -67,5 +83,53 @@ uncons (CatQueue Nil Nil) = Nothing uncons (CatQueue Nil r) = uncons (CatQueue (reverse r) Nil) uncons (CatQueue (Cons a as) r) = Just (Tuple a (CatQueue as r)) +instance semigroupCatQueue :: Semigroup (CatQueue a) where + append = append + +instance monoidCatQueue :: Monoid (CatQueue a) where + mempty = empty + instance showCatQueue :: Show a => Show (CatQueue a) where show (CatQueue l r) = "(CatQueue " <> show l <> " " <> show r <> ")" + +instance foldableCatQueue :: Foldable CatQueue where + foldMap f q = foldMapDefaultL f q + foldr f s q = foldrDefault f s q + foldl f = go + where + go acc q = case uncons q of + Just (Tuple x xs) -> go (f acc x) xs + Nothing -> acc + +instance unfoldableCatQueue :: Unfoldable CatQueue where + unfoldr f b = go b empty + where + go source memo = case f source of + Nothing -> memo + Just (Tuple one rest) -> go rest (snoc memo one) + +instance functorCatQueue :: Functor CatQueue where + map f (CatQueue l r) = CatQueue (map f l) (map f r) + +instance applyCatQueue :: Apply CatQueue where + apply = ap + +instance applicativeCatQueue :: Applicative CatQueue where + pure = singleton + +instance bindCatQueue :: Bind CatQueue where + bind = flip foldMap + +instance monadCatQueue :: Monad CatQueue + +instance altCatQueue :: Alt CatQueue where + alt = append + +instance plusCatQueue :: Plus CatQueue where + empty = empty + +instance alternativeCatQueue :: Alternative CatQueue + +instance monadZeroCatQueue :: MonadZero CatQueue + +instance monadPlusCatQueue :: MonadPlus CatQueue From 96b195203cdea04263e5c90327a8c3ec2abf1f26 Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Mon, 12 Feb 2018 15:12:04 -0800 Subject: [PATCH 2/7] CatQueue instance tests and fromFoldable Port over tests from CatList. --- src/Data/CatQueue.purs | 7 +++++++ test/Test/Data/CatQueue.purs | 26 +++++++++++++++++++++++++- 2 files changed, 32 insertions(+), 1 deletion(-) diff --git a/src/Data/CatQueue.purs b/src/Data/CatQueue.purs index 97424c5..063fc2b 100644 --- a/src/Data/CatQueue.purs +++ b/src/Data/CatQueue.purs @@ -15,6 +15,7 @@ module Data.CatQueue , append , snoc , uncons + , fromFoldable ) where import Prelude hiding (append) @@ -83,6 +84,12 @@ uncons (CatQueue Nil Nil) = Nothing uncons (CatQueue Nil r) = uncons (CatQueue (reverse r) Nil) uncons (CatQueue (Cons a as) r) = Just (Tuple a (CatQueue as r)) +-- | Convert any `Foldable` into a `CatQueue`. +-- | +-- | Running time: `O(n)` +fromFoldable :: forall f a. Foldable f => f a -> CatQueue a +fromFoldable f = foldMap singleton f + instance semigroupCatQueue :: Semigroup (CatQueue a) where append = append diff --git a/test/Test/Data/CatQueue.purs b/test/Test/Data/CatQueue.purs index 2c1e6af..c152ad5 100644 --- a/test/Test/Data/CatQueue.purs +++ b/test/Test/Data/CatQueue.purs @@ -1,13 +1,15 @@ module Test.Data.CatQueue (testCatQueue) where import Data.CatQueue +import Prelude import Control.Monad.Eff (Eff) import Control.Monad.Eff.Console (CONSOLE, log) +import Data.Foldable (foldMap) import Data.Maybe (Maybe(..), fromJust, isNothing) import Data.Tuple (fst, snd) +import Data.Unfoldable (replicate) import Partial.Unsafe (unsafePartial) -import Prelude (Unit, (==), ($), (<$>), (<<<), discard) import Test.Assert (ASSERT, assert) testCatQueue :: forall eff. Eff (console :: CONSOLE, assert :: ASSERT | eff) Unit @@ -36,3 +38,25 @@ testCatQueue = unsafePartial do assert $ fst (fromJust (uncons queue1)) == 10 assert $ fst (fromJust (uncons (snd (fromJust (uncons queue1))))) == 20 assert $ fst (fromJust (uncons (snd (fromJust (uncons (snd (fromJust (uncons queue1)))))))) == 30 + + log "appending two empty lists should be empty" + assert $ null (empty <> empty) + + log "foldMap over a queue of monoids should produce the concatenation of the monoids" + let queue2 = ((empty `snoc` "a") `snoc` "b") `snoc` "c" + assert $ foldMap id queue2 == "abc" + + log "fromFoldable should convert an array into a CatList with the same values" + let queue3 = fromFoldable ["a", "b", "c"] + assert $ fst (fromJust (uncons queue3)) == "a" + assert $ fst (fromJust (uncons (snd (fromJust (uncons queue3))))) == "b" + assert $ fst (fromJust (uncons (snd (fromJust (uncons (snd (fromJust (uncons queue3)))))))) == "c" + assert $ null (snd (fromJust (uncons (snd (fromJust (uncons (snd (fromJust (uncons queue3))))))))) + + log "functor should correctly map a function over the contents of a CatList" + let queue4 = (_ + 3) <$> fromFoldable [1, 2, 3] + assert $ foldMap (\v -> [v]) queue4 == [4, 5, 6] + + log "replicate should produce a CatList with a value repeated" + let queue5 = (replicate 3 "foo") :: CatQueue String + assert $ foldMap (\v -> [v]) queue5 == ["foo", "foo", "foo"] From fe703ac28c223b49d13894095838f4db05f37070 Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Mon, 12 Feb 2018 15:16:28 -0800 Subject: [PATCH 3/7] Queue fold stack safety tests --- test/Test/Data/CatQueue.purs | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/test/Test/Data/CatQueue.purs b/test/Test/Data/CatQueue.purs index c152ad5..945afbe 100644 --- a/test/Test/Data/CatQueue.purs +++ b/test/Test/Data/CatQueue.purs @@ -1,14 +1,16 @@ module Test.Data.CatQueue (testCatQueue) where -import Data.CatQueue import Prelude import Control.Monad.Eff (Eff) import Control.Monad.Eff.Console (CONSOLE, log) -import Data.Foldable (foldMap) +import Data.CatQueue (CatQueue, empty, fromFoldable, null, singleton, snoc, uncons) +import Data.Foldable (foldMap, foldl) import Data.Maybe (Maybe(..), fromJust, isNothing) +import Data.Monoid.Additive (Additive(..)) +import Data.Newtype (ala) import Data.Tuple (fst, snd) -import Data.Unfoldable (replicate) +import Data.Unfoldable (range, replicate) import Partial.Unsafe (unsafePartial) import Test.Assert (ASSERT, assert) @@ -46,6 +48,14 @@ testCatQueue = unsafePartial do let queue2 = ((empty `snoc` "a") `snoc` "b") `snoc` "c" assert $ foldMap id queue2 == "abc" + log "foldMap is stack safe" + let longList :: CatQueue Int + longList = range 0 10000 + assert $ ala Additive foldMap longList == 50005000 + + log "foldl is stack-safe" + assert $ foldl (+) 0 longList == 50005000 + log "fromFoldable should convert an array into a CatList with the same values" let queue3 = fromFoldable ["a", "b", "c"] assert $ fst (fromJust (uncons queue3)) == "a" From f9495cb79331c85e00d3c9e3f5a5a28c31382be3 Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Mon, 12 Feb 2018 17:14:10 -0800 Subject: [PATCH 4/7] CatQueue: Eq and Traversable implementations and tests --- src/Data/CatQueue.purs | 21 +++++++++++++++++++++ test/Test/Data/CatQueue.purs | 17 +++++++++++------ 2 files changed, 32 insertions(+), 6 deletions(-) diff --git a/src/Data/CatQueue.purs b/src/Data/CatQueue.purs index 063fc2b..21c1ce4 100644 --- a/src/Data/CatQueue.purs +++ b/src/Data/CatQueue.purs @@ -22,6 +22,7 @@ import Prelude hiding (append) import Control.Alt (class Alt) import Control.Alternative (class Alternative) +import Control.Apply (lift2) import Control.MonadPlus (class MonadPlus) import Control.MonadZero (class MonadZero) import Control.Plus (class Plus) @@ -30,6 +31,7 @@ import Data.List (List(..), reverse) import Data.List as L import Data.Maybe (Maybe(..)) import Data.Monoid (class Monoid) +import Data.Traversable (class Traversable, sequenceDefault) import Data.Tuple (Tuple(..)) import Data.Unfoldable (class Unfoldable) @@ -90,6 +92,19 @@ uncons (CatQueue (Cons a as) r) = Just (Tuple a (CatQueue as r)) fromFoldable :: forall f a. Foldable f => f a -> CatQueue a fromFoldable f = foldMap singleton f +cqEq :: forall a. Eq a => CatQueue a -> CatQueue a -> Boolean +cqEq = go + where + elemEq = eq :: (a -> a -> Boolean) + go xs ys = case uncons xs, uncons ys of + Just (Tuple x xs'), Just (Tuple y ys') + | x `elemEq` y -> go xs' ys' + Nothing, Nothing -> true + _ , _ -> false + +instance eqCatQueue :: Eq a => Eq (CatQueue a) where + eq = cqEq + instance semigroupCatQueue :: Semigroup (CatQueue a) where append = append @@ -115,6 +130,12 @@ instance unfoldableCatQueue :: Unfoldable CatQueue where Nothing -> memo Just (Tuple one rest) -> go rest (snoc memo one) +instance traversableCatQueue :: Traversable CatQueue where + traverse f = + map (foldl snoc empty) + <<< foldl (\acc -> lift2 snoc acc <<< f) (pure empty) + sequence = sequenceDefault + instance functorCatQueue :: Functor CatQueue where map f (CatQueue l r) = CatQueue (map f l) (map f r) diff --git a/test/Test/Data/CatQueue.purs b/test/Test/Data/CatQueue.purs index 945afbe..bbfddb5 100644 --- a/test/Test/Data/CatQueue.purs +++ b/test/Test/Data/CatQueue.purs @@ -9,6 +9,7 @@ import Data.Foldable (foldMap, foldl) import Data.Maybe (Maybe(..), fromJust, isNothing) import Data.Monoid.Additive (Additive(..)) import Data.Newtype (ala) +import Data.Traversable (traverse) import Data.Tuple (fst, snd) import Data.Unfoldable (range, replicate) import Partial.Unsafe (unsafePartial) @@ -41,6 +42,13 @@ testCatQueue = unsafePartial do assert $ fst (fromJust (uncons (snd (fromJust (uncons queue1))))) == 20 assert $ fst (fromJust (uncons (snd (fromJust (uncons (snd (fromJust (uncons queue1)))))))) == 30 + log "fromFoldable should convert an array into a CatList with the same values" + let queue3 = fromFoldable ["a", "b", "c"] + assert $ fst (fromJust (uncons queue3)) == "a" + assert $ fst (fromJust (uncons (snd (fromJust (uncons queue3))))) == "b" + assert $ fst (fromJust (uncons (snd (fromJust (uncons (snd (fromJust (uncons queue3)))))))) == "c" + assert $ null (snd (fromJust (uncons (snd (fromJust (uncons (snd (fromJust (uncons queue3))))))))) + log "appending two empty lists should be empty" assert $ null (empty <> empty) @@ -56,12 +64,8 @@ testCatQueue = unsafePartial do log "foldl is stack-safe" assert $ foldl (+) 0 longList == 50005000 - log "fromFoldable should convert an array into a CatList with the same values" - let queue3 = fromFoldable ["a", "b", "c"] - assert $ fst (fromJust (uncons queue3)) == "a" - assert $ fst (fromJust (uncons (snd (fromJust (uncons queue3))))) == "b" - assert $ fst (fromJust (uncons (snd (fromJust (uncons (snd (fromJust (uncons queue3)))))))) == "c" - assert $ null (snd (fromJust (uncons (snd (fromJust (uncons (snd (fromJust (uncons queue3))))))))) + log "sequence is stack-safe" + assert $ traverse Just longList == Just longList log "functor should correctly map a function over the contents of a CatList" let queue4 = (_ + 3) <$> fromFoldable [1, 2, 3] @@ -70,3 +74,4 @@ testCatQueue = unsafePartial do log "replicate should produce a CatList with a value repeated" let queue5 = (replicate 3 "foo") :: CatQueue String assert $ foldMap (\v -> [v]) queue5 == ["foo", "foo", "foo"] + From d83737b56f01573d93e808a379276137475f7927 Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Mon, 12 Feb 2018 18:50:27 -0800 Subject: [PATCH 5/7] Queue Ord instance --- src/Data/CatQueue.purs | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/src/Data/CatQueue.purs b/src/Data/CatQueue.purs index 21c1ce4..5070c36 100644 --- a/src/Data/CatQueue.purs +++ b/src/Data/CatQueue.purs @@ -102,9 +102,25 @@ cqEq = go Nothing, Nothing -> true _ , _ -> false +cqCompare :: forall a. Ord a => CatQueue a -> CatQueue a -> Ordering +cqCompare = go + where + elemCompare = compare :: (a -> a -> Ordering) + go xs ys = case uncons xs, uncons ys of + Just (Tuple x xs'), Just (Tuple y ys') -> + case elemCompare x y of + EQ -> go xs' ys' + ordering -> ordering + Just _, Nothing -> GT + Nothing, Just _ -> LT + Nothing, Nothing -> EQ + instance eqCatQueue :: Eq a => Eq (CatQueue a) where eq = cqEq +instance ordCatQueue :: Ord a => Ord (CatQueue a) where + compare = cqCompare + instance semigroupCatQueue :: Semigroup (CatQueue a) where append = append From 04178b4676f26ec01529ec085b7ea2879d28417a Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Tue, 13 Feb 2018 08:27:31 -0800 Subject: [PATCH 6/7] style --- src/Data/CatQueue.purs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Data/CatQueue.purs b/src/Data/CatQueue.purs index 5070c36..6d603e9 100644 --- a/src/Data/CatQueue.purs +++ b/src/Data/CatQueue.purs @@ -131,8 +131,8 @@ instance showCatQueue :: Show a => Show (CatQueue a) where show (CatQueue l r) = "(CatQueue " <> show l <> " " <> show r <> ")" instance foldableCatQueue :: Foldable CatQueue where - foldMap f q = foldMapDefaultL f q - foldr f s q = foldrDefault f s q + foldMap = foldMapDefaultL + foldr f = foldrDefault f foldl f = go where go acc q = case uncons q of From 6059ea69f24221b23c1ff67d9cca8282cdc4e33a Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 30 Apr 2018 12:48:15 +0100 Subject: [PATCH 7/7] Remove monomorphic versions of class members --- src/Data/CatList.purs | 23 +++++++---------------- src/Data/CatQueue.purs | 13 +++---------- test/Test/Data/CatList.purs | 9 +-------- test/Test/Data/CatQueue.purs | 5 ++--- 4 files changed, 13 insertions(+), 37 deletions(-) diff --git a/src/Data/CatList.purs b/src/Data/CatList.purs index 8e6dffa..4fad3c5 100644 --- a/src/Data/CatList.purs +++ b/src/Data/CatList.purs @@ -19,26 +19,19 @@ module Data.CatList , fromFoldable ) where +import Prelude hiding (append) + import Control.Alt (class Alt) import Control.Alternative (class Alternative) -import Control.Applicative (pure, class Applicative) -import Control.Apply ((<*>), class Apply) -import Control.Bind (class Bind) -import Control.Monad (ap, class Monad) import Control.MonadPlus (class MonadPlus) import Control.MonadZero (class MonadZero) import Control.Plus (class Plus) import Data.CatQueue as Q import Data.Foldable (class Foldable, foldMapDefaultL) import Data.Foldable as Foldable -import Data.Function (flip) -import Data.Functor ((<$>), class Functor) import Data.List as L import Data.Maybe (Maybe(..)) import Data.Monoid (mempty, class Monoid) -import Data.NaturalTransformation (type (~>)) -import Data.Semigroup (class Semigroup, (<>)) -import Data.Show (class Show, show) import Data.Traversable (sequence, traverse, class Traversable) import Data.Tuple (Tuple(..)) import Data.Unfoldable (class Unfoldable) @@ -140,18 +133,13 @@ foldr k b q = go q L.Nil fromFoldable :: forall f. Foldable f => f ~> CatList fromFoldable f = Foldable.foldMap singleton f -map :: forall a b. (a -> b) -> CatList a -> CatList b -map _ CatNil = CatNil -map f (CatCons a q) = - let d = if Q.null q then CatNil else (foldr link CatNil q) - in f a `cons` map f d - foldMap :: forall a m. Monoid m => (a -> m) -> CatList a -> m foldMap f CatNil = mempty foldMap f (CatCons a q) = let d = if Q.null q then CatNil else (foldr link CatNil q) in f a <> foldMap f d +-- | Running time: `O(1)` instance semigroupCatList :: Semigroup (CatList a) where append = append @@ -189,7 +177,10 @@ instance traversableCatList :: Traversable CatList where in cons <$> a <*> sequence d instance functorCatList :: Functor CatList where - map = map + map _ CatNil = CatNil + map f (CatCons a q) = + let d = if Q.null q then CatNil else (foldr link CatNil q) + in f a `cons` map f d instance applyCatList :: Apply CatList where apply = ap diff --git a/src/Data/CatQueue.purs b/src/Data/CatQueue.purs index 6d603e9..6a6fbc8 100644 --- a/src/Data/CatQueue.purs +++ b/src/Data/CatQueue.purs @@ -12,13 +12,12 @@ module Data.CatQueue , null , singleton , length - , append , snoc , uncons , fromFoldable ) where -import Prelude hiding (append) +import Prelude import Control.Alt (class Alt) import Control.Alternative (class Alternative) @@ -51,13 +50,6 @@ null :: forall a. CatQueue a -> Boolean null (CatQueue Nil Nil) = true null _ = false --- | Append all elements of a queue to the end of another --- | queue, creating a new queue. --- | --- | Running time: `O(n) in the length of the second queue` -append :: forall a. CatQueue a -> CatQueue a -> CatQueue a -append cq = foldl snoc cq - -- | Create a queue containing a single element. -- | -- | Running time: `O(1)` @@ -121,8 +113,9 @@ instance eqCatQueue :: Eq a => Eq (CatQueue a) where instance ordCatQueue :: Ord a => Ord (CatQueue a) where compare = cqCompare +-- | Running time: `O(n) in the length of the second queue` instance semigroupCatQueue :: Semigroup (CatQueue a) where - append = append + append = foldl snoc instance monoidCatQueue :: Monoid (CatQueue a) where mempty = empty diff --git a/test/Test/Data/CatList.purs b/test/Test/Data/CatList.purs index c57967c..7a95412 100644 --- a/test/Test/Data/CatList.purs +++ b/test/Test/Data/CatList.purs @@ -2,22 +2,15 @@ module Test.Data.CatList (testCatList) where import Data.CatList -import Control.Bind (discard) -import Control.Category (id) import Control.Monad.Eff (Eff) import Control.Monad.Eff.Console (CONSOLE, log, logShow) -import Data.CommutativeRing ((+)) -import Data.Eq ((==)) import Data.Foldable (foldMap, foldl) -import Data.Function (($)) -import Data.Functor ((<$>)) import Data.Maybe (Maybe(..), fromJust) import Data.Monoid.Additive (Additive(..)) import Data.Tuple (fst, snd) import Data.Unfoldable (range, replicate) -import Data.Unit (Unit) import Partial.Unsafe (unsafePartial) -import Prelude ((<<<)) +import Prelude (Unit, discard, id, ($), (+), (<$>), (<<<), (==)) import Test.Assert (ASSERT, assert) testCatList :: forall eff. Eff (console :: CONSOLE, assert :: ASSERT | eff) Unit diff --git a/test/Test/Data/CatQueue.purs b/test/Test/Data/CatQueue.purs index bbfddb5..dfcf5ab 100644 --- a/test/Test/Data/CatQueue.purs +++ b/test/Test/Data/CatQueue.purs @@ -4,7 +4,7 @@ import Prelude import Control.Monad.Eff (Eff) import Control.Monad.Eff.Console (CONSOLE, log) -import Data.CatQueue (CatQueue, empty, fromFoldable, null, singleton, snoc, uncons) +import Data.CatQueue (CatQueue, empty, fromFoldable, null, length, singleton, snoc, uncons) import Data.Foldable (foldMap, foldl) import Data.Maybe (Maybe(..), fromJust, isNothing) import Data.Monoid.Additive (Additive(..)) @@ -60,7 +60,7 @@ testCatQueue = unsafePartial do let longList :: CatQueue Int longList = range 0 10000 assert $ ala Additive foldMap longList == 50005000 - + log "foldl is stack-safe" assert $ foldl (+) 0 longList == 50005000 @@ -74,4 +74,3 @@ testCatQueue = unsafePartial do log "replicate should produce a CatList with a value repeated" let queue5 = (replicate 3 "foo") :: CatQueue String assert $ foldMap (\v -> [v]) queue5 == ["foo", "foo", "foo"] -