Skip to content

Commit 2cf0f3d

Browse files
Prove properties about delete and nub
1 parent 7bef1a5 commit 2cf0f3d

File tree

1 file changed

+63
-0
lines changed

1 file changed

+63
-0
lines changed

lib/Haskell/Data/List.agda

Lines changed: 63 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -38,3 +38,66 @@ sortOn f =
3838
map snd
3939
∘ sortBy (comparing fst)
4040
∘ map (λ x let y = f x in seq y (y , x))
41+
42+
{-----------------------------------------------------------------------------
43+
Properties
44+
------------------------------------------------------------------------------}
45+
--
46+
lemma-neq-trans
47+
: ∀ ⦃ _ : Eq a ⦄ ⦃ _ : IsLawfulEq a ⦄
48+
(x y z : a)
49+
(x == z) ≡ True
50+
(y == z) ≡ False
51+
(x == y) ≡ False
52+
--
53+
lemma-neq-trans x y z eqxz
54+
rewrite equality x z eqxz
55+
rewrite eqSymmetry y z
56+
= λ x x
57+
58+
-- | A deleted item is no longer an element.
59+
--
60+
prop-elem-delete
61+
: ∀ ⦃ _ : Eq a ⦄ ⦃ _ : IsLawfulEq a ⦄
62+
(x y : a) (zs : List a)
63+
elem x (delete y zs)
64+
≡ (if x == y then False else elem x zs)
65+
--
66+
prop-elem-delete x y []
67+
with x == y
68+
... | False = refl
69+
... | True = refl
70+
prop-elem-delete x y (z ∷ zs)
71+
with recurse prop-elem-delete x y zs
72+
with y == z in eqyz
73+
... | True
74+
with x == z in eqxz
75+
... | True
76+
rewrite equality' _ _ (trans (equality x z eqxz) (sym (equality y z eqyz)))
77+
= recurse
78+
... | False
79+
= recurse
80+
prop-elem-delete x y (z ∷ zs)
81+
| False
82+
with x == z in eqxz
83+
... | True
84+
rewrite (lemma-neq-trans x y z eqxz eqyz)
85+
= refl
86+
... | False
87+
= recurse
88+
89+
-- | An item is an element of the 'nub' iff it is
90+
-- an element of the original list.
91+
--
92+
prop-elem-nub
93+
: ∀ ⦃ _ : Eq a ⦄ ⦃ _ : IsLawfulEq a ⦄
94+
(x : a) (ys : List a)
95+
elem x (nub ys)
96+
≡ elem x ys
97+
--
98+
prop-elem-nub x [] = refl
99+
prop-elem-nub x (y ∷ ys)
100+
rewrite prop-elem-delete x y (nub ys)
101+
with x == y
102+
... | True = refl
103+
... | False = prop-elem-nub x ys

0 commit comments

Comments
 (0)