michael/lean2
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

feat(hott/nat): prove computation rule for cases by inequality

Browse source
This commit is contained in:
Floris van Doorn 2015-06-04 22:30:09 -04:00
parent 0b9c8e14a4
commit ac03bf7a4a
2 changed files with 106 additions and 76 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

121
hott/init/nat.hlean
View file

@ -6,7 +6,7 @@ Authors: Floris van Doorn, Leonardo de Moura
prelude prelude
import init.wf init.tactic init.hedberg init.util init.types import init.wf init.tactic init.hedberg init.util init.types
open eq decidable sum lift open eq decidable sum lift is_trunc
namespace nat namespace nat
notation `ℕ` := nat notation `ℕ` := nat
@ -58,20 +58,20 @@ namespace nat
/- properties of inequality -/ /- properties of inequality -/
theorem le_of_eq {n m : ℕ} (p : n = m) : n ≤ m := p ▸ le.refl n definition le_of_eq {n m : ℕ} (p : n = m) : n ≤ m := p ▸ le.refl n
theorem le_succ (n : ℕ) : n ≤ succ n := by repeat constructor definition le_succ (n : ℕ) : n ≤ succ n := by repeat constructor
theorem pred_le (n : ℕ) : pred n ≤ n := by cases n;all_goals (repeat constructor) definition pred_le (n : ℕ) : pred n ≤ n := by cases n;all_goals (repeat constructor)
theorem le.trans [trans] {n m k : ℕ} (H1 : n ≤ m) (H2 : m ≤ k) : n ≤ k := definition le.trans [trans] {n m k : ℕ} (H1 : n ≤ m) (H2 : m ≤ k) : n ≤ k :=
by induction H2 with n H2 IH;exact H1;exact le.step IH by induction H2 with n H2 IH;exact H1;exact le.step IH
theorem le_succ_of_le {n m : ℕ} (H : n ≤ m) : n ≤ succ m := le.trans H !le_succ definition le_succ_of_le {n m : ℕ} (H : n ≤ m) : n ≤ succ m := le.trans H !le_succ
theorem le_of_succ_le {n m : ℕ} (H : succ n ≤ m) : n ≤ m := le.trans !le_succ H definition le_of_succ_le {n m : ℕ} (H : succ n ≤ m) : n ≤ m := le.trans !le_succ H
theorem le_of_lt {n m : ℕ} (H : n < m) : n ≤ m := le_of_succ_le H definition le_of_lt {n m : ℕ} (H : n < m) : n ≤ m := le_of_succ_le H
definition succ_le_succ [unfold-c 3] {n m : ℕ} (H : n ≤ m) : succ n ≤ succ m := definition succ_le_succ [unfold-c 3] {n m : ℕ} (H : n ≤ m) : succ n ≤ succ m :=
by induction H;reflexivity;exact le.step v_0 by induction H;reflexivity;exact le.step v_0
@ -85,28 +85,28 @@ namespace nat
definition le_succ_of_pred_le [unfold-c 1] {n m : ℕ} (H : pred n ≤ m) : n ≤ succ m := definition le_succ_of_pred_le [unfold-c 1] {n m : ℕ} (H : pred n ≤ m) : n ≤ succ m :=
by cases n;exact le.step H;exact succ_le_succ H by cases n;exact le.step H;exact succ_le_succ H
theorem not_succ_le_self {n : ℕ} : ¬succ n ≤ n := definition not_succ_le_self {n : ℕ} : ¬succ n ≤ n :=
by induction n with n IH;all_goals intros;cases a;apply IH;exact le_of_succ_le_succ a by induction n with n IH;all_goals intros;cases a;apply IH;exact le_of_succ_le_succ a
theorem zero_le (n : ℕ) : 0 ≤ n := definition zero_le (n : ℕ) : 0 ≤ n :=
by induction n with n IH;apply le.refl;exact le.step IH by induction n with n IH;apply le.refl;exact le.step IH
theorem lt.step {n m : ℕ} (H : n < m) : n < succ m := definition lt.step {n m : ℕ} (H : n < m) : n < succ m :=
le.step H le.step H
theorem zero_lt_succ (n : ℕ) : 0 < succ n := definition zero_lt_succ (n : ℕ) : 0 < succ n :=
by induction n with n IH;apply le.refl;exact le.step IH by induction n with n IH;apply le.refl;exact le.step IH
theorem lt.trans [trans] {n m k : ℕ} (H1 : n < m) (H2 : m < k) : n < k := definition lt.trans [trans] {n m k : ℕ} (H1 : n < m) (H2 : m < k) : n < k :=
le.trans (le.step H1) H2 le.trans (le.step H1) H2
theorem lt_of_le_of_lt [trans] {n m k : ℕ} (H1 : n ≤ m) (H2 : m < k) : n < k := definition lt_of_le_of_lt [trans] {n m k : ℕ} (H1 : n ≤ m) (H2 : m < k) : n < k :=
le.trans (succ_le_succ H1) H2 le.trans (succ_le_succ H1) H2
theorem lt_of_lt_of_le [trans] {n m k : ℕ} (H1 : n < m) (H2 : m ≤ k) : n < k := definition lt_of_lt_of_le [trans] {n m k : ℕ} (H1 : n < m) (H2 : m ≤ k) : n < k :=
le.trans H1 H2 le.trans H1 H2
theorem le.antisymm {n m : ℕ} (H1 : n ≤ m) (H2 : m ≤ n) : n = m := definition le.antisymm {n m : ℕ} (H1 : n ≤ m) (H2 : m ≤ n) : n = m :=
begin begin
cases H1 with m' H1', cases H1 with m' H1',
{ reflexivity}, { reflexivity},
@ -115,47 +115,48 @@ namespace nat
{ exfalso, apply not_succ_le_self, exact lt.trans H1' H2'}}, { exfalso, apply not_succ_le_self, exact lt.trans H1' H2'}},
end end
theorem not_succ_le_zero (n : ℕ) : ¬succ n ≤ zero := definition not_succ_le_zero (n : ℕ) : ¬succ n ≤ zero :=
by intro H; cases H by intro H; cases H
theorem lt.irrefl (n : ℕ) : ¬n < n := not_succ_le_self definition lt.irrefl (n : ℕ) : ¬n < n := not_succ_le_self
theorem self_lt_succ (n : ℕ) : n < succ n := !le.refl definition self_lt_succ (n : ℕ) : n < succ n := !le.refl
theorem lt.base (n : ℕ) : n < succ n := !le.refl definition lt.base (n : ℕ) : n < succ n := !le.refl
theorem le_lt_antisymm {n m : ℕ} (H1 : n ≤ m) (H2 : m < n) : empty := definition le_lt_antisymm {n m : ℕ} (H1 : n ≤ m) (H2 : m < n) : empty :=
!lt.irrefl (lt_of_le_of_lt H1 H2) !lt.irrefl (lt_of_le_of_lt H1 H2)
theorem lt_le_antisymm {n m : ℕ} (H1 : n < m) (H2 : m ≤ n) : empty := definition lt_le_antisymm {n m : ℕ} (H1 : n < m) (H2 : m ≤ n) : empty :=
le_lt_antisymm H2 H1 le_lt_antisymm H2 H1
theorem lt.asymm {n m : ℕ} (H1 : n < m) (H2 : m < n) : empty := definition lt.asymm {n m : ℕ} (H1 : n < m) (H2 : m < n) : empty :=
le_lt_antisymm (le_of_lt H1) H2 le_lt_antisymm (le_of_lt H1) H2
definition lt.by_cases {a b : ℕ} {P : Type} (H1 : a < b → P) (H2 : a = b → P) (H3 : b < a → P) : P := definition lt.trichotomy (a b : ℕ) : a < b ⊎ a = b ⊎ b < a :=
begin begin
revert b H1 H2 H3, induction a with a IH, revert b, induction a with a IH,
{ intros, cases b, { intro b, cases b,
exact H2 idp, exact inr (inl idp),
exact H1 !zero_lt_succ}, exact inl !zero_lt_succ},
{ intros, cases b with b, { intro b, cases b with b,
exact H3 !zero_lt_succ, exact inr (inr !zero_lt_succ),
{ apply IH, { cases IH b with H H,
intro H, exact H1 (succ_le_succ H), exact inl (succ_le_succ H),
intro H, exact H2 (ap succ H), cases H with H H,
intro H, exact H3 (succ_le_succ H)}} exact inr (inl (ap succ H)),
exact inr (inr (succ_le_succ H))}}
end end
theorem lt.trichotomy (a b : ℕ) : a < b ⊎ a = b ⊎ b < a := definition lt.by_cases {a b : ℕ} {P : Type} (H1 : a < b → P) (H2 : a = b → P) (H3 : b < a → P) : P :=
lt.by_cases inl (λH, inr (inl H)) (λH, inr (inr H)) by induction (lt.trichotomy a b) with H H; exact H1 H; cases H with H H; exact H2 H;exact H3 H
definition lt_ge_by_cases {a b : ℕ} {P : Type} (H1 : a < b → P) (H2 : a ≥ b → P) : P := definition lt_ge_by_cases {a b : ℕ} {P : Type} (H1 : a < b → P) (H2 : a ≥ b → P) : P :=
lt.by_cases H1 (λH, H2 (le_of_eq H⁻¹)) (λH, H2 (le_of_lt H)) lt.by_cases H1 (λH, H2 (le_of_eq H⁻¹)) (λH, H2 (le_of_lt H))
theorem lt_or_ge (a b : ℕ) : (a < b) ⊎ (a ≥ b) := definition lt_or_ge (a b : ℕ) : (a < b) ⊎ (a ≥ b) :=
lt_ge_by_cases inl inr lt_ge_by_cases inl inr
theorem not_lt_zero (a : ℕ) : ¬ a < zero := definition not_lt_zero (a : ℕ) : ¬ a < zero :=
by intro H; cases H by intro H; cases H
-- less-than is well-founded -- less-than is well-founded
@ -177,13 +178,13 @@ namespace nat
definition measure.wf {A : Type} (f : A → ℕ) : well_founded (measure f) := definition measure.wf {A : Type} (f : A → ℕ) : well_founded (measure f) :=
inv_image.wf f lt.wf inv_image.wf f lt.wf
theorem succ_lt_succ {a b : ℕ} (H : a < b) : succ a < succ b := definition succ_lt_succ {a b : ℕ} (H : a < b) : succ a < succ b :=
succ_le_succ H succ_le_succ H
theorem lt_of_succ_lt {a b : ℕ} (H : succ a < b) : a < b := definition lt_of_succ_lt {a b : ℕ} (H : succ a < b) : a < b :=
le_of_succ_le H le_of_succ_le H
theorem lt_of_succ_lt_succ {a b : ℕ} (H : succ a < succ b) : a < b := definition lt_of_succ_lt_succ {a b : ℕ} (H : succ a < succ b) : a < b :=
le_of_succ_le_succ H le_of_succ_le_succ H
definition decidable_le [instance] : decidable_rel le := definition decidable_le [instance] : decidable_rel le :=
@ -202,49 +203,49 @@ namespace nat
definition decidable_gt [instance] : decidable_rel gt := _ definition decidable_gt [instance] : decidable_rel gt := _
definition decidable_ge [instance] : decidable_rel ge := _ definition decidable_ge [instance] : decidable_rel ge := _
theorem eq_or_lt_of_le {a b : ℕ} (H : a ≤ b) : a = b ⊎ a < b := definition eq_or_lt_of_le {a b : ℕ} (H : a ≤ b) : a = b ⊎ a < b :=
by cases H with b' H; exact sum.inl rfl; exact sum.inr (succ_le_succ H) by cases H with b' H; exact sum.inl rfl; exact sum.inr (succ_le_succ H)
theorem le_of_eq_or_lt {a b : ℕ} (H : a = b ⊎ a < b) : a ≤ b := definition le_of_eq_or_lt {a b : ℕ} (H : a = b ⊎ a < b) : a ≤ b :=
by cases H with H H; exact le_of_eq H; exact le_of_lt H by cases H with H H; exact le_of_eq H; exact le_of_lt H
theorem eq_or_lt_of_not_lt {a b : ℕ} (hnlt : ¬ a < b) : a = b ⊎ b < a := definition eq_or_lt_of_not_lt {a b : ℕ} (hnlt : ¬ a < b) : a = b ⊎ b < a :=
sum.rec_on (lt.trichotomy a b) sum.rec_on (lt.trichotomy a b)
(λ hlt, absurd hlt hnlt) (λ hlt, absurd hlt hnlt)
(λ h, h) (λ h, h)
theorem lt_succ_of_le {a b : ℕ} (h : a ≤ b) : a < succ b := definition lt_succ_of_le {a b : ℕ} (h : a ≤ b) : a < succ b :=
succ_le_succ h succ_le_succ h
theorem lt_of_succ_le {a b : ℕ} (h : succ a ≤ b) : a < b := h definition lt_of_succ_le {a b : ℕ} (h : succ a ≤ b) : a < b := h
theorem succ_le_of_lt {a b : ℕ} (h : a < b) : succ a ≤ b := h definition succ_le_of_lt {a b : ℕ} (h : a < b) : succ a ≤ b := h
definition max (a b : ℕ) : ℕ := if a < b then b else a definition max (a b : ℕ) : ℕ := if a < b then b else a
definition min (a b : ℕ) : ℕ := if a < b then a else b definition min (a b : ℕ) : ℕ := if a < b then a else b
theorem max_self (a : ℕ) : max a a = a := definition max_self (a : ℕ) : max a a = a :=
eq.rec_on !if_t_t rfl eq.rec_on !if_t_t rfl
theorem max_eq_right {a b : ℕ} (H : a < b) : max a b = b := definition max_eq_right {a b : ℕ} (H : a < b) : max a b = b :=
if_pos H if_pos H
theorem max_eq_left {a b : ℕ} (H : ¬ a < b) : max a b = a := definition max_eq_left {a b : ℕ} (H : ¬ a < b) : max a b = a :=
if_neg H if_neg H
theorem eq_max_right {a b : ℕ} (H : a < b) : b = max a b := definition eq_max_right {a b : ℕ} (H : a < b) : b = max a b :=
eq.rec_on (max_eq_right H) rfl eq.rec_on (max_eq_right H) rfl
theorem eq_max_left {a b : ℕ} (H : ¬ a < b) : a = max a b := definition eq_max_left {a b : ℕ} (H : ¬ a < b) : a = max a b :=
eq.rec_on (max_eq_left H) rfl eq.rec_on (max_eq_left H) rfl
theorem le_max_left (a b : ℕ) : a ≤ max a b := definition le_max_left (a b : ℕ) : a ≤ max a b :=
by_cases by_cases
(λ h : a < b, le_of_lt (eq.rec_on (eq_max_right h) h)) (λ h : a < b, le_of_lt (eq.rec_on (eq_max_right h) h))
(λ h : ¬ a < b, eq.rec_on (eq_max_left h) !le.refl) (λ h : ¬ a < b, eq.rec_on (eq_max_left h) !le.refl)
theorem le_max_right (a b : ℕ) : b ≤ max a b := definition le_max_right (a b : ℕ) : b ≤ max a b :=
by_cases by_cases
(λ h : a < b, eq.rec_on (eq_max_right h) !le.refl) (λ h : a < b, eq.rec_on (eq_max_right h) !le.refl)
(λ h : ¬ a < b, sum.rec_on (eq_or_lt_of_not_lt h) (λ h : ¬ a < b, sum.rec_on (eq_or_lt_of_not_lt h)
@ -253,21 +254,21 @@ namespace nat
have aux : a = max a b, from eq_max_left (lt.asymm h), have aux : a = max a b, from eq_max_left (lt.asymm h),
eq.rec_on aux (le_of_lt h))) eq.rec_on aux (le_of_lt h)))
theorem succ_sub_succ_eq_sub (a b : ℕ) : succ a - succ b = a - b := definition succ_sub_succ_eq_sub (a b : ℕ) : succ a - succ b = a - b :=
by induction b with b IH; reflexivity; apply ap pred IH by induction b with b IH; reflexivity; apply ap pred IH
theorem sub_eq_succ_sub_succ (a b : ℕ) : a - b = succ a - succ b := definition sub_eq_succ_sub_succ (a b : ℕ) : a - b = succ a - succ b :=
eq.rec_on (succ_sub_succ_eq_sub a b) rfl eq.rec_on (succ_sub_succ_eq_sub a b) rfl
theorem zero_sub_eq_zero (a : ℕ) : zero - a = zero := definition zero_sub_eq_zero (a : ℕ) : zero - a = zero :=
nat.rec_on a nat.rec_on a
rfl rfl
(λ a₁ (ih : zero - a₁ = zero), ap pred ih) (λ a₁ (ih : zero - a₁ = zero), ap pred ih)
theorem zero_eq_zero_sub (a : ℕ) : zero = zero - a := definition zero_eq_zero_sub (a : ℕ) : zero = zero - a :=
eq.rec_on (zero_sub_eq_zero a) rfl eq.rec_on (zero_sub_eq_zero a) rfl
theorem sub_lt {a b : ℕ} : zero < a → zero < b → a - b < a := definition sub_lt {a b : ℕ} : zero < a → zero < b → a - b < a :=
have aux : Π {a}, zero < a → Π {b}, zero < b → a - b < a, from have aux : Π {a}, zero < a → Π {b}, zero < b → a - b < a, from
λa h₁, le.rec_on h₁ λa h₁, le.rec_on h₁
(λb h₂, le.cases_on h₂ (λb h₂, le.cases_on h₂
@ -282,7 +283,7 @@ namespace nat
(lt.trans (@ih b₁ bpos) (lt.base a₁)))), (lt.trans (@ih b₁ bpos) (lt.base a₁)))),
λ h₁ h₂, aux h₁ h₂ λ h₁ h₂, aux h₁ h₂
theorem sub_le (a b : ℕ) : a - b ≤ a := definition sub_le (a b : ℕ) : a - b ≤ a :=
nat.rec_on b nat.rec_on b
(le.refl a) (le.refl a)
(λ b₁ ih, le.trans !pred_le ih) (λ b₁ ih, le.trans !pred_le ih)

61
hott/types/nat/hott.hlean
View file

@ -11,7 +11,6 @@ import .basic
open is_trunc unit empty eq equiv open is_trunc unit empty eq equiv
namespace nat namespace nat
definition is_hprop_le [instance] (n m : ℕ) : is_hprop (n ≤ m) := definition is_hprop_le [instance] (n m : ℕ) : is_hprop (n ≤ m) :=
begin begin
assert lem : Π{n m : ℕ} (p : n ≤ m) (q : n = m), p = q ▸ le.refl n, assert lem : Π{n m : ℕ} (p : n ≤ m) (q : n = m), p = q ▸ le.refl n,
@ -25,27 +24,57 @@ namespace nat
{ exfalso, apply not_succ_le_self a}, { exfalso, apply not_succ_le_self a},
{ exact ap le.step !v_0}}, { exact ap le.step !v_0}},
end end
definition le_equiv_succ_le_succ (n m : ℕ) : (n ≤ m) ≃ (succ n ≤ succ m) := definition le_equiv_succ_le_succ (n m : ℕ) : (n ≤ m) ≃ (succ n ≤ succ m) :=
equiv_of_is_hprop succ_le_succ le_of_succ_le_succ equiv_of_is_hprop succ_le_succ le_of_succ_le_succ
definition le_succ_equiv_pred_le (n m : ℕ) : (n ≤ succ m) ≃ (pred n ≤ m) := definition le_succ_equiv_pred_le (n m : ℕ) : (n ≤ succ m) ≃ (pred n ≤ m) :=
equiv_of_is_hprop pred_le_pred le_succ_of_pred_le equiv_of_is_hprop pred_le_pred le_succ_of_pred_le
theorem lt_by_cases_lt {a b : ℕ} {P : Type} (H1 : a < b → P) (H2 : a = b → P)
(H3 : a > b → P) (H : a < b) : lt.by_cases H1 H2 H3 = H1 H :=
begin
unfold lt.by_cases, induction (lt.trichotomy a b) with H' H',
{ esimp, exact ap H1 !is_hprop.elim},
{ exfalso, cases H' with H' H', apply lt.irrefl, exact H' ▸ H, exact lt.asymm H H'}
end
-- definition is_hprop_lt [instance] (n m : ℕ) : is_hprop (n < m) := theorem lt_by_cases_eq {a b : ℕ} {P : Type} (H1 : a < b → P) (H2 : a = b → P)
-- begin (H3 : a > b → P) (H : a = b) : lt.by_cases H1 H2 H3 = H2 H :=
-- assert H : Π{n m : ℕ} (p : n < m) (q : succ n = m), p = q ▸ lt.base n, begin
-- { intros, cases p, unfold lt.by_cases, induction (lt.trichotomy a b) with H' H',
-- { assert H' : q = idp, apply is_hset.elim, { exfalso, apply lt.irrefl, exact H ▸ H'},
-- cases H', reflexivity}, { cases H' with H' H', esimp, exact ap H2 !is_hprop.elim, exfalso, apply lt.irrefl, exact H ▸ H'}
-- { cases q, exfalso, exact lt.irrefl b a}}, end
-- apply is_hprop.mk, intros p q,
-- induction q,
-- { apply H},
-- { cases p,
-- exfalso, exact lt.irrefl b a,
-- exact ap lt.step !v_0}
-- end
-- definition is_hprop_le (n m : ℕ) : is_hprop (n ≤ m) := !is_hprop_lt theorem lt_by_cases_ge {a b : ℕ} {P : Type} (H1 : a < b → P) (H2 : a = b → P)
(H3 : a > b → P) (H : a > b) : lt.by_cases H1 H2 H3 = H3 H :=
begin
unfold lt.by_cases, induction (lt.trichotomy a b) with H' H',
{ exfalso, exact lt.asymm H H'},
{ cases H' with H' H', exfalso, apply lt.irrefl, exact H' ▸ H, esimp, exact ap H3 !is_hprop.elim}
end
theorem lt_ge_by_cases_lt {n m : ℕ} {P : Type} (H1 : n < m → P) (H2 : n ≥ m → P)
(H : n < m) : lt_ge_by_cases H1 H2 = H1 H :=
by apply lt_by_cases_lt
theorem lt_ge_by_cases_ge {n m : ℕ} {P : Type} (H1 : n < m → P) (H2 : n ≥ m → P)
(H : n ≥ m) : lt_ge_by_cases H1 H2 = H2 H :=
begin
unfold [lt_ge_by_cases,lt.by_cases], induction (lt.trichotomy n m) with H' H',
{ exfalso, apply lt.irrefl, exact lt_of_le_of_lt H H'},
{ cases H' with H' H'; all_goals (esimp; apply ap H2 !is_hprop.elim)}
end
theorem lt_ge_by_cases_le {n m : ℕ} {P : Type} {H1 : n ≤ m → P} {H2 : n ≥ m → P}
(H : n ≤ m) (Heq : Π(p : n = m), H1 (le_of_eq p) = H2 (le_of_eq p⁻¹))
: lt_ge_by_cases (λH', H1 (le_of_lt H')) H2 = H1 H :=
begin
unfold [lt_ge_by_cases,lt.by_cases], induction (lt.trichotomy n m) with H' H',
{ esimp, apply ap H1 !is_hprop.elim},
{ cases H' with H' H',
esimp, exact !Heq⁻¹ ⬝ ap H1 !is_hprop.elim,
exfalso, apply lt.irrefl, apply lt_of_le_of_lt H H'}
end
end nat end nat