Skip to content

Commit a9e97a3

Browse files
Reimplement split and flatten in Data.List.NonEmpty (#1723)
1 parent 88ea96e commit a9e97a3

File tree

5 files changed

+277
-190
lines changed

5 files changed

+277
-190
lines changed

CHANGELOG.md

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -418,6 +418,13 @@ Non-backwards compatible changes
418418
in order to keep another new definition of `_>>=_`, located in `DiagonalBind`
419419
which is also a submodule of `Data.Vec.Base`.
420420

421+
* The functions `split`, `flatten` and `flatten-split` have been removed from
422+
`Data.List.NonEmpty`. In their place `groupSeqs` and `ungroupSeqs`
423+
have been added to `Data.List.NonEmpty.Base` which morally perform the same
424+
operations but without computing the accompanying proofs. The proofs can be
425+
found in `Data.List.NonEmpty.Properties` under the names `groupSeqs-groups`
426+
and `ungroupSeqs` and `groupSeqs`.
427+
421428
* The constructors `+0` and `+[1+_]` from `Data.Integer.Base` are no longer
422429
exported by `Data.Rational.Base`. You will have to open `Data.Integer(.Base)`
423430
directly to use them.
@@ -777,6 +784,11 @@ New modules
777784
Data.Vec.Reflection
778785
```
779786

787+
* The `All` predicate over non-empty lists:
788+
```
789+
Data.List.NonEmpty.Relation.Unary.All
790+
```
791+
780792
* A small library for heterogenous equational reasoning on vectors:
781793
```
782794
Data.Vec.Properties.Heterogeneous

src/Data/List/NonEmpty.agda

Lines changed: 15 additions & 145 deletions
Original file line numberDiff line numberDiff line change
@@ -27,160 +27,30 @@ open import Function.Equivalence
2727
open import Relation.Binary.PropositionalEquality as P using (_≡_; _≢_; refl)
2828
open import Relation.Nullary.Decidable using (isYes)
2929

30-
private
31-
variable
32-
a b c : Level
33-
A : Set a
34-
B : Set b
35-
C : Set c
36-
3730
------------------------------------------------------------------------
3831
-- Re-export basic type and operations
3932

4033
open import Data.List.NonEmpty.Base public
4134

42-
------------------------------------------------------------------------
43-
-- More operations
44-
45-
-- Groups all contiguous elements for which the predicate returns the
46-
-- same result into lists.
47-
48-
split : (p : A Bool) List A
49-
List (List⁺ (∃ (T ∘ p)) ⊎ List⁺ (∃ (T ∘ not ∘ p)))
50-
split p [] = []
51-
split p (x ∷ xs) with p x | P.inspect p x | split p xs
52-
... | true | P.[ px≡t ] | inj₁ xs′ ∷ xss = inj₁ ((x , Eq.from T-≡ ⟨$⟩ px≡t) ∷⁺ xs′) ∷ xss
53-
... | true | P.[ px≡t ] | xss = inj₁ [ x , Eq.from T-≡ ⟨$⟩ px≡t ] ∷ xss
54-
... | false | P.[ px≡f ] | inj₂ xs′ ∷ xss = inj₂ ((x , Eq.from T-not-≡ ⟨$⟩ px≡f) ∷⁺ xs′) ∷ xss
55-
... | false | P.[ px≡f ] | xss = inj₂ [ x , Eq.from T-not-≡ ⟨$⟩ px≡f ] ∷ xss
56-
57-
-- If we flatten the list returned by split, then we get the list we
58-
-- started with.
59-
60-
flatten : {p q} {P : A Set p} {Q : A Set q}
61-
List (List⁺ (∃ P) ⊎ List⁺ (∃ Q)) List A
62-
flatten = List.concat ∘
63-
List.map Sum.[ toList ∘ map proj₁ , toList ∘ map proj₁ ]
64-
65-
flatten-split : (p : A Bool) (xs : List A) flatten (split p xs) ≡ xs
66-
flatten-split p [] = refl
67-
flatten-split p (x ∷ xs)
68-
with p x | P.inspect p x | split p xs | flatten-split p xs
69-
... | true | P.[ _ ] | [] | hyp = P.cong (_∷_ x) hyp
70-
... | true | P.[ _ ] | inj₁ _ ∷ _ | hyp = P.cong (_∷_ x) hyp
71-
... | true | P.[ _ ] | inj₂ _ ∷ _ | hyp = P.cong (_∷_ x) hyp
72-
... | false | P.[ _ ] | [] | hyp = P.cong (_∷_ x) hyp
73-
... | false | P.[ _ ] | inj₁ _ ∷ _ | hyp = P.cong (_∷_ x) hyp
74-
... | false | P.[ _ ] | inj₂ _ ∷ _ | hyp = P.cong (_∷_ x) hyp
75-
76-
-- Groups all contiguous elements /not/ satisfying the predicate into
77-
-- lists. Elements satisfying the predicate are dropped.
78-
79-
wordsBy : (A Bool) List A List (List⁺ A)
80-
wordsBy p =
81-
List.mapMaybe Sum.[ const nothing , just ∘′ map proj₁ ] ∘ split p
8235

8336
------------------------------------------------------------------------
84-
-- Examples
85-
86-
-- Note that these examples are simple unit tests, because the type
87-
-- checker verifies them.
37+
-- DEPRECATED
38+
------------------------------------------------------------------------
39+
-- Please use the new names as continuing support for the old names is
40+
-- not guaranteed.
8841

8942
private
90-
module Examples {A B : Set}
91-
(_⊕_ : A B B)
92-
(_⊗_ : B A B)
93-
(_⊙_ : A A A)
94-
(f : A B)
95-
(a b c : A)
96-
where
97-
98-
hd : head (a ∷⁺ b ∷⁺ [ c ]) ≡ a
99-
hd = refl
100-
101-
tl : tail (a ∷⁺ b ∷⁺ [ c ]) ≡ b ∷ c ∷ []
102-
tl = refl
103-
104-
mp : map f (a ∷⁺ b ∷⁺ [ c ]) ≡ f a ∷⁺ f b ∷⁺ [ f c ]
105-
mp = refl
106-
107-
right : foldr _⊕_ f (a ∷⁺ b ∷⁺ [ c ]) ≡ (a ⊕ (b ⊕ f c))
108-
right = refl
109-
110-
right₁ : foldr₁ _⊙_ (a ∷⁺ b ∷⁺ [ c ]) ≡ (a ⊙ (b ⊙ c))
111-
right₁ = refl
112-
113-
left : foldl _⊗_ f (a ∷⁺ b ∷⁺ [ c ]) ≡ ((f a ⊗ b) ⊗ c)
114-
left = refl
115-
116-
left₁ : foldl₁ _⊙_ (a ∷⁺ b ∷⁺ [ c ]) ≡ ((a ⊙ b) ⊙ c)
117-
left₁ = refl
118-
119-
⁺app⁺ : (a ∷⁺ b ∷⁺ [ c ]) ⁺++⁺ (b ∷⁺ [ c ]) ≡
120-
a ∷⁺ b ∷⁺ c ∷⁺ b ∷⁺ [ c ]
121-
⁺app⁺ = refl
122-
123-
⁺app : (a ∷⁺ b ∷⁺ [ c ]) ⁺++ (b ∷ c ∷ []) ≡
124-
a ∷⁺ b ∷⁺ c ∷⁺ b ∷⁺ [ c ]
125-
⁺app = refl
126-
127-
app⁺ : (a ∷ b ∷ c ∷ []) ++⁺ (b ∷⁺ [ c ]) ≡
128-
a ∷⁺ b ∷⁺ c ∷⁺ b ∷⁺ [ c ]
129-
app⁺ = refl
130-
131-
conc : concat ((a ∷⁺ b ∷⁺ [ c ]) ∷⁺ [ b ∷⁺ [ c ] ]) ≡
132-
a ∷⁺ b ∷⁺ c ∷⁺ b ∷⁺ [ c ]
133-
conc = refl
134-
135-
rev : reverse (a ∷⁺ b ∷⁺ [ c ]) ≡ c ∷⁺ b ∷⁺ [ a ]
136-
rev = refl
137-
138-
snoc : (a ∷ b ∷ c ∷ []) ∷ʳ a ≡ a ∷⁺ b ∷⁺ c ∷⁺ [ a ]
139-
snoc = refl
140-
141-
snoc⁺ : (a ∷⁺ b ∷⁺ [ c ]) ⁺∷ʳ a ≡ a ∷⁺ b ∷⁺ c ∷⁺ [ a ]
142-
snoc⁺ = refl
143-
144-
split-true : split (const true) (a ∷ b ∷ c ∷ []) ≡
145-
inj₁ ((a , tt) ∷⁺ (b , tt) ∷⁺ [ c , tt ]) ∷ []
146-
split-true = refl
147-
148-
split-false : split (const false) (a ∷ b ∷ c ∷ []) ≡
149-
inj₂ ((a , tt) ∷⁺ (b , tt) ∷⁺ [ c , tt ]) ∷ []
150-
split-false = refl
151-
152-
split-≡1 :
153-
split (ℕ._≡ᵇ 1) (1231121 ∷ []) ≡
154-
inj₁ [ 1 , tt ] ∷ inj₂ ((2 , tt) ∷⁺ [ 3 , tt ]) ∷
155-
inj₁ ((1 , tt) ∷⁺ [ 1 , tt ]) ∷ inj₂ [ 2 , tt ] ∷ inj₁ [ 1 , tt ] ∷
156-
[]
157-
split-≡1 = refl
158-
159-
wordsBy-true : wordsBy (const true) (a ∷ b ∷ c ∷ []) ≡ []
160-
wordsBy-true = refl
161-
162-
wordsBy-false : wordsBy (const false) (a ∷ b ∷ c ∷ []) ≡
163-
(a ∷⁺ b ∷⁺ [ c ]) ∷ []
164-
wordsBy-false = refl
165-
166-
wordsBy-≡1 :
167-
wordsBy (ℕ._≡ᵇ 1) (1231121 ∷ []) ≡
168-
(2 ∷⁺ [ 3 ]) ∷ [ 2 ] ∷ []
169-
wordsBy-≡1 = refl
170-
171-
------------------------------------------------------------------------
172-
-- DEPRECATED
173-
------------------------------------------------------------------------
174-
-- Please use the new names as continuing support for the old names is
175-
-- not guaranteed.
43+
variable
44+
a : Level
45+
A : Set a
17646

177-
-- Version 1.4
47+
-- Version 1.4
17848

179-
infixl 5 _∷ʳ'_
49+
infixl 5 _∷ʳ'_
18050

181-
_∷ʳ'_ : (xs : List A) (x : A) SnocView (xs ∷ʳ x)
182-
_∷ʳ'_ = SnocView._∷ʳ′_
183-
{-# WARNING_ON_USAGE _∷ʳ'_
184-
"Warning: _∷ʳ'_ (ending in an apostrophe) was deprecated in v1.4.
185-
Please use _∷ʳ′_ (ending in a prime) instead."
186-
#-}
51+
_∷ʳ'_ : (xs : List A) (x : A) SnocView (xs ∷ʳ x)
52+
_∷ʳ'_ = SnocView._∷ʳ′_
53+
{-# WARNING_ON_USAGE _∷ʳ'_
54+
"Warning: _∷ʳ'_ (ending in an apostrophe) was deprecated in v1.4.
55+
Please use _∷ʳ′_ (ending in a prime) instead."
56+
#-}

src/Data/List/NonEmpty/Base.agda

Lines changed: 129 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,7 @@ module Data.List.NonEmpty.Base where
1010

1111
open import Level using (Level)
1212
open import Data.Bool.Base using (Bool; false; true; not; T)
13+
open import Data.Bool.Properties using (T?)
1314
open import Data.List.Base as List using (List; []; _∷_)
1415
open import Data.Maybe.Base using (Maybe ; nothing; just)
1516
open import Data.Nat.Base as ℕ
@@ -18,17 +19,19 @@ open import Data.Sum.Base as Sum using (_⊎_; inj₁; inj₂)
1819
open import Data.These.Base as These using (These; this; that; these)
1920
open import Data.Vec.Base as Vec using (Vec; []; _∷_)
2021
open import Function.Base
21-
open import Relation.Binary.PropositionalEquality.Core using (_≢_)
22+
open import Relation.Binary.PropositionalEquality.Core
23+
using (_≡_; _≢_; refl)
24+
open import Relation.Unary using (Pred; Decidable; U; ∅)
25+
open import Relation.Unary.Properties using (U?; ∅?)
26+
open import Relation.Nullary using (does)
2227

2328
private
2429
variable
25-
a b c : Level
26-
A : Set a
27-
B : Set b
28-
C : Set c
30+
a p : Level
31+
A B C : Set a
2932

3033
------------------------------------------------------------------------
31-
-- Non-empty lists
34+
-- Definition
3235

3336
infixr 5 _∷_
3437

@@ -40,6 +43,7 @@ record List⁺ (A : Set a) : Set a where
4043

4144
open List⁺ public
4245

46+
------------------------------------------------------------------------
4347
-- Basic combinators
4448

4549
uncons : List⁺ A A × List A
@@ -85,7 +89,8 @@ map f (x ∷ xs) = (f x ∷ List.map f xs)
8589
replicate : n n ≢ 0 A List⁺ A
8690
replicate n n≢0 a = a ∷ List.replicate (pred n) a
8791

88-
-- when dropping more than the size of the length of the list, the last element remains
92+
-- when dropping more than the size of the length of the list, the
93+
-- last element remains
8994
drop+ : List⁺ A List⁺ A
9095
drop+ zero xs = xs
9196
drop+ (suc n) (x ∷ []) = x ∷ []
@@ -199,3 +204,120 @@ snocView (x ∷ .(xs List.∷ʳ y)) | xs List.∷ʳ′ y = (x ∷ xs) ∷ʳ′ y
199204
last : List⁺ A A
200205
last xs with snocView xs
201206
last .(ys ∷ʳ y) | ys ∷ʳ′ y = y
207+
208+
-- Groups all contiguous elements for which the predicate returns the
209+
-- same result into lists. The left sums are the ones for which the
210+
-- predicate holds, the right ones are the ones for which it doesn't.
211+
groupSeqsᵇ : (A Bool) List A List (List⁺ A ⊎ List⁺ A)
212+
groupSeqsᵇ p [] = []
213+
groupSeqsᵇ p (x ∷ xs) with p x | groupSeqsᵇ p xs
214+
... | true | inj₁ xs′ ∷ xss = inj₁ (x ∷⁺ xs′) ∷ xss
215+
... | true | xss = inj₁ [ x ] ∷ xss
216+
... | false | inj₂ xs′ ∷ xss = inj₂ (x ∷⁺ xs′) ∷ xss
217+
... | false | xss = inj₂ [ x ] ∷ xss
218+
219+
-- Groups all contiguous elements /not/ satisfying the predicate into
220+
-- lists. Elements satisfying the predicate are dropped.
221+
wordsByᵇ : (A Bool) List A List (List⁺ A)
222+
wordsByᵇ p = List.mapMaybe Sum.[ const nothing , just ] ∘ groupSeqsᵇ p
223+
224+
groupSeqs : {P : Pred A p} Decidable P List A List (List⁺ A ⊎ List⁺ A)
225+
groupSeqs P? = groupSeqsᵇ (does ∘ P?)
226+
227+
wordsBy : {P : Pred A p} Decidable P List A List (List⁺ A)
228+
wordsBy P? = wordsByᵇ (does ∘ P?)
229+
230+
-- Inverse operation for groupSequences.
231+
ungroupSeqs : List (List⁺ A ⊎ List⁺ A) List A
232+
ungroupSeqs = List.concat ∘ List.map Sum.[ toList , toList ]
233+
234+
------------------------------------------------------------------------
235+
-- Examples
236+
237+
-- Note that these examples are simple unit tests, because the type
238+
-- checker verifies them.
239+
240+
private
241+
module Examples {A B : Set}
242+
(_⊕_ : A B B)
243+
(_⊗_ : B A B)
244+
(_⊙_ : A A A)
245+
(f : A B)
246+
(a b c : A)
247+
where
248+
249+
hd : head (a ∷⁺ b ∷⁺ [ c ]) ≡ a
250+
hd = refl
251+
252+
tl : tail (a ∷⁺ b ∷⁺ [ c ]) ≡ b ∷ c ∷ []
253+
tl = refl
254+
255+
mp : map f (a ∷⁺ b ∷⁺ [ c ]) ≡ f a ∷⁺ f b ∷⁺ [ f c ]
256+
mp = refl
257+
258+
right : foldr _⊕_ f (a ∷⁺ b ∷⁺ [ c ]) ≡ (a ⊕ (b ⊕ f c))
259+
right = refl
260+
261+
right₁ : foldr₁ _⊙_ (a ∷⁺ b ∷⁺ [ c ]) ≡ (a ⊙ (b ⊙ c))
262+
right₁ = refl
263+
264+
left : foldl _⊗_ f (a ∷⁺ b ∷⁺ [ c ]) ≡ ((f a ⊗ b) ⊗ c)
265+
left = refl
266+
267+
left₁ : foldl₁ _⊙_ (a ∷⁺ b ∷⁺ [ c ]) ≡ ((a ⊙ b) ⊙ c)
268+
left₁ = refl
269+
270+
⁺app⁺ : (a ∷⁺ b ∷⁺ [ c ]) ⁺++⁺ (b ∷⁺ [ c ]) ≡
271+
a ∷⁺ b ∷⁺ c ∷⁺ b ∷⁺ [ c ]
272+
⁺app⁺ = refl
273+
274+
⁺app : (a ∷⁺ b ∷⁺ [ c ]) ⁺++ (b ∷ c ∷ []) ≡
275+
a ∷⁺ b ∷⁺ c ∷⁺ b ∷⁺ [ c ]
276+
⁺app = refl
277+
278+
app⁺ : (a ∷ b ∷ c ∷ []) ++⁺ (b ∷⁺ [ c ]) ≡
279+
a ∷⁺ b ∷⁺ c ∷⁺ b ∷⁺ [ c ]
280+
app⁺ = refl
281+
282+
conc : concat ((a ∷⁺ b ∷⁺ [ c ]) ∷⁺ [ b ∷⁺ [ c ] ]) ≡
283+
a ∷⁺ b ∷⁺ c ∷⁺ b ∷⁺ [ c ]
284+
conc = refl
285+
286+
rev : reverse (a ∷⁺ b ∷⁺ [ c ]) ≡ c ∷⁺ b ∷⁺ [ a ]
287+
rev = refl
288+
289+
snoc : (a ∷ b ∷ c ∷ []) ∷ʳ a ≡ a ∷⁺ b ∷⁺ c ∷⁺ [ a ]
290+
snoc = refl
291+
292+
snoc⁺ : (a ∷⁺ b ∷⁺ [ c ]) ⁺∷ʳ a ≡ a ∷⁺ b ∷⁺ c ∷⁺ [ a ]
293+
snoc⁺ = refl
294+
295+
groupSeqs-true : groupSeqs U? (a ∷ b ∷ c ∷ []) ≡
296+
inj₁ (a ∷⁺ b ∷⁺ [ c ]) ∷ []
297+
groupSeqs-true = refl
298+
299+
groupSeqs-false : groupSeqs ∅? (a ∷ b ∷ c ∷ []) ≡
300+
inj₂ (a ∷⁺ b ∷⁺ [ c ]) ∷ []
301+
groupSeqs-false = refl
302+
303+
groupSeqs-≡1 : groupSeqsᵇ (ℕ._≡ᵇ 1) (1231121 ∷ []) ≡
304+
inj₁ [ 1 ] ∷
305+
inj₂ (2 ∷⁺ [ 3 ]) ∷
306+
inj₁ (1 ∷⁺ [ 1 ]) ∷
307+
inj₂ [ 2 ] ∷
308+
inj₁ [ 1 ] ∷
309+
[]
310+
groupSeqs-≡1 = refl
311+
312+
wordsBy-true : wordsByᵇ (const true) (a ∷ b ∷ c ∷ []) ≡ []
313+
wordsBy-true = refl
314+
315+
wordsBy-false : wordsByᵇ (const false) (a ∷ b ∷ c ∷ []) ≡
316+
(a ∷⁺ b ∷⁺ [ c ]) ∷ []
317+
wordsBy-false = refl
318+
319+
wordsBy-≡1 : wordsByᵇ (ℕ._≡ᵇ 1) (1231121 ∷ []) ≡
320+
(2 ∷⁺ [ 3 ]) ∷
321+
[ 2 ] ∷
322+
[]
323+
wordsBy-≡1 = refl

0 commit comments

Comments
 (0)