Modular arithmetic proofs in agda - math

I'm trying to prove (n : ℕ) → ∃[ m ] n * n ≡ 3 * m + 2 → ⊥. Typically I would prove this by rewriting it in terms of congruence, and then splitting on each case. There doesn't seem to be a modular arithmetic module in agda-stdlib. How should I implement modular arithmetic or approach this kind of problem without modular arithmetic?
Edit: there has been discussion in the comments that is not quite precise enough to lead me to an answer, so in the hopes of clarifying what cannot fit in the word count I am dumping my various attempts at this problem, some of which inspired by things in the comments.
open Data.Nat.Divisibility.Core
open Data.Nat.Base
open Relation.Binary.Core
open Level using (0ℓ)
open Relation.Binary.PropositionalEquality
open Data.Empty
open Relation.Nullary
open Data.Product using (Σ; _,_; ∃; Σ-syntax; ∃-syntax)
open Relation.Binary.PropositionalEquality.≡-Reasoning
open Data.Nat.Solver
open +-*-Solver
data Z/3 : (n : ℕ) → Set where
Z/3₀ : (n : ℕ) → ∃[ m ] n ≡ 3 * m → Z/3 n
Z/3₁ : (n : ℕ) → ∃[ m ] n ≡ 3 * m + 1 → Z/3 n
Z/3₂ : (n : ℕ) → ∃[ m ] n ≡ 3 * m + 2 → Z/3 n
data _≋_ : Rel ℕ 0ℓ where
3∣|a-b| : ∀ {a b : ℕ} → 3 ∣ ∣ a - b ∣ → a ≋ b
q' : {a : ℕ} → (2 ≋ ((a + 3) * (a + 3))) → (∃[ a' ] 2 ≋ (a' * a'))
q' = {!!}
qq : (n : ℕ) → Z/3 (n * n)
qq zero = Z/3₀ zero (zero , refl)
qq (suc zero) = Z/3₁ 1 (zero , refl)
qq (suc (suc zero)) = Z/3₁ 4 (1 , refl)
qq (suc (suc (suc n))) = Z/3₁ ((3 + n) * (3 + n)) ({!!} , {!!})
q'' : (n : ℕ) → ∃[ m ] n * n ≡ 3 * m + 2 → ⊥
q'' zero (zero , ())
q'' zero (suc fst , ())
q'' (suc zero) (suc zero , ())
q'' (suc zero) (suc (suc fst) , ())
q'' (suc (suc zero)) (suc (suc (suc (suc zero))) , ())
q'' (suc (suc zero)) (suc (suc (suc (suc (suc fst)))) , ())
q'' (suc (suc (suc n))) (suc fst , snd) = q'' n ({!!} , {!!})
sq : {a : ℕ} → Z/3 a → Z/3 (a * a)
sq (Z/3₀ n (m , p)) = Z/3₀ (n * n) (3 * m * m , q) where
q =
begin
n * n
≡⟨ cong (λ e → e * n) p ⟩
(3 * m) * n
≡⟨ cong (λ e → (3 * m) * e) p ⟩
(3 * m) * (3 * m)
≡⟨ solve 1 (λ m' → (con 3 :* m') :* (con 3 :* m') := con 3 :* m' :* m' :+ (con 3 :* m' :* m' :+ (con 3 :* m' :* m' :+ con zero))) refl m ⟩
3 * m * m + (3 * m * m + (3 * m * m + zero))
∎
-- (3 * b + 1) * (3 * b + 1)
-- 9b^2 + 6b + 1
-- 3(3b^2 + 2b) +1
-- (3 * b + 2) * (3 * b + 2)
-- 9b^2 + 12b + 4
-- 3(3b^2+4b+1) + 1
sq (Z/3₁ n (m , p)) = Z/3₁ (n * n) (3 * m * m + 2 * m , q) where
q =
begin
n * n
≡⟨ cong (λ e → e * n) p ⟩
(3 * m + 1) * n
≡⟨ cong (λ e → (3 * m + 1) * e) p ⟩
(3 * m + 1) * (3 * m + 1)
≡⟨ solve 1 (λ m' → (con 3 :* m' :+ con 1) :* (con 3 :* m' :+ con 1) := (m' :+ (m' :+ (m' :+ con 0))) :* m' :+ (m' :+ (m' :+ con 0)) :+ ((m' :+ (m' :+ (m' :+ con 0))) :* m' :+ (m' :+ (m' :+ con 0)) :+ ((m' :+ (m' :+ (m' :+ con 0))) :* m' :+ (m' :+ (m' :+ con 0)) :+ con 0)) :+ con 1 ) refl m ⟩
(m + (m + (m + 0))) * m + (m + (m + 0)) + ((m + (m + (m + 0))) * m + (m + (m + 0)) + ((m + (m + (m + 0))) * m + (m + (m + 0)) + 0)) + 1
∎
sq (Z/3₂ n (m , p)) = Z/3₁ (n * n) (3 * m * m + 4 * m + 1 , {!!})
q : {a : ℕ} → ¬(2 ≋ (a * a))
q {zero} (3∣|a-b| (divides zero ()))
q {zero} (3∣|a-b| (divides (suc quotient) ()))
q {suc zero} (3∣|a-b| (divides zero ()))
q {suc zero} (3∣|a-b| (divides (suc quotient) ()))
q {suc (suc zero)} (3∣|a-b| (divides zero ()))
q {suc (suc zero)} (3∣|a-b| (divides (suc quotient) ()))
q {suc (suc (suc a))} (3∣|a-b| (divides (suc quotient) equality)) = {!!}

Building on Mark's proof outline:
module SOMod where
open import Data.Empty
open import Data.Nat
open import Data.Nat.Properties
open import Data.Nat.DivMod
open import Data.Product
open import Relation.Binary.PropositionalEquality
open import Relation.Nullary.Negation
open ≡-Reasoning
lemma : ∀ m n → (n * n) % 3 ≢ (3 * m + 2) % 3
lemma m n p = contradiction ≡2 (≢2 n)
where
≡2 : ((n % 3) * (n % 3)) % 3 ≡ 2
≡2 = begin
((n % 3) * (n % 3)) % 3 ≡˘⟨ %-distribˡ-* n n 3 ⟩
(n * n) % 3 ≡⟨ p ⟩
(3 * m + 2) % 3 ≡⟨ cong (_% 3) (+-comm (3 * m) 2) ⟩
(2 + 3 * m) % 3 ≡⟨ cong (λ # → (2 + #) % 3) (*-comm 3 m) ⟩
(2 + m * 3) % 3 ≡⟨ [m+kn]%n≡m%n 2 m 3 ⟩
2 % 3 ≡⟨⟩
2 ∎
≢2 : ∀ n → ((n % 3) * (n % 3)) % 3 ≢ 2
≢2 zero = λ ()
≢2 (suc zero) = λ ()
≢2 (suc (suc zero)) = λ ()
≢2 (suc (suc (suc n))) = ≢2 n
proof : ∀ n → ∃[ m ] n * n ≡ 3 * m + 2 → ⊥
proof n (m , p) = contradiction (cong (_% 3) p) (lemma m n)

Related

How to make Isabelle use basic math rules?

I'm trying to learn Isabelle:
theory test
imports Main
begin
datatype tree = Leaf | Node tree tree
fun nodes :: "tree ⇒ nat" where
"nodes Leaf = 1"|
"nodes (Node x y) = 1 + (nodes x) + (nodes y)"
fun explode :: "nat ⇒ tree ⇒ tree" where
"explode 0 t = t" |
"explode (Suc n) t = explode n (Node t t)"
theorem tree_count: "nodes (explode h l) = 2^h + 2^h * (nodes l) - 1"
apply(induction h arbitrary: l)
apply(auto simp add: numeral_eq_Suc)
done
end
However, the theorem is not solved:
Failed to finish proof:
goal (1 subgoal):
1. ⋀h l. (⋀l. nodes (explode h l) = Suc (Suc 0) ^ h + Suc (Suc 0) ^ h * nodes l - Suc 0) ⟹
Suc (Suc 0) ^ h + (Suc (Suc 0) ^ h + Suc (Suc 0) ^ h * (nodes l + nodes l)) - Suc 0 =
Suc (Suc 0) ^ h + Suc (Suc 0) ^ h + (Suc (Suc 0) ^ h + Suc (Suc 0) ^ h) * nodes l - Suc 0
If I'm not mistaken, Isabelle is just not applying x + x = 2*x and a + (b + c) = a + b + c. So I tried adding a lemma to use it with simp:
lemma a: "(x:nat) + x = 2*x"
But this fails with
Type unification failed: Clash of types "_ ⇒ _" and "_ set"
Type error in application: incompatible operand type
Operator: (∈) x :: ??'a set ⇒ bool
Operand: nat :: int ⇒ nat
I assume that it's just not possible to define the type of a variable in a lemma?
Now I could of course redifine the addition - but I guess that's not really best practice.
What would be the best way to solve the initial problem?
Some general approaches to find the right lemmas:
Use the theorem search, either via the query panel or in the text with find_theorems:
find_theorems ‹_ * (_ + _)›
find_theorems name: assoc "_ + _ + _"
find_theorems ‹2 * ?z = ?z + ?z›
Use sledgehammer.
Try the algebra_simps collection as suggested by waldelb (There are also ac_simps, algebra_split_simps, field_simps, and field_split_simps ).
Try to split it up into smaller steps. This helps the simp tool, because simplification can work on both sides of the equation and because you can guide it to the right intermediate steps. The example below is a bit too extreme, doing only one rewrite per step. In general, you can just add intermediary steps where the automatic ones fail.
theorem tree_count: ‹nodes (explode h l) = 2^h + 2^h * (nodes l) - 1›
proof (induction h arbitrary: l)
case 0
show ‹nodes (explode 0 l) = 2 ^ 0 + 2 ^ 0 * nodes l - 1›
by simp
next
case (Suc h)
have ‹nodes (explode (Suc h) l)
= nodes (explode h (Node l l))›
by (subst explode.simps, rule refl)
also have "... = 2 ^ h + 2 ^ h * nodes (Node l l) - 1"
by (subst Suc, rule refl)
also have "... = 2 ^ h + 2 ^ h * (1 + nodes l + nodes l) - 1"
by (subst nodes.simps, rule refl)
also have "... = 2 ^ h + 2 ^ h * (1 + (nodes l + nodes l)) - 1"
by (subst add.assoc, rule refl)
also have "... = 2 ^ h + 2 ^ h * (1 + (2 * nodes l)) - 1"
by (subst mult_2, rule refl)
also have "... = 2 ^ h + (2 ^ h * 1 + 2 ^ h * (2 * nodes l)) - 1"
by (subst distrib_left, rule refl)
also have "... = 2 ^ h + (2 ^ h * 1 + 2 ^ h * 2 * nodes l) - 1"
by (subst mult.assoc, rule refl)
also have "... = 2 ^ h + (2 ^ h * 1 + 2 ^ Suc h * nodes l) - 1"
by (subst power_Suc2, rule refl)
also have "... = (2 ^ h + 2 ^ h * 1) + 2 ^ Suc h * nodes l - 1"
by (subst add.assoc, rule refl)
also have "... = (2 ^ h + 2 ^ h) + 2 ^ Suc h * nodes l - 1"
by (subst mult_1_right, rule refl)
also have "... = 2 ^ h * 2 + 2 ^ Suc h * nodes l - 1"
by (subst mult_2_right, rule refl)
also have "... = 2 ^ Suc h + 2 ^ Suc h * nodes l - 1"
by (subst power_Suc2, rule refl)
finally show ?case .
qed
algebra_simps is a list of common math rules. Adding it solves the problem:
apply(auto simp add: numeral_eq_Suc algebra_simps)

Increment binary value type by one

I want to increment a binary value by one, but I'm still not very familiar with how recursion in agda works.
Why aren't I getting the right output here?
Bin Type Definition
data Bin : Set where
⟨⟩ : Bin
_O : Bin → Bin
_I : Bin → Bin
My increment function
inc : Bin → Bin
inc ⟨⟩ = ⟨⟩ I
inc (x O) = ⟨⟩ I
inc (x I) = (inc x) I
A quick correction of your algorithm
Your increment function is not correct. Considering your definition of binary numbers:
data Bin : Set where
⟨⟩ : Bin
_O : Bin → Bin
_I : Bin → Bin
Your increment function should be written as follows:
inc : Bin → Bin
inc ⟨⟩ = ⟨⟩ I
inc (x O) = x I
inc (x I) = (inc x) O
When the right number is zero, you just replace it by one, but you must not forget to keep the left part of the number.
When the right number is 1, you have to keep incrementing its left part, but you also need to transform this 1 into a 0.
A quick validation of the new algorithm
But, don't take my word for it, let us try and (partially) validate our function. After all, we are in a proof assistant, aren't we ?
A good way to validate such a function is to assess which property it should provide. The result of your incremental function has to be equal to 1 plus its input value. Agda provides natural numbers so let us transform your binary numbers into naturals to check such a property. First, some imports:
open import Data.Nat
open import Data.Nat.Properties
open import Relation.Binary.PropositionalEquality
Then a function which transforms a binary number into a natural number:
_↑ : Bin → ℕ
⟨⟩ ↑ = 0
(x O) ↑ = x ↑ + x ↑
(x I) ↑ = suc (x ↑ + x ↑)
Finally, our validation property:
prop : ∀ {b} → (inc b) ↑ ≡ suc (b ↑)
prop {⟨⟩} = refl
prop {b O} = refl
prop {b I} rewrite prop {b} | +-suc (b ↑) (b ↑) = refl
This validation is of course incomplete (by nature) but at least it gives you confidence in your algorithm. You should always try and prove such assumptions when writing algorithms, which is the whole point of Agda (well, not the whole point, but at least part of it).
More on validation
To further make my point, I decided to try and keep validating your representation of binary numbers by implementing the reciprocal transformation from naturals to binary numbers:
_↓ : ℕ → Bin
zero ↓ = ⟨⟩
suc n ↓ = inc (n ↓)
We can directly prove that the two transformations are reciprocal when going up then down:
↑↓ : ∀ {n} → (n ↓) ↑ ≡ n
↑↓ {zero} = refl
↑↓ {suc n} rewrite prop {n ↓} | ↑↓ {n} = refl
Then I tried to do the other way around:
↓↑ : ∀ {b} → (b ↑) ↓ ≡ b
↓↑ {⟨⟩} = refl
↓↑ {b O} rewrite prop₂ {b ↑} rewrite ↓↑ {b} = refl
↓↑ {b I} rewrite prop₂ {b ↑} rewrite ↓↑ {b} = refl
This side needs prop₂ which has the following signature:
prop₂ : ∀ {n} → (n + n) ↓ ≡ (n ↓) O
This property should be true (in the sense that the binary numbers as we think of them should satisfy it), but it cannot be proven in your formalism because you can represent zero in an infinite number of ways, and all these ways are not prepositionally equal (for instance, the first case of prop₂ when n is equal to 0 requires to prove ⟨⟩ ≡ (⟨⟩ O) which cannot be proven).
All in all, validation not only allows us to find faulty algorithms (or to prove algorithms correct) but it can also reveal inconsistencies or mistakes in the basics of our theories themselves (even though in this case, a quick look could have been enough to see that 0 can be represented an infinite number of different manners).
As a side note, I am not saying that there should always be a single way of representing a specific element of an abstract data type, but it surely helps, especially when working with propositional equality, which is very often required.
On another side note, I am sorry if I got a little carried away but I find these kind of topics very enlightening regarding the use of proof assistants and formal validation.
Please feel free to ask for any further explanation.
The complete (and incomplete in a way) code
module BinaryNumber where
open import Data.Nat
open import Data.Nat.Properties
open import Relation.Binary.PropositionalEquality
data Bin : Set where
⟨⟩ : Bin
_O : Bin → Bin
_I : Bin → Bin
inc : Bin → Bin
inc ⟨⟩ = ⟨⟩ I
inc (x O) = x I
inc (x I) = (inc x) O
_↑ : Bin → ℕ
⟨⟩ ↑ = 0
(x O) ↑ = x ↑ + x ↑
(x I) ↑ = suc (x ↑ + x ↑)
prop : ∀ {b} → (inc b) ↑ ≡ suc (b ↑)
prop {⟨⟩} = refl
prop {b O} = refl
prop {b I} rewrite prop {b} | +-suc (b ↑) (b ↑) = refl
_↓ : ℕ → Bin
zero ↓ = ⟨⟩
suc n ↓ = inc (n ↓)
↑↓ : ∀ {n} → (n ↓) ↑ ≡ n
↑↓ {zero} = refl
↑↓ {suc n} rewrite prop {n ↓} | ↑↓ {n} = refl
prop₂ : ∀ {n} → (n + n) ↓ ≡ (n ↓) O
prop₂ {zero} = {!!}
prop₂ {suc n} = {!!}
↓↑ : ∀ {b} → (b ↑) ↓ ≡ b
↓↑ {⟨⟩} = refl
↓↑ {b O} rewrite prop₂ {b ↑} rewrite ↓↑ {b} = refl
↓↑ {b I} rewrite prop₂ {b ↑} rewrite ↓↑ {b} = refl
The standard library
As a last remark, the binary numbers are present in the standard library in the file Data.Nat.Binary.Base with the associated properties (in particular the properties of reciprocity which are not provable in your representation) in the file Data.Nat.Binary.Properties if you feel like looking how they are implemented there.
When we define inc as Bin → Bin, we are saying that it takes values of type Bin and returns values of the same type i.e. Bin.
Since we have 3 constructors available for creating Bin, all the values of type Bin would have one of the following 3 forms:
⟨⟩
b I where b is some value of type Bin
b O where b is some value of type Bin
For case 1, since ⟨⟩ stands for zero.
inc ⟨⟩ = ⟨⟩ I
For case 2, we know that adding one to a number ending with zero will just change the last digit to one, so
inc (x O) = x I
and for case 3, when a number is ending with 1, on incrementing it we get zero at the end, and carryover is generated that needs to be passed forward. Carryover can be passed by using our same inc function. Assuming (inc x) gives a binary number, we take that output and append zero at the end.
inc (x I) = (inc x) O
Also, just to extent upon the excellent answer given by MrO, who correctly pointed out that since there are infinitely many ways to represent zeros (and all numbers)
(b ↓) ↑ = b
can't be proved for b with leading zeros before the first significant digit. But if we restrict domain of ↓↑ to only binary numbers which are only canonical i.e binary number without any leading zeros, proof can be derived.
Proof of (b ↓) ↑ = b for canonical b
Extending MrO's code,
module BinaryNumber where
open import Data.Nat
open import Data.Nat.Properties
open import Relation.Binary.PropositionalEquality
open Relation.Binary.PropositionalEquality.≡-Reasoning
data Bin : Set where
⟨⟩ : Bin
_O : Bin → Bin
_I : Bin → Bin
inc : Bin → Bin
inc ⟨⟩ = ⟨⟩ I
inc (x O) = x I
inc (x I) = (inc x) O
_↑ : Bin → ℕ
⟨⟩ ↑ = 0
(x O) ↑ = x ↑ + x ↑
(x I) ↑ = suc (x ↑ + x ↑)
prop : ∀ {b} → (inc b) ↑ ≡ suc (b ↑)
prop {⟨⟩} = refl
prop {b O} = refl
prop {b I} rewrite prop {b} | +-suc (b ↑) (b ↑) = refl
_↓ : ℕ → Bin
zero ↓ = ⟨⟩ O
suc n ↓ = inc (n ↓)
↑↓ : ∀ {n} → (n ↓) ↑ ≡ n
↑↓ {zero} = refl
↑↓ {suc n} rewrite prop {n ↓} | ↑↓ {n} = refl
-- One b -> b start with ⟨⟩ I
data One : Bin → Set where
first : One (⟨⟩ I)
nextO : ∀ { b : Bin }
→ One b
------------
→ One (b O)
nextI : ∀ { b : Bin }
→ One b
------------
→ One (b I)
-- Can i.e Canonical representing binary numbers without extras leading zeros after ⟨⟩. For e.g ⟨⟩ O O I I and ⟨⟩ I I both represents binary form of number 3 but only ⟨⟩ I I is the canonical
data Can : Bin → Set where
startWithZero : Can (⟨⟩ O)
startWithOne : ∀ {b : Bin }
→ One b
------------
→ Can b
-- If m ≤ n then m ≤ (n + 1)
≤-sucʳ : ∀ {m n : ℕ }
→ m ≤ n
-----------
→ m ≤ suc n
≤-sucʳ z≤n = z≤n
≤-sucʳ (s≤s m≤n) = s≤s (≤-sucʳ m≤n)
-- If m ≤ n then m ≤ (n + p)
≤-addʳ : ∀ (m n p : ℕ)
→ m ≤ n
--------
→ m ≤ n + p
≤-addʳ m n zero m≤n rewrite +-comm n zero = m≤n
≤-addʳ m n (suc p) m≤n rewrite +-comm n (suc p) | +-comm p n = ≤-sucʳ (≤-addʳ m n p m≤n)
-- If a natural number n has eqivalent binary form (⟨⟩ I b) then 1 ≤ n
1-≤-oneb : ∀ { b : Bin }
→ One b
---------
→ suc zero ≤ b ↑
1-≤-oneb first = s≤s z≤n
1-≤-oneb {b O} (nextO oneb) = ≤-addʳ 1 ((b ↑)) ((b ↑)) (1-≤-oneb oneb)
1-≤-oneb {b I} (nextI oneb) = ≤-sucʳ (≤-addʳ 1 ((b ↑)) ((b ↑)) (1-≤-oneb oneb))
-- If 0 ≤ (n + 1) then 1 ≤ n
0-≤-suc : ∀ (n : ℕ)
→ 0 ≤ suc n
-----------
→ 1 ≤ suc n
0-≤-suc n z≤n = s≤s z≤n
-- If 1 ≤ n and binary form of n is b then binary form of (n + n) using ↓ is b O
↓-over-+ : ∀ (n : ℕ)
→ 1 ≤ n
-----------------------
→ (n + n) ↓ ≡ (n ↓) O
↓-over-+ (suc zero) s≤n = refl
↓-over-+ (suc (suc n)) (s≤s s≤n) = begin
(suc (suc n) + (suc (suc n))) ↓
≡⟨⟩
inc (( suc n + (suc (suc n))) ↓)
≡⟨ cong (inc) (cong (_↓) (+-comm (suc n) (suc (suc n)))) ⟩
inc (inc ((suc n + suc n) ↓))
≡⟨ cong (inc) (cong inc (↓-over-+ (suc n) (0-≤-suc n s≤n))) ⟩
refl
-- For all binary numbers that are canonical, ↑↓ is identity (returns same b)
↑↓-canb : ∀ ( b : Bin )
→ Can b
--------------
→ (b ↑) ↓ ≡ b
↑↓-canb _ startWithZero = refl
↑↓-canb _ (startWithOne first) = refl
↑↓-canb (b O) (startWithOne (nextO x)) rewrite ↓-over-+ (b ↑) (1-≤-oneb x) | ↑↓-canb b (startWithOne x) = refl
↑↓-canb (b I) (startWithOne (nextI x)) rewrite ↓-over-+ (b ↑) (1-≤-oneb x) | ↑↓-canb b (startWithOne x) = refl

How to define an alias in Agda's type delaration?

My code:
law : ∀ a x → ((suc a) * (suc a) ÷ (suc a) ⟨ x ⟩) →ℕ ≡ (suc a , refl)
law a x = refl
I think there's too many suc a and I want to give an alias to suc a, something like (this code just describes my idea, it doesn't compile):
law : ∀ a x → ((s : suc a) * s ÷ s ⟨ x ⟩) →ℕ ≡ (s , refl)
law a x = refl
Can I achieve that?
Sure. You can use let
law : ∀ a x → let s = suc a in (s * s ÷ s ⟨ x ⟩) →ℕ ≡ (s , refl)
law a x = refl
or define an anonymous module:
module _ (a : ℕ) where
s = suc a
law : ∀ x → (s * s ÷ s ⟨ x ⟩) →ℕ ≡ (s , refl)
law x = refl
Outside of the module law has the same type signature as the one you provided.

Agda: Product of even numbers is even

I am pretty new to Agda. I am working on a question from the assignment. I have got most of it but there is one goal on which i am stuck.
data Arith : Set where
Num : ℕ → Arith
Plus : Arith → Arith → Arith
Times : Arith → Arith → Arith
eval : Arith → ℕ
eval (Num x) = x
eval (Plus e1 e2) = eval e1 + eval e2
eval (Times e1 e2) = eval e1 * eval e2
data Even : ℕ → Set where
zEven : Even 0
ssEven : {n : ℕ} → Even n → Even (suc (suc n))
-- [PROBLEM 1]
plusEven : ∀ n m → Even n → Even m → Even (n + m)
plusEven zero m x x₁ = x₁
plusEven (suc zero) m () x₁
plusEven (suc (suc .0)) m (ssEven zEven) x₁ = ssEven x₁
plusEven (suc (suc ._)) m (ssEven (ssEven x)) x₁ = ssEven (ssEven (plusEven _ m x x₁ ))
-- [PROBLEM 2]
timesEven : ∀ n m → Even n → Even m → Even (n * m)
timesEven zero m x x₁ = zEven
timesEven (suc ._) zero (ssEven x) x₁ = (timesEven _ zero x x₁)
timesEven (suc ._) (suc ._) (ssEven x) (ssEven x₁) = ssEven ((λ h → {!!}) (timesEven _ _ x x₁))
The goal I have to prove is
Goal: Even (.n₁ + suc (suc (.n₁ + .n * suc (suc .n₁))))
I feel that I have to use plusEven some how. But the goal does not look that straightforward. Have I made the problem difficult for me? or am I on the right track? Is there an easier way to do this? I don't want the solution to this. But a push in the right direction would be appreciated. I have been stuck on this for a while now.
If n is even, then n * m is even too, so it's irrelevant whether m is even or not and hence you should just throw away this constraint. So the actual theorems are (I made n and m implicit, because this is convenient)
timesEvenLeft : ∀ {n m} → Even n → Even (n * m)
timesEvenRight : ∀ {n m} → Even m → Even (n * m)
You can prove that n * m ≡ m * n and derive the latter theorem from the former. Hence it only remains to prove the first one. In the recursive case you need to prove Even (suc (suc n) * m) (which reduces to Even (m + (m + n * m)) having Even (n * m) (the induction hypothesis) in scope. For this you'll need yet another lemma:
plusDoubleEven : ∀ {n} m → Even n → Even (m + (m + n))
I really liked the answers posted here and they helped me a lot. But I cannot change the question given in the assignment. I used the answers posted to come up with a solution to the problem. It took me a while and it looks a little messy but it works. Thought i'd post it here too.
timesEven : ∀ n m → Even n → Even m → Even (n * m)
timesEven zero m x x₁ = zEven
timesEven (suc zero) m () x₁
timesEven (suc (suc n)) zero (ssEven x) x₁ = timesEven n zero x x₁
timesEven (suc (suc n)) (suc zero) x ()
timesEven (suc (suc n)) (suc (suc m)) (ssEven x) (ssEven x₁) = ssEven ((λ h → plusEven m (suc (suc (m + n * suc (suc m)))) x₁ (ssEven (plusEven m (n * suc (suc m)) x₁ h))) (timesEven n (suc (suc m)) x (ssEven x₁)))
It's probably not what is expected of you for this homework but a clean way to deal with these lemmas without doing too much work is, as hinted at by #user3237465, to reuse well-known properties of the natural numbers.
One way to get more out of these well-known properties is to introduce an alternative definition of Even which you can prove equivalent to the inductive one:
data Even : ℕ → Set where
zEven : Even 0
ssEven : {n : ℕ} → Even n → Even (suc (suc n))
record Even′ (n : ℕ) : Set where
constructor mkEven′
field factor : ℕ
.equality : n ≡ factor * 2
open Even′
Even⇒Even′ : {n : ℕ} → Even n → Even′ n
(...)
Even′⇒Even : {n : ℕ} → Even′ n → Even n
(...)
You can then prove plusEven and timesEven(Right/Left) by using equational reasoning, reusing lemmas from the standard library. For instance the proof of plusEven becomes:
plusEven′ : ∀ n m → Even′ n → Even′ m → Even′ (n + m)
plusEven′ n m (mkEven′ p Hp) (mkEven′ q Hq) = mkEven′ (p + q) eq where
.eq : n + m ≡ (p + q) * 2
eq = begin
n + m ≡⟨ cong₂ _+_ Hp Hq ⟩
p * 2 + q * 2 ≡⟨ sym (distribʳ-*-+ 2 p q) ⟩
(p + q) * 2
∎
plusEven : ∀ n m → Even n → Even m → Even (n + m)
plusEven n m en em = Even′⇒Even (plusEven′ n m (Even⇒Even′ en) (Even⇒Even′ em))
Here is a gist with all the right imports and all the proofs.

How to prove that the defining equations of the recursor for N hold propositionally using the induction principle for N in Agda?

This is an exercise from the Homotopy Type Theory book. Here's what I have:
data ℕ : Set where
zero : ℕ
succ : ℕ → ℕ
iter : {C : Set} → C → (C → C) → ℕ → C
iter z f zero = z
iter z f (succ n) = f (iter z f n)
succℕ : {C : Set} → (ℕ → C → C) → ℕ × C → ℕ × C
succℕ f (n , x) = (succ n , f n x)
iterℕ : {C : Set} → C → (ℕ → C → C) → ℕ → ℕ × C
iterℕ z f = iter (zero , z) (succℕ f)
recℕ : {C : Set} → C → (ℕ → C → C) → ℕ → C
recℕ z f = _×_.proj₂ ∘ iterℕ z f
indℕ : {C : ℕ → Set} → C zero → ((n : ℕ) → C n → C (succ n)) → (n : ℕ) → C n
indℕ z f zero = z
indℕ z f (succ n) = f n (indℕ z f n)
recℕzfzero≡z : {C : Set} {z : C} {f : ℕ → C → C} → recℕ z f zero ≡ z
recℕzfzero≡z = refl
recℕzfsuccn≡fnrecℕzfn : {C : Set} {z : C} {f : ℕ → C → C} (n : ℕ) →
recℕ z f (succ n) ≡ f n (recℕ z f n)
recℕzfsuccn≡fnrecℕzfn = indℕ refl ?
I don't know how to prove that recℕ z f (succ n) ≡ f n (recℕ z f n). I need to prove:
(n : ℕ) → recℕ z f (succ n) ≡ f n (recℕ z f n)
→ recℕ z f (succ (succ n)) ≡ f (succ n) (recℕ z f (succ n))
In English, given a natural number n and the induction hypothesis prove the consequent.
The infix operator _∘_ is normal function composition. The _≡_ and _×_ data types are defined as:
data _≡_ {A : Set} : A → A → Set where
refl : {x : A} → x ≡ x
record _×_ (A B : Set) : Set where
constructor _,_
field
_×_.proj₁ : A
_×_.proj₂ : B
I've been thinking of a solution for quite a while but I can't figure out how to solve this problem.
Let's get some help from Agda-mode for emacs:
recℕzfsuccn≡fnrecℕzfn : {C : Set} {z : C} {f : ℕ → C → C} (n : ℕ) →
recℕ z f (succ n) ≡ f n (recℕ z f n)
recℕzfsuccn≡fnrecℕzfn {f = f} n = {!!}
If we normalize the context in the hole by typing C-u C-u C-c C-, (each time I feel like I'm trying to invoke fatality in Mortal Kombat), we'll see (I cleaned up your definitions a bit)
Goal: f
(proj₁
(iter (0 , .z) (λ nx → succ (proj₁ nx) , f (proj₁ nx) (proj₂ nx))
n))
(proj₂
(iter (0 , .z) (λ nx → succ (proj₁ nx) , f (proj₁ nx) (proj₂ nx))
n))
≡
f n
(proj₂
(iter (0 , .z) (λ nx → succ (proj₁ nx) , f (proj₁ nx) (proj₂ nx))
n))
The second arguments to f are equal at both sides, so we can write
recℕzfsuccn≡fnrecℕzfn {f = f} n = cong (λ m -> f m (recℕ _ f n)) {!!}
where
cong : ∀ {a b} {A : Set a} {B : Set b}
(f : A → B) {x y} → x ≡ y → f x ≡ f y
cong f refl = refl
Now the goal is
Goal: proj₁ (iter (zero , .z) (succℕ f) n) ≡ n
which is a straightforward lemma
lem : {C : Set} {z : C} {f : ℕ → C → C} (n : ℕ)
→ proj₁ (iter (zero , z) (succℕ f) n) ≡ n
lem = indℕ refl (λ _ -> cong succ)
So
recℕzfsuccn≡fnrecℕzfn : {C : Set} {z : C} {f : ℕ → C → C} (n : ℕ) →
recℕ z f (succ n) ≡ f n (recℕ z f n)
recℕzfsuccn≡fnrecℕzfn {f = f} n = cong (λ m -> f m (recℕ _ f n)) (lem n)
The whole code.

Resources