With rewrite I have a succinct syntax (e.g. no congruence property invoked) and I can prove :
-- * is associative
*-assoc : ∀ a b c → (a * b) * c ≡ a * (b * c)
*-assoc zero b c = refl
*-assoc (succ a) b c rewrite *+-dist b (a * b) c | *-assoc a b c = refl
however, my small brain can parse better this proof
--written in equational style
*-assoc' : ∀ a b c → (a * b) * c ≡ a * (b * c)
*-assoc' zero b c = refl
*-assoc' (succ a) b c = (succ a * b) * c ≡⟨ refl ⟩
(b + a * b) * c ≡⟨ *+-dist b (a * b) c ⟩
b * c + (a * b) * c ≡⟨ cong (λ x -> b * c + x) (*-assoc a b c) ⟩
b * c + a * (b * c) ≡⟨ refl ⟩
(succ a) * (b * c) ∎
but I have to specify which subterm to 'transform' by invoking congruence.
Is there a way to combine rewrite and equational writing to get rid of the congruence mention ?
Thanks in advance
Related
I want to prove that (c * a) / (c * b) = a / b in agda using the division function defined in the standard library. The proofs keep coming back to this thing div-helper that is very difficult to work with and reason about.
open import Data.Nat.DivMod using (_/_)
open import Relation.Binary.PropositionalEquality using (_≡_)
open import Data.Nat using (ℕ; suc; zero)
/-cancelˡ : ∀ c a b {b≢0} {b*c≢0} → ((c * a) / (c * b)) {b*c≢0} ≡ (a / b) {b≢0}
/-cancelˡ (suc c) a (suc b) {b≢0} {b*c≢0} = ?
That hole simplifies to:
div-helper 0 (b + c * suc b) (a + c * a) (b + c * suc b) ≡ div-helper 0 b a b
I could come up with two different proofs.
Proof 1 is completely agnostic of div-helper's structure. It is based on lemmas about division from the standard library. It proves a few additional lemmas about division, which it then uses to prove the property we're after. It's a little involved, but I think that the additional lemmas are useful in their own right.
Proof 2 considers the structure of div-helper and proves two invariants from which the property follows trivially. It's way more concise.
This is the property we're after:
∀ (a b n : ℕ) → divₕ 0 (b + n + b * n) (a + n * a) (b + n + b * n) ≡ divₕ 0 b a b
What makes this look a little weird is that the division helper takes n (as opposed to suc n) for a / suc n. That's where b + n + b * n comes from - suc (b + n + b * n) is equal to suc b * suc n.
Stated in terms of / instead of the division helper, the proof thus says that (a * suc n) / (suc b * suc n) is equal to a / suc b.
This is proof 1:
module Answer where
open import Relation.Binary.PropositionalEquality as P using (_≡_; cong; refl; subst; sym)
open import Data.Nat
open import Data.Nat.DivMod
open import Data.Nat.DivMod.Core
open import Data.Nat.Properties
open import Agda.Builtin.Nat using () renaming (div-helper to divₕ; mod-helper to modₕ)
divₕ′ : ℕ → ℕ → ℕ
divₕ′ a m = divₕ 0 m a m
modₕ′ : ℕ → ℕ → ℕ
modₕ′ a m = modₕ 0 m a m
a<n⇒a[divₕ]n≡0 : ∀ (a n n′ : ℕ) → a ≤ n → divₕ 0 n′ a n ≡ 0
a<n⇒a[divₕ]n≡0 zero _ _ _ = refl
a<n⇒a[divₕ]n≡0 (suc a) (suc n) n′ (s≤s a≤n) = a<n⇒a[divₕ]n≡0 a n n′ a≤n
a*n[modₕ]n≡0 : ∀ (a n : ℕ) → modₕ 0 n (a * suc n) n ≡ 0
a*n[modₕ]n≡0 zero n = refl
a*n[modₕ]n≡0 (suc a) n rewrite +-comm (suc n) (a * suc n) | a+n[modₕ]n≡a[modₕ]n 0 (a * suc n) n = a*n[modₕ]n≡0 a n
a<n⇒a+b*n[divₕ]n≡b : ∀ (a b n : ℕ) → a ≤ n → divₕ 0 n (a + b * suc n) n ≡ b
a<n⇒a+b*n[divₕ]n≡b a b n a≤n =
begin
divₕ′ (a + b * suc n) n
≡⟨ +-distrib-divₕ 0 0 a (b * suc n) n lem₁ ⟩
divₕ′ a n + divₕ′ (b * suc n) n
≡⟨ cong (_+ divₕ′ (b * suc n) n) (a<n⇒a[divₕ]n≡0 a n n a≤n) ⟩
0 + divₕ′ (b * suc n) n
≡⟨ +-identityˡ (divₕ 0 n (b * suc n) n) ⟩
divₕ′ (b * suc n) n
≡⟨ m*n/n≡m b (suc n) ⟩
b
∎
where
open P.≡-Reasoning
≤₁ = a[modₕ]n<n 0 a n
≤₂ = ≤-reflexive (a*n[modₕ]n≡0 b n)
<₃ : n + 0 < suc n
<₃ = s≤s (≤-reflexive (+-identityʳ n))
lem₁ : modₕ′ a n + modₕ′ (b * suc n) n < suc n
lem₁ = <-transʳ (+-mono-≤ ≤₁ ≤₂) <₃
a[divₕ]m*n≡a[divₕ]m[divₕ]n : ∀ (a m n : ℕ) → divₕ 0 (m + n + m * n) a (m + n + m * n) ≡ divₕ 0 n (divₕ 0 m a m) n
a[divₕ]m*n≡a[divₕ]m[divₕ]n a m n =
begin
divₕ′ a mn
≡⟨ cong (λ # → divₕ′ # mn) (div-mod-lemma 0 0 a m) ⟩
divₕ′ (modₕ′ a m + divₕ′ a m * suc m) mn
≡⟨ cong (λ # → divₕ′ (modₕ′ a m + # * suc m) mn) (div-mod-lemma 0 0 (divₕ′ a m) n) ⟩
divₕ′ (modₕ′ a m + (modₕ′ (divₕ′ a m) n + divₕ′ (divₕ′ a m) n * suc n) * suc m) mn
≡⟨ cong (λ # → divₕ′ (modₕ′ a m + #) mn) (*-distribʳ-+ (suc m) (modₕ′ (divₕ′ a m) n) (divₕ′ (divₕ′ a m) n * suc n)) ⟩
divₕ′ (modₕ′ a m + (modₕ′ (divₕ′ a m) n * suc m + divₕ′ (divₕ′ a m) n * suc n * suc m)) mn
≡⟨ cong (λ # → divₕ′ # mn) (sym (+-assoc (modₕ′ a m) (modₕ′ (divₕ′ a m) n * suc m) (divₕ′ (divₕ′ a m) n * suc n * suc m))) ⟩
divₕ′ (modₕ′ a m + modₕ′ (divₕ′ a m) n * suc m + divₕ′ (divₕ′ a m) n * suc n * suc m) mn
≡⟨ cong (λ # → divₕ′ (modₕ′ a m + modₕ′ (divₕ′ a m) n * suc m + #) mn) (*-assoc (divₕ′ (divₕ′ a m) n) (suc n) (suc m))⟩
divₕ′ (modₕ′ a m + modₕ′ (divₕ′ a m) n * suc m + divₕ′ (divₕ′ a m) n * (suc n * suc m)) mn
≡⟨ cong (λ # → divₕ′ (modₕ′ a m + modₕ′ (divₕ′ a m) n * suc m + divₕ′ (divₕ′ a m) n * #) mn) (*-comm (suc n) (suc m)) ⟩
divₕ′ (modₕ′ a m + modₕ′ (divₕ′ a m) n * suc m + divₕ′ (divₕ′ a m) n * (suc m * suc n)) mn
≡⟨ cong (λ # → divₕ′ (modₕ′ a m + modₕ′ (divₕ′ a m) n * suc m + divₕ′ (divₕ′ a m) n * #) mn) lem₁ ⟩
divₕ′ (modₕ′ a m + modₕ′ (divₕ′ a m) n * suc m + divₕ′ (divₕ′ a m) n * suc mn) mn
≡⟨ a<n⇒a+b*n[divₕ]n≡b (modₕ′ a m + modₕ′ (divₕ′ a m) n * suc m) (divₕ′ (divₕ′ a m) n) mn lem₄ ⟩
divₕ 0 n (divₕ′ a m) n
∎
where
open P.≡-Reasoning
mn = m + n + m * n
lem₁ : suc m * suc n ≡ suc mn
lem₁ rewrite +-comm m n | *-comm m (suc n) | *-comm m n | +-assoc n m (n * m) = refl
lem₂ : m + n * suc m ≡ mn
lem₂ rewrite *-comm n (suc m) | +-assoc m n (m * n) = refl
≤₁ = a[modₕ]n<n 0 a m
≤₂ = a[modₕ]n<n 0 (divₕ 0 m a m) n
≤₃ = ≤-refl {suc m}
lem₃ = +-mono-≤ ≤₁ (*-mono-≤ ≤₂ ≤₃)
lem₄ : modₕ′ a m + modₕ′ (divₕ′ a m) n * suc m ≤ mn
lem₄ = subst (λ # → modₕ′ a m + modₕ′ (divₕ′ a m) n * suc m ≤ #) lem₂ lem₃
a*n[divₕ]b*n≡a[divₕ]b : ∀ (a b n : ℕ) → divₕ 0 (b + n + b * n) (a + n * a) (b + n + b * n) ≡ divₕ 0 b a b
a*n[divₕ]b*n≡a[divₕ]b a b n =
begin
divₕ′ na nb
≡⟨ cong (λ # → divₕ′ na #) nb≡bn ⟩
divₕ′ na bn
≡⟨ a[divₕ]m*n≡a[divₕ]m[divₕ]n na n b ⟩
divₕ′ (divₕ′ na n) b
≡⟨ cong (λ # → divₕ′ (divₕ′ # n) b) lem₁ ⟩
divₕ′ (divₕ′ (a * suc n) n) b
≡⟨ cong (λ # → divₕ′ # b) (a*n[divₕ]n≡a 0 a n) ⟩
divₕ 0 b a b
∎
where
open P.≡-Reasoning
na = a + n * a
nb = b + n + b * n
bn = n + b + n * b
nb≡bn : nb ≡ bn
nb≡bn rewrite +-comm n b | *-comm n b = refl
lem₁ : na ≡ a * suc n
lem₁ rewrite *-comm a (suc n) = refl
Now let's look at proof 2. Simply append it to the above code, so that I don't have to repeat the imports:
a*n[divₕ]b*n≡a[divₕ]b′ : ∀ (a b n : ℕ) → divₕ 0 (b + n + b * n) (a + n * a) (b + n + b * n) ≡ divₕ 0 b a b
a*n[divₕ]b*n≡a[divₕ]b′ a b n rewrite +-comm b n | *-comm b n = lem₂ n 0 b a b
where
lem₁ : ∀ (a k m n j : ℕ) → divₕ k m (a + n) (a + j) ≡ divₕ k m n j
lem₁ zero k m n j = refl
lem₁ (suc a) k m n j = lem₁ a k m n j
lem₂ : ∀ (a k m n j : ℕ) → divₕ k (a + m + a * m) (suc a * n) (a + j + a * j) ≡ divₕ k m n j
lem₂ a k m zero j rewrite *-zeroʳ a = refl
lem₂ a k m (suc n) zero
rewrite *-zeroʳ a
| +-identityʳ a
| *-suc a n
| P.sym (+-assoc n a (a * n))
| +-comm n a
| +-assoc a n (a * n)
| P.sym (+-suc a (n + a * n))
| lem₁ a k (a + m + a * m) (suc (n + a * n)) 0
= lem₂ a (suc k) m n m
lem₂ a k m (suc n) (suc j)
rewrite *-suc a n
| P.sym (+-assoc n a (a * n))
| +-comm n a
| +-assoc a n (a * n)
| P.sym (+-suc a (n + a * n))
| +-assoc a (suc j) (a * suc j)
| lem₁ a k (a + m + a * m) (suc (n + a * n)) (suc j + a * suc j)
| *-suc a j
| P.sym (+-assoc j a (a * j))
| +-comm j a
= lem₂ a k m n j
The first lemma is an invariant that says that we can add an identical value a to the last two arguments of div-helper, n and j. It's used by the second lemma, which is the more interesting one.
The second lemma is an invariant that says that you can multiply the last three arguments, m, n, and j, with an identical value a. Its a proof by induction on the last two arguments, n and j. This makes it closely follow the structure of div-helper.
The proof thus covers the same three different cases that show up in the three defining equations of div-helper:
n is zero
n is non-zero, but j is zero
n and j are both non-zero
The property that we're after then follows directly from the second lemma. This is basically the idea outlined in the other response, where the second lemma is the more general version of the property that we're after.
Note that the invariants div-helper respects are spelt out in the builtin file Agda.Builtin.Nat. You should state a more general version of your lemma satisfied by div-helper.
I'm experimenting with Homotopy Type Theory in Agda. I use HITs to define the integers:
{-# OPTIONS --cubical --safe #-}
open import Cubical.Foundations.Prelude
open import Data.Nat using (ℕ; _+_)
data ℤ : Set where
-- | An integer i is a pair of natural numbers (m, n)
-- where i = m - n
int : ℕ → ℕ → ℤ
-- | (a, b) = (c, d)
-- a - b = c - d
-- a + d = b + c
int-eq : ∀ {a b c d : ℕ} → (a + d ≡ b + c) → int a b ≡ int c d
Now, I want to define addition on the integers:
add-ints : ℤ → ℤ → ℤ
add-ints (int a b) (int c d) = int (a + c) (b + d)
However, the compiler gives an error because I need to pattern match the equality constructors as well:
Incomplete pattern matching for add-ints. Missing cases:
add-ints (int-eq x i) (int x₁ x₂)
add-ints x (int-eq x₁ i)
when checking the definition of add-ints
So, I end up with this:
add-ints : ℤ → ℤ → ℤ
add-ints (int a b) (int c d) = int (a + c) (b + d)
add-ints (int-eq x i) (int c d) = { }0
add-ints (int a b) (int-eq x i) = { }1
add-ints (int-eq x i) (int-eq y j) = { }2
Agda's typed holes don't help:
?0 : ℤ
?1 : ℤ
?2 : ℤ
———— Errors ————————————————————————————————————————————————
Failed to solve the following constraints:
?0 (x = x) (i = i) (c = a) (d = b)
= ?2 (x = x) (i = i) (y = x₁) (j = i0)
: ℤ
?0 (x = x) (i = i) (c = c) (d = d)
= ?2 (x = x) (i = i) (y = x₁) (j = i1)
: ℤ
?1 (a = a₁) (b = b₁) (x = x₁) (i = i)
= ?2 (x = x) (i = i0) (y = x₁) (j = i)
: ℤ
?1 (a = c₁) (b = d₁) (x = x₁) (i = i)
= ?2 (x = x) (i = i1) (y = x₁) (j = i)
: ℤ
int (a + x) (b + x₁) = ?0 (x = x₂) (i = i0) (c = x) (d = x₁) : ℤ
int (c + x) (d + x₁) = ?0 (x = x₂) (i = i1) (c = x) (d = x₁) : ℤ
int (x + a) (x₁ + b) = ?1 (a = x) (b = x₁) (x = x₂) (i = i0) : ℤ
int (x + c) (x₁ + d) = ?1 (a = x) (b = x₁) (x = x₂) (i = i1) : ℤ
The Agda documentation gives examples of HIT usage, where it pattern matches on the equality constructors when operating on the torus and propositional truncation. However, as someone without a background in topology, I don't completely follow what's going on.
What is the purpose of the i and j from the [0, 1] interval, and why do they appear in my equality constructor patterns? How do I use i and j? How do I handle the higher inductive cases?
You can think of path constructors as taking an interval variable, and satisfying additional equations about the endpoints of that interval,
data ℤ : Set where
int : ℕ → ℕ → ℤ
int-eq : ∀ {a b c d : ℕ} → (a + d ≡ b + c) → I → ℤ
-- such that int-eq {a} {b} {c} {d} _ i0 = int a b
-- and int-eq {a} {b} {c} {d} _ i1 = int c d
In your equations for add-ints of int-eq you also have to produce a ℤ, and it has to match the first clause (for the int constructor) at both endpoints. These are the constraints that Agda reports, saying that the different clauses have to agree.
You can start with ?0 first. For which only the last two contraints matter. It helps here to fill in the implicit variables,
add-ints (int-eq {a0} {b0} {a1} {b1} x i) (int c d) = { }0
To match the first clause, you need to come up with a value of type ℤ that is equal to int (a0 + c) (b0 + d) when i = i0 and equal to int (a1 + c) (b1 + d) when i = i1. You can use an int-eq constructor for this,
?0 = int-eq {a0 + c} {b0 + d} {a1 + c} {b1 + d} ?4 i
The equality ?4 has to be worked out.
I have the following definition
open import Relation.Binary.PropositionalEquality
data _≅_ (A B : Set) : Set where
mkBij : (f : A → B) (g : B → A)
→ (∀ a → a ≡ g (f a))
→ (∀ b → b ≡ f (g b))
→ A ≅ B
And I'm trying to show transitivity. I have what I need, but I don't know how to combine them to get the proof object I want. This is the proof so far.
transtv : ∀ {A B C} → A ≅ B → B ≅ C → A ≅ C
transtv (mkBij f₁ g₁ x y) (mkBij f₂ g₂ w z) =
mkBij (λ x₁ → f₂ (f₁ x₁)) (λ z₁ → g₁ (g₂ z₁))
(λ a → let xa = x a
wb = w (f₁ a)
in {!!})
(λ c → let zc = z c
yb = y (g₂ c)
in {!!})
In the first hole, I have these: (the second hole is identical)
Goal: a ≡ g₁ (g₂ (f₂ (f₁ a)))
wb : f₁ a ≡ g₂ (f₂ (f₁ a))
xa : a ≡ g₁ (f₁ a)
Now, it's obvious that if I replace f₁ a with g₂ (f₂ (f₁ a)) in xa I get to the goal. But I don't know how to do this substitution in agda. What kind of function or language construct do I need to do this?
You can write it very compactly as
trans xa (cong g₁ wb)
Or, using Function._⟨_⟩_:
xa ⟨ trans ⟩ (cong g₁ wb)
I solved it with equational reasoning in the following way:
transtv : ∀ {A B C} → A ≅ B → B ≅ C → A ≅ C
transtv (mkBij f₁ g₁ x y) (mkBij f₂ g₂ w z) =
mkBij (λ x₁ → f₂ (f₁ x₁)) (λ z₁ → g₁ (g₂ z₁))
(λ a → let xa = x a
wb = w (f₁ a)
in begin
a
≡⟨ xa ⟩
g₁ (f₁ a)
≡⟨ cong g₁ wb ⟩
g₁ (g₂ (f₂ (f₁ a)))
∎)
(λ c → let zc = z c
yb = y (g₂ c)
in begin
c
≡⟨ zc ⟩
f₂ (g₂ c)
≡⟨ cong f₂ yb ⟩
f₂ (f₁ (g₁ (g₂ c)))
∎)
I am trying to prove commutative property over natural number on multiplication operation.
--proving comm over *
*comm : ∀ a b → (a * b) ≡ (b * a)
*comm zero b = sym (rightId* b)
*comm (suc a) b = {!!}
when i check goal I found that it is b + a * b ≡ b * suc a. So i proved this.
lemma*-swap : ∀ a b → a + a * b ≡ a * suc b
Now when i tried :
*comm : ∀ a b → (a * b) ≡ (b * a)
*comm zero b = sym (rightId* b)
*comm (suc a) b = lemma*-swap b a
This should work as it satisfied the goal but why this is not working?? Please suggest me where I am wrong.
b + a * b (the expression in the goal) and a + a * b (the expression in lemma*-swap) are distinct so applying lemma*-swap does not satisfy the goal.
You need to rewrite the induction hypothesis *comm a b to turn a * b into b * a in the goal so that the expression lemma*-swap b a can be used to discharge the goal.
I am trying to proof the below lemma
infixr 5 _~_
_~_ = trans
lemma-+swap : ∀ a b c → a + (b + c) ≡ b + (a + c)
lemma-+swap zero b c = refl
lemma-+swap (suc a) b c = (+-assoc a b c) ~ (comm-+ a (b + c)) ~ (+-assoc b c a)
Note : I imported this file
open import Relation.Binary.PropositionalEquality as PropEq
using (_≡_; refl; sym; trans; cong; cong₂)
While on paper I tried in this way :
(a + b) + c equivalent a + (b + c) -- associativity
a + (b + c) equivalent to (b + c) + a -- commutativity
(b + c) + a equi to b + (c + a) -- associativity
I wrote this in goal but getting error. I have proof of associative and commutative property. Please help.
Transcribing the proof you already have on paper
A very nice way of writing proofs like this is to use the Relation.Binary.PropositionalEquality.≡-Reasoning module, because it enables you to write out your proof exactly how you would do it on paper:
open import Relation.Binary.PropositionalEquality as PropEq using (_≡_)
open import Data.Nat
open import Data.Nat.Properties.Simple using (+-assoc; +-comm)
lemma-+swap : ∀ a b c → a + (b + c) ≡ b + (a + c)
lemma-+swap a b c = begin
a + (b + c) ≡⟨ {!!} ⟩
(a + b) + c ≡⟨ {!!} ⟩
(b + a) + c ≡⟨ {!!} ⟩
b + (a + c) ∎
where
open PropEq.≡-Reasoning
Now all you need to fill in are the three holes corresponding to the three steps of the proof.
Using the semiring solver
The hassle-free way is to just let the semiring solver take care of your equality, since addition and multiplication of natural numbers form a semiring. However, I don't recommend you do this for now, since it seems you need way more experience with the fundamentals to ensure you won't fall into the trap of thinking the semiring solver is black-box magic that shouldn't be understood. So the below is meant more for other readers of this answer and not so much to OP:
open import Relation.Binary.PropositionalEquality as PropEq using (_≡_; refl)
open import Data.Nat
lemma-+swap : ∀ a b c → a + (b + c) ≡ b + (a + c)
lemma-+swap = solve 3 (λ a b c → a :+ (b :+ c) := b :+ (a :+ c)) refl
where
open import Data.Nat.Properties as Nat
open Nat.SemiringSolver
You are basically doing needless case splitting. Let's check the goal in both function clauses. In the first one, we get:
lemma-+swap zero b c = ?
-- goal: b + c ≡ b + c
which is satisfied by simple refl. The second one is however:
lemma-+swap (suc a) b c = ?
-- goal: suc (a + (b + c)) ≡ b + suc (a + c)
And notice that +-assoc a b c (from Data.Nat.Properties.Simple) has a type a + b + c ≡ a + (b + c) - with no suc in sight.
So you have two options: the prefered one is to avoid case splitting and use the properties directly. The other one is to use the properties with suc a instead of a.
Your implementation also most likely won't work even if you fix the above problem.
Here, I assume your properties have the same type as the ones from the module mentioned above (which is a fair assumption, given that for the other variations the subexpression +-assoc a b c ~ comm-+ a (b + c) ~ +-assoc b c a does not typecheck).
+-assoc a b c : a + b + c ≡ a + (b + c)
+-comm a (b + c) : a + (b + c) ≡ b + c + a
+-assoc b c a : b + c + a ≡ b + (c + a)
+-assoc a b c ~ comm-+ a (b + c) ~ +-assoc b c a : a + b + c ≡ b + (c + a) (*)
So, the subexpression has the type (*), but your goal is a + (b + c) ≡ b + (a + c).