~ubuntu-branches/ubuntu/utopic/agda-stdlib/utopic-proposed

« back to all changes in this revision

Viewing changes to src/Data/Nat/Properties.agda

  • Committer: Package Import Robot
  • Author(s): Iain Lane
  • Date: 2014-08-05 09:46:46 UTC
  • mfrom: (1.1.6)
  • Revision ID: package-import@ubuntu.com-20140805094646-zqd0c4m8ndngqg6x
Tags: 0.8-1
* [4ca6fd0] Update debian/watch to fetch tarballs from github
* [84d4313] Imported Upstream version 0.8
* [7b08243] debian/control: Require agda 2.4.x per upstream
* [37e7e10] debian/control: Standards-Version → 3.9.5, no changes required.
* [9051b9d] Run upstream's "GenerateEverything" script

Show diffs side-by-side

added added

removed removed

Lines of Context:
26
26
open import Data.Sum
27
27
 
28
28
------------------------------------------------------------------------
 
29
 
 
30
-- basic lemmas about (ℕ, +, *, 0, 1):
 
31
open import Data.Nat.Properties.Simple
 
32
 
29
33
-- (ℕ, +, *, 0, 1) is a commutative semiring
30
 
 
31
 
private
32
 
 
33
 
  +-assoc : Associative _+_
34
 
  +-assoc zero    _ _ = refl
35
 
  +-assoc (suc m) n o = cong suc $ +-assoc m n o
36
 
 
37
 
  +-identity : Identity 0 _+_
38
 
  +-identity = (λ _ → refl) , n+0≡n
39
 
    where
40
 
    n+0≡n : RightIdentity 0 _+_
41
 
    n+0≡n zero    = refl
42
 
    n+0≡n (suc n) = cong suc $ n+0≡n n
43
 
 
44
 
  m+1+n≡1+m+n : ∀ m n → m + suc n ≡ suc (m + n)
45
 
  m+1+n≡1+m+n zero    n = refl
46
 
  m+1+n≡1+m+n (suc m) n = cong suc (m+1+n≡1+m+n m n)
47
 
 
48
 
  +-comm : Commutative _+_
49
 
  +-comm zero    n = sym $ proj₂ +-identity n
50
 
  +-comm (suc m) n =
51
 
    begin
52
 
      suc m + n
53
 
    ≡⟨ refl ⟩
54
 
      suc (m + n)
55
 
    ≡⟨ cong suc (+-comm m n) ⟩
56
 
      suc (n + m)
57
 
    ≡⟨ sym (m+1+n≡1+m+n n m) ⟩
58
 
      n + suc m
59
 
    ∎
60
 
 
61
 
  m*1+n≡m+mn : ∀ m n → m * suc n ≡ m + m * n
62
 
  m*1+n≡m+mn zero    n = refl
63
 
  m*1+n≡m+mn (suc m) n =
64
 
    begin
65
 
      suc m * suc n
66
 
    ≡⟨ refl ⟩
67
 
      suc n + m * suc n
68
 
    ≡⟨ cong (λ x → suc n + x) (m*1+n≡m+mn m n) ⟩
69
 
      suc n + (m + m * n)
70
 
    ≡⟨ refl ⟩
71
 
      suc (n + (m + m * n))
72
 
    ≡⟨ cong suc (sym $ +-assoc n m (m * n)) ⟩
73
 
      suc (n + m + m * n)
74
 
    ≡⟨ cong (λ x → suc (x + m * n)) (+-comm n m) ⟩
75
 
      suc (m + n + m * n)
76
 
    ≡⟨ cong suc (+-assoc m n (m * n)) ⟩
77
 
      suc (m + (n + m * n))
78
 
    ≡⟨ refl ⟩
79
 
      suc m + suc m * n
80
 
    ∎
81
 
 
82
 
  *-zero : Zero 0 _*_
83
 
  *-zero = (λ _ → refl) , n*0≡0
84
 
    where
85
 
    n*0≡0 : RightZero 0 _*_
86
 
    n*0≡0 zero    = refl
87
 
    n*0≡0 (suc n) = n*0≡0 n
88
 
 
89
 
  *-comm : Commutative _*_
90
 
  *-comm zero    n = sym $ proj₂ *-zero n
91
 
  *-comm (suc m) n =
92
 
    begin
93
 
      suc m * n
94
 
    ≡⟨ refl ⟩
95
 
      n + m * n
96
 
    ≡⟨ cong (λ x → n + x) (*-comm m n) ⟩
97
 
      n + n * m
98
 
    ≡⟨ sym (m*1+n≡m+mn n m) ⟩
99
 
      n * suc m
100
 
    ∎
101
 
 
102
 
  distribʳ-*-+ : _*_ DistributesOverʳ _+_
103
 
  distribʳ-*-+ m zero    o = refl
104
 
  distribʳ-*-+ m (suc n) o =
105
 
                           begin
106
 
      (suc n + o) * m
107
 
                           ≡⟨ refl ⟩
108
 
      m + (n + o) * m
109
 
                           ≡⟨ cong (_+_ m) $ distribʳ-*-+ m n o ⟩
110
 
      m + (n * m + o * m)
111
 
                           ≡⟨ sym $ +-assoc m (n * m) (o * m) ⟩
112
 
      m + n * m + o * m
113
 
                           ≡⟨ refl ⟩
114
 
      suc n * m + o * m
115
 
                           ∎
116
 
 
117
 
  *-assoc : Associative _*_
118
 
  *-assoc zero    n o = refl
119
 
  *-assoc (suc m) n o =
120
 
                         begin
121
 
    (suc m * n) * o
122
 
                         ≡⟨ refl ⟩
123
 
    (n + m * n) * o
124
 
                         ≡⟨ distribʳ-*-+ o n (m * n) ⟩
125
 
    n * o + (m * n) * o
126
 
                         ≡⟨ cong (λ x → n * o + x) $ *-assoc m n o ⟩
127
 
    n * o + m * (n * o)
128
 
                         ≡⟨ refl ⟩
129
 
    suc m * (n * o)
130
 
                         ∎
131
 
 
132
34
isCommutativeSemiring : IsCommutativeSemiring _≡_ _+_ _*_ 0 1
133
35
isCommutativeSemiring = record
134
36
  { +-isCommutativeMonoid = record
137
39
      ; assoc         = +-assoc
138
40
      ; ∙-cong        = cong₂ _+_
139
41
      }
140
 
    ; identityˡ = proj₁ +-identity
 
42
    ; identityˡ = λ _ → refl
141
43
    ; comm      = +-comm
142
44
    }
143
45
  ; *-isCommutativeMonoid = record
146
48
      ; assoc         = *-assoc
147
49
      ; ∙-cong        = cong₂ _*_
148
50
      }
149
 
    ; identityˡ = proj₂ +-identity
 
51
    ; identityˡ = +-right-identity
150
52
    ; comm      = *-comm
151
53
    }
152
54
  ; distribʳ = distribʳ-*-+
153
 
  ; zeroˡ    = proj₁ *-zero
 
55
  ; zeroˡ    = λ _ → refl
154
56
  }
155
57
 
156
58
commutativeSemiring : CommutativeSemiring _ _
477
379
n∸n≡0 (suc n) = n∸n≡0 n
478
380
 
479
381
∸-+-assoc : ∀ m n o → (m ∸ n) ∸ o ≡ m ∸ (n + o)
480
 
∸-+-assoc m       n       zero    = cong (_∸_ m) (sym $ proj₂ +-identity n)
 
382
∸-+-assoc m       n       zero    = cong (_∸_ m) (sym $ +-right-identity n)
481
383
∸-+-assoc zero    zero    (suc o) = refl
482
384
∸-+-assoc zero    (suc n) (suc o) = refl
483
385
∸-+-assoc (suc m) zero    (suc o) = refl
486
388
+-∸-assoc : ∀ m {n o} → o ≤ n → (m + n) ∸ o ≡ m + (n ∸ o)
487
389
+-∸-assoc m (z≤n {n = n})             = begin m + n ∎
488
390
+-∸-assoc m (s≤s {m = o} {n = n} o≤n) = begin
489
 
  (m + suc n) ∸ suc o  ≡⟨ cong (λ n → n ∸ suc o) (m+1+n≡1+m+n m n) ⟩
 
391
  (m + suc n) ∸ suc o  ≡⟨ cong (λ n → n ∸ suc o) (+-suc m n) ⟩
490
392
  suc (m + n) ∸ suc o  ≡⟨ refl ⟩
491
393
  (m + n) ∸ o          ≡⟨ +-∸-assoc m o≤n ⟩
492
394
  m + (n ∸ o)          ∎
495
397
m+n∸n≡m m n = begin
496
398
  (m + n) ∸ n  ≡⟨ +-∸-assoc m (≤-refl {x = n}) ⟩
497
399
  m + (n ∸ n)  ≡⟨ cong (_+_ m) (n∸n≡0 n) ⟩
498
 
  m + 0        ≡⟨ proj₂ +-identity m ⟩
 
400
  m + 0        ≡⟨ +-right-identity m ⟩
499
401
  m            ∎
500
402
 
501
403
m+n∸m≡n : ∀ {m n} → m ≤ n → m + (n ∸ m) ≡ n
540
442
                       ∎
541
443
i∸k∸j+j∸k≡i+j∸k (suc i) zero (suc k) = begin
542
444
  i ∸ k + 0
543
 
             ≡⟨ proj₂ +-identity _ ⟩
 
445
             ≡⟨ +-right-identity _ ⟩
544
446
  i ∸ k
545
 
             ≡⟨ cong (λ x → x ∸ k) (sym (proj₂ +-identity _)) ⟩
 
447
             ≡⟨ cong (λ x → x ∸ k) (sym (+-right-identity _)) ⟩
546
448
  i + 0 ∸ k
547
449
             ∎
548
450
i∸k∸j+j∸k≡i+j∸k (suc i) (suc j) (suc k) = begin
550
452
                             ≡⟨ i∸k∸j+j∸k≡i+j∸k (suc i) j k ⟩
551
453
  suc i + j ∸ k
552
454
                             ≡⟨ cong (λ x → x ∸ k)
553
 
                                     (sym (m+1+n≡1+m+n i j)) ⟩
 
455
                                     (sym (+-suc i j)) ⟩
554
456
  i + suc j ∸ k
555
457
                             ∎
556
458