I am a beginner in PLFA, when I read the Induction section, I accidentally wrote a +-swap proof that I can't understand:
+-suc': ∀ (m n: ℕ) → m + suc n ≡ suc (m + n)
+-suc' zero n = refl
+-suc' (suc m) n rewrite +-suc' m n = refl
+-swap: ∀ (m n p: ℕ) → m + (n + p) ≡ n + (m + p)
+-swap zero n p = refl
+-swap (suc m) n p rewrite +-suc' n (m + p) | +-swap m n p = refl
I don't know why this proof is right, so I try to prove it by a chain of equations (which is wrong):
+-swap (suc m) n p =
begin
(suc m) + (n + p)
≡⟨⟩ n + (suc (m + p))
≡⟨ +-suc' n (m + p)⟩
suc (n + (m + p))
≡⟨ cong suc (+-swap m n p)⟩
n + ((suc m) + p)
∎
I know I really don't understand how rewrite works. I learn from the following document that rewrite will expand into with:
https://agda.readthedocs.io/en/v2.6.2/language/with-abstraction.html#with-rewrite
But I don't find how rewrite containing | expands in the document. I guess the | in rewrite is also a kind of syntactic sugar:
+-swap (suc m) n p rewrite +-suc' n (m + p) | +-swap m n p = refl
will expand into:
+-swap (suc m) n p rewrite +-suc' n (m + p) rewrite +-swap m n p = refl
I tried to replace the second rewrite with with, no problem:
+-swap (suc m) n p rewrite +-suc' n (m + p)
with m + (n + p) | +-swap m n p
... | .(n + (m + p)) | refl = refl
But if I replaced the first rewrite with with, it gives an error:
+-swap (suc m) n p with n + (suc (m + p)) | +-suc' n (m + p)
... | .(suc (n + m + p)) | refl
rewrite +-swap m n p = refl
+-swap (suc m) n p with n + (suc (m + p)) | +-suc' n (m + p)
... | .(suc (n + m + p)) | refl
with m + (n + p) | +-swap m n p
... | .(n + (m + p)) | refl = refl
Error message:
n + m != n of type ℕ
when checking that the given dot pattern suc (n + m + p) matches
the inferred value suc (n + (m + p))
How do multiple rewrites expand into with? How can this proof be accomplished with an equation chain?
Related
The PLFA exercise: what if we write the arithmetic more "naturally" in Quantifiers chapter (https://plfa.github.io/Quantifiers/) ?
∃-even′ : ∀ {n : ℕ} → ∃[ m ] ( 2 * m ≡ n) → even n
∃-odd′ : ∀ {n : ℕ} → ∃[ m ] (2 * m + 1 ≡ n) → odd n
I have make the type right. But have got Termination checking failed for the following functions:
dbl≡2* : ∀ n → n + n ≡ 2 * n
dbl≡2* n = cong (n +_) (sym (+-identityʳ n))
+-suc1 : ∀ (m : ℕ) → m + 1 ≡ suc m
+-suc1 m =
begin
m + 1
≡⟨⟩
m + (suc zero)
≡⟨ +-suc m zero ⟩
suc (m + zero)
≡⟨ cong suc (+-identityʳ m) ⟩
suc m
∎
help1 : ∀ m → 2 * m + 1 ≡ suc (m + m)
help1 m =
begin
2 * m + 1
≡⟨ sym ( cong (_+ 1) (dbl≡2* m) ) ⟩
m + m + 1 -- must use every rule
≡⟨ +-assoc m m 1 ⟩
m + (m + 1)
≡⟨ cong (m +_) (+-suc1 m) ⟩
m + suc m
≡⟨ +-suc m m ⟩
suc (m + m)
∎
∃-even′ ⟨ zero , refl ⟩ = even-zero
∃-even′ ⟨ suc m , refl ⟩ rewrite +-identityʳ m
| +-suc m m
= even-suc (∃-odd′ ⟨ (m) , help1 m ⟩)
∃-odd′ ⟨ m , refl ⟩ rewrite +-suc (2 * m) 0
| +-identityʳ m
| +-identityʳ (m + m)
| dbl≡2* m
= odd-suc (∃-even′ ⟨ m , refl ⟩)
For the normal version, the same mutually-recursive define can work fine.
∃-even : ∀ {n : ℕ} → ∃[ m ] ( m * 2 ≡ n) → even n
∃-odd : ∀ {n : ℕ} → ∃[ m ] (1 + m * 2 ≡ n) → odd n
∃-even ⟨ zero , refl ⟩ = even-zero
∃-even ⟨ suc x , refl ⟩ = even-suc (∃-odd ⟨ x , refl ⟩)
∃-odd ⟨ x , refl ⟩ = odd-suc (∃-even ⟨ x , refl ⟩)
∃-even′ ⟨ zero , refl ⟩ = even-zero
∃-even′ ⟨ suc m , refl ⟩ rewrite +-identityʳ m
| +-suc m m
= even-suc (∃-odd′ ⟨ m , help1 m ⟩)
∃-odd′ ⟨ m , refl ⟩ rewrite +-suc (2 * m) 0
| +-identityʳ m
| +-identityʳ (m + m)
| dbl≡2* m
= odd-suc (∃-even′ ⟨ m , refl ⟩)
Your recursive calls are:
∃-even′ ⟨ suc m , refl ⟩ -> ∃-odd′ ⟨ m , help1 m ⟩
∃-odd′ ⟨ m , refl ⟩ -> ∃-even′ ⟨ m , refl ⟩
In the first one, suc m -> m decreases, but refl -> help1 m (on its surface) increases. If you passed refl as the second argument to ∃-odd′, then the termination checker would accept it, since it means the second argument stays the same, while the first one strictly monotonically decreases over a complete chain of two calls.
So how can we change that first recursive call to ∃-odd′ ⟨ m , refl ⟩? By rewriting by sym (help1 m):
∃-even′ ( suc m , refl ) rewrite +-identityʳ m
| +-suc m m
| sym (help1 m)
= even-suc (∃-odd′ (m , refl))
This code is then accepted by the termination checker.
Given the Peano definition of natural numbers:
data ℕ : Set where
zero : ℕ
suc : ℕ → ℕ
_+_ : ℕ → ℕ → ℕ
zero + n = n
(suc m) + n = suc (m + n)
We can prove by different methods the property ∀ (m : ℕ) → zero + m ≡ m + zero.
For example:
comm-+₀ : ∀ (m : ℕ) → zero + m ≡ m + zero
comm-+₀ zero = refl
comm-+₀ (suc n) =
begin
zero + suc n
≡⟨⟩
zero + suc (zero + n)
≡⟨⟩
suc (zero + n)
≡⟨ cong suc (comm-+₀ n) ⟩
suc (n + zero)
≡⟨⟩
suc n + zero
∎
And more compactly:
comm-+₀ : ∀ (m : ℕ) → zero + m ≡ m + zero
comm-+₀ zero = refl
comm-+₀ (suc n) = cong suc (comm-+₀ n)
If we want, we can even use rewrite and forgo cong:
comm-+₀ : ∀ (m : ℕ) → zero + m ≡ m + zero
comm-+₀ zero = refl
comm-+₀ (suc n) rewrite comm-+₀ n = refl
But wait! That doesn't work. Agda will tell us that the expression is wrong because it can't prove the following:
suc (n + 0) ≡ suc (n + 0 + 0)
If we present Agda the symmetrical rewrite of the property, sym (comm-+₀ n), it will type check without errors.
So, my question is: why do we need sym in this case? The proof worked perfectly fine without it with the other strategies. Does rewrite work on both sides simultaneously and not just the left side?
In every cases, the goal when m is of the form suc n is:
suc n ≡ suc (n + 0)
To solve this goal by providing a correctly typed term, the right way is, as you noticed:
cong suc (comm-+₀ n)
However, when using rewrite with an equality a ≡ b you modify directly the goal by substituting all occurences of a by b In your case, using rewrite on the quantity comm-+₀ n whose type is n ≡ n + 0 leads to the replacing of every occurence of n by n + 0, thus transforming the goal from
suc n ≡ suc (n + 0)
to
suc (n + 0) ≡ suc (n + 0 + 0)
which is not what you want to do. Since rewriting replaces all occurences of the left side by the right side, reversing the equality using sym will instead replace the only occurence of n + 0 by n thus transforming the goal from
suc n ≡ suc (n + 0)
to
suc n ≡ suc n
which is your expected behaviour and let you conclude using refl direcly. This explains why you need to use sym.
To summarize :
rewrite interacts directly with the type of the goal.
rewrite rewrites from left to right.
rewrite rewrites all occurences it finds in the type of the goal.
More on rewrite can be found here:
https://agda.readthedocs.io/en/v2.6.0.1/language/with-abstraction.html#with-rewrite
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 need to define two versions of an operation with a slightly different definition. It is a series of compositions with Nat indices involved.
open import Data.Nat
data Hom : ℕ → ℕ → Set where
id : (m : ℕ) → Hom m m
_∘_ : ∀ {m n k} → Hom n k → Hom m n → Hom m k
p : (n : ℕ) → Hom (suc n) n
p1 : (m n : ℕ) → Hom (m + n) n
p1 zero n = id n
p1 (suc m) n = p1 m n ∘ p (m + n)
p2 : (m n : ℕ) → Hom (m + n) n
p2 zero n = id n
p2 (suc m) n = {!!} -- p n ∘ p2 m (1 + n)
-- Goal: Hom (suc (m + n)) n
-- Have: Hom (m + suc n) n
I would like to define both p1 and p2 and be able to use them interchangeably. Is this doable?
You can define p2 by direct recursion (no subst or rewriting) over _+_ using the trick described here. Looks like this:
record Homable (H : ℕ → ℕ → Set) : Set where
field
id-able : (m : ℕ) → H m m
_∘-able_ : ∀ {m n k} → H n k → H m n → H m k
p-able : (n : ℕ) → H (suc n) n
suc-homable : ∀ {H} → Homable H → Homable (λ m n -> H (suc m) (suc n))
suc-homable homable = record
{ id-able = λ m → id-able (suc m)
; _∘-able_ = _∘-able_
; p-able = λ m → p-able (suc m)
} where open Homable homable
p2-go : ∀ {H} → Homable H → (m : ℕ) → H m 0
p2-go homable zero = id-able 0 where
open Homable homable
p2-go homable (suc m) = p-able 0 ∘-able p2-go (suc-homable homable) m where
open Homable homable
plus-homable-hom : ∀ k → Homable (λ m n → Hom (m + k) (n + k))
plus-homable-hom k = record
{ id-able = λ n → id (n + k)
; _∘-able_ = _∘_
; p-able = λ n → p (n + k)
}
p2 : (m n : ℕ) → Hom (m + n) n
p2 m n = p2-go (plus-homable-hom n) m
The cost is that you need to maintain those Homable records which is somewhat tedious, but to my experience proving things about functions defined this way is simpler than about functions defined in terms of subst or over _+′_ (unless you never want to coerce _+′_ to _+_, of course).
Well, the value you provide has a type that is equal to the type of the hole, but Agda does not see this fact. More formally, the two types are propositionally equal but not judgementally equal. The problem is caused by the index m + suc n, which is propositionally but not judgementally equal to suc m + n because of how addition is defined. One way to solve your problem is to manually explain to Agda that the two types are equal:
open import Data.Nat
open import Data.Nat.Properties
open import Relation.Binary.PropositionalEquality
data Hom : ℕ → ℕ → Set where
id : (m : ℕ) → Hom m m
_∘_ : ∀ {m n k} → Hom n k → Hom m n → Hom m k
p : (n : ℕ) → Hom (suc n) n
p1 : (m n : ℕ) → Hom (m + n) n
p1 zero n = id n
p1 (suc m) n = p1 m n ∘ p (m + n)
p2 : (m n : ℕ) → Hom (m + n) n
p2 zero n = id n
p2 (suc m) n = subst (λ k → Hom k n) (+-suc m n) (p n ∘ p2 m (suc n))
However, this approach is not without downsides, as p2 (suc m) n is now not judgementally equal to your intended definition but to the expression above involving subst.
The problem seems essentially linked to what you're trying to do: IIUC, p1 and p2 are actually provably equal but defined using a different recursion structure. That's fine, but then the indices of your result type should follow the same recursion structure, i.e. you should define p2 using a different version of + that recurses in the appropriate way for p2:
_+′_ : ℕ → ℕ → ℕ
zero +′ n = n
suc m +′ n = m +′ suc n
p2′ : (m n : ℕ) → Hom (m +′ n) n
p2′ zero n = id n
p2′ (suc m) n = p n ∘ p2′ m (suc n)
However, this has another downside that the type of p1 and p2′ are no longer judgementally equal (but still propositionally equal though).
Another thing you can try is to use Agda's rewrite rules to give _+_ satisfy additional judgemental equalities, but this is dangerous as it may break some of Agda's desirable qualities as a logic. In this case, I suspect it's fine, but I'd have to check.
In summary, there are a number of things you can try but none is without downsides. Which is your best option depends on what you're trying to use this for.
In thinking about:
In Agda is it possible to define a datatype that has equations?
I was playing with the following datatype:
data Int : Set where
Z : Int
S : Int -> Int
P : Int -> Int
The above is a poor definition of Integers, and the answers in the above give a way around this. However, one can define a reduction on the above Int type that might be useful.
normalize : Int -> Int
normalize Z = Z
normalize (S n) with normalize n
... | P m = m
... | m = S m
normalize (P n) with normalize n
... | S m = m
... | m = P m
The thing that needs to be proved is:
idempotent : (n : Int) -> normalize n \== normalize (normalize n)
When you expand the cases out, you get for example
idempotent (P n) = ?
The goal for the hole has type
(normalize (P n) | normalize n) \== normalize (normalize (P n) | normalize n)
And I haven't seen this "|" before, nor do I know how to produce a proof of a type involving them. The proof needs to pattern match,for example,
idempotent (P n) with inspect (normalize n)
... (S m) with-\== = ?
... m with-\== = ?
But here the hole for the second case still has a "|" in it. So I am a bit confused.
-------- EDIT ---------------
It would be helpful to prove a simpler statement:
normLemma : (n m : NZ) -> normalize n \== P m -> normalize (S n) \== m
The "on paper" proof is rather straightforward. Assuming normalize n = P m, consider
normalize (S n) = case normalize n of
P k -> k
x -> S x
But normalize n is assumed to be P m, hence normalize (S n) = k. Then k = m, since normalize n = P m = P k which implies m = k. Thus normalize (S n) = m.
User Vitus proposed to use normal forms.
If we have these two functions:
normalForm : ∀ n -> NormalForm (normalize n)
idempotent' : ∀ {n} -> NormalForm n -> normalize n ≡ n
then we can easily compose them to obtain the result we need:
idempotent : ∀ n -> normalize (normalize n) ≡ normalize n
idempotent = idempotent' ∘ normalForm
Here is the definition of normal forms:
data NormalForm : Int -> Set where
NZ : NormalForm Z
NSZ : NormalForm (S Z)
NPZ : NormalForm (P Z)
NSS : ∀ {n} -> NormalForm (S n) -> NormalForm (S (S n))
NPP : ∀ {n} -> NormalForm (P n) -> NormalForm (P (P n))
I.e. only terms like S (S ... (S Z)... and P (P ... (P Z)...) are in the normal form.
And proofs are rather straightforward:
normalForm : ∀ n -> NormalForm (normalize n)
normalForm Z = NZ
normalForm (S n) with normalize n | normalForm n
... | Z | nf = NSZ
... | S _ | nf = NSS nf
... | P ._ | NPZ = NZ
... | P ._ | NPP nf = nf
normalForm (P n) with normalize n | normalForm n
... | Z | nf = NPZ
... | S ._ | NSZ = NZ
... | S ._ | NSS nf = nf
... | P _ | nf = NPP nf
idempotent' : ∀ {n} -> NormalForm n -> normalize n ≡ n
idempotent' NZ = refl
idempotent' NSZ = refl
idempotent' NPZ = refl
idempotent' (NSS p) rewrite idempotent' p = refl
idempotent' (NPP p) rewrite idempotent' p = refl
The whole code: https://gist.github.com/flickyfrans/f2c7d5413b3657a94950#file-another-one
idempotent : (n : Int) -> normalize (normalize n) ≡ normalize n
idempotent Z = refl
idempotent (S n) with normalize n | inspect normalize n
... | Z | _ = refl
... | S m | [ p ] = {!!}
... | P m | [ p ] = {!!}
Context in the first hole is
Goal: (normalize (S (S m)) | (normalize (S m) | normalize m)) ≡
S (S m)
————————————————————————————————————————————————————————————
p : normalize n ≡ S m
m : Int
n : Int
(normalize (S (S m)) | (normalize (S m) | normalize m)) ≡ S (S m) is just an expanded version of normalize (S (S m)). So we can rewrite the context a bit:
Goal: normalize (S (S m)) ≡ S (S m)
————————————————————————————————————————————————————————————
p : normalize n ≡ S m
m : Int
n : Int
Due to the definition of the normalize function
normalize (S n) with normalize n
... | P m = m
... | m = S m
normalize (S n) ≡ S (normalize n), if normalize n doesn't contain Ps.
If we have an equation like normalize n ≡ S m, than m is already normalized and doesn't contain Ps. But if m doesn't contain Ps, so and normalize m. So we have normalize (S m) ≡ S (normalize m).
Let's prove a little more general lemma:
normalize-S : ∀ n {m} -> normalize n ≡ S m -> ∀ i -> normalize (m ‵add‵ i) ≡ m ‵add‵ i
where ‵add‵ is
_‵add‵_ : Int -> ℕ -> Int
n ‵add‵ 0 = n
n ‵add‵ (suc i) = S (n ‵add‵ i)
normalize-S states, that if m doesn't contain Ps, than this holds:
normalize (S (S ... (S m)...)) ≡ S (S ... (S (normalize m))...)
Here is a proof:
normalize-S : ∀ n {m} -> normalize n ≡ S m -> ∀ i -> normalize (m ‵add‵ i) ≡ m ‵add‵ i
normalize-S Z () i
normalize-S (S n) p i with normalize n | inspect normalize n
normalize-S (S n) refl i | Z | _ = {!!}
normalize-S (S n) refl i | S m | [ q ] = {!!}
normalize-S (S n) refl i | P (S m) | [ q ] = {!!}
normalize-S (P n) p i with normalize n | inspect normalize n
normalize-S (P n) () i | Z | _
normalize-S (P n) refl i | S (S m) | [ q ] = {!!}
normalize-S (P n) () i | P _ | _
Context in the first hole is
Goal: normalize (Z ‵add‵ i) ≡ Z ‵add‵ i
————————————————————————————————————————————————————————————
i : ℕ
.w : Reveal .Data.Unit.Core.hide normalize n is Z
n : Int
I.e. normalize (S (S ... (S Z)...)) ≡ S (S ... (S Z)...). We can easily prove it:
normalize-add : ∀ i -> normalize (Z ‵add‵ i) ≡ Z ‵add‵ i
normalize-add 0 = refl
normalize-add (suc i) rewrite normalize-add i with i
... | 0 = refl
... | suc _ = refl
So we can fill the first hole with normalize-add i.
Context in the second hole is
Goal: normalize (S m ‵add‵ i) ≡ S m ‵add‵ i
————————————————————————————————————————————————————————————
i : ℕ
q : .Data.Unit.Core.reveal (.Data.Unit.Core.hide normalize n) ≡ S m
m : Int
n : Int
While normalize-S n q (suc i) has this type:
(normalize (S (m ‵add‵ i)) | normalize (m ‵add‵ i)) ≡ S (m ‵add‵ i)
Or, shortly, normalize (S (m ‵add‵ i)) ≡ S (m ‵add‵ i). So we need to replace S m ‵add‵ i with S (m ‵add‵ i):
inj-add : ∀ n i -> S n ‵add‵ i ≡ S (n ‵add‵ i)
inj-add n 0 = refl
inj-add n (suc i) = cong S (inj-add n i)
And now we can write
normalize-S (S n) refl i | S m | [ q ] rewrite inj-add m i = normalize-S n q (suc i)
Context in the third hole is
Goal: normalize (m ‵add‵ i) ≡ m ‵add‵ i
————————————————————————————————————————————————————————————
i : ℕ
q : .Data.Unit.Core.reveal (.Data.Unit.Core.hide normalize n) ≡
P (S m)
m : Int
n : Int
normalize-P n q 0 gives us normalize (S m) ≡ S m where normalize-P is dual of normalize-S and has this type:
normalize-P : ∀ n {m} -> normalize n ≡ P m -> ∀ i -> normalize (m ‵sub‵ i) ≡ m ‵sub‵ i
We can apply normalize-S to something, that has type normalize (S m) ≡ S m: normalize-S (S m) (normalize-P n q 0) i. This expression has precisely the type we want. So we can write
normalize-S (S n) refl i | P (S m) | [ q ] = normalize-S (S m) (normalize-P n q 0) i
The fourth hole is similar to the third:
normalize-S (P n) refl i | S (S m) | [ q ] = normalize-S (S m) (normalize-S n q 0) i
There is a problem with this holes: Agda doesn't see, that normalize-S (S m) _ _ terminates, since S m is not syntactically smaller than S n. It's possible however to convience Agda by using well-founded recursion.
Having all this stuff we can easily proof the idempotent theorem:
idempotent : (n : Int) -> normalize (normalize n) ≡ normalize n
idempotent Z = refl
idempotent (S n) with normalize n | inspect normalize n
... | Z | _ = refl
... | S m | [ p ] = normalize-S n p 2
... | P m | [ p ] = normalize-P n p 0
idempotent (P n) with normalize n | inspect normalize n
... | Z | _ = refl
... | S m | [ p ] = normalize-S n p 0
... | P m | [ p ] = normalize-P n p 2
Here is the code: https://gist.github.com/flickyfrans/f2c7d5413b3657a94950
There are both versions: with the {-# TERMINATING #-} pragma and without.
EDIT
idempotent is simply
idempotent : ∀ n -> normalize (normalize n) ≡ normalize n
idempotent n with normalize n | inspect normalize n
... | Z | _ = refl
... | S _ | [ p ] = normalize-S n p 1
... | P _ | [ p ] = normalize-P n p 1