From 5a6aa63552829ee60bc2a3de7f8929128fe6fdf7 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Sat, 12 May 2018 12:13:49 -0400 Subject: [PATCH 01/10] Define a tfoldMap operation with a default definition. --- Data/TASequence.hs | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/Data/TASequence.hs b/Data/TASequence.hs index e72b347..2b761d4 100644 --- a/Data/TASequence.hs +++ b/Data/TASequence.hs @@ -104,7 +104,16 @@ class TASequence (s :: (k -> k -> *) -> k -> k -> *) where -- > TAEmptyL -> tempty -- > h :< t -> f h <| tmap f t tmap :: (forall x y. c x y -> d x y) -> s c x y -> s d x y - + + -- | Apply a function to all elements in a type aligned sequence, and combine them using a 'Category' instance. + -- + -- Default definition: + -- + -- > tfoldMap f q = case tviewl q of + -- > TAEmptyL -> id + -- > h :< t -> f h >>> tfoldMap f t + tfoldMap :: Category d => (forall x y. c x y -> d x y) -> s c x y -> d x y + l |> r = l >< tsingleton r l <| r = tsingleton l >< r l >< r = case tviewl l of @@ -127,6 +136,9 @@ class TASequence (s :: (k -> k -> *) -> k -> k -> *) where TAEmptyL -> tempty h :< t -> f h <| tmap f t + tfoldMap f q = case tviewl q of + TAEmptyL -> id + h :< t -> f h >>> tfoldMap f t data TAViewL s c x y where TAEmptyL :: TAViewL s c x x From 06d9722213359e2b73f928989b6e82bc69d17af0 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Sat, 12 May 2018 12:14:12 -0400 Subject: [PATCH 02/10] Define tfoldMap for BinaryTree. --- Data/TASequence/BinaryTree.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/Data/TASequence/BinaryTree.hs b/Data/TASequence/BinaryTree.hs index 8995dde..15d31e9 100644 --- a/Data/TASequence/BinaryTree.hs +++ b/Data/TASequence/BinaryTree.hs @@ -19,6 +19,7 @@ module Data.TASequence.BinaryTree(module Data.TASequence, BinaryTree) where import Control.Category import Data.TASequence +import Prelude hiding (id) data BinaryTree c x y where Empty :: BinaryTree c x x @@ -39,6 +40,10 @@ instance TASequence BinaryTree where tmap phi (Leaf c) = Leaf (phi c) tmap phi (Node b b') = Node (tmap phi b) (tmap phi b') + tfoldMap phi Empty = id + tfoldMap phi (Leaf c) = phi c + tfoldMap phi (Node a b) = tfoldMap phi a >>> tfoldMap phi b + instance Category (BinaryTree c) where id = tempty (.) = flip (><) From 58f517763fb14d9b91f23d97dc132bec5266e4b1 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Sat, 12 May 2018 12:20:04 -0400 Subject: [PATCH 03/10] Define tfoldMap for SnocList. --- Data/TASequence/SnocList.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Data/TASequence/SnocList.hs b/Data/TASequence/SnocList.hs index 1e9b118..702783a 100644 --- a/Data/TASequence/SnocList.hs +++ b/Data/TASequence/SnocList.hs @@ -18,6 +18,7 @@ module Data.TASequence.SnocList(module Data.TASequence,SnocList(..)) where import Control.Category import Data.TASequence +import Prelude hiding (id) data SnocList c x y where SNil :: SnocList c x x @@ -32,6 +33,9 @@ instance TASequence SnocList where tmap phi SNil = SNil tmap phi (Snoc s c) = Snoc (tmap phi s) (phi c) + tfoldMap phi SNil = id + tfoldMap phi (Snoc s c) = tfoldMap phi s >>> phi c + instance Category (SnocList c) where id = tempty (.) = flip (><) From c5ede51afb3a1f97cf222d45ead5d20392bb0596 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Sat, 12 May 2018 12:20:25 -0400 Subject: [PATCH 04/10] Define tfoldMap for ToCatQueue. --- Data/TASequence/ToCatQueue.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Data/TASequence/ToCatQueue.hs b/Data/TASequence/ToCatQueue.hs index 76f1c01..6ef1028 100644 --- a/Data/TASequence/ToCatQueue.hs +++ b/Data/TASequence/ToCatQueue.hs @@ -24,6 +24,7 @@ module Data.TASequence.ToCatQueue(module Data.TASequence,ToCatQueue) where import Control.Category import Data.TASequence +import Prelude hiding (id) -- | The catenable queue type. The first type argument is the -- type of the queue we use (|>) @@ -51,6 +52,9 @@ instance TASequence q => TASequence (ToCatQueue q) where tmap phi C0 = C0 tmap phi (CN c q) = CN (phi c) (tmap (tmap phi) q) + tfoldMap phi C0 = id + tfoldMap phi (CN c q) = phi c >>> tfoldMap (tfoldMap phi) q + instance TASequence q => Category (ToCatQueue q c) where id = tempty (.) = flip (><) From 40d9e6d28c3fb832ae34c3c354de6b604ddf8ebb Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Sat, 12 May 2018 12:24:20 -0400 Subject: [PATCH 05/10] Define tfoldMap for Queue. --- Data/TASequence/Queue.hs | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/Data/TASequence/Queue.hs b/Data/TASequence/Queue.hs index b7f66bd..af8ee13 100644 --- a/Data/TASequence/Queue.hs +++ b/Data/TASequence/Queue.hs @@ -23,6 +23,7 @@ module Data.TASequence.Queue(module Data.TASequence,Queue) where import Control.Category import Data.TASequence +import Prelude hiding (id) data P c a b where (:*) :: c a w -> c w b -> P c a b @@ -60,13 +61,24 @@ instance TASequence Queue where tmap f (Q1 x) = Q1 (f x) tmap f (QN l m r) = QN (tmapb f l) (tmap (tmapp f) m) (tmapb f r) + tfoldMap f Q0 = id + tfoldMap f (Q1 x) = f x + tfoldMap f (QN l m r) = tfoldMapb f l >>> tfoldMap (tfoldMapp f) m >>> tfoldMapb f r + instance Category (Queue c) where id = tempty (.) = flip (><) tmapp :: (forall x y. c x y -> d x y) -> P c x y -> P d x y tmapp phi (a :* b) = phi a :* phi b - + +tfoldMapp :: Category d => (forall x y. c x y -> d x y) -> P c x y -> d x y +tfoldMapp phi (a :* b) = phi a >>> phi b + tmapb :: (forall x y. c x y -> d x y) -> B c x y -> B d x y tmapb phi (B1 c) = B1 (phi c) tmapb phi (B2 p) = B2 (tmapp phi p) + +tfoldMapb :: Category d => (forall x y. c x y -> d x y) -> B c x y -> d x y +tfoldMapb phi (B1 c) = phi c +tfoldMapb phi (B2 p) = tfoldMapp phi p From 7474dc544eaf85b2851226fa98f6959eb7b3b2cd Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Sat, 12 May 2018 12:28:04 -0400 Subject: [PATCH 06/10] Define tfoldMap for FingerTree. --- Data/TASequence/FingerTree.hs | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/Data/TASequence/FingerTree.hs b/Data/TASequence/FingerTree.hs index 1e14a2e..52a70ef 100644 --- a/Data/TASequence/FingerTree.hs +++ b/Data/TASequence/FingerTree.hs @@ -24,6 +24,7 @@ module Data.TASequence.FingerTree (module Data.TASequence, FingerTree ) where import Control.Category import Data.TASequence +import Prelude hiding (id) data FingerTree r a b where @@ -71,6 +72,10 @@ instance TASequence FingerTree where tmap f (Single a) = Single (f a) tmap f (Deep l m r) = Deep (mapd f l) (tmap (mapn f) m) (mapd f r) + tfoldMap f Empty = id + tfoldMap f (Single a) = f a + tfoldMap f (Deep l m r) = foldMapd f l >>> tfoldMap (foldMapn f) m >>> foldMapd f r + instance Category (FingerTree c) where id = tempty (.) = flip (><) @@ -194,11 +199,19 @@ nodes (a ::: b ::: c ::: xs) = Node3 a b c ::: nodes xs mapn :: (forall x y. c x y -> d x y) -> Node c x y -> Node d x y mapn phi (Node2 r s) = Node2 (phi r) (phi s) mapn phi (Node3 r s t) = Node3 (phi r) (phi s) (phi t) - + +foldMapn :: Category d => (forall x y. c x y -> d x y) -> Node c x y -> d x y +foldMapn phi (Node2 r s) = phi r >>> phi s +foldMapn phi (Node3 r s t) = phi r >>> phi s >>> phi t + mapd :: (forall x y. c x y -> d x y) -> Digit c x y -> Digit d x y mapd phi (One r) = One (phi r) mapd phi (Two r s) = Two (phi r) (phi s) mapd phi (Three r s t) = Three (phi r) (phi s) (phi t) mapd phi (Four r s t u) = Four (phi r) (phi s) (phi t) (phi u) - +foldMapd :: Category d => (forall x y. c x y -> d x y) -> Digit c x y -> d x y +foldMapd phi (One r) = phi r +foldMapd phi (Two r s) = phi r >>> phi s +foldMapd phi (Three r s t) = phi r >>> phi s >>> phi t +foldMapd phi (Four r s t u) = phi r >>> phi s >>> phi t >>> phi u From 70216a85342857ca32f94fadaf708c2b22711a3e Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Sat, 12 May 2018 12:29:34 -0400 Subject: [PATCH 07/10] =?UTF-8?q?Define=20a=20tfold=20operation=20=C3=A0?= =?UTF-8?q?=20la=20Foldable.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Data/TASequence.hs | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/Data/TASequence.hs b/Data/TASequence.hs index 2b761d4..7b75a09 100644 --- a/Data/TASequence.hs +++ b/Data/TASequence.hs @@ -114,6 +114,13 @@ class TASequence (s :: (k -> k -> *) -> k -> k -> *) where -- > h :< t -> f h >>> tfoldMap f t tfoldMap :: Category d => (forall x y. c x y -> d x y) -> s c x y -> d x y + -- | Combine all elements in a type aligned sequence using a 'Category' instance. + -- + -- Default definition: + -- + -- > tfold = tfoldMap id + tfold :: Category c => s c x y -> c x y + l |> r = l >< tsingleton r l <| r = tsingleton l >< r l >< r = case tviewl l of @@ -140,6 +147,8 @@ class TASequence (s :: (k -> k -> *) -> k -> k -> *) where TAEmptyL -> id h :< t -> f h >>> tfoldMap f t + tfold = tfoldMap id + data TAViewL s c x y where TAEmptyL :: TAViewL s c x x (:<) :: c x y -> s c y z -> TAViewL s c x z From 11fa49846fc09fcd0e3a26f7351e9fd3ff7c6b8d Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Sat, 12 May 2018 13:04:48 -0400 Subject: [PATCH 08/10] Add a foldr method to TASequence. This uses an approach due to Joachim Breitner (https://stackoverflow.com/a/30986119/88018) mirroring the definition of foldr given in base using the Endo Monoid. --- Data/TASequence.hs | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/Data/TASequence.hs b/Data/TASequence.hs index 7b75a09..a54e88e 100644 --- a/Data/TASequence.hs +++ b/Data/TASequence.hs @@ -121,6 +121,9 @@ class TASequence (s :: (k -> k -> *) -> k -> k -> *) where -- > tfold = tfoldMap id tfold :: Category c => s c x y -> c x y + -- | Right-associative fold of a type aligned sequence. + tfoldr :: (forall x y z . c y z -> d x y -> d x z) -> d p q -> s c q r -> d p r + l |> r = l >< tsingleton r l <| r = tsingleton l >< r l >< r = case tviewl l of @@ -149,6 +152,8 @@ class TASequence (s :: (k -> k -> *) -> k -> k -> *) where tfold = tfoldMap id + tfoldr f z t = appEndo (tfoldMap (\ x -> Endo (f x)) t) z + data TAViewL s c x y where TAEmptyL :: TAViewL s c x x (:<) :: c x y -> s c y z -> TAViewL s c x z @@ -156,3 +161,11 @@ data TAViewL s c x y where data TAViewR s c x y where TAEmptyR :: TAViewR s c x x (:>) :: s c x y -> c y z -> TAViewR s c x z + + +-- Approach due to Joachim Breitner: https://stackoverflow.com/a/30986119/88018 +newtype Endo h c d = Endo { appEndo :: forall b. h b c -> h b d } + +instance Category (Endo h) where + id = Endo id + Endo f1 . Endo f2 = Endo (f1 . f2) From d0dc00f726afeda5e6d13593504893ded630638e Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Sat, 12 May 2018 14:23:15 -0400 Subject: [PATCH 09/10] Correct the type & definition of foldr & Endo for left-to-right, right-associated folds over sequences. --- Data/TASequence.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Data/TASequence.hs b/Data/TASequence.hs index a54e88e..09b53aa 100644 --- a/Data/TASequence.hs +++ b/Data/TASequence.hs @@ -122,7 +122,7 @@ class TASequence (s :: (k -> k -> *) -> k -> k -> *) where tfold :: Category c => s c x y -> c x y -- | Right-associative fold of a type aligned sequence. - tfoldr :: (forall x y z . c y z -> d x y -> d x z) -> d p q -> s c q r -> d p r + tfoldr :: (forall x y z . c x y -> d y z -> d x z) -> d q r -> s c p q -> d p r l |> r = l >< tsingleton r l <| r = tsingleton l >< r @@ -163,9 +163,9 @@ data TAViewR s c x y where (:>) :: s c x y -> c y z -> TAViewR s c x z --- Approach due to Joachim Breitner: https://stackoverflow.com/a/30986119/88018 -newtype Endo h c d = Endo { appEndo :: forall b. h b c -> h b d } +-- Approach adapted from Joachim Breitner: https://stackoverflow.com/a/30986119/88018 +newtype Endo h c d = Endo { appEndo :: forall b. h d b -> h c b } instance Category (Endo h) where id = Endo id - Endo f1 . Endo f2 = Endo (f1 . f2) + Endo f1 . Endo f2 = Endo (f2 . f1) From 4a35ba0c750190ead416a81134494eb0b267ca36 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Sat, 12 May 2018 14:40:34 -0400 Subject: [PATCH 10/10] Define foldl for type-aligned sequences via a dual approach. --- Data/TASequence.hs | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) diff --git a/Data/TASequence.hs b/Data/TASequence.hs index 09b53aa..324bd93 100644 --- a/Data/TASequence.hs +++ b/Data/TASequence.hs @@ -124,6 +124,9 @@ class TASequence (s :: (k -> k -> *) -> k -> k -> *) where -- | Right-associative fold of a type aligned sequence. tfoldr :: (forall x y z . c x y -> d y z -> d x z) -> d q r -> s c p q -> d p r + -- | Left-associative fold of a type aligned sequence. + tfoldl :: (forall x y z . d x y -> c y z -> d x z) -> d p q -> s c q r -> d p r + l |> r = l >< tsingleton r l <| r = tsingleton l >< r l >< r = case tviewl l of @@ -152,7 +155,9 @@ class TASequence (s :: (k -> k -> *) -> k -> k -> *) where tfold = tfoldMap id - tfoldr f z t = appEndo (tfoldMap (\ x -> Endo (f x)) t) z + tfoldr f z t = appEndoR (tfoldMap (\ x -> EndoR (\ y -> f x y)) t) z + + tfoldl f z t = appEndoL (tfoldMap (\ x -> EndoL (\ y -> f y x)) t) z data TAViewL s c x y where TAEmptyL :: TAViewL s c x x @@ -164,8 +169,14 @@ data TAViewR s c x y where -- Approach adapted from Joachim Breitner: https://stackoverflow.com/a/30986119/88018 -newtype Endo h c d = Endo { appEndo :: forall b. h d b -> h c b } +newtype EndoR h c d = EndoR { appEndoR :: forall b. h d b -> h c b } + +instance Category (EndoR h) where + id = EndoR id + EndoR f1 . EndoR f2 = EndoR (f2 . f1) + +newtype EndoL h c d = EndoL { appEndoL :: forall b . h b c -> h b d } -instance Category (Endo h) where - id = Endo id - Endo f1 . Endo f2 = Endo (f2 . f1) +instance Category (EndoL h) where + id = EndoL id + EndoL f1 . EndoL f2 = EndoL (f1 . f2)