4 | import Data.List1.Properties
6 | import Syntax.PreorderReasoning
14 | export infixl 8 `p`
,`sub`
24 | 0 Op1 : Type -> Type
29 | 0 Op2 : Type -> Type
33 | public export %tcinline
34 | 0 Assoc : Op2 a -> Type
35 | Assoc p = (u,v,w : a) -> u `p` (v `p` w) === (u `p` v) `p` w
38 | public export %tcinline
39 | 0 Associative : Op2 a -> Type
40 | Associative p = {u,v,w : a} -> u `p` (v `p` w) === (u `p` v) `p` w
44 | 0 Commutative : Op2 a -> Type
45 | Commutative p = {u,v : a} -> u `p` v === v `p` u
50 | 0 LeftNeutral : (z : a) -> Op2 a -> Type
51 | LeftNeutral z p = {u : a} -> z `p` u === u
56 | 0 RightNeutral : (z : a) -> Op2 a -> Type
57 | RightNeutral z p = {u : a} -> u `p` z === u
61 | 0 LeftInverse : (z : a) -> (i : Op1 a) -> Op2 a -> Type
62 | LeftInverse z i p = {u : a} -> i u `p` u === z
66 | 0 RightInverse : (z : a) -> (i : Op1 a) -> Op2 a -> Type
67 | RightInverse z i p = {u : a} -> u `p` i u === z
76 | rightNeutral : LeftNeutral z p -> Commutative p -> RightNeutral z p
77 | rightNeutral ln com = Calc $
85 | leftNeutral : RightNeutral z p -> Commutative p -> LeftNeutral z p
86 | leftNeutral rn com = Calc $
93 | rightInverse : LeftInverse z i p -> Commutative p -> RightInverse z i p
94 | rightInverse li com = Calc $
96 | ~~ (i u) `p` u ... com
101 | leftInverse : RightInverse z i p -> Commutative p -> LeftInverse z i p
102 | leftInverse ri com = Calc $
104 | ~~ u `p` (i u) ... com
113 | record Semigroup (a : Type) (p : Op2 a) where
114 | constructor MkSemigroup
115 | associative : Associative p
119 | record CommutativeSemigroup (a : Type) (p : Op2 a) where
120 | constructor MkCommutativeSemigroup
121 | associative : Associative p
122 | commutative : Commutative p
124 | namespace CommutativeSemigroup
128 | (.sgrp) : CommutativeSemigroup a p -> Semigroup a p
129 | c.sgrp = MkSemigroup c.associative
138 | record Monoid (a : Type) (z : a) (p : Op2 a) where
139 | constructor MkMonoid
140 | associative : Associative p
141 | rightNeutral : RightNeutral z p
142 | leftNeutral : LeftNeutral z p
148 | (.sgrp) : Monoid a z p -> Semigroup a p
149 | m.sgrp = MkSemigroup m.associative
153 | record CommutativeMonoid (a : Type) (z : a) (p : Op2 a) where
154 | constructor MkCommutativeMonoid
155 | associative : Associative p
156 | commutative : Commutative p
157 | leftNeutral : LeftNeutral z p
160 | mkCommutativeMonoid :
164 | -> ((u,v,w : a) -> u `p` (v `p` w) === (u `p` v) `p` w)
165 | -> ((u,v : a) -> u `p` v === v `p` u)
166 | -> ((u : a) -> z `p` u === u)
167 | -> CommutativeMonoid a z p
168 | mkCommutativeMonoid assoc comm ln =
169 | MkCommutativeMonoid (assoc _ _ _) (comm _ _) (ln _)
171 | namespace CommutativeMonoid
175 | (.sgrp) : CommutativeMonoid a z p -> Semigroup a p
176 | m.sgrp = MkSemigroup m.associative
180 | (.csgrp) : CommutativeMonoid a z p -> CommutativeSemigroup a p
181 | m.csgrp = MkCommutativeSemigroup m.associative m.commutative
185 | (.rightNeutral) : CommutativeMonoid a z p -> RightNeutral z p
186 | m.rightNeutral = rightNeutral {p} m.leftNeutral m.commutative
190 | (.mon) : CommutativeMonoid a z p -> Monoid a z p
191 | m.mon = MkMonoid m.associative m.rightNeutral m.leftNeutral
199 | record Group (a : Type) (z : a) (i : Op1 a) (p : Op2 a) where
200 | constructor MkGroup
201 | associative : Associative p
202 | leftNeutral : LeftNeutral z p
203 | rightNeutral : RightNeutral z p
204 | leftInverse : LeftInverse z i p
205 | rightInverse : RightInverse z i p
213 | -> u `p` v === u `p` w
215 | leftInjective g prf = Calc $
217 | ~~ z `p` v ..< g.leftNeutral
218 | ~~ (i u `p` u) `p` v ..< cong (`p` v) g.leftInverse
219 | ~~ i u `p` (u `p` v) ..< g.associative
220 | ~~ i u `p` (u `p` w) ... cong (i u `p`) prf
221 | ~~ (i u `p` u) `p` w ... g.associative
222 | ~~ z `p` w ... cong (`p` w) g.leftInverse
223 | ~~ w ... g.leftNeutral
227 | 0 solveInverseLeft :
232 | solveInverseLeft g prf = leftInjective g $
Calc $
235 | ~~ v `p` i v ..< g.rightInverse
243 | -> i (u `p` v) === i v `p` i u
244 | invertProduct g = sym $
solveInverseLeft g $
Calc $
245 | |~ (u `p` v) `p` (i v `p` i u)
246 | ~~ u `p` (v `p` (i v `p` i u)) ..< g.associative
247 | ~~ u `p` ((v `p` i v) `p` i u) ... cong (u `p`) g.associative
248 | ~~ u `p` (z `p` i u) ... cong (\q => u `p` (q `p` i u)) g.rightInverse
249 | ~~ u `p` i u ... cong (u `p`) g.leftNeutral
250 | ~~ z ... g.rightInverse
258 | -> v `p` u === w `p` u
260 | rightInjective g prf = Calc $
262 | ~~ v `p` z ..< g.rightNeutral
263 | ~~ v `p` (u `p` i u) ..< cong (p v) g.rightInverse
264 | ~~ (v `p` u) `p` i u ... g.associative
265 | ~~ (w `p` u) `p` i u ... cong (`p` i u) prf
266 | ~~ w `p` (u `p` i u) ..< g.associative
267 | ~~ w `p` z ... cong (w `p`) g.rightInverse
268 | ~~ w ... g.rightNeutral
272 | 0 solveInverseRight :
277 | solveInverseRight g prf = rightInjective g $
Calc $
280 | ~~ i v `p` v ..< g.leftInverse
285 | 0 inverseZero : Group a z i p -> i z === z
286 | inverseZero g = sym $
solveInverseRight g $
g.rightNeutral
290 | 0 inverseInvolutory : Group a z i p -> {u : a} -> i (i u) === u
291 | inverseInvolutory g = sym $
solveInverseRight g g.rightInverse
297 | (.sgrp) : Group a z i p -> Semigroup a p
298 | g.sgrp = MkSemigroup g.associative
302 | (.mon) : Group a z i p -> Monoid a z p
303 | g.mon = MkMonoid g.associative g.rightNeutral g.leftNeutral
307 | record AbelianGroup (a : Type) (z : a) (i : Op1 a) (p : Op2 a) where
308 | constructor MkAbelianGroup
309 | associative : Associative p
310 | commutative : Commutative p
311 | leftNeutral : LeftNeutral z p
312 | leftInverse : LeftInverse z i p
314 | namespace AbelianGroup
318 | (.sgrp) : AbelianGroup a z i p -> Semigroup a p
319 | g.sgrp = MkSemigroup g.associative
323 | (.cmon) : AbelianGroup a z i p -> CommutativeMonoid a z p
324 | g.cmon = MkCommutativeMonoid g.associative g.commutative g.leftNeutral
328 | (.csgrp) : AbelianGroup a z i p -> CommutativeSemigroup a p
329 | g.csgrp = g.cmon.csgrp
333 | (.rightNeutral) : AbelianGroup a z i p -> RightNeutral z p
334 | g.rightNeutral = g.cmon.rightNeutral
338 | (.rightInverse) : AbelianGroup a z i p -> RightInverse z i p
339 | g.rightInverse = rightInverse {p} g.leftInverse g.commutative
343 | (.mon) : AbelianGroup a z i p -> Monoid a z p
348 | (.grp) : AbelianGroup a z i p -> Group a z i p
362 | 0 sgrp_list1 : Semigroup (List1 a) (++)
363 | sgrp_list1 = MkSemigroup (appendAssociative _ _ _)
370 | 0 mon_list : Monoid (List a) [] (++)
371 | mon_list = MkMonoid (appendAssociative _ _ _) (appendNilRightNeutral _) Refl
378 | 0 cmon_nat_plus : CommutativeMonoid Nat Z (+)
380 | mkCommutativeMonoid plusAssociative plusCommutative plusZeroLeftNeutral
383 | 0 cmon_nat_mult : CommutativeMonoid Nat 1 (*)
385 | mkCommutativeMonoid multAssociative multCommutative multOneLeftNeutral
393 | 0 appendAssoc : Associative ((<+>) {ty = Maybe a})
394 | appendAssoc {u = Just vx} = Refl
395 | appendAssoc {u = Nothing} = Refl
398 | 0 appendRightNeutral : RightNeutral Nothing ((<+>) {ty = Maybe a})
399 | appendRightNeutral {u = Just _} = Refl
400 | appendRightNeutral {u = Nothing} = Refl
405 | 0 mon_maybe : Monoid (Maybe a) Nothing (<+>)
406 | mon_maybe = MkMonoid appendAssoc appendRightNeutral Refl
414 | union : (p : a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
415 | union p Nothing m = m
416 | union p (Just u) Nothing = Just u
417 | union p (Just u) (Just v) = Just $
p u v
421 | 0 unionAssoc : Associative p -> Associative (union p)
422 | unionAssoc {u=Nothing} s = Refl
423 | unionAssoc {u=Just u} {v=Nothing} s = Refl
424 | unionAssoc {u=Just u} {v=Just v} {w=Nothing} s = Refl
425 | unionAssoc {u=Just u} {v=Just v} {w=Just w} s = cong Just s
428 | 0 unionCommutative : Commutative p -> Commutative (union p)
429 | unionCommutative {u=Nothing} {v=Nothing} _ = Refl
430 | unionCommutative {u=Nothing} {v=Just v} _ = Refl
431 | unionCommutative {u=Just u} {v=Nothing} _ = Refl
432 | unionCommutative {u=Just u} {v=Just v} s = cong Just s
435 | 0 unionRightNeutral : RightNeutral Nothing (union p)
436 | unionRightNeutral {u = Just _} = Refl
437 | unionRightNeutral {u = Nothing} = Refl
440 | 0 mon_union : Associative p -> Monoid (Maybe a) Nothing (union p)
441 | mon_union ap = MkMonoid (unionAssoc ap) unionRightNeutral Refl
445 | CommutativeSemigroup a p
446 | -> CommutativeMonoid (Maybe a) Nothing (union p)
448 | MkCommutativeMonoid
449 | (mon_union s.associative).associative
450 | (unionCommutative s.commutative)
459 | 0 appendAssoc : Associative ((<+>) {ty = Ordering})
460 | appendAssoc {u = EQ} = Refl
461 | appendAssoc {u = LT} = Refl
462 | appendAssoc {u = GT} = Refl
465 | 0 appendRightNeutral : RightNeutral EQ ((<+>) {ty = Ordering})
466 | appendRightNeutral {u = EQ} = Refl
467 | appendRightNeutral {u = LT} = Refl
468 | appendRightNeutral {u = GT} = Refl
473 | 0 mon_ordering : Monoid Ordering EQ (<+>)
474 | mon_ordering = MkMonoid appendAssoc appendRightNeutral Refl
486 | 0 appendLeftNeutral : LeftNeutral MkUnit ((<+>) {ty = Unit})
487 | appendLeftNeutral {u = ()} = Refl
491 | 0 agrp_unit : AbelianGroup Unit MkUnit Unit.neg (<+>)
492 | agrp_unit = MkAbelianGroup Refl Refl appendLeftNeutral Refl
498 | unsafeRefl : a === b
499 | unsafeRefl = believe_me (Refl {x = a})
502 | 0 mon_string : Monoid String "" Prelude.String.(++)
503 | mon_string = MkMonoid unsafeRefl unsafeRefl unsafeRefl
506 | 0 plus_bits8 : AbelianGroup Bits8 0 Prelude.negate Prelude.(+)
507 | plus_bits8 = MkAbelianGroup unsafeRefl unsafeRefl unsafeRefl unsafeRefl
510 | 0 mult_bits8 : CommutativeMonoid Bits8 1 Prelude.(*)
511 | mult_bits8 = MkCommutativeMonoid unsafeRefl unsafeRefl unsafeRefl
514 | 0 plus_bits16 : AbelianGroup Bits16 0 Prelude.negate Prelude.(+)
515 | plus_bits16 = MkAbelianGroup unsafeRefl unsafeRefl unsafeRefl unsafeRefl
518 | 0 mult_bits16 : CommutativeMonoid Bits16 1 Prelude.(*)
519 | mult_bits16 = MkCommutativeMonoid unsafeRefl unsafeRefl unsafeRefl
522 | 0 plus_bits32 : AbelianGroup Bits32 0 Prelude.negate Prelude.(+)
523 | plus_bits32 = MkAbelianGroup unsafeRefl unsafeRefl unsafeRefl unsafeRefl
526 | 0 mult_bits32 : CommutativeMonoid Bits32 1 Prelude.(*)
527 | mult_bits32 = MkCommutativeMonoid unsafeRefl unsafeRefl unsafeRefl
530 | 0 plus_bits64 : AbelianGroup Bits64 0 Prelude.negate Prelude.(+)
531 | plus_bits64 = MkAbelianGroup unsafeRefl unsafeRefl unsafeRefl unsafeRefl
534 | 0 mult_bits64 : CommutativeMonoid Bits64 1 Prelude.(*)
535 | mult_bits64 = MkCommutativeMonoid unsafeRefl unsafeRefl unsafeRefl
538 | 0 plus_int8 : AbelianGroup Int8 0 Prelude.negate Prelude.(+)
539 | plus_int8 = MkAbelianGroup unsafeRefl unsafeRefl unsafeRefl unsafeRefl
542 | 0 mult_int8 : CommutativeMonoid Int8 1 Prelude.(*)
543 | mult_int8 = MkCommutativeMonoid unsafeRefl unsafeRefl unsafeRefl
546 | 0 plus_int16 : AbelianGroup Int16 0 Prelude.negate Prelude.(+)
547 | plus_int16 = MkAbelianGroup unsafeRefl unsafeRefl unsafeRefl unsafeRefl
550 | 0 mult_int16 : CommutativeMonoid Int16 1 Prelude.(*)
551 | mult_int16 = MkCommutativeMonoid unsafeRefl unsafeRefl unsafeRefl
554 | 0 plus_int32 : AbelianGroup Int32 0 Prelude.negate Prelude.(+)
555 | plus_int32 = MkAbelianGroup unsafeRefl unsafeRefl unsafeRefl unsafeRefl
558 | 0 mult_int32 : CommutativeMonoid Int32 1 Prelude.(*)
559 | mult_int32 = MkCommutativeMonoid unsafeRefl unsafeRefl unsafeRefl
562 | 0 plus_int64 : AbelianGroup Int64 0 Prelude.negate Prelude.(+)
563 | plus_int64 = MkAbelianGroup unsafeRefl unsafeRefl unsafeRefl unsafeRefl
566 | 0 mult_int64 : CommutativeMonoid Int64 1 Prelude.(*)
567 | mult_int64 = MkCommutativeMonoid unsafeRefl unsafeRefl unsafeRefl
570 | 0 plus_integer : AbelianGroup Integer 0 Prelude.negate Prelude.(+)
571 | plus_integer = MkAbelianGroup unsafeRefl unsafeRefl unsafeRefl unsafeRefl
574 | 0 mult_integer : CommutativeMonoid Integer 1 Prelude.(*)
575 | mult_integer = MkCommutativeMonoid unsafeRefl unsafeRefl unsafeRefl