From 194cc8e2416b5969cfdab4006bb9e20cb75e5adc Mon Sep 17 00:00:00 2001 From: Johan Commelin Date: Fri, 15 May 2020 17:50:09 +0000 Subject: [PATCH] refactor(library): decouple algebraic hierarchy from core lib (#229) This PR allows moving `ordered_monoid`, `semiring`, and all the other algebraic classes into mathlib. Classes that are only about orders, such as `decidable_linear_order` remain in core. Co-authored-by: Gabriel Ebner --- library/data/bitvec.lean | 17 +- library/data/rbtree/basic.lean | 4 +- library/data/stream.lean | 4 +- library/init/algebra/default.lean | 3 +- library/init/algebra/field.lean | 345 -------- library/init/algebra/functions.lean | 358 +------- library/init/algebra/group.lean | 436 ---------- library/init/algebra/norm_num.lean | 268 ------ library/init/algebra/ordered_field.lean | 441 ---------- library/init/algebra/ordered_group.lean | 634 -------------- library/init/algebra/ordered_ring.lean | 412 ---------- library/init/algebra/ring.lean | 338 -------- library/init/data/array/slice.lean | 2 +- library/init/data/int/basic.lean | 136 +-- library/init/data/int/comp_lemmas.lean | 30 +- library/init/data/int/order.lean | 772 ++++++++++++++++-- library/init/data/list/lemmas.lean | 8 +- library/init/data/nat/basic.lean | 4 + library/init/data/nat/bitwise.lean | 44 +- library/init/data/nat/gcd.lean | 2 +- library/init/data/nat/lemmas.lean | 345 ++++---- library/init/data/string/ops.lean | 2 +- library/init/meta/well_founded_tactics.lean | 4 +- library/system/io.lean | 2 +- src/library/CMakeLists.txt | 2 +- src/library/app_builder.cpp | 146 ---- src/library/app_builder.h | 24 - src/library/arith_instance.cpp | 168 ---- src/library/arith_instance.h | 144 ---- src/library/constants.cpp | 80 -- src/library/constants.h | 20 - src/library/constants.txt | 20 - src/library/equations_compiler/elim_match.cpp | 2 +- tests/lean/123-2.lean | 6 + tests/lean/123-2.lean.expected.out | 10 +- tests/lean/1862.lean | 7 +- tests/lean/1862.lean.expected.out | 2 +- tests/lean/1898.lean | 2 +- tests/lean/1898.lean.expected.out | 4 +- tests/lean/1952.lean | 2 +- tests/lean/1952.lean.expected.out | 12 +- tests/lean/bad_end_error_pos.lean | 15 +- tests/lean/field_type_mismatch.lean | 3 + .../field_type_mismatch.lean.expected.out | 4 +- tests/lean/get_unused_name.lean | 2 +- tests/lean/interactive/goal_info.lean | 8 +- tests/lean/nested_match.lean | 2 +- tests/lean/out_param_proj.lean | 5 + tests/lean/quote_error_pos.lean | 6 + tests/lean/quote_error_pos.lean.expected.out | 4 +- tests/lean/rquote.lean | 4 +- tests/lean/rquote.lean.expected.out | 2 +- tests/lean/run/1442.lean | 4 + tests/lean/run/1675.lean | 2 +- tests/lean/run/1685.lean | 2 +- tests/lean/run/236c.lean | 6 +- tests/lean/run/ac_refl1.lean | 5 + tests/lean/run/add_semi.lean | 5 + tests/lean/run/aexp.lean | 15 +- tests/lean/run/auto_param_in_structures.lean | 2 +- tests/lean/run/auto_quote1.lean | 4 +- tests/lean/run/bin_tree.lean | 2 +- tests/lean/run/cc_ac1.lean | 5 + tests/lean/run/cc_ac2.lean | 5 + tests/lean/run/cc_ac3.lean | 23 +- tests/lean/run/cc_ac5.lean | 15 + tests/lean/run/cc_ac_bug.lean | 5 + tests/lean/run/check_constants.lean | 20 - tests/lean/run/conv_tac1.lean | 8 +- tests/lean/run/cpdt.lean | 43 - tests/lean/run/dsimp_options.lean | 2 +- tests/lean/run/dsimp_proj.lean | 2 +- tests/lean/run/ematch2.lean | 13 + tests/lean/run/ematch_attr_to_defs.lean | 35 - tests/lean/run/eq_cases_on.lean | 4 +- tests/lean/run/funext_tactic.lean | 18 +- tests/lean/run/handthen.lean | 2 + tests/lean/run/hinst_lemma1.lean | 2 +- tests/lean/run/hinst_lemmas1.lean | 6 +- tests/lean/run/interactive1.lean | 2 +- .../lean/run/intros_defeq_canonizer_bug.lean | 3 + tests/lean/run/local_attribute.lean | 2 +- tests/lean/run/mario_type_context.lean | 12 + tests/lean/run/mrw.lean | 4 +- .../run/name_resolution_with_params_bug.lean | 2 +- tests/lean/run/nat_sub_ematch.lean | 2 +- tests/lean/run/psum_wf_rec.lean | 4 +- tests/lean/run/rw1.lean | 2 + tests/lean/run/sebastien_coe_simp.lean | 4 +- tests/lean/run/show_goal.lean | 14 +- tests/lean/run/simp_lemma_issue.lean | 12 +- tests/lean/run/simp_lemmas_with_mvars.lean | 6 +- tests/lean/run/simp_tc_err.lean | 2 + tests/lean/run/simp_zeta.lean | 2 + tests/lean/run/smt_assert_define.lean | 4 +- tests/lean/run/smt_ematch1.lean | 6 +- tests/lean/run/smt_ematch2.lean | 109 --- tests/lean/run/smt_ematch3.lean | 47 -- tests/lean/run/smt_ematch_alg_issue.lean | 6 + tests/lean/run/smt_tests.lean | 6 +- tests/lean/run/term_app2.lean | 6 +- tests/lean/run/u_eq_max_u_v.lean | 5 +- tests/lean/run/using_smt2.lean | 4 +- tests/lean/simp_symm.lean | 2 +- tests/lean/task.lean | 2 + tests/lean/type_context.lean | 2 +- tests/lean/type_context.lean.expected.out | 6 +- tests/lean/vm_override.lean | 2 +- 108 files changed, 1289 insertions(+), 4563 deletions(-) delete mode 100644 library/init/algebra/field.lean delete mode 100644 library/init/algebra/group.lean delete mode 100644 library/init/algebra/norm_num.lean delete mode 100644 library/init/algebra/ordered_field.lean delete mode 100644 library/init/algebra/ordered_group.lean delete mode 100644 library/init/algebra/ordered_ring.lean delete mode 100644 library/init/algebra/ring.lean delete mode 100644 src/library/arith_instance.cpp delete mode 100644 src/library/arith_instance.h delete mode 100644 tests/lean/run/cpdt.lean delete mode 100644 tests/lean/run/ematch_attr_to_defs.lean delete mode 100644 tests/lean/run/smt_ematch2.lean delete mode 100644 tests/lean/run/smt_ematch3.lean diff --git a/library/data/bitvec.lean b/library/data/bitvec.lean index 74afea77ad..a5c5d1d8f5 100644 --- a/library/data/bitvec.lean +++ b/library/data/bitvec.lean @@ -43,9 +43,9 @@ section shift begin by_cases (i ≤ n), { have h₁ := sub_le n i, - rw [min_eq_right h], rw [min_eq_left h₁, ← nat.add_sub_assoc h, add_comm, nat.add_sub_cancel] }, + rw [min_eq_right h], rw [min_eq_left h₁, ← nat.add_sub_assoc h, nat.add_comm, nat.add_sub_cancel] }, { have h₁ := le_of_not_ge h, - rw [min_eq_left h₁, sub_eq_zero_of_le h₁, zero_min, add_zero] } + rw [min_eq_left h₁, sub_eq_zero_of_le h₁, zero_min, nat.add_zero] } end $ repeat fill (min n i) ++ₜ take (n-i) x @@ -158,7 +158,9 @@ section conversion theorem bits_to_nat_to_list {n : ℕ} (x : bitvec n) : bitvec.to_nat x = bits_to_nat (vector.to_list x) := rfl - local attribute [simp] add_comm add_assoc add_left_comm mul_comm mul_assoc mul_left_comm + local attribute [simp] nat.add_comm nat.add_assoc nat.add_left_comm nat.mul_comm nat.mul_assoc + local attribute [simp] nat.zero_add nat.add_zero nat.one_mul nat.mul_one nat.zero_mul nat.mul_zero + -- mul_left_comm theorem to_nat_append {m : ℕ} (xs : bitvec m) (b : bool) : bitvec.to_nat (xs ++ₜ b::nil) = bitvec.to_nat xs * 2 + bitvec.to_nat (b::nil) := @@ -189,15 +191,10 @@ section conversion theorem to_nat_of_nat {k n : ℕ} : bitvec.to_nat (bitvec.of_nat k n) = n % 2^k := begin - induction k with k generalizing n, + induction k with k ih generalizing n, { unfold pow nat.pow, simp [nat.mod_one], refl }, { have h : 0 < 2, { apply le_succ }, - rw [ of_nat_succ - , to_nat_append - , k_ih - , bits_to_nat_to_bool - , mod_pow_succ h], - ac_refl, } + rw [of_nat_succ, to_nat_append, ih, bits_to_nat_to_bool, mod_pow_succ h, nat.mul_comm] } end protected def to_int : Π {n : nat}, bitvec n → int diff --git a/library/data/rbtree/basic.lean b/library/data/rbtree/basic.lean index 5d8397ec53..8d6e012da1 100644 --- a/library/data/rbtree/basic.lean +++ b/library/data/rbtree/basic.lean @@ -201,7 +201,7 @@ lemma depth_max' : ∀ {c n} {t : rbnode α}, is_red_black t c n → depth max t begin intros c n' t h, induction h, - case leaf_rb { simp [max, depth, upper] }, + case leaf_rb { simp [max, depth, upper, nat.mul_zero] }, case red_rb { suffices : succ (max (depth max h_l) (depth max h_r)) ≤ 2 * h_n + 1, { simp [depth, upper, *] at * }, @@ -211,7 +211,7 @@ begin have : depth max h_l ≤ 2*h_n + 1, from le_trans h_ih_rb_l (upper_le _ _), have : depth max h_r ≤ 2*h_n + 1, from le_trans h_ih_rb_r (upper_le _ _), suffices new : max (depth max h_l) (depth max h_r) + 1 ≤ 2 * h_n + 2*1, - { simp [depth, upper, succ_eq_add_one, left_distrib, *] at * }, + { simp [depth, upper, succ_eq_add_one, nat.left_distrib, *] at * }, apply succ_le_succ, apply max_le; assumption } end diff --git a/library/data/stream.lean b/library/data/stream.lean index 68d29dbf17..88a157d477 100644 --- a/library/data/stream.lean +++ b/library/data/stream.lean @@ -42,14 +42,14 @@ theorem head_cons (a : α) (s : stream α) : head (a :: s) = a := rfl theorem tail_cons (a : α) (s : stream α) : tail (a :: s) = s := rfl theorem tail_drop (n : nat) (s : stream α) : tail (drop n s) = drop n (tail s) := -funext (λ i, begin unfold tail drop, simp [add_comm, add_left_comm] end) +funext (λ i, begin unfold tail drop, simp [nat.add_comm, nat.add_left_comm] end) theorem nth_drop (n m : nat) (s : stream α) : nth n (drop m s) = nth (n+m) s := rfl theorem tail_eq_drop (s : stream α) : tail s = drop 1 s := rfl theorem drop_drop (n m : nat) (s : stream α) : drop n (drop m s) = drop (n+m) s := -funext (λ i, begin unfold drop, rw add_assoc end) +funext (λ i, begin unfold drop, rw nat.add_assoc end) theorem nth_succ (n : nat) (s : stream α) : nth (succ n) s = nth n (tail s) := rfl diff --git a/library/init/algebra/default.lean b/library/init/algebra/default.lean index 6473cbe1a5..7e83c3c3cd 100644 --- a/library/init/algebra/default.lean +++ b/library/init/algebra/default.lean @@ -4,5 +4,4 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura -/ prelude -import init.algebra.group init.algebra.ordered_group init.algebra.ring init.algebra.ordered_ring -import init.algebra.field init.algebra.ordered_field init.algebra.norm_num init.algebra.functions +import init.algebra.functions diff --git a/library/init/algebra/field.lean b/library/init/algebra/field.lean deleted file mode 100644 index 13649130a1..0000000000 --- a/library/init/algebra/field.lean +++ /dev/null @@ -1,345 +0,0 @@ -/- -Copyright (c) 2014 Robert Lewis. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Robert Lewis, Leonardo de Moura - -Structures with multiplicative and additive components, including division rings and fields. -The development is modeled after Isabelle's library. --/ -prelude -import init.algebra.ring -universe u - -/- Make sure instances defined in this file have lower priority than the ones - defined for concrete structures -/ -set_option default_priority 100 - -set_option old_structure_cmd true - -class division_ring (α : Type u) extends ring α, has_inv α, zero_ne_one_class α := -(mul_inv_cancel : ∀ {a : α}, a ≠ 0 → a * a⁻¹ = 1) -(inv_mul_cancel : ∀ {a : α}, a ≠ 0 → a⁻¹ * a = 1) -(inv_zero : (0 : α)⁻¹ = 0) - -variable {α : Type u} - -section division_ring -variables [division_ring α] - -protected definition algebra.div (a b : α) : α := -a * b⁻¹ - -instance division_ring_has_div : has_div α := -⟨algebra.div⟩ - -lemma division_def (a b : α) : a / b = a * b⁻¹ := -rfl - -@[simp] lemma inv_zero : 0⁻¹ = (0:α) := -division_ring.inv_zero - -@[simp] lemma div_zero (a : α) : a / 0 = (0:α) := -calc - a / 0 = (a:α) * 0⁻¹ : by rw division_def - ... = a * 0 : by rw inv_zero - ... = (0:α) : by rw mul_zero - -@[simp] -lemma mul_inv_cancel {a : α} (h : a ≠ 0) : a * a⁻¹ = 1 := -division_ring.mul_inv_cancel h - -@[simp] -lemma inv_mul_cancel {a : α} (h : a ≠ 0) : a⁻¹ * a = 1 := -division_ring.inv_mul_cancel h - -@[simp] -lemma one_div_eq_inv (a : α) : 1 / a = a⁻¹ := -one_mul a⁻¹ - -lemma inv_eq_one_div (a : α) : a⁻¹ = 1 / a := -by simp - -local attribute [simp] -division_def mul_comm mul_assoc -mul_left_comm mul_inv_cancel inv_mul_cancel - -lemma div_eq_mul_one_div (a b : α) : a / b = a * (1 / b) := -by simp - -lemma mul_one_div_cancel {a : α} (h : a ≠ 0) : a * (1 / a) = 1 := -by simp [h] - -lemma one_div_mul_cancel {a : α} (h : a ≠ 0) : (1 / a) * a = 1 := -by simp [h] - -lemma div_self {a : α} (h : a ≠ 0) : a / a = 1 := -by simp [h] - -lemma one_div_one : 1 / 1 = (1:α) := -div_self (ne.symm zero_ne_one) - -lemma mul_div_assoc (a b c : α) : (a * b) / c = a * (b / c) := -by simp - -lemma one_div_ne_zero {a : α} (h : a ≠ 0) : 1 / a ≠ 0 := -assume : 1 / a = 0, -have 0 = (1:α), from eq.symm (by rw [← mul_one_div_cancel h, this, mul_zero]), -absurd this zero_ne_one - -lemma ne_zero_of_one_div_ne_zero {a : α} (h : 1 / a ≠ 0) : a ≠ 0 := -assume ha : a = 0, begin rw [ha, div_zero] at h, contradiction end - -lemma inv_ne_zero {a : α} (h : a ≠ 0) : a⁻¹ ≠ 0 := -by rw inv_eq_one_div; exact one_div_ne_zero h - -lemma eq_zero_of_one_div_eq_zero {a : α} (h : 1 / a = 0) : a = 0 := -classical.by_cases - (assume ha, ha) - (assume ha, false.elim ((one_div_ne_zero ha) h)) - -lemma one_inv_eq : 1⁻¹ = (1:α) := -calc 1⁻¹ = 1 * 1⁻¹ : by rw [one_mul] - ... = (1:α) : by simp - -local attribute [simp] one_inv_eq - -lemma div_one (a : α) : a / 1 = a := -by simp - -lemma zero_div (a : α) : 0 / a = 0 := -by simp - --- note: integral domain has a "mul_ne_zero". a commutative division ring is an integral --- domain, but let's not define that class for now. -lemma division_ring.mul_ne_zero {a b : α} (ha : a ≠ 0) (hb : b ≠ 0) : a * b ≠ 0 := -assume : a * b = 0, -have a * 1 = 0, by rw [← mul_one_div_cancel hb, ← mul_assoc, this, zero_mul], -have a = 0, by rwa mul_one at this, -absurd this ha - -lemma mul_ne_zero_comm {a b : α} (h : a * b ≠ 0) : b * a ≠ 0 := -have h₁ : a ≠ 0, from ne_zero_of_mul_ne_zero_right h, -have h₂ : b ≠ 0, from ne_zero_of_mul_ne_zero_left h, -division_ring.mul_ne_zero h₂ h₁ - -lemma eq_one_div_of_mul_eq_one {a b : α} (h : a * b = 1) : b = 1 / a := -have a ≠ 0, from - assume : a = 0, - have 0 = (1:α), by rwa [this, zero_mul] at h, - absurd this zero_ne_one, -have b = (1 / a) * a * b, by rw [one_div_mul_cancel this, one_mul], -show b = 1 / a, by rwa [mul_assoc, h, mul_one] at this - -lemma eq_one_div_of_mul_eq_one_left {a b : α} (h : b * a = 1) : b = 1 / a := -have a ≠ 0, from - assume : a = 0, - have 0 = (1:α), by rwa [this, mul_zero] at h, - absurd this zero_ne_one, -by rw [← h, mul_div_assoc, div_self this, mul_one] - -lemma division_ring.one_div_mul_one_div {a b : α} : (1 / a) * (1 / b) = 1 / (b * a) := -match classical.em (a = 0), classical.em (b = 0) with -| or.inr ha, or.inr hb := - have (b * a) * ((1 / a) * (1 / b)) = 1, - by rw [mul_assoc, ← mul_assoc a, mul_one_div_cancel ha, one_mul, mul_one_div_cancel hb], - eq_one_div_of_mul_eq_one this -| or.inl ha, _ := by simp [ha] -| _ , or.inl hb := by simp [hb] -end - -lemma one_div_neg_one_eq_neg_one : (1:α) / (-1) = -1 := -have (-1) * (-1) = (1:α), by rw [neg_mul_neg, one_mul], -eq.symm (eq_one_div_of_mul_eq_one this) - -lemma one_div_neg_eq_neg_one_div (a : α) : 1 / (- a) = - (1 / a) := -calc - 1 / (- a) = 1 / ((-1) * a) : by rw neg_eq_neg_one_mul - ... = (1 / a) * (1 / (- 1)) : by rw division_ring.one_div_mul_one_div - ... = (1 / a) * (-1) : by rw one_div_neg_one_eq_neg_one - ... = - (1 / a) : by rw [mul_neg_eq_neg_mul_symm, mul_one] - -lemma div_neg_eq_neg_div (a b : α) : b / (- a) = - (b / a) := -calc - b / (- a) = b * (1 / (- a)) : by rw [← inv_eq_one_div, division_def] - ... = b * -(1 / a) : by rw one_div_neg_eq_neg_one_div - ... = -(b * (1 / a)) : by rw neg_mul_eq_mul_neg - ... = - (b * a⁻¹) : by rw inv_eq_one_div - -lemma neg_div (a b : α) : (-b) / a = - (b / a) := -by rw [neg_eq_neg_one_mul, mul_div_assoc, ← neg_eq_neg_one_mul] - -lemma neg_div_neg_eq (a b : α) : (-a) / (-b) = a / b := -by rw [div_neg_eq_neg_div, neg_div, neg_neg] - -lemma one_div_one_div (a : α) : 1 / (1 / a) = a := -match classical.em (a = 0) with -| or.inl h := by simp [h] -| or.inr h := eq.symm (eq_one_div_of_mul_eq_one_left (mul_one_div_cancel h)) -end - -lemma inv_inv' (a : α) : a⁻¹⁻¹ = a := -by rw [inv_eq_one_div, inv_eq_one_div, one_div_one_div] - -lemma eq_of_one_div_eq_one_div {a b : α} (h : 1 / a = 1 / b) : a = b := -by rw [← one_div_one_div a, h,one_div_one_div] - -lemma mul_inv' (a b : α) : (b * a)⁻¹ = a⁻¹ * b⁻¹ := -eq.symm $ calc - a⁻¹ * b⁻¹ = (1 / a) * (1 / b) : by simp - ... = (1 / (b * a)) : division_ring.one_div_mul_one_div - ... = (b * a)⁻¹ : by simp - -lemma one_div_div (a b : α) : 1 / (a / b) = b / a := -by rw [one_div_eq_inv, division_def, mul_inv', - inv_inv', division_def] - -lemma div_helper {a : α} (b : α) (h : a ≠ 0) : (1 / (a * b)) * a = 1 / b := -by simp only [division_def, mul_inv', one_mul, mul_assoc, inv_mul_cancel h, mul_one] - -lemma mul_div_cancel (a : α) {b : α} (hb : b ≠ 0) : a * b / b = a := -by simp [hb] - -lemma div_mul_cancel (a : α) {b : α} (hb : b ≠ 0) : a / b * b = a := -by simp [hb] - -lemma div_div_eq_mul_div (a b c : α) : - a / (b / c) = (a * c) / b := -by rw [div_eq_mul_one_div, one_div_div, ← mul_div_assoc] - -lemma div_mul_left {a b : α} (hb : b ≠ 0) : b / (a * b) = 1 / a := -by simp only [division_def, mul_inv', ← mul_assoc, mul_inv_cancel hb] - -lemma mul_div_mul_right (a : α) (b : α) {c : α} (hc : c ≠ 0) : - (a * c) / (b * c) = a / b := -by rw [mul_div_assoc, div_mul_left hc, ← mul_div_assoc, mul_one] - -lemma div_add_div_same (a b c : α) : a / c + b / c = (a + b) / c := -eq.symm $ right_distrib a b (c⁻¹) - -lemma div_sub_div_same (a b c : α) : (a / c) - (b / c) = (a - b) / c := -by rw [sub_eq_add_neg, ← neg_div, div_add_div_same, sub_eq_add_neg] - -lemma one_div_mul_add_mul_one_div_eq_one_div_add_one_div {a b : α} (ha : a ≠ 0) (hb : b ≠ 0) : - (1 / a) * (a + b) * (1 / b) = 1 / a + 1 / b := -by rw [(left_distrib (1 / a)), (one_div_mul_cancel ha), right_distrib, one_mul, - mul_assoc, (mul_one_div_cancel hb), mul_one, add_comm] - -lemma one_div_mul_sub_mul_one_div_eq_one_div_add_one_div {a b : α} (ha : a ≠ 0) (hb : b ≠ 0) : - (1 / a) * (b - a) * (1 / b) = 1 / a - 1 / b := -by rw [(mul_sub_left_distrib (1 / a)), (one_div_mul_cancel ha), mul_sub_right_distrib, - one_mul, mul_assoc, (mul_one_div_cancel hb), mul_one] - -lemma div_eq_one_iff_eq (a : α) {b : α} (hb : b ≠ 0) : a / b = 1 ↔ a = b := -iff.intro - (assume : a / b = 1, calc - a = a / b * b : by simp [hb] - ... = 1 * b : by rw this - ... = b : by simp) - (assume : a = b, by simp [this, hb]) - -lemma eq_of_div_eq_one (a : α) {b : α} (Hb : b ≠ 0) : a / b = 1 → a = b := -iff.mp $ div_eq_one_iff_eq a Hb - -lemma eq_div_iff_mul_eq (a b : α) {c : α} (hc : c ≠ 0) : a = b / c ↔ a * c = b := -iff.intro - (assume : a = b / c, by rw [this, (div_mul_cancel _ hc)]) - (assume : a * c = b, by rw [← this, mul_div_cancel _ hc]) - -lemma eq_div_of_mul_eq (a b : α) {c : α} (hc : c ≠ 0) : a * c = b → a = b / c := -iff.mpr $ eq_div_iff_mul_eq a b hc - -lemma mul_eq_of_eq_div (a b: α) {c : α} (hc : c ≠ 0) : a = b / c → a * c = b := -iff.mp $ eq_div_iff_mul_eq a b hc - -lemma add_div_eq_mul_add_div (a b : α) {c : α} (hc : c ≠ 0) : a + b / c = (a * c + b) / c := -have (a + b / c) * c = a * c + b, by rw [right_distrib, (div_mul_cancel _ hc)], - (iff.mpr (eq_div_iff_mul_eq _ _ hc)) this - -lemma mul_mul_div (a : α) {c : α} (hc : c ≠ 0) : a = a * c * (1 / c) := -by simp [hc] - -lemma eq_of_mul_eq_mul_of_nonzero_left {a b c : α} (h : a ≠ 0) (h₂ : a * b = a * c) : b = c := -by rw [← one_mul b, ← inv_mul_cancel h, mul_assoc, h₂, ← mul_assoc, inv_mul_cancel h, one_mul] - -lemma eq_of_mul_eq_mul_of_nonzero_right {a b c : α} (h : c ≠ 0) (h2 : a * c = b * c) : a = b := -by rw [← mul_one a, ← mul_inv_cancel h, ← mul_assoc, h2, mul_assoc, mul_inv_cancel h, mul_one] - -end division_ring - -class field (α : Type u) extends comm_ring α, has_inv α, zero_ne_one_class α := -(mul_inv_cancel : ∀ {a : α}, a ≠ 0 → a * a⁻¹ = 1) -(inv_zero : (0 : α)⁻¹ = 0) - -section field - -variable [field α] - -instance field.to_division_ring : division_ring α := -{ inv_mul_cancel := λ _ h, by rw [mul_comm, field.mul_inv_cancel h] - ..show field α, by apply_instance } - -lemma one_div_mul_one_div (a b : α) : (1 / a) * (1 / b) = 1 / (a * b) := -by rw [division_ring.one_div_mul_one_div, mul_comm b] - -lemma div_mul_right {a : α} (b : α) (ha : a ≠ 0) : a / (a * b) = 1 / b := -by rw [mul_comm, div_mul_left ha] - -lemma mul_div_cancel_left {a : α} (b : α) (ha : a ≠ 0) : a * b / a = b := -by rw [mul_comm a, (mul_div_cancel _ ha)] - -lemma mul_div_cancel' (a : α) {b : α} (hb : b ≠ 0) : b * (a / b) = a := -by rw [mul_comm, (div_mul_cancel _ hb)] - -lemma one_div_add_one_div {a b : α} (ha : a ≠ 0) (hb : b ≠ 0) : 1 / a + 1 / b = (a + b) / (a * b) := -by rw [add_comm, ← div_mul_left ha, ← div_mul_right _ hb, - division_def, division_def, division_def, ← right_distrib, mul_comm a] - -local attribute [simp] mul_assoc mul_comm mul_left_comm - -lemma div_mul_div (a b c d : α) : - (a / b) * (c / d) = (a * c) / (b * d) := -begin simp [division_def], rw [mul_inv', mul_comm d⁻¹] end - -lemma mul_div_mul_left (a b : α) {c : α} (hc : c ≠ 0) : - (c * a) / (c * b) = a / b := -by rw [← div_mul_div, div_self hc, one_mul] - -lemma div_mul_eq_mul_div (a b c : α) : (b / c) * a = (b * a) / c := -by simp [division_def] - -lemma div_mul_eq_mul_div_comm (a b c : α) : - (b / c) * a = b * (a / c) := -by rw [div_mul_eq_mul_div, ← one_mul c, ← div_mul_div, - div_one, one_mul] - -lemma div_add_div (a : α) {b : α} (c : α) {d : α} (hb : b ≠ 0) (hd : d ≠ 0) : - (a / b) + (c / d) = ((a * d) + (b * c)) / (b * d) := -by rw [← mul_div_mul_right _ b hd, ← mul_div_mul_left c d hb, div_add_div_same] - -lemma div_sub_div (a : α) {b : α} (c : α) {d : α} (hb : b ≠ 0) (hd : d ≠ 0) : - (a / b) - (c / d) = ((a * d) - (b * c)) / (b * d) := -begin - simp [sub_eq_add_neg], - rw [neg_eq_neg_one_mul, ← mul_div_assoc, div_add_div _ _ hb hd, - ← mul_assoc, mul_comm b, mul_assoc, ← neg_eq_neg_one_mul] -end - -lemma mul_eq_mul_of_div_eq_div (a : α) {b : α} (c : α) {d : α} (hb : b ≠ 0) - (hd : d ≠ 0) (h : a / b = c / d) : a * d = c * b := -by rw [← mul_one (a*d), mul_assoc, mul_comm d, ← mul_assoc, ← div_self hb, - ← div_mul_eq_mul_div_comm, h, div_mul_eq_mul_div, div_mul_cancel _ hd] - -lemma div_div_eq_div_mul (a b c : α) : - (a / b) / c = a / (b * c) := -by rw [div_eq_mul_one_div, div_mul_div, mul_one] - -lemma div_div_div_div_eq (a : α) {b c d : α} : - (a / b) / (c / d) = (a * d) / (b * c) := -by rw [div_div_eq_mul_div, div_mul_eq_mul_div, - div_div_eq_div_mul] - -lemma div_mul_eq_div_mul_one_div (a b c : α) : - a / (b * c) = (a / b) * (1 / c) := -by rw [← div_div_eq_div_mul, ← div_eq_mul_one_div] - -end field diff --git a/library/init/algebra/functions.lean b/library/init/algebra/functions.lean index 993dc44770..7b0f436ee0 100644 --- a/library/init/algebra/functions.lean +++ b/library/init/algebra/functions.lean @@ -4,13 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Leonardo de Moura -/ prelude -import init.algebra.ordered_field + +import init.algebra.order init.meta universe u definition min {α : Type u} [decidable_linear_order α] (a b : α) : α := if a ≤ b then a else b definition max {α : Type u} [decidable_linear_order α] (a b : α) : α := if a ≤ b then b else a -definition abs {α : Type u} [decidable_linear_ordered_add_comm_group α] (a : α) : α := max a (-a) section open decidable tactic @@ -128,357 +128,3 @@ or.elim (le_or_gt a b) (assume h : a ≤ b, by min_tac a b) (assume h : a > b, by min_tac a b) end - - -section -variables {α : Type u} [decidable_linear_ordered_cancel_add_comm_monoid α] - -lemma min_add_add_left (a b c : α) : min (a + b) (a + c) = a + min b c := -eq.symm (eq_min - (show a + min b c ≤ a + b, from add_le_add_left (min_le_left _ _) _) - (show a + min b c ≤ a + c, from add_le_add_left (min_le_right _ _) _) - (assume d, - assume : d ≤ a + b, - assume : d ≤ a + c, - decidable.by_cases - (assume : b ≤ c, by rwa [min_eq_left this]) - (assume : ¬ b ≤ c, by rwa [min_eq_right (le_of_lt (lt_of_not_ge this))]))) - -lemma min_add_add_right (a b c : α) : min (a + c) (b + c) = min a b + c := -begin rw [add_comm a c, add_comm b c, add_comm _ c], apply min_add_add_left end - -lemma max_add_add_left (a b c : α) : max (a + b) (a + c) = a + max b c := -eq.symm (eq_max - (add_le_add_left (le_max_left _ _) _) - (add_le_add_left (le_max_right _ _) _) - (assume d, - assume : a + b ≤ d, - assume : a + c ≤ d, - decidable.by_cases - (assume : b ≤ c, by rwa [max_eq_right this]) - (assume : ¬ b ≤ c, by rwa [max_eq_left (le_of_lt (lt_of_not_ge this))]))) - -lemma max_add_add_right (a b c : α) : max (a + c) (b + c) = max a b + c := -begin rw [add_comm a c, add_comm b c, add_comm _ c], apply max_add_add_left end -end - -section -variables {α : Type u} [decidable_linear_ordered_add_comm_group α] - -lemma max_neg_neg (a b : α) : max (-a) (-b) = - min a b := -eq.symm (eq_max - (show -a ≤ -(min a b), from neg_le_neg $ min_le_left a b) - (show -b ≤ -(min a b), from neg_le_neg $ min_le_right a b) - (assume d, - assume H₁ : -a ≤ d, - assume H₂ : -b ≤ d, - have H : -d ≤ min a b, - from le_min (neg_le_of_neg_le H₁) (neg_le_of_neg_le H₂), - show -(min a b) ≤ d, from neg_le_of_neg_le H)) - -lemma min_eq_neg_max_neg_neg (a b : α) : min a b = - max (-a) (-b) := -by rw [max_neg_neg, neg_neg] - -lemma min_neg_neg (a b : α) : min (-a) (-b) = - max a b := -by rw [min_eq_neg_max_neg_neg, neg_neg, neg_neg] - -lemma max_eq_neg_min_neg_neg (a b : α) : max a b = - min (-a) (-b) := -by rw [min_neg_neg, neg_neg] -end - -section decidable_linear_ordered_add_comm_group -variables {α : Type u} [decidable_linear_ordered_add_comm_group α] - -lemma abs_of_nonneg {a : α} (h : a ≥ 0) : abs a = a := -have h' : -a ≤ a, from le_trans (neg_nonpos_of_nonneg h) h, -max_eq_left h' - -lemma abs_of_pos {a : α} (h : a > 0) : abs a = a := -abs_of_nonneg (le_of_lt h) - -lemma abs_of_nonpos {a : α} (h : a ≤ 0) : abs a = -a := -have h' : a ≤ -a, from le_trans h (neg_nonneg_of_nonpos h), -max_eq_right h' - -lemma abs_of_neg {a : α} (h : a < 0) : abs a = -a := -abs_of_nonpos (le_of_lt h) - -lemma abs_zero : abs 0 = (0:α) := -abs_of_nonneg (le_refl _) - -lemma abs_neg (a : α) : abs (-a) = abs a := -begin unfold abs, rw [max_comm, neg_neg] end - -lemma abs_pos_of_pos {a : α} (h : a > 0) : abs a > 0 := -by rwa (abs_of_pos h) - -lemma abs_pos_of_neg {a : α} (h : a < 0) : abs a > 0 := -abs_neg a ▸ abs_pos_of_pos (neg_pos_of_neg h) - -lemma abs_sub (a b : α) : abs (a - b) = abs (b - a) := -by rw [← neg_sub, abs_neg] - -lemma ne_zero_of_abs_ne_zero {a : α} (h : abs a ≠ 0) : a ≠ 0 := -assume ha, h (eq.symm ha ▸ abs_zero) - -/- these assume a linear order -/ - -lemma eq_zero_of_neg_eq {a : α} (h : -a = a) : a = 0 := -match lt_trichotomy a 0 with -| or.inl h₁ := - have a > 0, from h ▸ neg_pos_of_neg h₁, - absurd h₁ (lt_asymm this) -| or.inr (or.inl h₁) := h₁ -| or.inr (or.inr h₁) := - have a < 0, from h ▸ neg_neg_of_pos h₁, - absurd h₁ (lt_asymm this) -end - -lemma abs_nonneg (a : α) : abs a ≥ 0 := -or.elim (le_total 0 a) - (assume h : 0 ≤ a, by rwa (abs_of_nonneg h)) - (assume h : a ≤ 0, calc - 0 ≤ -a : neg_nonneg_of_nonpos h - ... = abs a : eq.symm (abs_of_nonpos h)) - -lemma abs_abs (a : α) : abs (abs a) = abs a := -abs_of_nonneg $ abs_nonneg a - -lemma le_abs_self (a : α) : a ≤ abs a := -or.elim (le_total 0 a) - (assume h : 0 ≤ a, - begin rw [abs_of_nonneg h] end) - (assume h : a ≤ 0, le_trans h $ abs_nonneg a) - -lemma neg_le_abs_self (a : α) : -a ≤ abs a := -abs_neg a ▸ le_abs_self (-a) - -lemma eq_zero_of_abs_eq_zero {a : α} (h : abs a = 0) : a = 0 := -have h₁ : a ≤ 0, from h ▸ le_abs_self a, -have h₂ : -a ≤ 0, from h ▸ abs_neg a ▸ le_abs_self (-a), -le_antisymm h₁ (nonneg_of_neg_nonpos h₂) - -lemma eq_of_abs_sub_eq_zero {a b : α} (h : abs (a - b) = 0) : a = b := -have a - b = 0, from eq_zero_of_abs_eq_zero h, -show a = b, from eq_of_sub_eq_zero this - -lemma abs_pos_of_ne_zero {a : α} (h : a ≠ 0) : abs a > 0 := -or.elim (lt_or_gt_of_ne h) abs_pos_of_neg abs_pos_of_pos - -lemma abs_by_cases (P : α → Prop) {a : α} (h1 : P a) (h2 : P (-a)) : P (abs a) := -or.elim (le_total 0 a) - (assume h : 0 ≤ a, eq.symm (abs_of_nonneg h) ▸ h1) - (assume h : a ≤ 0, eq.symm (abs_of_nonpos h) ▸ h2) - -lemma abs_le_of_le_of_neg_le {a b : α} (h1 : a ≤ b) (h2 : -a ≤ b) : abs a ≤ b := -abs_by_cases (λ x : α, x ≤ b) h1 h2 - -lemma abs_lt_of_lt_of_neg_lt {a b : α} (h1 : a < b) (h2 : -a < b) : abs a < b := -abs_by_cases (λ x : α, x < b) h1 h2 - -private lemma aux1 {a b : α} (h1 : a + b ≥ 0) (h2 : a ≥ 0) : abs (a + b) ≤ abs a + abs b := -decidable.by_cases - (assume h3 : b ≥ 0, calc - abs (a + b) ≤ abs (a + b) : by apply le_refl - ... = a + b : by rw (abs_of_nonneg h1) - ... = abs a + b : by rw (abs_of_nonneg h2) - ... = abs a + abs b : by rw (abs_of_nonneg h3)) - (assume h3 : ¬ b ≥ 0, - have h4 : b ≤ 0, from le_of_lt (lt_of_not_ge h3), - calc - abs (a + b) = a + b : by rw (abs_of_nonneg h1) - ... = abs a + b : by rw (abs_of_nonneg h2) - ... ≤ abs a + 0 : add_le_add_left h4 _ - ... ≤ abs a + -b : add_le_add_left (neg_nonneg_of_nonpos h4) _ - ... = abs a + abs b : by rw (abs_of_nonpos h4)) - -private lemma aux2 {a b : α} (h1 : a + b ≥ 0) : abs (a + b) ≤ abs a + abs b := -or.elim (le_total b 0) - (assume h2 : b ≤ 0, - have h3 : ¬ a < 0, from - assume h4 : a < 0, - have h5 : a + b < 0, - begin - have aux := add_lt_add_of_lt_of_le h4 h2, - rwa [add_zero] at aux - end, - not_lt_of_ge h1 h5, - aux1 h1 (le_of_not_gt h3)) - (assume h2 : 0 ≤ b, - begin - have h3 : abs (b + a) ≤ abs b + abs a, - begin - rw add_comm at h1, - exact aux1 h1 h2 - end, - rw [add_comm, add_comm (abs a)], - exact h3 - end) - -lemma abs_add_le_abs_add_abs (a b : α) : abs (a + b) ≤ abs a + abs b := -or.elim (le_total 0 (a + b)) - (assume h2 : 0 ≤ a + b, aux2 h2) - (assume h2 : a + b ≤ 0, - have h3 : -a + -b = -(a + b), by rw neg_add, - have h4 : -(a + b) ≥ 0, from neg_nonneg_of_nonpos h2, - have h5 : -a + -b ≥ 0, begin rw [← h3] at h4, exact h4 end, - calc - abs (a + b) = abs (-a + -b) : by rw [← abs_neg, neg_add] - ... ≤ abs (-a) + abs (-b) : aux2 h5 - ... = abs a + abs b : by rw [abs_neg, abs_neg]) - -lemma abs_sub_abs_le_abs_sub (a b : α) : abs a - abs b ≤ abs (a - b) := -have h1 : abs a - abs b + abs b ≤ abs (a - b) + abs b, from -calc - abs a - abs b + abs b = abs a : by rw sub_add_cancel - ... = abs (a - b + b) : by rw sub_add_cancel - ... ≤ abs (a - b) + abs b : by apply abs_add_le_abs_add_abs, -le_of_add_le_add_right h1 - -lemma abs_sub_le (a b c : α) : abs (a - c) ≤ abs (a - b) + abs (b - c) := -calc - abs (a - c) = abs (a - b + (b - c)) : by rw [sub_eq_add_neg, sub_eq_add_neg, sub_eq_add_neg, - add_assoc, neg_add_cancel_left] - ... ≤ abs (a - b) + abs (b - c) : by apply abs_add_le_abs_add_abs - -lemma abs_add_three (a b c : α) : abs (a + b + c) ≤ abs a + abs b + abs c := -begin - apply le_trans, - apply abs_add_le_abs_add_abs, - apply le_trans, - apply add_le_add_right, - apply abs_add_le_abs_add_abs, - apply le_refl -end - -lemma dist_bdd_within_interval {a b lb ub : α} (h : lb < ub) (hal : lb ≤ a) (hau : a ≤ ub) - (hbl : lb ≤ b) (hbu : b ≤ ub) : abs (a - b) ≤ ub - lb := -begin - cases (decidable.em (b ≤ a)) with hba hba, - rw (abs_of_nonneg (sub_nonneg_of_le hba)), - apply sub_le_sub, - apply hau, - apply hbl, - rw [abs_of_neg (sub_neg_of_lt (lt_of_not_ge hba)), neg_sub], - apply sub_le_sub, - apply hbu, - apply hal -end - -end decidable_linear_ordered_add_comm_group - - -section decidable_linear_ordered_comm_ring -variables {α : Type u} [decidable_linear_ordered_comm_ring α] - -lemma abs_mul (a b : α) : abs (a * b) = abs a * abs b := -or.elim (le_total 0 a) - (assume h1 : 0 ≤ a, - or.elim (le_total 0 b) - (assume h2 : 0 ≤ b, - calc - abs (a * b) = a * b : abs_of_nonneg (mul_nonneg h1 h2) - ... = abs a * b : by rw (abs_of_nonneg h1) - ... = abs a * abs b : by rw (abs_of_nonneg h2)) - (assume h2 : b ≤ 0, - calc - abs (a * b) = -(a * b) : abs_of_nonpos (mul_nonpos_of_nonneg_of_nonpos h1 h2) - ... = a * -b : by rw neg_mul_eq_mul_neg - ... = abs a * -b : by rw (abs_of_nonneg h1) - ... = abs a * abs b : by rw (abs_of_nonpos h2))) - (assume h1 : a ≤ 0, - or.elim (le_total 0 b) - (assume h2 : 0 ≤ b, - calc - abs (a * b) = -(a * b) : abs_of_nonpos (mul_nonpos_of_nonpos_of_nonneg h1 h2) - ... = -a * b : by rw neg_mul_eq_neg_mul - ... = abs a * b : by rw (abs_of_nonpos h1) - ... = abs a * abs b : by rw (abs_of_nonneg h2)) - (assume h2 : b ≤ 0, - calc - abs (a * b) = a * b : abs_of_nonneg (mul_nonneg_of_nonpos_of_nonpos h1 h2) - ... = -a * -b : by rw neg_mul_neg - ... = abs a * -b : by rw (abs_of_nonpos h1) - ... = abs a * abs b : by rw (abs_of_nonpos h2))) - - -lemma abs_mul_abs_self (a : α) : abs a * abs a = a * a := -abs_by_cases (λ x, x * x = a * a) rfl (neg_mul_neg a a) - -lemma abs_mul_self (a : α) : abs (a * a) = a * a := -by rw [abs_mul, abs_mul_abs_self] - -lemma sub_le_of_abs_sub_le_left {a b c : α} (h : abs (a - b) ≤ c) : b - c ≤ a := -if hz : 0 ≤ a - b then - (calc - a ≥ b : le_of_sub_nonneg hz - ... ≥ b - c : sub_le_self _ (le_trans (abs_nonneg _) h)) -else - have habs : b - a ≤ c, by rwa [abs_of_neg (lt_of_not_ge hz), neg_sub] at h, - have habs' : b ≤ c + a, from le_add_of_sub_right_le habs, - sub_left_le_of_le_add habs' - -lemma sub_le_of_abs_sub_le_right {a b c : α} (h : abs (a - b) ≤ c) : a - c ≤ b := -sub_le_of_abs_sub_le_left (abs_sub a b ▸ h) - -lemma sub_lt_of_abs_sub_lt_left {a b c : α} (h : abs (a - b) < c) : b - c < a := -if hz : 0 ≤ a - b then - (calc - a ≥ b : le_of_sub_nonneg hz - ... > b - c : sub_lt_self _ (lt_of_le_of_lt (abs_nonneg _) h)) -else - have habs : b - a < c, by rwa [abs_of_neg (lt_of_not_ge hz), neg_sub] at h, - have habs' : b < c + a, from lt_add_of_sub_right_lt habs, - sub_left_lt_of_lt_add habs' - - -lemma sub_lt_of_abs_sub_lt_right {a b c : α} (h : abs (a - b) < c) : a - c < b := -sub_lt_of_abs_sub_lt_left (abs_sub a b ▸ h) - -lemma abs_sub_square (a b : α) : abs (a - b) * abs (a - b) = a * a + b * b - (1 + 1) * a * b := -begin - rw abs_mul_abs_self, - simp [left_distrib, right_distrib, add_assoc, add_comm, add_left_comm, mul_comm, sub_eq_add_neg] -end - -lemma eq_zero_of_mul_self_add_mul_self_eq_zero {x y : α} (h : x * x + y * y = 0) : x = 0 := -have x * x ≤ (0 : α), from calc - x * x ≤ x * x + y * y : le_add_of_nonneg_right (mul_self_nonneg y) - ... = 0 : h, -eq_zero_of_mul_self_eq_zero (le_antisymm this (mul_self_nonneg x)) - -lemma abs_abs_sub_abs_le_abs_sub (a b : α) : abs (abs a - abs b) ≤ abs (a - b) := -begin - apply nonneg_le_nonneg_of_squares_le, - apply abs_nonneg, - iterate {rw abs_sub_square}, - iterate {rw abs_mul_abs_self}, - apply sub_le_sub_left, - iterate {rw mul_assoc}, - apply mul_le_mul_of_nonneg_left, - rw [← abs_mul], - apply le_abs_self, - apply le_of_lt, - apply add_pos, - apply zero_lt_one, - apply zero_lt_one -end - -end decidable_linear_ordered_comm_ring - -section discrete_linear_ordered_field -variables {α : Type u} [discrete_linear_ordered_field α] - -lemma abs_div (a b : α) : abs (a / b) = abs a / abs b := -decidable.by_cases - (assume h : b = 0, by rw [h, abs_zero, div_zero, div_zero, abs_zero]) - (assume h : b ≠ 0, - have h₁ : abs b ≠ 0, from - assume h₂, h (eq_zero_of_abs_eq_zero h₂), - eq_div_of_mul_eq _ _ h₁ - (show abs (a / b) * abs b = abs a, by rw [← abs_mul, div_mul_cancel _ h])) - -lemma abs_one_div (a : α) : abs (1 / a) = 1 / abs a := -by rw [abs_div, abs_of_nonneg (zero_le_one : 1 ≥ (0 : α))] - -end discrete_linear_ordered_field diff --git a/library/init/algebra/group.lean b/library/init/algebra/group.lean deleted file mode 100644 index f78268c2f7..0000000000 --- a/library/init/algebra/group.lean +++ /dev/null @@ -1,436 +0,0 @@ -/- -Copyright (c) 2016 Microsoft Corporation. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jeremy Avigad, Leonardo de Moura --/ -prelude -import init.logic init.algebra.classes init.meta init.meta.decl_cmds init.meta.smt.rsimp - -/- Make sure instances defined in this file have lower priority than the ones - defined for concrete structures -/ -set_option default_priority 100 - -set_option old_structure_cmd true - -universe u -variables {α : Type u} - -class semigroup (α : Type u) extends has_mul α := -(mul_assoc : ∀ a b c : α, a * b * c = a * (b * c)) - -class comm_semigroup (α : Type u) extends semigroup α := -(mul_comm : ∀ a b : α, a * b = b * a) - -class left_cancel_semigroup (α : Type u) extends semigroup α := -(mul_left_cancel : ∀ a b c : α, a * b = a * c → b = c) - -class right_cancel_semigroup (α : Type u) extends semigroup α := -(mul_right_cancel : ∀ a b c : α, a * b = c * b → a = c) - -class monoid (α : Type u) extends semigroup α, has_one α := -(one_mul : ∀ a : α, 1 * a = a) (mul_one : ∀ a : α, a * 1 = a) - -class comm_monoid (α : Type u) extends monoid α, comm_semigroup α - -class group (α : Type u) extends monoid α, has_inv α := -(mul_left_inv : ∀ a : α, a⁻¹ * a = 1) - -class comm_group (α : Type u) extends group α, comm_monoid α - -lemma mul_assoc [semigroup α] : ∀ a b c : α, a * b * c = a * (b * c) := -semigroup.mul_assoc - -instance semigroup_to_is_associative [semigroup α] : is_associative α (*) := -⟨mul_assoc⟩ - -lemma mul_comm [comm_semigroup α] : ∀ a b : α, a * b = b * a := -comm_semigroup.mul_comm - -instance comm_semigroup_to_is_commutative [comm_semigroup α] : is_commutative α (*) := -⟨mul_comm⟩ - -lemma mul_left_comm [comm_semigroup α] : ∀ a b c : α, a * (b * c) = b * (a * c) := -left_comm has_mul.mul mul_comm mul_assoc - -local attribute [simp] mul_assoc - -lemma mul_right_comm [comm_semigroup α] : ∀ a b c : α, a * b * c = a * c * b := -right_comm has_mul.mul mul_comm mul_assoc - -lemma mul_left_cancel [left_cancel_semigroup α] {a b c : α} : a * b = a * c → b = c := -left_cancel_semigroup.mul_left_cancel a b c - -lemma mul_right_cancel [right_cancel_semigroup α] {a b c : α} : a * b = c * b → a = c := -right_cancel_semigroup.mul_right_cancel a b c - -lemma mul_left_cancel_iff [left_cancel_semigroup α] {a b c : α} : a * b = a * c ↔ b = c := -⟨mul_left_cancel, congr_arg _⟩ - -lemma mul_right_cancel_iff [right_cancel_semigroup α] {a b c : α} : b * a = c * a ↔ b = c := -⟨mul_right_cancel, congr_arg _⟩ - -@[simp] lemma one_mul [monoid α] : ∀ a : α, 1 * a = a := -monoid.one_mul - -@[simp] lemma mul_one [monoid α] : ∀ a : α, a * 1 = a := -monoid.mul_one - -@[simp] lemma mul_left_inv [group α] : ∀ a : α, a⁻¹ * a = 1 := -group.mul_left_inv - -def inv_mul_self := @mul_left_inv - -@[simp] lemma inv_mul_cancel_left [group α] (a b : α) : a⁻¹ * (a * b) = b := -by rw [← mul_assoc, mul_left_inv, one_mul] - -@[simp] lemma inv_mul_cancel_right [group α] (a b : α) : a * b⁻¹ * b = a := -by simp - -@[simp] lemma inv_eq_of_mul_eq_one [group α] {a b : α} (h : a * b = 1) : a⁻¹ = b := -by rw [← mul_one a⁻¹, ←h, ←mul_assoc, mul_left_inv, one_mul] - -@[simp] lemma one_inv [group α] : 1⁻¹ = (1 : α) := -inv_eq_of_mul_eq_one (one_mul 1) - -@[simp] lemma inv_inv [group α] (a : α) : (a⁻¹)⁻¹ = a := -inv_eq_of_mul_eq_one (mul_left_inv a) - -@[simp] lemma mul_right_inv [group α] (a : α) : a * a⁻¹ = 1 := -have a⁻¹⁻¹ * a⁻¹ = 1, by rw mul_left_inv, -by rwa [inv_inv] at this - -def mul_inv_self := @mul_right_inv - -lemma inv_inj [group α] {a b : α} (h : a⁻¹ = b⁻¹) : a = b := -have a = a⁻¹⁻¹, by simp, -begin rw this, simp [h] end - -lemma group.mul_left_cancel [group α] {a b c : α} (h : a * b = a * c) : b = c := -have a⁻¹ * (a * b) = b, by simp, -begin simp [h] at this, rw this end - -lemma group.mul_right_cancel [group α] {a b c : α} (h : a * b = c * b) : a = c := -have a * b * b⁻¹ = a, by simp, -begin simp [h] at this, rw this end - -instance group.to_left_cancel_semigroup [s : group α] : left_cancel_semigroup α := -{ mul_left_cancel := @group.mul_left_cancel α s, ..s } - -instance group.to_right_cancel_semigroup [s : group α] : right_cancel_semigroup α := -{ mul_right_cancel := @group.mul_right_cancel α s, ..s } - -lemma mul_inv_cancel_left [group α] (a b : α) : a * (a⁻¹ * b) = b := -by rw [← mul_assoc, mul_right_inv, one_mul] - -lemma mul_inv_cancel_right [group α] (a b : α) : a * b * b⁻¹ = a := -by rw [mul_assoc, mul_right_inv, mul_one] - -@[simp] lemma mul_inv_rev [group α] (a b : α) : (a * b)⁻¹ = b⁻¹ * a⁻¹ := -inv_eq_of_mul_eq_one begin rw [mul_assoc, ← mul_assoc b, mul_right_inv, one_mul, mul_right_inv] end - -lemma eq_inv_of_eq_inv [group α] {a b : α} (h : a = b⁻¹) : b = a⁻¹ := -by simp [h] - -lemma eq_inv_of_mul_eq_one [group α] {a b : α} (h : a * b = 1) : a = b⁻¹ := -have a⁻¹ = b, from inv_eq_of_mul_eq_one h, -by simp [this.symm] - -lemma eq_mul_inv_of_mul_eq [group α] {a b c : α} (h : a * c = b) : a = b * c⁻¹ := -by simp [h.symm] - -lemma eq_inv_mul_of_mul_eq [group α] {a b c : α} (h : b * a = c) : a = b⁻¹ * c := -by simp [h.symm] - -lemma inv_mul_eq_of_eq_mul [group α] {a b c : α} (h : b = a * c) : a⁻¹ * b = c := -by simp [h] - -lemma mul_inv_eq_of_eq_mul [group α] {a b c : α} (h : a = c * b) : a * b⁻¹ = c := -by simp [h] - -lemma eq_mul_of_mul_inv_eq [group α] {a b c : α} (h : a * c⁻¹ = b) : a = b * c := -by simp [h.symm] - -lemma eq_mul_of_inv_mul_eq [group α] {a b c : α} (h : b⁻¹ * a = c) : a = b * c := -by simp [h.symm, mul_inv_cancel_left] - -lemma mul_eq_of_eq_inv_mul [group α] {a b c : α} (h : b = a⁻¹ * c) : a * b = c := -by rw [h, mul_inv_cancel_left] - -lemma mul_eq_of_eq_mul_inv [group α] {a b c : α} (h : a = c * b⁻¹) : a * b = c := -by simp [h] - -lemma mul_inv [comm_group α] (a b : α) : (a * b)⁻¹ = a⁻¹ * b⁻¹ := -by rw [mul_inv_rev, mul_comm] - -/- αdditive "sister" structures. - Example, add_semigroup mirrors semigroup. - These structures exist just to help automation. - In an alternative design, we could have the binary operation as an - extra argument for semigroup, monoid, group, etc. However, the lemmas - would be hard to index since they would not contain any constant. - For example, mul_assoc would be - - lemma mul_assoc {α : Type u} {op : α → α → α} [semigroup α op] : - ∀ a b c : α, op (op a b) c = op a (op b c) := - semigroup.mul_assoc - - The simplifier cannot effectively use this lemma since the pattern for - the left-hand-side would be - - ?op (?op ?a ?b) ?c - - Remark: we use a tactic for transporting theorems from the multiplicative fragment - to the additive one. --/ - -class add_semigroup (α : Type u) extends has_add α := -(add_assoc : ∀ a b c : α, a + b + c = a + (b + c)) - -class add_comm_semigroup (α : Type u) extends add_semigroup α := -(add_comm : ∀ a b : α, a + b = b + a) - -class add_left_cancel_semigroup (α : Type u) extends add_semigroup α := -(add_left_cancel : ∀ a b c : α, a + b = a + c → b = c) - -class add_right_cancel_semigroup (α : Type u) extends add_semigroup α := -(add_right_cancel : ∀ a b c : α, a + b = c + b → a = c) - -class add_monoid (α : Type u) extends add_semigroup α, has_zero α := -(zero_add : ∀ a : α, 0 + a = a) (add_zero : ∀ a : α, a + 0 = a) - -class add_comm_monoid (α : Type u) extends add_monoid α, add_comm_semigroup α - -class add_group (α : Type u) extends add_monoid α, has_neg α := -(add_left_neg : ∀ a : α, -a + a = 0) - -class add_comm_group (α : Type u) extends add_group α, add_comm_monoid α - -open tactic - -meta def transport_with_dict (dict : name_map name) (src : name) (tgt : name) : command := -copy_decl_using dict src tgt ->> copy_attribute `reducible src tgt tt ->> copy_attribute `simp src tgt tt ->> copy_attribute `instance src tgt tt - -/- Transport multiplicative to additive -/ -meta def transport_multiplicative_to_additive (ls : list (name × name)) : command := -let dict := native.rb_map.of_list ls in -ls.foldl (λ t ⟨src, tgt⟩, do - env ← get_env, - if (env.get tgt).to_bool = ff - then t >> transport_with_dict dict src tgt - else t) -skip - -run_cmd transport_multiplicative_to_additive - [/- map operations -/ - (`has_mul.mul, `has_add.add), (`has_one.one, `has_zero.zero), (`has_inv.inv, `has_neg.neg), - (`has_mul, `has_add), (`has_one, `has_zero), (`has_inv, `has_neg), - /- map constructors -/ - (`has_mul.mk, `has_add.mk), (`has_one, `has_zero.mk), (`has_inv, `has_neg.mk), - /- map structures -/ - (`semigroup, `add_semigroup), - (`monoid, `add_monoid), - (`group, `add_group), - (`comm_semigroup, `add_comm_semigroup), - (`comm_monoid, `add_comm_monoid), - (`comm_group, `add_comm_group), - (`left_cancel_semigroup, `add_left_cancel_semigroup), - (`right_cancel_semigroup, `add_right_cancel_semigroup), - (`left_cancel_semigroup.mk, `add_left_cancel_semigroup.mk), - (`right_cancel_semigroup.mk, `add_right_cancel_semigroup.mk), - /- map instances -/ - (`semigroup.to_has_mul, `add_semigroup.to_has_add), - (`monoid.to_has_one, `add_monoid.to_has_zero), - (`group.to_has_inv, `add_group.to_has_neg), - (`comm_semigroup.to_semigroup, `add_comm_semigroup.to_add_semigroup), - (`monoid.to_semigroup, `add_monoid.to_add_semigroup), - (`comm_monoid.to_monoid, `add_comm_monoid.to_add_monoid), - (`comm_monoid.to_comm_semigroup, `add_comm_monoid.to_add_comm_semigroup), - (`group.to_monoid, `add_group.to_add_monoid), - (`comm_group.to_group, `add_comm_group.to_add_group), - (`comm_group.to_comm_monoid, `add_comm_group.to_add_comm_monoid), - (`left_cancel_semigroup.to_semigroup, `add_left_cancel_semigroup.to_add_semigroup), - (`right_cancel_semigroup.to_semigroup, `add_right_cancel_semigroup.to_add_semigroup), - /- map projections -/ - (`semigroup.mul_assoc, `add_semigroup.add_assoc), - (`comm_semigroup.mul_comm, `add_comm_semigroup.add_comm), - (`left_cancel_semigroup.mul_left_cancel, `add_left_cancel_semigroup.add_left_cancel), - (`right_cancel_semigroup.mul_right_cancel, `add_right_cancel_semigroup.add_right_cancel), - (`monoid.one_mul, `add_monoid.zero_add), - (`monoid.mul_one, `add_monoid.add_zero), - (`group.mul_left_inv, `add_group.add_left_neg), - (`group.mul, `add_group.add), - (`group.mul_assoc, `add_group.add_assoc), - /- map lemmas -/ - (`mul_assoc, `add_assoc), - (`mul_comm, `add_comm), - (`mul_left_comm, `add_left_comm), - (`mul_right_comm, `add_right_comm), - (`one_mul, `zero_add), - (`mul_one, `add_zero), - (`mul_left_inv, `add_left_neg), - (`mul_left_cancel, `add_left_cancel), - (`mul_right_cancel, `add_right_cancel), - (`mul_left_cancel_iff, `add_left_cancel_iff), - (`mul_right_cancel_iff, `add_right_cancel_iff), - (`inv_mul_cancel_left, `neg_add_cancel_left), - (`inv_mul_cancel_right, `neg_add_cancel_right), - (`eq_inv_mul_of_mul_eq, `eq_neg_add_of_add_eq), - (`inv_eq_of_mul_eq_one, `neg_eq_of_add_eq_zero), - (`inv_inv, `neg_neg), - (`mul_right_inv, `add_right_neg), - (`mul_inv_cancel_left, `add_neg_cancel_left), - (`mul_inv_cancel_right, `add_neg_cancel_right), - (`mul_inv_rev, `neg_add_rev), - (`mul_inv, `neg_add), - (`inv_inj, `neg_inj), - (`group.mul_left_cancel, `add_group.add_left_cancel), - (`group.mul_right_cancel, `add_group.add_right_cancel), - (`group.to_left_cancel_semigroup, `add_group.to_left_cancel_add_semigroup), - (`group.to_right_cancel_semigroup, `add_group.to_right_cancel_add_semigroup), - (`eq_inv_of_eq_inv, `eq_neg_of_eq_neg), - (`eq_inv_of_mul_eq_one, `eq_neg_of_add_eq_zero), - (`eq_mul_inv_of_mul_eq, `eq_add_neg_of_add_eq), - (`inv_mul_eq_of_eq_mul, `neg_add_eq_of_eq_add), - (`mul_inv_eq_of_eq_mul, `add_neg_eq_of_eq_add), - (`eq_mul_of_mul_inv_eq, `eq_add_of_add_neg_eq), - (`eq_mul_of_inv_mul_eq, `eq_add_of_neg_add_eq), - (`mul_eq_of_eq_inv_mul, `add_eq_of_eq_neg_add), - (`mul_eq_of_eq_mul_inv, `add_eq_of_eq_add_neg), - (`one_inv, `neg_zero) -] - -instance add_semigroup_to_is_eq_associative [add_semigroup α] : is_associative α (+) := -⟨add_assoc⟩ - -instance add_comm_semigroup_to_is_eq_commutative [add_comm_semigroup α] : is_commutative α (+) := -⟨add_comm⟩ - -local attribute [simp] add_assoc add_comm add_left_comm - -def neg_add_self := @add_left_neg -def add_neg_self := @add_right_neg -def eq_of_add_eq_add_left := @add_left_cancel -def eq_of_add_eq_add_right := @add_right_cancel - -@[reducible] protected def algebra.sub [add_group α] (a b : α) : α := -a + -b - -instance add_group_has_sub [add_group α] : has_sub α := -⟨algebra.sub⟩ - -local attribute [simp] -lemma sub_eq_add_neg [add_group α] (a b : α) : a - b = a + -b := -rfl - -lemma sub_self [add_group α] (a : α) : a - a = 0 := -add_right_neg a - -lemma sub_add_cancel [add_group α] (a b : α) : a - b + b = a := -neg_add_cancel_right a b - -lemma add_sub_cancel [add_group α] (a b : α) : a + b - b = a := -add_neg_cancel_right a b - -lemma add_sub_assoc [add_group α] (a b c : α) : a + b - c = a + (b - c) := -by rw [sub_eq_add_neg, add_assoc, ←sub_eq_add_neg] - -lemma eq_of_sub_eq_zero [add_group α] {a b : α} (h : a - b = 0) : a = b := -have 0 + b = b, by rw zero_add, -have (a - b) + b = b, by rwa h, -by rwa [sub_eq_add_neg, neg_add_cancel_right] at this - -lemma sub_eq_zero_of_eq [add_group α] {a b : α} (h : a = b) : a - b = 0 := -by rw [h, sub_self] - -lemma sub_eq_zero_iff_eq [add_group α] {a b : α} : a - b = 0 ↔ a = b := -⟨eq_of_sub_eq_zero, sub_eq_zero_of_eq⟩ - -lemma zero_sub [add_group α] (a : α) : 0 - a = -a := -zero_add (-a) - -lemma sub_zero [add_group α] (a : α) : a - 0 = a := -by rw [sub_eq_add_neg, neg_zero, add_zero] - -lemma sub_ne_zero_of_ne [add_group α] {a b : α} (h : a ≠ b) : a - b ≠ 0 := -begin - intro hab, - apply h, - apply eq_of_sub_eq_zero hab -end - -lemma sub_neg_eq_add [add_group α] (a b : α) : a - (-b) = a + b := -by rw [sub_eq_add_neg, neg_neg] - -lemma neg_sub [add_group α] (a b : α) : -(a - b) = b - a := -neg_eq_of_add_eq_zero (by rw [sub_eq_add_neg, sub_eq_add_neg, add_assoc, neg_add_cancel_left, add_right_neg]) - -lemma add_sub [add_group α] (a b c : α) : a + (b - c) = a + b - c := -by simp - -lemma sub_add_eq_sub_sub_swap [add_group α] (a b c : α) : a - (b + c) = a - c - b := -by simp - -lemma add_sub_add_right_eq_sub [add_group α] (a b c : α) : (a + c) - (b + c) = a - b := -by rw [sub_add_eq_sub_sub_swap]; simp - -lemma eq_sub_of_add_eq [add_group α] {a b c : α} (h : a + c = b) : a = b - c := -by simp [h.symm] - -lemma sub_eq_of_eq_add [add_group α] {a b c : α} (h : a = c + b) : a - b = c := -by simp [h] - -lemma eq_add_of_sub_eq [add_group α] {a b c : α} (h : a - c = b) : a = b + c := -by simp [h.symm] - -lemma add_eq_of_eq_sub [add_group α] {a b c : α} (h : a = c - b) : a + b = c := -by simp [h] - -lemma sub_add_eq_sub_sub [add_comm_group α] (a b c : α) : a - (b + c) = a - b - c := -by simp - -lemma neg_add_eq_sub [add_comm_group α] (a b : α) : -a + b = b - a := -by simp - -lemma sub_add_eq_add_sub [add_comm_group α] (a b c : α) : a - b + c = a + c - b := -by simp - -lemma sub_sub [add_comm_group α] (a b c : α) : a - b - c = a - (b + c) := -by simp - -lemma sub_add [add_comm_group α] (a b c : α) : a - b + c = a - (b - c) := -by simp - -lemma add_sub_add_left_eq_sub [add_comm_group α] (a b c : α) : (c + a) - (c + b) = a - b := -by simp - -lemma eq_sub_of_add_eq' [add_comm_group α] {a b c : α} (h : c + a = b) : a = b - c := -by simp [h.symm] - -lemma sub_eq_of_eq_add' [add_comm_group α] {a b c : α} (h : a = b + c) : a - b = c := -begin simp [h], rw [add_left_comm], simp end - -lemma eq_add_of_sub_eq' [add_comm_group α] {a b c : α} (h : a - b = c) : a = b + c := -by simp [h.symm] - -lemma add_eq_of_eq_sub' [add_comm_group α] {a b c : α} (h : b = c - a) : a + b = c := -begin simp [h], rw [add_comm c, add_neg_cancel_left] end - -lemma sub_sub_self [add_comm_group α] (a b : α) : a - (a - b) = b := -begin simp, rw [add_comm b, add_neg_cancel_left] end - -lemma add_sub_comm [add_comm_group α] (a b c d : α) : a + b - (c + d) = (a - c) + (b - d) := -by simp - -lemma sub_eq_sub_add_sub [add_comm_group α] (a b c : α) : a - b = c - b + (a - c) := -begin simp, rw [add_left_comm c], simp end - -lemma neg_neg_sub_neg [add_comm_group α] (a b : α) : - (-a - -b) = a - b := -by simp - -/- The following lemmas generate too many instances for rsimp -/ -attribute [no_rsimp] - mul_assoc mul_comm mul_left_comm - add_assoc add_comm add_left_comm diff --git a/library/init/algebra/norm_num.lean b/library/init/algebra/norm_num.lean deleted file mode 100644 index 9721558d0c..0000000000 --- a/library/init/algebra/norm_num.lean +++ /dev/null @@ -1,268 +0,0 @@ -/- -Copyright (c) 2016 Microsoft Corporation. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Robert Lewis and Leonardo de Moura --/ -prelude -import init.algebra.field init.algebra.ordered_ring -import init.data.nat.lemmas - -namespace norm_num -universe u -variable {α : Type u} - -def add1 [has_add α] [has_one α] (a : α) : α := -a + 1 - -local attribute [reducible] bit0 bit1 add1 -local attribute [simp] right_distrib left_distrib sub_eq_add_neg - -private meta def u : tactic unit := -`[unfold bit0 bit1 add1] - -private meta def usimp : tactic unit := -u >> `[simp [add_comm, add_left_comm]] - -lemma mul_zero [mul_zero_class α] (a : α) : a * 0 = 0 := -by simp - -lemma zero_mul [mul_zero_class α] (a : α) : 0 * a = 0 := -by simp - -lemma mul_one [monoid α] (a : α) : a * 1 = a := -by simp - -lemma mul_bit0 [distrib α] (a b : α) : a * (bit0 b) = bit0 (a * b) := -by simp - -lemma mul_bit0_helper [distrib α] (a b t : α) (h : a * b = t) : a * (bit0 b) = bit0 t := -begin rw [← h], simp end - -lemma mul_bit1 [semiring α] (a b : α) : a * (bit1 b) = bit0 (a * b) + a := -by simp - -lemma mul_bit1_helper [semiring α] (a b s t : α) (hs : a * b = s) (ht : bit0 s + a = t) : - a * (bit1 b) = t := -by simp [hs, ht] - -lemma subst_into_prod [has_mul α] (l r tl tr t : α) (prl : l = tl) (prr : r = tr) (prt : tl * tr = t) : l * r = t := -by simp [prl, prr, prt] - -lemma mk_cong (op : α → α) (a b : α) (h : a = b) : op a = op b := -by simp [h] - -lemma neg_add_neg_eq_of_add_add_eq_zero [add_comm_group α] (a b c : α) (h : c + a + b = 0) : -a + -b = c := -begin - apply add_neg_eq_of_eq_add, - apply neg_eq_of_add_eq_zero, - simp [add_comm, add_left_comm] at h, simp [add_comm], assumption -end - -lemma neg_add_neg_helper [add_comm_group α] (a b c : α) (h : a + b = c) : -a + -b = -c := -begin apply @neg_inj α, simp [neg_add, neg_neg], assumption end - -lemma neg_add_pos_eq_of_eq_add [add_comm_group α] (a b c : α) (h : b = c + a) : -a + b = c := -begin apply neg_add_eq_of_eq_add, simp [add_comm] at h, assumption end - -lemma neg_add_pos_helper1 [add_comm_group α] (a b c : α) (h : b + c = a) : -a + b = -c := -begin apply neg_add_eq_of_eq_add, apply eq_add_neg_of_add_eq h end - -lemma neg_add_pos_helper2 [add_comm_group α] (a b c : α) (h : a + c = b) : -a + b = c := -begin apply neg_add_eq_of_eq_add, rw h end - -lemma pos_add_neg_helper [add_comm_group α] (a b c : α) (h : b + a = c) : a + b = c := -by rw [← h, add_comm a b] - -lemma subst_into_subtr [add_group α] (l r t : α) (h : l + -r = t) : l - r = t := -by simp [h] - -lemma neg_neg_helper [add_group α] (a b : α) (h : a = -b) : -a = b := -by simp [h] - -lemma neg_mul_neg_helper [ring α] (a b c : α) (h : a * b = c) : (-a) * (-b) = c := -by simp [h] - -lemma neg_mul_pos_helper [ring α] (a b c : α) (h : a * b = c) : (-a) * b = -c := -by simp [h] - -lemma pos_mul_neg_helper [ring α] (a b c : α) (h : a * b = c) : a * (-b) = -c := -by simp [h] - -lemma div_add_helper [field α] (n d b c val : α) (hd : d ≠ 0) (h : n + b * d = val) - (h2 : c * d = val) : n / d + b = c := -begin - apply eq_of_mul_eq_mul_of_nonzero_right hd, - rw [h2, ← h, right_distrib, div_mul_cancel _ hd] -end - -lemma add_div_helper [field α] (n d b c val : α) (hd : d ≠ 0) (h : d * b + n = val) - (h2 : d * c = val) : b + n / d = c := -begin - apply eq_of_mul_eq_mul_of_nonzero_left hd, - rw [h2, ← h, left_distrib, mul_div_cancel' _ hd] -end - -lemma div_mul_helper [field α] (n d c v : α) (h : (n * c) / d = v) : - (n / d) * c = v := -by rw [← h, div_mul_eq_mul_div_comm, mul_div_assoc] - -lemma mul_div_helper [field α] (a n d v : α) (hd : d ≠ 0) (h : (a * n) / d = v) : - a * (n / d) = v := -by rw [← h, mul_div_assoc] - -lemma nonzero_of_div_helper [field α] (a b : α) (ha : a ≠ 0) (hb : b ≠ 0) : a / b ≠ 0 := -begin - intro hab, - have habb : (a / b) * b = 0, rw [hab, zero_mul], - rw [div_mul_cancel _ hb] at habb, - exact ha habb -end - -lemma div_helper [field α] (n d v : α) (hd : d ≠ 0) (h : v * d = n) : n / d = v := -begin - apply eq_of_mul_eq_mul_of_nonzero_right hd, - rw (div_mul_cancel _ hd), - exact eq.symm h -end - -lemma div_eq_div_helper [field α] (a b c d v : α) (h1 : a * d = v) (h2 : c * b = v) - (hb : b ≠ 0) (hd : d ≠ 0) : a / b = c / d := -begin - apply eq_div_of_mul_eq, - exact hd, - rw div_mul_eq_mul_div, - apply eq.symm, - apply eq_div_of_mul_eq, - exact hb, - rw [h1, h2] -end - -lemma subst_into_div [has_div α] (a₁ b₁ a₂ b₂ v : α) (h : a₁ / b₁ = v) (h1 : a₂ = a₁) - (h2 : b₂ = b₁) : a₂ / b₂ = v := -by rw [h1, h2, h] - - -lemma add_comm_four [add_comm_semigroup α] (a b : α) : a + a + (b + b) = (a + b) + (a + b) := -by simp [add_left_comm] - -lemma add_comm_middle [add_comm_semigroup α] (a b c : α) : a + b + c = a + c + b := -by simp [add_comm, add_left_comm] - -lemma bit0_add_bit0 [add_comm_semigroup α] (a b : α) : bit0 a + bit0 b = bit0 (a + b) := -by usimp - -lemma bit0_add_bit0_helper [add_comm_semigroup α] (a b t : α) (h : a + b = t) : - bit0 a + bit0 b = bit0 t := -begin rw [← h], usimp end - -lemma bit1_add_bit0 [add_comm_semigroup α] [has_one α] (a b : α) : bit1 a + bit0 b = bit1 (a + b) := -by rw add_comm; usimp - -lemma bit1_add_bit0_helper [add_comm_semigroup α] [has_one α] (a b t : α) - (h : a + b = t) : bit1 a + bit0 b = bit1 t := -begin rw [← h, add_comm], usimp end - -lemma bit0_add_bit1 [add_comm_semigroup α] [has_one α] (a b : α) : - bit0 a + bit1 b = bit1 (a + b) := -by usimp - -lemma bit0_add_bit1_helper [add_comm_semigroup α] [has_one α] (a b t : α) - (h : a + b = t) : bit0 a + bit1 b = bit1 t := -begin rw [← h], usimp end - -lemma bit1_add_bit1 [add_comm_semigroup α] [has_one α] (a b : α) : - bit1 a + bit1 b = bit0 (add1 (a + b)) := -by usimp - -lemma bit1_add_bit1_helper [add_comm_semigroup α] [has_one α] (a b t s : α) - (h : (a + b) = t) (h2 : add1 t = s) : bit1 a + bit1 b = bit0 s := -begin rw [← h] at h2, rw [← h2], usimp end - -lemma bin_add_zero [add_monoid α] (a : α) : a + 0 = a := -by simp - -lemma bin_zero_add [add_monoid α] (a : α) : 0 + a = a := -by simp - -lemma one_add_bit0 [add_comm_semigroup α] [has_one α] (a : α) : 1 + bit0 a = bit1 a := -begin unfold bit0 bit1, simp [add_comm] end - -lemma bit0_add_one [has_add α] [has_one α] (a : α) : bit0 a + 1 = bit1 a := -rfl - -lemma bit1_add_one [has_add α] [has_one α] (a : α) : bit1 a + 1 = add1 (bit1 a) := -rfl - -lemma bit1_add_one_helper [has_add α] [has_one α] (a t : α) (h : add1 (bit1 a) = t) : - bit1 a + 1 = t := -by rw [← h] - -lemma one_add_bit1 [add_comm_semigroup α] [has_one α] (a : α) : 1 + bit1 a = add1 (bit1 a) := -begin unfold bit0 bit1 add1, simp [add_left_comm] end - -lemma one_add_bit1_helper [add_comm_semigroup α] [has_one α] (a t : α) - (h : add1 (bit1 a) = t) : 1 + bit1 a = t := -begin rw [← h], usimp end - -lemma add1_bit0 [has_add α] [has_one α] (a : α) : add1 (bit0 a) = bit1 a := -rfl - -lemma add1_bit1 [add_comm_semigroup α] [has_one α] (a : α) : - add1 (bit1 a) = bit0 (add1 a) := -by usimp - -lemma add1_bit1_helper [add_comm_semigroup α] [has_one α] (a t : α) (h : add1 a = t) : - add1 (bit1 a) = bit0 t := -begin rw [← h], usimp end - -lemma add1_one [has_add α] [has_one α] : add1 (1 : α) = bit0 1 := -rfl - -lemma add1_zero [add_monoid α] [has_one α] : add1 (0 : α) = 1 := -by usimp - -lemma one_add_one [has_add α] [has_one α] : (1 : α) + 1 = bit0 1 := -rfl - -lemma subst_into_sum [has_add α] (l r tl tr t : α) (prl : l = tl) (prr : r = tr) - (prt : tl + tr = t) : l + r = t := -by rw [← prt, prr, prl] - -lemma neg_zero_helper [add_group α] (a : α) (h : a = 0) : - a = 0 := -begin rw h, simp end - -lemma pos_bit0_helper [linear_ordered_semiring α] (a : α) (h : a > 0) : bit0 a > 0 := -begin u, apply add_pos h h end - -lemma nonneg_bit0_helper [linear_ordered_semiring α] (a : α) (h : a ≥ 0) : bit0 a ≥ 0 := -begin u, apply add_nonneg h h end - -lemma pos_bit1_helper [linear_ordered_semiring α] (a : α) (h : a ≥ 0) : bit1 a > 0 := -begin - u, - apply add_pos_of_nonneg_of_pos, - apply nonneg_bit0_helper _ h, - apply zero_lt_one -end - -lemma nonneg_bit1_helper [linear_ordered_semiring α] (a : α) (h : a ≥ 0) : bit1 a ≥ 0 := -begin apply le_of_lt, apply pos_bit1_helper _ h end - -lemma nonzero_of_pos_helper [linear_ordered_semiring α] (a : α) (h : a > 0) : a ≠ 0 := - ne_of_gt h - -lemma nonzero_of_neg_helper [linear_ordered_ring α] (a : α) (h : a ≠ 0) : -a ≠ 0 := -begin intro ha, apply h, apply neg_inj, rwa neg_zero end - -lemma sub_nat_zero_helper {a b c d: ℕ} (hac : a = c) (hbd : b = d) (hcd : c < d) : a - b = 0 := -begin - simp *, apply nat.sub_eq_zero_of_le, apply le_of_lt, assumption -end - -lemma sub_nat_pos_helper {a b c d e : ℕ} (hac : a = c) (hbd : b = d) (hced : e + d = c) : - a - b = e := -begin -simp *, rw [← hced, nat.add_sub_cancel] -end - -end norm_num diff --git a/library/init/algebra/ordered_field.lean b/library/init/algebra/ordered_field.lean deleted file mode 100644 index 5a76d27a7d..0000000000 --- a/library/init/algebra/ordered_field.lean +++ /dev/null @@ -1,441 +0,0 @@ -/- -Copyright (c) 2014 Robert Lewis. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Robert Lewis, Leonardo de Moura --/ -prelude -import init.algebra.ordered_ring init.algebra.field - -set_option old_structure_cmd true - -universe u - -class linear_ordered_field (α : Type u) extends linear_ordered_ring α, field α - -section linear_ordered_field -variables {α : Type u} [linear_ordered_field α] - -lemma mul_zero_lt_mul_inv_of_pos {a : α} (h : 0 < a) : a * 0 < a * (1 / a) := -calc a * 0 = 0 : by rw mul_zero - ... < 1 : zero_lt_one - ... = a * a⁻¹ : eq.symm (mul_inv_cancel (ne.symm (ne_of_lt h))) - ... = a * (1 / a) : by rw inv_eq_one_div - -lemma mul_zero_lt_mul_inv_of_neg {a : α} (h : a < 0) : a * 0 < a * (1 / a) := -calc a * 0 = 0 : by rw mul_zero - ... < 1 : zero_lt_one - ... = a * a⁻¹ : eq.symm (mul_inv_cancel (ne_of_lt h)) - ... = a * (1 / a) : by rw inv_eq_one_div - -lemma one_div_pos_of_pos {a : α} (h : 0 < a) : 0 < 1 / a := -lt_of_mul_lt_mul_left (mul_zero_lt_mul_inv_of_pos h) (le_of_lt h) - -lemma pos_of_one_div_pos {a : α} (h : 0 < 1 / a) : 0 < a := -one_div_one_div a ▸ one_div_pos_of_pos h - -lemma one_div_neg_of_neg {a : α} (h : a < 0) : 1 / a < 0 := -gt_of_mul_lt_mul_neg_left (mul_zero_lt_mul_inv_of_neg h) (le_of_lt h) - -lemma neg_of_one_div_neg {a : α} (h : 1 / a < 0) : a < 0 := -one_div_one_div a ▸ one_div_neg_of_neg h - -lemma le_mul_of_ge_one_right {a b : α} (hb : b ≥ 0) (h : a ≥ 1) : b ≤ b * a := -suffices b * 1 ≤ b * a, by rwa mul_one at this, -mul_le_mul_of_nonneg_left h hb - -lemma le_mul_of_ge_one_left {a b : α} (hb : b ≥ 0) (h : a ≥ 1) : b ≤ a * b := -by rw mul_comm; exact le_mul_of_ge_one_right hb h - -lemma lt_mul_of_gt_one_right {a b : α} (hb : b > 0) (h : a > 1) : b < b * a := -suffices b * 1 < b * a, by rwa mul_one at this, -mul_lt_mul_of_pos_left h hb - -lemma one_le_div_of_le (a : α) {b : α} (hb : b > 0) (h : b ≤ a) : 1 ≤ a / b := -have hb' : b ≠ 0, from ne.symm (ne_of_lt hb), -have hbinv : 1 / b > 0, from one_div_pos_of_pos hb, -calc - 1 = b * (1 / b) : eq.symm (mul_one_div_cancel hb') - ... ≤ a * (1 / b) : mul_le_mul_of_nonneg_right h (le_of_lt hbinv) - ... = a / b : eq.symm $ div_eq_mul_one_div a b - -lemma le_of_one_le_div (a : α) {b : α} (hb : b > 0) (h : 1 ≤ a / b) : b ≤ a := -have hb' : b ≠ 0, from ne.symm (ne_of_lt hb), -calc - b ≤ b * (a / b) : le_mul_of_ge_one_right (le_of_lt hb) h - ... = a : by rw [mul_div_cancel' _ hb'] - -lemma one_lt_div_of_lt (a : α) {b : α} (hb : b > 0) (h : b < a) : 1 < a / b := -have hb' : b ≠ 0, from ne.symm (ne_of_lt hb), -have hbinv : 1 / b > 0, from one_div_pos_of_pos hb, calc - 1 = b * (1 / b) : eq.symm (mul_one_div_cancel hb') - ... < a * (1 / b) : mul_lt_mul_of_pos_right h hbinv - ... = a / b : eq.symm $ div_eq_mul_one_div a b - -lemma lt_of_one_lt_div (a : α) {b : α} (hb : b > 0) (h : 1 < a / b) : b < a := -have hb' : b ≠ 0, from ne.symm (ne_of_lt hb), -calc - b < b * (a / b) : lt_mul_of_gt_one_right hb h - ... = a : by rw [mul_div_cancel' _ hb'] - --- the following lemmas amount to four iffs, for <, ≤, ≥, >. - -lemma mul_le_of_le_div {a b c : α} (hc : 0 < c) (h : a ≤ b / c) : a * c ≤ b := -div_mul_cancel b (ne.symm (ne_of_lt hc)) ▸ mul_le_mul_of_nonneg_right h (le_of_lt hc) - -lemma le_div_of_mul_le {a b c : α} (hc : 0 < c) (h : a * c ≤ b) : a ≤ b / c := -calc - a = a * c * (1 / c) : mul_mul_div a (ne.symm (ne_of_lt hc)) - ... ≤ b * (1 / c) : mul_le_mul_of_nonneg_right h (le_of_lt (one_div_pos_of_pos hc)) - ... = b / c : eq.symm $ div_eq_mul_one_div b c - -lemma mul_lt_of_lt_div {a b c : α} (hc : 0 < c) (h : a < b / c) : a * c < b := -div_mul_cancel b (ne.symm (ne_of_lt hc)) ▸ mul_lt_mul_of_pos_right h hc - -lemma lt_div_of_mul_lt {a b c : α} (hc : 0 < c) (h : a * c < b) : a < b / c := -calc - a = a * c * (1 / c) : mul_mul_div a (ne.symm (ne_of_lt hc)) - ... < b * (1 / c) : mul_lt_mul_of_pos_right h (one_div_pos_of_pos hc) - ... = b / c : eq.symm $ div_eq_mul_one_div b c - -lemma mul_le_of_div_le_of_neg {a b c : α} (hc : c < 0) (h : b / c ≤ a) : a * c ≤ b := -div_mul_cancel b (ne_of_lt hc) ▸ mul_le_mul_of_nonpos_right h (le_of_lt hc) - -lemma div_le_of_mul_le_of_neg {a b c : α} (hc : c < 0) (h : a * c ≤ b) : b / c ≤ a := -calc - a = a * c * (1 / c) : mul_mul_div a (ne_of_lt hc) - ... ≥ b * (1 / c) : mul_le_mul_of_nonpos_right h (le_of_lt (one_div_neg_of_neg hc)) - ... = b / c : eq.symm $ div_eq_mul_one_div b c - -lemma mul_lt_of_gt_div_of_neg {a b c : α} (hc : c < 0) (h : a > b / c) : a * c < b := -div_mul_cancel b (ne_of_lt hc) ▸ mul_lt_mul_of_neg_right h hc - -lemma div_lt_of_mul_lt_of_pos {a b c : α} (hc : c > 0) (h : b < a * c) : b / c < a := -calc - a = a * c * (1 / c) : mul_mul_div a (ne_of_gt hc) - ... > b * (1 / c) : mul_lt_mul_of_pos_right h (one_div_pos_of_pos hc) - ... = b / c : eq.symm $ div_eq_mul_one_div b c - -lemma div_lt_of_mul_gt_of_neg {a b c : α} (hc : c < 0) (h : a * c < b) : b / c < a := -calc - a = a * c * (1 / c) : mul_mul_div a (ne_of_lt hc) - ... > b * (1 / c) : mul_lt_mul_of_neg_right h (one_div_neg_of_neg hc) - ... = b / c : eq.symm $ div_eq_mul_one_div b c - -lemma div_le_of_le_mul {a b c : α} (hb : b > 0) (h : a ≤ b * c) : a / b ≤ c := -calc - a / b = a * (1 / b) : div_eq_mul_one_div a b - ... ≤ (b * c) * (1 / b) : mul_le_mul_of_nonneg_right h (le_of_lt (one_div_pos_of_pos hb)) - ... = (b * c) / b : eq.symm $ div_eq_mul_one_div (b * c) b - ... = c : by rw [mul_div_cancel_left _ (ne.symm (ne_of_lt hb))] - -lemma le_mul_of_div_le {a b c : α} (hc : c > 0) (h : a / c ≤ b) : a ≤ b * c := -calc - a = a / c * c : by rw (div_mul_cancel _ (ne.symm (ne_of_lt hc))) - ... ≤ b * c : mul_le_mul_of_nonneg_right h (le_of_lt hc) - - -- following these in the isabelle file, there are 8 biconditionals for the above with - signs - -- skipping for now - -lemma mul_sub_mul_div_mul_neg {a b c d : α} (hc : c ≠ 0) (hd : d ≠ 0) (h : a / c < b / d) : - (a * d - b * c) / (c * d) < 0 := -have h1 : a / c - b / d < 0, from calc - a / c - b / d < b / d - b / d : sub_lt_sub_right h _ - ... = 0 : by rw sub_self, -calc - 0 > a / c - b / d : h1 - ... = (a * d - c * b) / (c * d) : div_sub_div _ _ hc hd - ... = (a * d - b * c) / (c * d) : by rw (mul_comm b c) - -lemma mul_sub_mul_div_mul_nonpos {a b c d : α} (hc : c ≠ 0) (hd : d ≠ 0) (h : a / c ≤ b / d) : - (a * d - b * c) / (c * d) ≤ 0 := -have h1 : a / c - b / d ≤ 0, from calc - a / c - b / d ≤ b / d - b / d : sub_le_sub_right h _ - ... = 0 : by rw sub_self, -calc - 0 ≥ a / c - b / d : h1 - ... = (a * d - c * b) / (c * d) : div_sub_div _ _ hc hd - ... = (a * d - b * c) / (c * d) : by rw (mul_comm b c) - -lemma div_lt_div_of_mul_sub_mul_div_neg {a b c d : α} (hc : c ≠ 0) (hd : d ≠ 0) - (h : (a * d - b * c) / (c * d) < 0) : a / c < b / d := -have (a * d - c * b) / (c * d) < 0, by rwa [mul_comm c b], -have a / c - b / d < 0, by rwa [div_sub_div _ _ hc hd], -have a / c - b / d + b / d < 0 + b / d, from add_lt_add_right this _, -by rwa [zero_add, sub_eq_add_neg, neg_add_cancel_right] at this - - -lemma div_le_div_of_mul_sub_mul_div_nonpos {a b c d : α} (hc : c ≠ 0) (hd : d ≠ 0) - (h : (a * d - b * c) / (c * d) ≤ 0) : a / c ≤ b / d := -have (a * d - c * b) / (c * d) ≤ 0, by rwa [mul_comm c b], -have a / c - b / d ≤ 0, by rwa [div_sub_div _ _ hc hd], -have a / c - b / d + b / d ≤ 0 + b / d, from add_le_add_right this _, -by rwa [zero_add, sub_eq_add_neg, neg_add_cancel_right] at this - - -lemma div_pos_of_pos_of_pos {a b : α} : 0 < a → 0 < b → 0 < a / b := -begin - intros, - rw div_eq_mul_one_div, - apply mul_pos, - assumption, - apply one_div_pos_of_pos, - assumption -end - -lemma div_nonneg_of_nonneg_of_pos {a b : α} : 0 ≤ a → 0 < b → 0 ≤ a / b := -begin - intros, rw div_eq_mul_one_div, - apply mul_nonneg, assumption, - apply le_of_lt, - apply one_div_pos_of_pos, - assumption -end - -lemma div_neg_of_neg_of_pos {a b : α} : a < 0 → 0 < b → a / b < 0 := -begin - intros, rw div_eq_mul_one_div, - apply mul_neg_of_neg_of_pos, - assumption, - apply one_div_pos_of_pos, - assumption -end - -lemma div_nonpos_of_nonpos_of_pos {a b : α} : a ≤ 0 → 0 < b → a / b ≤ 0 := -begin - intros, rw div_eq_mul_one_div, - apply mul_nonpos_of_nonpos_of_nonneg, - assumption, - apply le_of_lt, - apply one_div_pos_of_pos, - assumption -end - -lemma div_neg_of_pos_of_neg {a b : α} : 0 < a → b < 0 → a / b < 0 := -begin - intros, rw div_eq_mul_one_div, - apply mul_neg_of_pos_of_neg, - assumption, - apply one_div_neg_of_neg, - assumption -end - -lemma div_nonpos_of_nonneg_of_neg {a b : α} : 0 ≤ a → b < 0 → a / b ≤ 0 := -begin - intros, rw div_eq_mul_one_div, - apply mul_nonpos_of_nonneg_of_nonpos, - assumption, - apply le_of_lt, - apply one_div_neg_of_neg, - assumption -end - -lemma div_pos_of_neg_of_neg {a b : α} : a < 0 → b < 0 → 0 < a / b := -begin - intros, rw div_eq_mul_one_div, - apply mul_pos_of_neg_of_neg, - assumption, - apply one_div_neg_of_neg, - assumption -end - -lemma div_nonneg_of_nonpos_of_neg {a b : α} : a ≤ 0 → b < 0 → 0 ≤ a / b := -begin - intros, rw div_eq_mul_one_div, - apply mul_nonneg_of_nonpos_of_nonpos, - assumption, - apply le_of_lt, - apply one_div_neg_of_neg, - assumption -end - -lemma div_lt_div_of_lt_of_pos {a b c : α} (h : a < b) (hc : 0 < c) : a / c < b / c := -begin - intros, - rw [div_eq_mul_one_div a c, div_eq_mul_one_div b c], - exact mul_lt_mul_of_pos_right h (one_div_pos_of_pos hc) -end - -lemma div_le_div_of_le_of_pos {a b c : α} (h : a ≤ b) (hc : 0 < c) : a / c ≤ b / c := -begin - rw [div_eq_mul_one_div a c, div_eq_mul_one_div b c], - exact mul_le_mul_of_nonneg_right h (le_of_lt (one_div_pos_of_pos hc)) -end - -lemma div_lt_div_of_lt_of_neg {a b c : α} (h : b < a) (hc : c < 0) : a / c < b / c := -begin - rw [div_eq_mul_one_div a c, div_eq_mul_one_div b c], - exact mul_lt_mul_of_neg_right h (one_div_neg_of_neg hc) -end - -lemma div_le_div_of_le_of_neg {a b c : α} (h : b ≤ a) (hc : c < 0) : a / c ≤ b / c := -begin - rw [div_eq_mul_one_div a c, div_eq_mul_one_div b c], - exact mul_le_mul_of_nonpos_right h (le_of_lt (one_div_neg_of_neg hc)) -end - -lemma add_halves (a : α) : a / 2 + a / 2 = a := -by { rw [div_add_div_same, ← two_mul, mul_div_cancel_left], exact two_ne_zero } - -lemma sub_self_div_two (a : α) : a - a / 2 = a / 2 := -suffices a / 2 + a / 2 - a / 2 = a / 2, by rwa add_halves at this, -by rw [add_sub_cancel] - -lemma add_midpoint {a b : α} (h : a < b) : a + (b - a) / 2 < b := -begin - rw [← div_sub_div_same, sub_eq_add_neg, add_comm (b/2), ← add_assoc, ← sub_eq_add_neg], - apply add_lt_of_lt_sub_right, - rw [sub_self_div_two, sub_self_div_two], - apply div_lt_div_of_lt_of_pos h two_pos -end - -lemma div_two_sub_self (a : α) : a / 2 - a = - (a / 2) := -suffices a / 2 - (a / 2 + a / 2) = - (a / 2), by rwa add_halves at this, -by rw [sub_add_eq_sub_sub, sub_self, zero_sub] - -lemma add_self_div_two (a : α) : (a + a) / 2 = a := -eq.symm - (iff.mpr (eq_div_iff_mul_eq _ _ (ne_of_gt (add_pos (@zero_lt_one α _) zero_lt_one))) - (begin unfold bit0, rw [left_distrib, mul_one] end)) - -lemma mul_le_mul_of_mul_div_le {a b c d : α} (h : a * (b / c) ≤ d) (hc : c > 0) : b * a ≤ d * c := -begin - rw [← mul_div_assoc] at h, rw [mul_comm b], - apply le_mul_of_div_le hc h -end - -lemma div_two_lt_of_pos {a : α} (h : a > 0) : a / 2 < a := -suffices a / (1 + 1) < a, begin unfold bit0, assumption end, -have ha : a / 2 > 0, from div_pos_of_pos_of_pos h (add_pos zero_lt_one zero_lt_one), -calc - a / 2 < a / 2 + a / 2 : lt_add_of_pos_left _ ha - ... = a : add_halves a - -lemma div_mul_le_div_mul_of_div_le_div_pos {a b c d e : α} (h : a / b ≤ c / d) - (he : e > 0) : a / (b * e) ≤ c / (d * e) := -begin - have h₁ := div_mul_eq_div_mul_one_div a b e, - have h₂ := div_mul_eq_div_mul_one_div c d e, - rw [h₁, h₂], - apply mul_le_mul_of_nonneg_right h, - apply le_of_lt, - apply one_div_pos_of_pos he -end - -lemma exists_add_lt_and_pos_of_lt {a b : α} (h : b < a) : ∃ c : α, b + c < a ∧ c > 0 := -begin - apply exists.intro ((a - b) / (1 + 1)), - split, - {have h2 : a + a > (b + b) + (a - b), - calc - a + a > b + a : add_lt_add_right h _ - ... = b + a + b - b : by rw add_sub_cancel - ... = b + b + a - b : by simp [add_comm, add_left_comm] - ... = (b + b) + (a - b) : by rw add_sub, - have h3 : (a + a) / 2 > ((b + b) + (a - b)) / 2, - exact div_lt_div_of_lt_of_pos h2 two_pos, - rw [one_add_one_eq_two, sub_eq_add_neg], - rw [add_self_div_two, ← div_add_div_same, add_self_div_two, sub_eq_add_neg] at h3, - exact h3}, - exact div_pos_of_pos_of_pos (sub_pos_of_lt h) two_pos -end - -lemma ge_of_forall_ge_sub {a b : α} (h : ∀ ε : α, ε > 0 → a ≥ b - ε) : a ≥ b := -begin - apply le_of_not_gt, - intro hb, - cases exists_add_lt_and_pos_of_lt hb with c hc, - have hc' := h c (and.right hc), - apply (not_le_of_gt (and.left hc)) (le_add_of_sub_right_le hc') -end - -lemma one_div_lt_one_div_of_lt {a b : α} (ha : 0 < a) (h : a < b) : 1 / b < 1 / a := -begin - apply lt_div_of_mul_lt ha, - rw [mul_comm, ← div_eq_mul_one_div], - apply div_lt_of_mul_lt_of_pos (lt_trans ha h), - rwa [one_mul] -end - -lemma one_div_le_one_div_of_le {a b : α} (ha : 0 < a) (h : a ≤ b) : 1 / b ≤ 1 / a := -(lt_or_eq_of_le h).elim - (λ h, le_of_lt $ one_div_lt_one_div_of_lt ha h) - (λ h, by rw [h]) - -lemma one_div_lt_one_div_of_lt_of_neg {a b : α} (hb : b < 0) (h : a < b) : 1 / b < 1 / a := -begin - apply div_lt_of_mul_gt_of_neg hb, - rw [mul_comm, ← div_eq_mul_one_div], - apply div_lt_of_mul_gt_of_neg (lt_trans h hb), - rwa [one_mul] -end - -lemma one_div_le_one_div_of_le_of_neg {a b : α} (hb : b < 0) (h : a ≤ b) : 1 / b ≤ 1 / a := -(lt_or_eq_of_le h).elim - (λ h, le_of_lt $ one_div_lt_one_div_of_lt_of_neg hb h) - (λ h, by rw [h]) - -lemma le_of_one_div_le_one_div {a b : α} (h : 0 < a) (hl : 1 / a ≤ 1 / b) : b ≤ a := -le_of_not_gt $ λ hn, not_lt_of_ge hl $ one_div_lt_one_div_of_lt h hn - -lemma le_of_one_div_le_one_div_of_neg {a b : α} (h : b < 0) (hl : 1 / a ≤ 1 / b) : b ≤ a := -le_of_not_gt $ λ hn, not_lt_of_ge hl $ one_div_lt_one_div_of_lt_of_neg h hn - -lemma lt_of_one_div_lt_one_div {a b : α} (h : 0 < a) (hl : 1 / a < 1 / b) : b < a := -lt_of_not_ge $ λ hn, not_le_of_gt hl $ one_div_le_one_div_of_le h hn - -lemma lt_of_one_div_lt_one_div_of_neg {a b : α} (h : b < 0) (hl : 1 / a < 1 / b) : b < a := -lt_of_not_ge $ λ hn, not_le_of_gt hl $ one_div_le_one_div_of_le_of_neg h hn - -lemma one_div_le_of_one_div_le_of_pos {a b : α} (ha : a > 0) (h : 1 / a ≤ b) : 1 / b ≤ a := -begin - rw [← one_div_one_div a], - apply one_div_le_one_div_of_le _ h, - apply one_div_pos_of_pos ha -end - -lemma one_div_le_of_one_div_le_of_neg {a b : α} (hb : b < 0) (h : 1 / a ≤ b) : 1 / b ≤ a := -le_of_not_gt $ λ hl, begin - have : a < 0, from lt_trans hl (one_div_neg_of_neg hb), - rw ← one_div_one_div a at hl, - exact not_lt_of_ge h (lt_of_one_div_lt_one_div_of_neg hb hl) -end - -lemma one_lt_one_div {a : α} (h1 : 0 < a) (h2 : a < 1) : 1 < 1 / a := -suffices 1 / 1 < 1 / a, by rwa one_div_one at this, -one_div_lt_one_div_of_lt h1 h2 - -lemma one_le_one_div {a : α} (h1 : 0 < a) (h2 : a ≤ 1) : 1 ≤ 1 / a := -suffices 1 / 1 ≤ 1 / a, by rwa one_div_one at this, -one_div_le_one_div_of_le h1 h2 - -lemma one_div_lt_neg_one {a : α} (h1 : a < 0) (h2 : -1 < a) : 1 / a < -1 := -suffices 1 / a < 1 / -1, by rwa one_div_neg_one_eq_neg_one at this, -one_div_lt_one_div_of_lt_of_neg h1 h2 - -lemma one_div_le_neg_one {a : α} (h1 : a < 0) (h2 : -1 ≤ a) : 1 / a ≤ -1 := -suffices 1 / a ≤ 1 / -1, by rwa one_div_neg_one_eq_neg_one at this, -one_div_le_one_div_of_le_of_neg h1 h2 - -lemma div_lt_div_of_pos_of_lt_of_pos {a b c : α} (hb : 0 < b) (h : b < a) (hc : 0 < c) : c / a < c / b := -begin - apply lt_of_sub_neg, - rw [div_eq_mul_one_div, div_eq_mul_one_div c b, ← mul_sub_left_distrib], - apply mul_neg_of_pos_of_neg, - exact hc, - apply sub_neg_of_lt, - apply one_div_lt_one_div_of_lt; assumption, -end - -lemma div_mul_le_div_mul_of_div_le_div_pos' {a b c d e : α} (h : a / b ≤ c / d) - (he : e > 0) : a / (b * e) ≤ c / (d * e) := -begin - rw [div_mul_eq_div_mul_one_div, div_mul_eq_div_mul_one_div], - apply mul_le_mul_of_nonneg_right h, - apply le_of_lt, - apply one_div_pos_of_pos he -end - -end linear_ordered_field - -class discrete_linear_ordered_field (α : Type u) extends linear_ordered_field α, - decidable_linear_ordered_comm_ring α diff --git a/library/init/algebra/ordered_group.lean b/library/init/algebra/ordered_group.lean deleted file mode 100644 index 7018fa2815..0000000000 --- a/library/init/algebra/ordered_group.lean +++ /dev/null @@ -1,634 +0,0 @@ -/- -Copyright (c) 2016 Microsoft Corporation. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jeremy Avigad, Leonardo de Moura --/ -prelude -import init.algebra.order init.algebra.group - -/- Make sure instances defined in this file have lower priority than the ones - defined for concrete structures -/ -set_option default_priority 100 - -set_option old_structure_cmd true - -universe u - -class ordered_cancel_add_comm_monoid (α : Type u) - extends add_comm_monoid α, add_left_cancel_semigroup α, - add_right_cancel_semigroup α, partial_order α := -(add_le_add_left : ∀ a b : α, a ≤ b → ∀ c : α, c + a ≤ c + b) -(le_of_add_le_add_left : ∀ a b c : α, a + b ≤ a + c → b ≤ c) - -section ordered_cancel_add_comm_monoid -variable {α : Type u} -variable [s : ordered_cancel_add_comm_monoid α] - -lemma add_le_add_left {a b : α} (h : a ≤ b) (c : α) : c + a ≤ c + b := -@ordered_cancel_add_comm_monoid.add_le_add_left α s a b h c - -lemma le_of_add_le_add_left {a b c : α} (h : a + b ≤ a + c) : b ≤ c := -@ordered_cancel_add_comm_monoid.le_of_add_le_add_left α s a b c h -end ordered_cancel_add_comm_monoid - -section ordered_cancel_add_comm_monoid -variable {α : Type u} -variable [ordered_cancel_add_comm_monoid α] - -lemma add_lt_add_left {a b : α} (h : a < b) (c : α) : c + a < c + b := -lt_of_le_not_le (add_le_add_left (le_of_lt h) _) $ - mt le_of_add_le_add_left (not_le_of_gt h) - -lemma lt_of_add_lt_add_left {a b c : α} (h : a + b < a + c) : b < c := -lt_of_le_not_le (le_of_add_le_add_left (le_of_lt h)) $ - mt (λ h, add_le_add_left h _) (not_le_of_gt h) - -lemma add_le_add_right {a b : α} (h : a ≤ b) (c : α) : a + c ≤ b + c := -add_comm c a ▸ add_comm c b ▸ add_le_add_left h c - -theorem add_lt_add_right {a b : α} (h : a < b) (c : α) : a + c < b + c := -begin - rw [add_comm a c, add_comm b c], - exact (add_lt_add_left h c) -end - -lemma add_le_add {a b c d : α} (h₁ : a ≤ b) (h₂ : c ≤ d) : a + c ≤ b + d := -le_trans (add_le_add_right h₁ c) (add_le_add_left h₂ b) - -lemma le_add_of_nonneg_right {a b : α} (h : b ≥ 0) : a ≤ a + b := -have a + b ≥ a + 0, from add_le_add_left h a, -by rwa add_zero at this - -lemma le_add_of_nonneg_left {a b : α} (h : b ≥ 0) : a ≤ b + a := -have 0 + a ≤ b + a, from add_le_add_right h a, -by rwa zero_add at this - -lemma add_lt_add {a b c d : α} (h₁ : a < b) (h₂ : c < d) : a + c < b + d := -lt_trans (add_lt_add_right h₁ c) (add_lt_add_left h₂ b) - -lemma add_lt_add_of_le_of_lt {a b c d : α} (h₁ : a ≤ b) (h₂ : c < d) : a + c < b + d := -lt_of_le_of_lt (add_le_add_right h₁ c) (add_lt_add_left h₂ b) - -lemma add_lt_add_of_lt_of_le {a b c d : α} (h₁ : a < b) (h₂ : c ≤ d) : a + c < b + d := -lt_of_lt_of_le (add_lt_add_right h₁ c) (add_le_add_left h₂ b) - -lemma lt_add_of_pos_right (a : α) {b : α} (h : b > 0) : a < a + b := -have a + 0 < a + b, from add_lt_add_left h a, -by rwa [add_zero] at this - -lemma lt_add_of_pos_left (a : α) {b : α} (h : b > 0) : a < b + a := -have 0 + a < b + a, from add_lt_add_right h a, -by rwa [zero_add] at this - -lemma le_of_add_le_add_right {a b c : α} (h : a + b ≤ c + b) : a ≤ c := -le_of_add_le_add_left - (show b + a ≤ b + c, begin rw [add_comm b a, add_comm b c], assumption end) - -lemma lt_of_add_lt_add_right {a b c : α} (h : a + b < c + b) : a < c := -lt_of_add_lt_add_left - (show b + a < b + c, begin rw [add_comm b a, add_comm b c], assumption end) - --- here we start using properties of zero. -lemma add_nonneg {a b : α} (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a + b := -zero_add (0:α) ▸ (add_le_add ha hb) - -lemma add_pos {a b : α} (ha : 0 < a) (hb : 0 < b) : 0 < a + b := - zero_add (0:α) ▸ (add_lt_add ha hb) - -lemma add_pos_of_pos_of_nonneg {a b : α} (ha : 0 < a) (hb : 0 ≤ b) : 0 < a + b := -zero_add (0:α) ▸ (add_lt_add_of_lt_of_le ha hb) - -lemma add_pos_of_nonneg_of_pos {a b : α} (ha : 0 ≤ a) (hb : 0 < b) : 0 < a + b := -zero_add (0:α) ▸ (add_lt_add_of_le_of_lt ha hb) - -lemma add_nonpos {a b : α} (ha : a ≤ 0) (hb : b ≤ 0) : a + b ≤ 0 := -zero_add (0:α) ▸ (add_le_add ha hb) - -lemma add_neg {a b : α} (ha : a < 0) (hb : b < 0) : a + b < 0 := -zero_add (0:α) ▸ (add_lt_add ha hb) - -lemma add_neg_of_neg_of_nonpos {a b : α} (ha : a < 0) (hb : b ≤ 0) : a + b < 0 := -zero_add (0:α) ▸ (add_lt_add_of_lt_of_le ha hb) - -lemma add_neg_of_nonpos_of_neg {a b : α} (ha : a ≤ 0) (hb : b < 0) : a + b < 0 := -zero_add (0:α) ▸ (add_lt_add_of_le_of_lt ha hb) - -lemma add_eq_zero_iff_eq_zero_and_eq_zero_of_nonneg_of_nonneg - {a b : α} (ha : 0 ≤ a) (hb : 0 ≤ b) : a + b = 0 ↔ a = 0 ∧ b = 0 := -iff.intro - (assume hab : a + b = 0, - have ha' : a ≤ 0, from - calc - a = a + 0 : by rw add_zero - ... ≤ a + b : add_le_add_left hb _ - ... = 0 : hab, - have haz : a = 0, from le_antisymm ha' ha, - have hb' : b ≤ 0, from - calc - b = 0 + b : by rw zero_add - ... ≤ a + b : by exact add_le_add_right ha _ - ... = 0 : hab, - have hbz : b = 0, from le_antisymm hb' hb, - and.intro haz hbz) - (assume ⟨ha', hb'⟩, - by rw [ha', hb', add_zero]) - -lemma le_add_of_nonneg_of_le {a b c : α} (ha : 0 ≤ a) (hbc : b ≤ c) : b ≤ a + c := -zero_add b ▸ add_le_add ha hbc - -lemma le_add_of_le_of_nonneg {a b c : α} (hbc : b ≤ c) (ha : 0 ≤ a) : b ≤ c + a := -add_zero b ▸ add_le_add hbc ha - -lemma lt_add_of_pos_of_le {a b c : α} (ha : 0 < a) (hbc : b ≤ c) : b < a + c := -zero_add b ▸ add_lt_add_of_lt_of_le ha hbc - -lemma lt_add_of_le_of_pos {a b c : α} (hbc : b ≤ c) (ha : 0 < a) : b < c + a := -add_zero b ▸ add_lt_add_of_le_of_lt hbc ha - -lemma add_le_of_nonpos_of_le {a b c : α} (ha : a ≤ 0) (hbc : b ≤ c) : a + b ≤ c := -zero_add c ▸ add_le_add ha hbc - -lemma add_le_of_le_of_nonpos {a b c : α} (hbc : b ≤ c) (ha : a ≤ 0) : b + a ≤ c := -add_zero c ▸ add_le_add hbc ha - -lemma add_lt_of_neg_of_le {a b c : α} (ha : a < 0) (hbc : b ≤ c) : a + b < c := -zero_add c ▸ add_lt_add_of_lt_of_le ha hbc - -lemma add_lt_of_le_of_neg {a b c : α} (hbc : b ≤ c) (ha : a < 0) : b + a < c := -add_zero c ▸ add_lt_add_of_le_of_lt hbc ha - -lemma lt_add_of_nonneg_of_lt {a b c : α} (ha : 0 ≤ a) (hbc : b < c) : b < a + c := -zero_add b ▸ add_lt_add_of_le_of_lt ha hbc - -lemma lt_add_of_lt_of_nonneg {a b c : α} (hbc : b < c) (ha : 0 ≤ a) : b < c + a := -add_zero b ▸ add_lt_add_of_lt_of_le hbc ha - -lemma lt_add_of_pos_of_lt {a b c : α} (ha : 0 < a) (hbc : b < c) : b < a + c := -zero_add b ▸ add_lt_add ha hbc - -lemma lt_add_of_lt_of_pos {a b c : α} (hbc : b < c) (ha : 0 < a) : b < c + a := -add_zero b ▸ add_lt_add hbc ha - -lemma add_lt_of_nonpos_of_lt {a b c : α} (ha : a ≤ 0) (hbc : b < c) : a + b < c := -zero_add c ▸ add_lt_add_of_le_of_lt ha hbc - -lemma add_lt_of_lt_of_nonpos {a b c : α} (hbc : b < c) (ha : a ≤ 0) : b + a < c := -add_zero c ▸ add_lt_add_of_lt_of_le hbc ha - -lemma add_lt_of_neg_of_lt {a b c : α} (ha : a < 0) (hbc : b < c) : a + b < c := -zero_add c ▸ add_lt_add ha hbc - -lemma add_lt_of_lt_of_neg {a b c : α} (hbc : b < c) (ha : a < 0) : b + a < c := -add_zero c ▸ add_lt_add hbc ha - -end ordered_cancel_add_comm_monoid - -class ordered_add_comm_group (α : Type u) extends add_comm_group α, partial_order α := -(add_le_add_left : ∀ a b : α, a ≤ b → ∀ c : α, c + a ≤ c + b) - -section ordered_add_comm_group -variable {α : Type u} -variable [ordered_add_comm_group α] - -lemma ordered_add_comm_group.add_lt_add_left (a b : α) (h : a < b) (c : α) : c + a < c + b := -begin - rw lt_iff_le_not_le at h ⊢, - split, - { apply ordered_add_comm_group.add_le_add_left _ _ h.1 }, - { intro w, - have w : -c + (c + b) ≤ -c + (c + a) := ordered_add_comm_group.add_le_add_left _ _ w _, - simp only [add_zero, add_comm, add_left_neg, add_left_comm] at w, - exact h.2 w }, -end - -lemma ordered_add_comm_group.le_of_add_le_add_left {a b c : α} (h : a + b ≤ a + c) : b ≤ c := -have -a + (a + b) ≤ -a + (a + c), from ordered_add_comm_group.add_le_add_left _ _ h _, -begin simp [neg_add_cancel_left] at this, assumption end - -lemma ordered_add_comm_group.lt_of_add_lt_add_left {a b c : α} (h : a + b < a + c) : b < c := -have -a + (a + b) < -a + (a + c), from ordered_add_comm_group.add_lt_add_left _ _ h _, -begin simp [neg_add_cancel_left] at this, assumption end -end ordered_add_comm_group - -instance ordered_add_comm_group.to_ordered_cancel_add_comm_monoid (α : Type u) [s : ordered_add_comm_group α] : ordered_cancel_add_comm_monoid α := -{ add_left_cancel := @add_left_cancel α _, - add_right_cancel := @add_right_cancel α _, - le_of_add_le_add_left := @ordered_add_comm_group.le_of_add_le_add_left α _, - ..s } - -section ordered_add_comm_group -variables {α : Type u} [ordered_add_comm_group α] - -lemma neg_le_neg {a b : α} (h : a ≤ b) : -b ≤ -a := -have 0 ≤ -a + b, from add_left_neg a ▸ add_le_add_left h (-a), -have 0 + -b ≤ -a + b + -b, from add_le_add_right this (-b), -by rwa [add_neg_cancel_right, zero_add] at this - -lemma le_of_neg_le_neg {a b : α} (h : -b ≤ -a) : a ≤ b := -suffices -(-a) ≤ -(-b), from - begin simp [neg_neg] at this, assumption end, -neg_le_neg h - -lemma nonneg_of_neg_nonpos {a : α} (h : -a ≤ 0) : 0 ≤ a := -have -a ≤ -0, by rwa neg_zero, -le_of_neg_le_neg this - -lemma neg_nonpos_of_nonneg {a : α} (h : 0 ≤ a) : -a ≤ 0 := -have -a ≤ -0, from neg_le_neg h, -by rwa neg_zero at this - -lemma nonpos_of_neg_nonneg {a : α} (h : 0 ≤ -a) : a ≤ 0 := -have -0 ≤ -a, by rwa neg_zero, -le_of_neg_le_neg this - -lemma neg_nonneg_of_nonpos {a : α} (h : a ≤ 0) : 0 ≤ -a := -have -0 ≤ -a, from neg_le_neg h, -by rwa neg_zero at this - -lemma neg_lt_neg {a b : α} (h : a < b) : -b < -a := -have 0 < -a + b, from add_left_neg a ▸ add_lt_add_left h (-a), -have 0 + -b < -a + b + -b, from add_lt_add_right this (-b), -by rwa [add_neg_cancel_right, zero_add] at this - -lemma lt_of_neg_lt_neg {a b : α} (h : -b < -a) : a < b := -neg_neg a ▸ neg_neg b ▸ neg_lt_neg h - -lemma pos_of_neg_neg {a : α} (h : -a < 0) : 0 < a := -have -a < -0, by rwa neg_zero, -lt_of_neg_lt_neg this - -lemma neg_neg_of_pos {a : α} (h : 0 < a) : -a < 0 := -have -a < -0, from neg_lt_neg h, -by rwa neg_zero at this - -lemma neg_of_neg_pos {a : α} (h : 0 < -a) : a < 0 := -have -0 < -a, by rwa neg_zero, -lt_of_neg_lt_neg this - -lemma neg_pos_of_neg {a : α} (h : a < 0) : 0 < -a := -have -0 < -a, from neg_lt_neg h, -by rwa neg_zero at this - -lemma le_neg_of_le_neg {a b : α} (h : a ≤ -b) : b ≤ -a := -begin - have h := neg_le_neg h, - rwa neg_neg at h -end - -lemma neg_le_of_neg_le {a b : α} (h : -a ≤ b) : -b ≤ a := -begin - have h := neg_le_neg h, - rwa neg_neg at h -end - -lemma lt_neg_of_lt_neg {a b : α} (h : a < -b) : b < -a := -begin - have h := neg_lt_neg h, - rwa neg_neg at h -end - -lemma neg_lt_of_neg_lt {a b : α} (h : -a < b) : -b < a := -begin - have h := neg_lt_neg h, - rwa neg_neg at h -end - -lemma sub_nonneg_of_le {a b : α} (h : b ≤ a) : 0 ≤ a - b := -begin - have h := add_le_add_right h (-b), - rwa add_right_neg at h -end - -lemma le_of_sub_nonneg {a b : α} (h : 0 ≤ a - b) : b ≤ a := -begin - have h := add_le_add_right h b, - rwa [sub_add_cancel, zero_add] at h -end - -lemma sub_nonpos_of_le {a b : α} (h : a ≤ b) : a - b ≤ 0 := -begin - have h := add_le_add_right h (-b), - rwa add_right_neg at h -end - -lemma le_of_sub_nonpos {a b : α} (h : a - b ≤ 0) : a ≤ b := -begin - have h := add_le_add_right h b, - rwa [sub_add_cancel, zero_add] at h -end - -lemma sub_pos_of_lt {a b : α} (h : b < a) : 0 < a - b := -begin - have h := add_lt_add_right h (-b), - rwa add_right_neg at h -end - -lemma lt_of_sub_pos {a b : α} (h : 0 < a - b) : b < a := -begin - have h := add_lt_add_right h b, - rwa [sub_add_cancel, zero_add] at h -end - -lemma sub_neg_of_lt {a b : α} (h : a < b) : a - b < 0 := -begin - have h := add_lt_add_right h (-b), - rwa add_right_neg at h -end - -lemma lt_of_sub_neg {a b : α} (h : a - b < 0) : a < b := -begin - have h := add_lt_add_right h b, - rwa [sub_add_cancel, zero_add] at h -end - -lemma add_le_of_le_neg_add {a b c : α} (h : b ≤ -a + c) : a + b ≤ c := -begin - have h := add_le_add_left h a, - rwa add_neg_cancel_left at h -end - -lemma le_neg_add_of_add_le {a b c : α} (h : a + b ≤ c) : b ≤ -a + c := -begin - have h := add_le_add_left h (-a), - rwa neg_add_cancel_left at h -end - -lemma add_le_of_le_sub_left {a b c : α} (h : b ≤ c - a) : a + b ≤ c := -begin - have h := add_le_add_left h a, - rwa [← add_sub_assoc, add_comm a c, add_sub_cancel] at h -end - -lemma le_sub_left_of_add_le {a b c : α} (h : a + b ≤ c) : b ≤ c - a := -begin - have h := add_le_add_right h (-a), - rwa [add_comm a b, add_neg_cancel_right] at h -end - -lemma add_le_of_le_sub_right {a b c : α} (h : a ≤ c - b) : a + b ≤ c := -begin - have h := add_le_add_right h b, - rwa sub_add_cancel at h -end - -lemma le_sub_right_of_add_le {a b c : α} (h : a + b ≤ c) : a ≤ c - b := -begin - have h := add_le_add_right h (-b), - rwa add_neg_cancel_right at h -end - -lemma le_add_of_neg_add_le {a b c : α} (h : -b + a ≤ c) : a ≤ b + c := -begin - have h := add_le_add_left h b, - rwa add_neg_cancel_left at h -end - -lemma neg_add_le_of_le_add {a b c : α} (h : a ≤ b + c) : -b + a ≤ c := -begin - have h := add_le_add_left h (-b), - rwa neg_add_cancel_left at h -end - -lemma le_add_of_sub_left_le {a b c : α} (h : a - b ≤ c) : a ≤ b + c := -begin - have h := add_le_add_right h b, - rwa [sub_add_cancel, add_comm] at h -end - -lemma sub_left_le_of_le_add {a b c : α} (h : a ≤ b + c) : a - b ≤ c := -begin - have h := add_le_add_right h (-b), - rwa [add_comm b c, add_neg_cancel_right] at h -end - -lemma le_add_of_sub_right_le {a b c : α} (h : a - c ≤ b) : a ≤ b + c := -begin - have h := add_le_add_right h c, - rwa sub_add_cancel at h -end - -lemma sub_right_le_of_le_add {a b c : α} (h : a ≤ b + c) : a - c ≤ b := -begin - have h := add_le_add_right h (-c), - rwa add_neg_cancel_right at h -end - -lemma le_add_of_neg_add_le_left {a b c : α} (h : -b + a ≤ c) : a ≤ b + c := -begin - rw add_comm at h, - exact le_add_of_sub_left_le h -end - -lemma neg_add_le_left_of_le_add {a b c : α} (h : a ≤ b + c) : -b + a ≤ c := -begin - rw add_comm, - exact sub_left_le_of_le_add h -end - -lemma le_add_of_neg_add_le_right {a b c : α} (h : -c + a ≤ b) : a ≤ b + c := -begin - rw add_comm at h, - exact le_add_of_sub_right_le h -end - -lemma neg_add_le_right_of_le_add {a b c : α} (h : a ≤ b + c) : -c + a ≤ b := -begin - rw add_comm at h, - apply neg_add_le_left_of_le_add h -end - -lemma le_add_of_neg_le_sub_left {a b c : α} (h : -a ≤ b - c) : c ≤ a + b := -le_add_of_neg_add_le_left (add_le_of_le_sub_right h) - -lemma neg_le_sub_left_of_le_add {a b c : α} (h : c ≤ a + b) : -a ≤ b - c := -begin - have h := le_neg_add_of_add_le (sub_left_le_of_le_add h), - rwa add_comm at h -end - -lemma le_add_of_neg_le_sub_right {a b c : α} (h : -b ≤ a - c) : c ≤ a + b := -le_add_of_sub_right_le (add_le_of_le_sub_left h) - -lemma neg_le_sub_right_of_le_add {a b c : α} (h : c ≤ a + b) : -b ≤ a - c := -le_sub_left_of_add_le (sub_right_le_of_le_add h) - -lemma sub_le_of_sub_le {a b c : α} (h : a - b ≤ c) : a - c ≤ b := -sub_left_le_of_le_add (le_add_of_sub_right_le h) - -lemma sub_le_sub_left {a b : α} (h : a ≤ b) (c : α) : c - b ≤ c - a := -add_le_add_left (neg_le_neg h) c - -lemma sub_le_sub_right {a b : α} (h : a ≤ b) (c : α) : a - c ≤ b - c := -add_le_add_right h (-c) - -lemma sub_le_sub {a b c d : α} (hab : a ≤ b) (hcd : c ≤ d) : a - d ≤ b - c := -add_le_add hab (neg_le_neg hcd) - -lemma add_lt_of_lt_neg_add {a b c : α} (h : b < -a + c) : a + b < c := -begin - have h := add_lt_add_left h a, - rwa add_neg_cancel_left at h -end - -lemma lt_neg_add_of_add_lt {a b c : α} (h : a + b < c) : b < -a + c := -begin - have h := add_lt_add_left h (-a), - rwa neg_add_cancel_left at h -end - -lemma add_lt_of_lt_sub_left {a b c : α} (h : b < c - a) : a + b < c := -begin - have h := add_lt_add_left h a, - rwa [← add_sub_assoc, add_comm a c, add_sub_cancel] at h -end - -lemma lt_sub_left_of_add_lt {a b c : α} (h : a + b < c) : b < c - a := -begin - have h := add_lt_add_right h (-a), - rwa [add_comm a b, add_neg_cancel_right] at h -end - -lemma add_lt_of_lt_sub_right {a b c : α} (h : a < c - b) : a + b < c := -begin - have h := add_lt_add_right h b, - rwa sub_add_cancel at h -end - -lemma lt_sub_right_of_add_lt {a b c : α} (h : a + b < c) : a < c - b := -begin - have h := add_lt_add_right h (-b), - rwa add_neg_cancel_right at h -end - -lemma lt_add_of_neg_add_lt {a b c : α} (h : -b + a < c) : a < b + c := -begin - have h := add_lt_add_left h b, - rwa add_neg_cancel_left at h -end - -lemma neg_add_lt_of_lt_add {a b c : α} (h : a < b + c) : -b + a < c := -begin - have h := add_lt_add_left h (-b), - rwa neg_add_cancel_left at h -end - -lemma lt_add_of_sub_left_lt {a b c : α} (h : a - b < c) : a < b + c := -begin - have h := add_lt_add_right h b, - rwa [sub_add_cancel, add_comm] at h -end - -lemma sub_left_lt_of_lt_add {a b c : α} (h : a < b + c) : a - b < c := -begin - have h := add_lt_add_right h (-b), - rwa [add_comm b c, add_neg_cancel_right] at h -end - -lemma lt_add_of_sub_right_lt {a b c : α} (h : a - c < b) : a < b + c := -begin - have h := add_lt_add_right h c, - rwa sub_add_cancel at h -end - -lemma sub_right_lt_of_lt_add {a b c : α} (h : a < b + c) : a - c < b := -begin - have h := add_lt_add_right h (-c), - rwa add_neg_cancel_right at h -end - -lemma lt_add_of_neg_add_lt_left {a b c : α} (h : -b + a < c) : a < b + c := -begin - rw add_comm at h, - exact lt_add_of_sub_left_lt h -end - -lemma neg_add_lt_left_of_lt_add {a b c : α} (h : a < b + c) : -b + a < c := -begin - rw add_comm, - exact sub_left_lt_of_lt_add h -end - -lemma lt_add_of_neg_add_lt_right {a b c : α} (h : -c + a < b) : a < b + c := -begin - rw add_comm at h, - exact lt_add_of_sub_right_lt h -end - -lemma neg_add_lt_right_of_lt_add {a b c : α} (h : a < b + c) : -c + a < b := -begin - rw add_comm at h, - apply neg_add_lt_left_of_lt_add h -end - -lemma lt_add_of_neg_lt_sub_left {a b c : α} (h : -a < b - c) : c < a + b := -lt_add_of_neg_add_lt_left (add_lt_of_lt_sub_right h) - -lemma neg_lt_sub_left_of_lt_add {a b c : α} (h : c < a + b) : -a < b - c := -begin - have h := lt_neg_add_of_add_lt (sub_left_lt_of_lt_add h), - rwa add_comm at h -end - -lemma lt_add_of_neg_lt_sub_right {a b c : α} (h : -b < a - c) : c < a + b := -lt_add_of_sub_right_lt (add_lt_of_lt_sub_left h) - -lemma neg_lt_sub_right_of_lt_add {a b c : α} (h : c < a + b) : -b < a - c := -lt_sub_left_of_add_lt (sub_right_lt_of_lt_add h) - -lemma sub_lt_of_sub_lt {a b c : α} (h : a - b < c) : a - c < b := -sub_left_lt_of_lt_add (lt_add_of_sub_right_lt h) - -lemma sub_lt_sub_left {a b : α} (h : a < b) (c : α) : c - b < c - a := -add_lt_add_left (neg_lt_neg h) c - -lemma sub_lt_sub_right {a b : α} (h : a < b) (c : α) : a - c < b - c := -add_lt_add_right h (-c) - -lemma sub_lt_sub {a b c d : α} (hab : a < b) (hcd : c < d) : a - d < b - c := -add_lt_add hab (neg_lt_neg hcd) - -lemma sub_lt_sub_of_le_of_lt {a b c d : α} (hab : a ≤ b) (hcd : c < d) : a - d < b - c := -add_lt_add_of_le_of_lt hab (neg_lt_neg hcd) - -lemma sub_lt_sub_of_lt_of_le {a b c d : α} (hab : a < b) (hcd : c ≤ d) : a - d < b - c := -add_lt_add_of_lt_of_le hab (neg_le_neg hcd) - -lemma sub_le_self (a : α) {b : α} (h : b ≥ 0) : a - b ≤ a := -calc - a - b = a + -b : rfl - ... ≤ a + 0 : add_le_add_left (neg_nonpos_of_nonneg h) _ - ... = a : by rw add_zero - -lemma sub_lt_self (a : α) {b : α} (h : b > 0) : a - b < a := -calc - a - b = a + -b : rfl - ... < a + 0 : add_lt_add_left (neg_neg_of_pos h) _ - ... = a : by rw add_zero - -lemma add_le_add_three {a b c d e f : α} (h₁ : a ≤ d) (h₂ : b ≤ e) (h₃ : c ≤ f) : - a + b + c ≤ d + e + f := -begin - apply le_trans, - apply add_le_add, - apply add_le_add, - assumption', - apply le_refl -end - -end ordered_add_comm_group - -class decidable_linear_ordered_add_comm_group (α : Type u) - extends add_comm_group α, decidable_linear_order α := -(add_le_add_left : ∀ a b : α, a ≤ b → ∀ c : α, c + a ≤ c + b) - -instance decidable_linear_ordered_comm_group.to_ordered_add_comm_group (α : Type u) - [s : decidable_linear_ordered_add_comm_group α] : ordered_add_comm_group α := -{ add := s.add, ..s } - -class decidable_linear_ordered_cancel_add_comm_monoid (α : Type u) - extends ordered_cancel_add_comm_monoid α, decidable_linear_order α - -lemma decidable_linear_ordered_add_comm_group.add_lt_add_left {α} [decidable_linear_ordered_add_comm_group α] - (a b : α) (h : a < b) (c : α) : c + a < c + b := - ordered_add_comm_group.add_lt_add_left a b h c - diff --git a/library/init/algebra/ordered_ring.lean b/library/init/algebra/ordered_ring.lean deleted file mode 100644 index edc3cb33dc..0000000000 --- a/library/init/algebra/ordered_ring.lean +++ /dev/null @@ -1,412 +0,0 @@ -/- -Copyright (c) 2016 Microsoft Corporation. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jeremy Avigad, Leonardo de Moura --/ -prelude -import init.algebra.ordered_group init.algebra.ring - -/- Make sure instances defined in this file have lower priority than the ones - defined for concrete structures -/ -set_option default_priority 100 - -set_option old_structure_cmd true - -universe u - -class ordered_semiring (α : Type u) - extends semiring α, ordered_cancel_add_comm_monoid α := -(mul_lt_mul_of_pos_left: ∀ a b c : α, a < b → 0 < c → c * a < c * b) -(mul_lt_mul_of_pos_right: ∀ a b c : α, a < b → 0 < c → a * c < b * c) - -lemma ordered_semiring.mul_le_mul_of_nonneg_left {α} [s : ordered_semiring α] (a b c : α) (h₁ : a ≤ b) (h₂ : 0 ≤ c) : c * a ≤ c * b := -begin - cases classical.em (b ≤ a), { simp [le_antisymm h h₁] }, - cases classical.em (c ≤ 0), { simp [le_antisymm h_1 h₂] }, - exact (le_not_le_of_lt (ordered_semiring.mul_lt_mul_of_pos_left a b c (lt_of_le_not_le h₁ h) (lt_of_le_not_le h₂ h_1))).left, -end - -lemma ordered_semiring.mul_le_mul_of_nonneg_right {α} [s : ordered_semiring α] (a b c : α) (h₁ : a ≤ b) (h₂ : 0 ≤ c) : a * c ≤ b * c := -begin - cases classical.em (b ≤ a), { simp [le_antisymm h h₁] }, - cases classical.em (c ≤ 0), { simp [le_antisymm h_1 h₂] }, - exact (le_not_le_of_lt (ordered_semiring.mul_lt_mul_of_pos_right a b c (lt_of_le_not_le h₁ h) (lt_of_le_not_le h₂ h_1))).left, -end - -variable {α : Type u} - -section ordered_semiring -variable [ordered_semiring α] - -lemma mul_le_mul_of_nonneg_left {a b c : α} (h₁ : a ≤ b) (h₂ : 0 ≤ c) : c * a ≤ c * b := -ordered_semiring.mul_le_mul_of_nonneg_left a b c h₁ h₂ - -lemma mul_le_mul_of_nonneg_right {a b c : α} (h₁ : a ≤ b) (h₂ : 0 ≤ c) : a * c ≤ b * c := -ordered_semiring.mul_le_mul_of_nonneg_right a b c h₁ h₂ - -lemma mul_lt_mul_of_pos_left {a b c : α} (h₁ : a < b) (h₂ : 0 < c) : c * a < c * b := -ordered_semiring.mul_lt_mul_of_pos_left a b c h₁ h₂ - -lemma mul_lt_mul_of_pos_right {a b c : α} (h₁ : a < b) (h₂ : 0 < c) : a * c < b * c := -ordered_semiring.mul_lt_mul_of_pos_right a b c h₁ h₂ - --- TODO: there are four variations, depending on which variables we assume to be nonneg -lemma mul_le_mul {a b c d : α} (hac : a ≤ c) (hbd : b ≤ d) (nn_b : 0 ≤ b) (nn_c : 0 ≤ c) : a * b ≤ c * d := -calc - a * b ≤ c * b : mul_le_mul_of_nonneg_right hac nn_b - ... ≤ c * d : mul_le_mul_of_nonneg_left hbd nn_c - -lemma mul_nonneg {a b : α} (ha : a ≥ 0) (hb : b ≥ 0) : a * b ≥ 0 := -have h : 0 * b ≤ a * b, from mul_le_mul_of_nonneg_right ha hb, -by rwa [zero_mul] at h - -lemma mul_nonpos_of_nonneg_of_nonpos {a b : α} (ha : a ≥ 0) (hb : b ≤ 0) : a * b ≤ 0 := -have h : a * b ≤ a * 0, from mul_le_mul_of_nonneg_left hb ha, -by rwa mul_zero at h - -lemma mul_nonpos_of_nonpos_of_nonneg {a b : α} (ha : a ≤ 0) (hb : b ≥ 0) : a * b ≤ 0 := -have h : a * b ≤ 0 * b, from mul_le_mul_of_nonneg_right ha hb, -by rwa zero_mul at h - -lemma mul_lt_mul {a b c d : α} (hac : a < c) (hbd : b ≤ d) (pos_b : 0 < b) (nn_c : 0 ≤ c) : a * b < c * d := -calc - a * b < c * b : mul_lt_mul_of_pos_right hac pos_b - ... ≤ c * d : mul_le_mul_of_nonneg_left hbd nn_c - -lemma mul_lt_mul' {a b c d : α} (h1 : a ≤ c) (h2 : b < d) (h3 : b ≥ 0) (h4 : c > 0) : - a * b < c * d := -calc - a * b ≤ c * b : mul_le_mul_of_nonneg_right h1 h3 - ... < c * d : mul_lt_mul_of_pos_left h2 h4 - -lemma mul_pos {a b : α} (ha : a > 0) (hb : b > 0) : a * b > 0 := -have h : 0 * b < a * b, from mul_lt_mul_of_pos_right ha hb, -by rwa zero_mul at h - -lemma mul_neg_of_pos_of_neg {a b : α} (ha : a > 0) (hb : b < 0) : a * b < 0 := -have h : a * b < a * 0, from mul_lt_mul_of_pos_left hb ha, -by rwa mul_zero at h - -lemma mul_neg_of_neg_of_pos {a b : α} (ha : a < 0) (hb : b > 0) : a * b < 0 := -have h : a * b < 0 * b, from mul_lt_mul_of_pos_right ha hb, -by rwa zero_mul at h - -lemma mul_self_le_mul_self {a b : α} (h1 : 0 ≤ a) (h2 : a ≤ b) : a * a ≤ b * b := -mul_le_mul h2 h2 h1 (le_trans h1 h2) - -lemma mul_self_lt_mul_self {a b : α} (h1 : 0 ≤ a) (h2 : a < b) : a * a < b * b := -mul_lt_mul' (le_of_lt h2) h2 h1 (lt_of_le_of_lt h1 h2) -end ordered_semiring - -class linear_ordered_semiring (α : Type u) extends ordered_semiring α, linear_order α := -(zero_lt_one : zero < one) - -section linear_ordered_semiring -variable [linear_ordered_semiring α] - -lemma zero_lt_one : 0 < (1:α) := -linear_ordered_semiring.zero_lt_one - -lemma zero_le_one : 0 ≤ (1:α) := -le_of_lt zero_lt_one - -lemma two_pos : 0 < (2:α) := add_pos zero_lt_one zero_lt_one - -lemma two_ne_zero : (2:α) ≠ 0 := -ne.symm (ne_of_lt two_pos) - -lemma two_gt_one : (2:α) > 1 := -calc (2:α) = 1+1 : one_add_one_eq_two - ... > 1+0 : add_lt_add_left zero_lt_one _ - ... = 1 : add_zero 1 - -lemma two_ge_one : (2:α) ≥ 1 := -le_of_lt two_gt_one - -lemma four_pos : (4:α) > 0 := -add_pos two_pos two_pos - -lemma lt_of_mul_lt_mul_left {a b c : α} (h : c * a < c * b) (hc : c ≥ 0) : a < b := -lt_of_not_ge - (assume h1 : b ≤ a, - have h2 : c * b ≤ c * a, from mul_le_mul_of_nonneg_left h1 hc, - not_lt_of_ge h2 h) - -lemma lt_of_mul_lt_mul_right {a b c : α} (h : a * c < b * c) (hc : c ≥ 0) : a < b := -lt_of_not_ge - (assume h1 : b ≤ a, - have h2 : b * c ≤ a * c, from mul_le_mul_of_nonneg_right h1 hc, - not_lt_of_ge h2 h) - -lemma le_of_mul_le_mul_left {a b c : α} (h : c * a ≤ c * b) (hc : c > 0) : a ≤ b := -le_of_not_gt - (assume h1 : b < a, - have h2 : c * b < c * a, from mul_lt_mul_of_pos_left h1 hc, - not_le_of_gt h2 h) - -lemma le_of_mul_le_mul_right {a b c : α} (h : a * c ≤ b * c) (hc : c > 0) : a ≤ b := -le_of_not_gt - (assume h1 : b < a, - have h2 : b * c < a * c, from mul_lt_mul_of_pos_right h1 hc, - not_le_of_gt h2 h) - -lemma pos_of_mul_pos_left {a b : α} (h : 0 < a * b) (h1 : 0 ≤ a) : 0 < b := -lt_of_not_ge - (assume h2 : b ≤ 0, - have h3 : a * b ≤ 0, from mul_nonpos_of_nonneg_of_nonpos h1 h2, - not_lt_of_ge h3 h) - -lemma pos_of_mul_pos_right {a b : α} (h : 0 < a * b) (h1 : 0 ≤ b) : 0 < a := -lt_of_not_ge - (assume h2 : a ≤ 0, - have h3 : a * b ≤ 0, from mul_nonpos_of_nonpos_of_nonneg h2 h1, - not_lt_of_ge h3 h) - -lemma nonneg_of_mul_nonneg_left {a b : α} (h : 0 ≤ a * b) (h1 : 0 < a) : 0 ≤ b := -le_of_not_gt - (assume h2 : b < 0, - not_le_of_gt (mul_neg_of_pos_of_neg h1 h2) h) - -lemma nonneg_of_mul_nonneg_right {a b : α} (h : 0 ≤ a * b) (h1 : 0 < b) : 0 ≤ a := -le_of_not_gt - (assume h2 : a < 0, - not_le_of_gt (mul_neg_of_neg_of_pos h2 h1) h) - -lemma neg_of_mul_neg_left {a b : α} (h : a * b < 0) (h1 : 0 ≤ a) : b < 0 := -lt_of_not_ge - (assume h2 : b ≥ 0, - not_lt_of_ge (mul_nonneg h1 h2) h) - -lemma neg_of_mul_neg_right {a b : α} (h : a * b < 0) (h1 : 0 ≤ b) : a < 0 := -lt_of_not_ge - (assume h2 : a ≥ 0, - not_lt_of_ge (mul_nonneg h2 h1) h) - -lemma nonpos_of_mul_nonpos_left {a b : α} (h : a * b ≤ 0) (h1 : 0 < a) : b ≤ 0 := -le_of_not_gt - (assume h2 : b > 0, - not_le_of_gt (mul_pos h1 h2) h) - -lemma nonpos_of_mul_nonpos_right {a b : α} (h : a * b ≤ 0) (h1 : 0 < b) : a ≤ 0 := -le_of_not_gt - (assume h2 : a > 0, - not_le_of_gt (mul_pos h2 h1) h) - -end linear_ordered_semiring - -class decidable_linear_ordered_semiring (α : Type u) extends linear_ordered_semiring α, decidable_linear_order α - -class ordered_ring (α : Type u) extends ring α, ordered_add_comm_group α, zero_ne_one_class α := -(mul_pos : ∀ a b : α, 0 < a → 0 < b → 0 < a * b) - -lemma ordered_ring.mul_nonneg {α} [s : ordered_ring α] (a b : α) (h₁ : 0 ≤ a) (h₂ : 0 ≤ b) : 0 ≤ a * b := -begin - cases classical.em (a ≤ 0), { simp [le_antisymm h h₁] }, - cases classical.em (b ≤ 0), { simp [le_antisymm h_1 h₂] }, - exact (le_not_le_of_lt (ordered_ring.mul_pos a b (lt_of_le_not_le h₁ h) (lt_of_le_not_le h₂ h_1))).left, -end - -lemma ordered_ring.mul_le_mul_of_nonneg_left [s : ordered_ring α] {a b c : α} - (h₁ : a ≤ b) (h₂ : 0 ≤ c) : c * a ≤ c * b := -have 0 ≤ b - a, from sub_nonneg_of_le h₁, -have 0 ≤ c * (b - a), from ordered_ring.mul_nonneg c (b - a) h₂ this, -begin - rw mul_sub_left_distrib at this, - apply le_of_sub_nonneg this -end - -lemma ordered_ring.mul_le_mul_of_nonneg_right [s : ordered_ring α] {a b c : α} - (h₁ : a ≤ b) (h₂ : 0 ≤ c) : a * c ≤ b * c := -have 0 ≤ b - a, from sub_nonneg_of_le h₁, -have 0 ≤ (b - a) * c, from ordered_ring.mul_nonneg (b - a) c this h₂, -begin - rw mul_sub_right_distrib at this, - apply le_of_sub_nonneg this -end - -lemma ordered_ring.mul_lt_mul_of_pos_left [s : ordered_ring α] {a b c : α} - (h₁ : a < b) (h₂ : 0 < c) : c * a < c * b := -have 0 < b - a, from sub_pos_of_lt h₁, -have 0 < c * (b - a), from ordered_ring.mul_pos c (b - a) h₂ this, -begin - rw mul_sub_left_distrib at this, - apply lt_of_sub_pos this -end - -lemma ordered_ring.mul_lt_mul_of_pos_right [s : ordered_ring α] {a b c : α} - (h₁ : a < b) (h₂ : 0 < c) : a * c < b * c := -have 0 < b - a, from sub_pos_of_lt h₁, -have 0 < (b - a) * c, from ordered_ring.mul_pos (b - a) c this h₂, -begin - rw mul_sub_right_distrib at this, - apply lt_of_sub_pos this -end - -instance ordered_ring.to_ordered_semiring [s : ordered_ring α] : ordered_semiring α := -{ mul_zero := mul_zero, - zero_mul := zero_mul, - add_left_cancel := @add_left_cancel α _, - add_right_cancel := @add_right_cancel α _, - le_of_add_le_add_left := @le_of_add_le_add_left α _, - mul_lt_mul_of_pos_left := @ordered_ring.mul_lt_mul_of_pos_left α _, - mul_lt_mul_of_pos_right := @ordered_ring.mul_lt_mul_of_pos_right α _, - ..s } - -section ordered_ring -variable [ordered_ring α] - -lemma mul_le_mul_of_nonpos_left {a b c : α} (h : b ≤ a) (hc : c ≤ 0) : c * a ≤ c * b := -have -c ≥ 0, from neg_nonneg_of_nonpos hc, -have -c * b ≤ -c * a, from mul_le_mul_of_nonneg_left h this, -have -(c * b) ≤ -(c * a), by rwa [← neg_mul_eq_neg_mul, ← neg_mul_eq_neg_mul] at this, -le_of_neg_le_neg this - -lemma mul_le_mul_of_nonpos_right {a b c : α} (h : b ≤ a) (hc : c ≤ 0) : a * c ≤ b * c := -have -c ≥ 0, from neg_nonneg_of_nonpos hc, -have b * -c ≤ a * -c, from mul_le_mul_of_nonneg_right h this, -have -(b * c) ≤ -(a * c), by rwa [← neg_mul_eq_mul_neg, ← neg_mul_eq_mul_neg] at this, -le_of_neg_le_neg this - -lemma mul_nonneg_of_nonpos_of_nonpos {a b : α} (ha : a ≤ 0) (hb : b ≤ 0) : 0 ≤ a * b := -have 0 * b ≤ a * b, from mul_le_mul_of_nonpos_right ha hb, -by rwa zero_mul at this - -lemma mul_lt_mul_of_neg_left {a b c : α} (h : b < a) (hc : c < 0) : c * a < c * b := -have -c > 0, from neg_pos_of_neg hc, -have -c * b < -c * a, from mul_lt_mul_of_pos_left h this, -have -(c * b) < -(c * a), by rwa [← neg_mul_eq_neg_mul, ← neg_mul_eq_neg_mul] at this, -lt_of_neg_lt_neg this - -lemma mul_lt_mul_of_neg_right {a b c : α} (h : b < a) (hc : c < 0) : a * c < b * c := -have -c > 0, from neg_pos_of_neg hc, -have b * -c < a * -c, from mul_lt_mul_of_pos_right h this, -have -(b * c) < -(a * c), by rwa [← neg_mul_eq_mul_neg, ← neg_mul_eq_mul_neg] at this, -lt_of_neg_lt_neg this - -lemma mul_pos_of_neg_of_neg {a b : α} (ha : a < 0) (hb : b < 0) : 0 < a * b := -have 0 * b < a * b, from mul_lt_mul_of_neg_right ha hb, -by rwa zero_mul at this - -end ordered_ring - -class linear_ordered_ring (α : Type u) extends ordered_ring α, linear_order α := -(zero_lt_one : zero < one) - -instance linear_ordered_ring.to_linear_ordered_semiring [s : linear_ordered_ring α] : linear_ordered_semiring α := -{ mul_zero := mul_zero, - zero_mul := zero_mul, - add_left_cancel := @add_left_cancel α _, - add_right_cancel := @add_right_cancel α _, - le_of_add_le_add_left := @le_of_add_le_add_left α _, - mul_lt_mul_of_pos_left := @mul_lt_mul_of_pos_left α _, - mul_lt_mul_of_pos_right := @mul_lt_mul_of_pos_right α _, - le_total := linear_ordered_ring.le_total, - ..s } - -section linear_ordered_ring -variable [linear_ordered_ring α] - -lemma mul_self_nonneg (a : α) : a * a ≥ 0 := -or.elim (le_total 0 a) - (assume h : a ≥ 0, mul_nonneg h h) - (assume h : a ≤ 0, mul_nonneg_of_nonpos_of_nonpos h h) - -lemma pos_and_pos_or_neg_and_neg_of_mul_pos {a b : α} (hab : a * b > 0) : - (a > 0 ∧ b > 0) ∨ (a < 0 ∧ b < 0) := -match lt_trichotomy 0 a with -| or.inl hlt₁ := - match lt_trichotomy 0 b with - | or.inl hlt₂ := or.inl ⟨hlt₁, hlt₂⟩ - | or.inr (or.inl heq₂) := begin rw [← heq₂, mul_zero] at hab, exact absurd hab (lt_irrefl _) end - | or.inr (or.inr hgt₂) := absurd hab (lt_asymm (mul_neg_of_pos_of_neg hlt₁ hgt₂)) - end -| or.inr (or.inl heq₁) := begin rw [← heq₁, zero_mul] at hab, exact absurd hab (lt_irrefl _) end -| or.inr (or.inr hgt₁) := - match lt_trichotomy 0 b with - | or.inl hlt₂ := absurd hab (lt_asymm (mul_neg_of_neg_of_pos hgt₁ hlt₂)) - | or.inr (or.inl heq₂) := begin rw [← heq₂, mul_zero] at hab, exact absurd hab (lt_irrefl _) end - | or.inr (or.inr hgt₂) := or.inr ⟨hgt₁, hgt₂⟩ - end -end - -lemma gt_of_mul_lt_mul_neg_left {a b c : α} (h : c * a < c * b) (hc : c ≤ 0) : a > b := -have nhc : -c ≥ 0, from neg_nonneg_of_nonpos hc, -have h2 : -(c * b) < -(c * a), from neg_lt_neg h, -have h3 : (-c) * b < (-c) * a, from calc - (-c) * b = - (c * b) : by rewrite neg_mul_eq_neg_mul - ... < -(c * a) : h2 - ... = (-c) * a : by rewrite neg_mul_eq_neg_mul, -lt_of_mul_lt_mul_left h3 nhc - - -lemma zero_gt_neg_one : -1 < (0:α) := -begin - have this := neg_lt_neg (@zero_lt_one α _), - rwa neg_zero at this -end - -lemma le_of_mul_le_of_ge_one {a b c : α} (h : a * c ≤ b) (hb : b ≥ 0) (hc : c ≥ 1) : a ≤ b := -have h' : a * c ≤ b * c, from calc - a * c ≤ b : h - ... = b * 1 : by rewrite mul_one - ... ≤ b * c : mul_le_mul_of_nonneg_left hc hb, -le_of_mul_le_mul_right h' (lt_of_lt_of_le zero_lt_one hc) - -lemma nonneg_le_nonneg_of_squares_le {a b : α} (hb : b ≥ 0) (h : a * a ≤ b * b) : a ≤ b := -le_of_not_gt (λhab, not_le_of_gt (mul_self_lt_mul_self hb hab) h) - -lemma mul_self_le_mul_self_iff {a b : α} (h1 : 0 ≤ a) (h2 : 0 ≤ b) : a ≤ b ↔ a * a ≤ b * b := -⟨mul_self_le_mul_self h1, nonneg_le_nonneg_of_squares_le h2⟩ - -lemma mul_self_lt_mul_self_iff {a b : α} (h1 : 0 ≤ a) (h2 : 0 ≤ b) : a < b ↔ a * a < b * b := -iff.trans (lt_iff_not_ge _ _) $ iff.trans (not_iff_not_of_iff $ mul_self_le_mul_self_iff h2 h1) $ - iff.symm (lt_iff_not_ge _ _) - -lemma linear_ordered_ring.eq_zero_or_eq_zero_of_mul_eq_zero - {a b : α} (h : a * b = 0) : a = 0 ∨ b = 0 := -match lt_trichotomy 0 a with -| or.inl hlt₁ := - match lt_trichotomy 0 b with - | or.inl hlt₂ := - have 0 < a * b, from mul_pos hlt₁ hlt₂, - begin rw h at this, exact absurd this (lt_irrefl _) end - | or.inr (or.inl heq₂) := or.inr heq₂.symm - | or.inr (or.inr hgt₂) := - have 0 > a * b, from mul_neg_of_pos_of_neg hlt₁ hgt₂, - begin rw h at this, exact absurd this (lt_irrefl _) end - end -| or.inr (or.inl heq₁) := or.inl heq₁.symm -| or.inr (or.inr hgt₁) := - match lt_trichotomy 0 b with - | or.inl hlt₂ := - have 0 > a * b, from mul_neg_of_neg_of_pos hgt₁ hlt₂, - begin rw h at this, exact absurd this (lt_irrefl _) end - | or.inr (or.inl heq₂) := or.inr heq₂.symm - | or.inr (or.inr hgt₂) := - have 0 < a * b, from mul_pos_of_neg_of_neg hgt₁ hgt₂, - begin rw h at this, exact absurd this (lt_irrefl _) end - end -end - -end linear_ordered_ring - -class linear_ordered_comm_ring (α : Type u) extends linear_ordered_ring α, comm_monoid α - -instance linear_ordered_comm_ring.to_integral_domain [s: linear_ordered_comm_ring α] : integral_domain α := -{ eq_zero_or_eq_zero_of_mul_eq_zero := @linear_ordered_ring.eq_zero_or_eq_zero_of_mul_eq_zero α _, - ..s } - -class decidable_linear_ordered_comm_ring (α : Type u) extends linear_ordered_comm_ring α, - decidable_linear_ordered_add_comm_group α - -instance decidable_linear_ordered_comm_ring.to_decidable_linear_ordered_semiring [d : decidable_linear_ordered_comm_ring α] : - decidable_linear_ordered_semiring α := -let s : linear_ordered_semiring α := @linear_ordered_ring.to_linear_ordered_semiring α _ in -{ zero_mul := @linear_ordered_semiring.zero_mul α s, - mul_zero := @linear_ordered_semiring.mul_zero α s, - add_left_cancel := @linear_ordered_semiring.add_left_cancel α s, - add_right_cancel := @linear_ordered_semiring.add_right_cancel α s, - le_of_add_le_add_left := @linear_ordered_semiring.le_of_add_le_add_left α s, - mul_lt_mul_of_pos_left := @linear_ordered_semiring.mul_lt_mul_of_pos_left α s, - mul_lt_mul_of_pos_right := @linear_ordered_semiring.mul_lt_mul_of_pos_right α s, - ..d } diff --git a/library/init/algebra/ring.lean b/library/init/algebra/ring.lean deleted file mode 100644 index e536a21144..0000000000 --- a/library/init/algebra/ring.lean +++ /dev/null @@ -1,338 +0,0 @@ -/- -Copyright (c) 2016 Microsoft Corporation. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jeremy Avigad, Leonardo de Moura --/ -prelude -import init.algebra.group - -/- Make sure instances defined in this file have lower priority than the ones - defined for concrete structures -/ -set_option default_priority 100 - -set_option old_structure_cmd true - -universe u - -class distrib (α : Type u) extends has_mul α, has_add α := -(left_distrib : ∀ a b c : α, a * (b + c) = (a * b) + (a * c)) -(right_distrib : ∀ a b c : α, (a + b) * c = (a * c) + (b * c)) - -variable {α : Type u} - -lemma left_distrib [distrib α] (a b c : α) : a * (b + c) = a * b + a * c := -distrib.left_distrib a b c - -def mul_add := @left_distrib - -lemma right_distrib [distrib α] (a b c : α) : (a + b) * c = a * c + b * c := -distrib.right_distrib a b c - -def add_mul := @right_distrib - -class mul_zero_class (α : Type u) extends has_mul α, has_zero α := -(zero_mul : ∀ a : α, 0 * a = 0) -(mul_zero : ∀ a : α, a * 0 = 0) - -@[simp] lemma zero_mul [mul_zero_class α] (a : α) : 0 * a = 0 := -mul_zero_class.zero_mul a - -@[simp] lemma mul_zero [mul_zero_class α] (a : α) : a * 0 = 0 := -mul_zero_class.mul_zero a - -class zero_ne_one_class (α : Type u) extends has_zero α, has_one α := -(zero_ne_one : 0 ≠ (1:α)) - -@[simp] -lemma zero_ne_one [s: zero_ne_one_class α] : 0 ≠ (1:α) := -@zero_ne_one_class.zero_ne_one α s - -@[simp] -lemma one_ne_zero [s: zero_ne_one_class α] : (1:α) ≠ 0 := -assume h, @zero_ne_one_class.zero_ne_one α s h.symm - -/- semiring -/ - -class semiring (α : Type u) extends add_comm_monoid α, monoid α, distrib α, mul_zero_class α - -section semiring - variables [semiring α] - - lemma one_add_one_eq_two : 1 + 1 = (2 : α) := - by unfold bit0 - - theorem two_mul (n : α) : 2 * n = n + n := - eq.trans (right_distrib 1 1 n) (by simp) - - lemma ne_zero_of_mul_ne_zero_right {a b : α} (h : a * b ≠ 0) : a ≠ 0 := - assume : a = 0, - have a * b = 0, by rw [this, zero_mul], - h this - - lemma ne_zero_of_mul_ne_zero_left {a b : α} (h : a * b ≠ 0) : b ≠ 0 := - assume : b = 0, - have a * b = 0, by rw [this, mul_zero], - h this - - lemma distrib_three_right (a b c d : α) : (a + b + c) * d = a * d + b * d + c * d := - by simp [right_distrib] -end semiring - -class comm_semiring (α : Type u) extends semiring α, comm_monoid α - -section comm_semiring - variables [comm_semiring α] (a b c : α) - - instance comm_semiring_has_dvd : has_dvd α := - has_dvd.mk (λ a b, ∃ c, b = a * c) - - -- TODO: this used to not have c explicit, but that seems to be important - -- for use with tactics, similar to exist.intro - theorem dvd.intro {a b : α} (c : α) (h : a * c = b) : a ∣ b := - exists.intro c h^.symm - - def dvd_of_mul_right_eq := @dvd.intro - - theorem dvd.intro_left {a b : α} (c : α) (h : c * a = b) : a ∣ b := - dvd.intro _ (begin rewrite mul_comm at h, apply h end) - - def dvd_of_mul_left_eq := @dvd.intro_left - - theorem exists_eq_mul_right_of_dvd {a b : α} (h : a ∣ b) : ∃ c, b = a * c := h - - theorem dvd.elim {P : Prop} {a b : α} (H₁ : a ∣ b) (H₂ : ∀ c, b = a * c → P) : P := - exists.elim H₁ H₂ - - theorem exists_eq_mul_left_of_dvd {a b : α} (h : a ∣ b) : ∃ c, b = c * a := - dvd.elim h (assume c, assume H1 : b = a * c, exists.intro c (eq.trans H1 (mul_comm a c))) - - theorem dvd.elim_left {P : Prop} {a b : α} (h₁ : a ∣ b) (h₂ : ∀ c, b = c * a → P) : P := - exists.elim (exists_eq_mul_left_of_dvd h₁) (assume c, assume h₃ : b = c * a, h₂ c h₃) - - @[simp] theorem dvd_refl : a ∣ a := - dvd.intro 1 (by simp) - - local attribute [simp] mul_assoc mul_comm mul_left_comm - - theorem dvd_trans {a b c : α} (h₁ : a ∣ b) (h₂ : b ∣ c) : a ∣ c := - match h₁, h₂ with - | ⟨d, (h₃ : b = a * d)⟩, ⟨e, (h₄ : c = b * e)⟩ := - ⟨d * e, show c = a * (d * e), by simp [h₃, h₄]⟩ - end - - def dvd.trans := @dvd_trans - - theorem eq_zero_of_zero_dvd {a : α} (h : 0 ∣ a) : a = 0 := - dvd.elim h (assume c, assume H' : a = 0 * c, eq.trans H' (zero_mul c)) - - @[simp] theorem dvd_zero : a ∣ 0 := dvd.intro 0 (by simp) - - @[simp] theorem one_dvd : 1 ∣ a := dvd.intro a (by simp) - - @[simp] theorem dvd_mul_right : a ∣ a * b := dvd.intro b rfl - - @[simp] theorem dvd_mul_left : a ∣ b * a := dvd.intro b (by simp) - - theorem dvd_mul_of_dvd_left {a b : α} (h : a ∣ b) (c : α) : a ∣ b * c := - dvd.elim h (λ d h', begin rw [h', mul_assoc], apply dvd_mul_right end) - - theorem dvd_mul_of_dvd_right {a b : α} (h : a ∣ b) (c : α) : a ∣ c * b := - begin rw mul_comm, exact dvd_mul_of_dvd_left h _ end - - theorem mul_dvd_mul : ∀ {a b c d : α}, a ∣ b → c ∣ d → a * c ∣ b * d - | a ._ c ._ ⟨e, rfl⟩ ⟨f, rfl⟩ := ⟨e * f, by simp⟩ - - theorem mul_dvd_mul_left (a : α) {b c : α} (h : b ∣ c) : a * b ∣ a * c := - mul_dvd_mul (dvd_refl a) h - - theorem mul_dvd_mul_right {a b : α} (h : a ∣ b) (c : α) : a * c ∣ b * c := - mul_dvd_mul h (dvd_refl c) - - theorem dvd_add {a b c : α} (h₁ : a ∣ b) (h₂ : a ∣ c) : a ∣ b + c := - dvd.elim h₁ (λ d hd, dvd.elim h₂ (λ e he, dvd.intro (d + e) (by simp [left_distrib, hd, he]))) - - theorem dvd_of_mul_right_dvd {a b c : α} (h : a * b ∣ c) : a ∣ c := - dvd.elim h (begin intros d h₁, rw [h₁, mul_assoc], apply dvd_mul_right end) - - theorem dvd_of_mul_left_dvd {a b c : α} (h : a * b ∣ c) : b ∣ c := - dvd.elim h (λ d ceq, dvd.intro (a * d) (by simp [ceq])) -end comm_semiring - -/- ring -/ - -class ring (α : Type u) extends add_comm_group α, monoid α, distrib α - -local attribute [simp] sub_eq_add_neg - -lemma ring.mul_zero [ring α] (a : α) : a * 0 = 0 := -have a * 0 + 0 = a * 0 + a * 0, from calc - a * 0 + 0 = a * (0 + 0) : by simp - ... = a * 0 + a * 0 : by rw left_distrib, -show a * 0 = 0, from (add_left_cancel this).symm - -lemma ring.zero_mul [ring α] (a : α) : 0 * a = 0 := -have 0 * a + 0 = 0 * a + 0 * a, from calc - 0 * a + 0 = (0 + 0) * a : by simp - ... = 0 * a + 0 * a : by rewrite right_distrib, -show 0 * a = 0, from (add_left_cancel this).symm - -instance ring.to_semiring [s : ring α] : semiring α := -{ mul_zero := ring.mul_zero, zero_mul := ring.zero_mul, ..s } - -lemma neg_mul_eq_neg_mul [s : ring α] (a b : α) : -(a * b) = -a * b := -neg_eq_of_add_eq_zero - begin rw [← right_distrib, add_right_neg, zero_mul] end - -lemma neg_mul_eq_mul_neg [s : ring α] (a b : α) : -(a * b) = a * -b := -neg_eq_of_add_eq_zero - begin rw [← left_distrib, add_right_neg, mul_zero] end - -@[simp] lemma neg_mul_eq_neg_mul_symm [s : ring α] (a b : α) : - a * b = - (a * b) := -eq.symm (neg_mul_eq_neg_mul a b) - -@[simp] lemma mul_neg_eq_neg_mul_symm [s : ring α] (a b : α) : a * - b = - (a * b) := -eq.symm (neg_mul_eq_mul_neg a b) - -lemma neg_mul_neg [s : ring α] (a b : α) : -a * -b = a * b := -by simp - -lemma neg_mul_comm [s : ring α] (a b : α) : -a * b = a * -b := -by simp - -theorem neg_eq_neg_one_mul [s : ring α] (a : α) : -a = -1 * a := -by simp - -lemma mul_sub_left_distrib [s : ring α] (a b c : α) : a * (b - c) = a * b - a * c := -calc - a * (b - c) = a * b + a * -c : left_distrib a b (-c) - ... = a * b - a * c : by simp - -def mul_sub := @mul_sub_left_distrib - -lemma mul_sub_right_distrib [s : ring α] (a b c : α) : (a - b) * c = a * c - b * c := -calc - (a - b) * c = a * c + -b * c : right_distrib a (-b) c - ... = a * c - b * c : by simp - -def sub_mul := @mul_sub_right_distrib - -class comm_ring (α : Type u) extends ring α, comm_semigroup α - -instance comm_ring.to_comm_semiring [s : comm_ring α] : comm_semiring α := -{ mul_zero := mul_zero, zero_mul := zero_mul, ..s } - -section comm_ring - variable [comm_ring α] - - local attribute [simp] add_assoc add_comm add_left_comm mul_comm - - lemma mul_self_sub_mul_self_eq (a b : α) : a * a - b * b = (a + b) * (a - b) := - begin simp [right_distrib, left_distrib], rw [add_comm (-(a*b)), add_left_comm (a*b)], simp end - - lemma mul_self_sub_one_eq (a : α) : a * a - 1 = (a + 1) * (a - 1) := - begin simp [right_distrib, left_distrib], rw [add_left_comm, add_comm (-a), add_left_comm a], simp end - - lemma add_mul_self_eq (a b : α) : (a + b) * (a + b) = a*a + 2*a*b + b*b := - calc (a + b)*(a + b) = a*a + (1+1)*a*b + b*b : by simp [right_distrib, left_distrib] - ... = a*a + 2*a*b + b*b : by rw one_add_one_eq_two - - theorem dvd_neg_of_dvd {a b : α} (h : a ∣ b) : (a ∣ -b) := - dvd.elim h - (assume c, assume : b = a * c, - dvd.intro (-c) (by simp [this])) - - theorem dvd_of_dvd_neg {a b : α} (h : a ∣ -b) : (a ∣ b) := - let t := dvd_neg_of_dvd h in by rwa neg_neg at t - - theorem dvd_neg_iff_dvd (a b : α) : (a ∣ -b) ↔ (a ∣ b) := - ⟨dvd_of_dvd_neg, dvd_neg_of_dvd⟩ - - theorem neg_dvd_of_dvd {a b : α} (h : a ∣ b) : -a ∣ b := - dvd.elim h - (assume c, assume : b = a * c, - dvd.intro (-c) (by simp [this])) - - theorem dvd_of_neg_dvd {a b : α} (h : -a ∣ b) : a ∣ b := - let t := neg_dvd_of_dvd h in by rwa neg_neg at t - - theorem neg_dvd_iff_dvd (a b : α) : (-a ∣ b) ↔ (a ∣ b) := - ⟨dvd_of_neg_dvd, neg_dvd_of_dvd⟩ - - theorem dvd_sub {a b c : α} (h₁ : a ∣ b) (h₂ : a ∣ c) : a ∣ b - c := - dvd_add h₁ (dvd_neg_of_dvd h₂) - - theorem dvd_add_iff_left {a b c : α} (h : a ∣ c) : a ∣ b ↔ a ∣ b + c := - ⟨λh₂, dvd_add h₂ h, λH, by have t := dvd_sub H h; rwa add_sub_cancel at t⟩ - - theorem dvd_add_iff_right {a b c : α} (h : a ∣ b) : a ∣ c ↔ a ∣ b + c := - by rw add_comm; exact dvd_add_iff_left h -end comm_ring - -class no_zero_divisors (α : Type u) extends has_mul α, has_zero α := -(eq_zero_or_eq_zero_of_mul_eq_zero : ∀ a b : α, a * b = 0 → a = 0 ∨ b = 0) - -lemma eq_zero_or_eq_zero_of_mul_eq_zero [no_zero_divisors α] {a b : α} (h : a * b = 0) : a = 0 ∨ b = 0 := -no_zero_divisors.eq_zero_or_eq_zero_of_mul_eq_zero a b h - -lemma eq_zero_of_mul_self_eq_zero [no_zero_divisors α] {a : α} (h : a * a = 0) : a = 0 := -or.elim (eq_zero_or_eq_zero_of_mul_eq_zero h) (assume h', h') (assume h', h') - -class integral_domain (α : Type u) extends comm_ring α, no_zero_divisors α, zero_ne_one_class α - -section integral_domain - variable [integral_domain α] - - lemma mul_eq_zero_iff_eq_zero_or_eq_zero {a b : α} : a * b = 0 ↔ a = 0 ∨ b = 0 := - ⟨eq_zero_or_eq_zero_of_mul_eq_zero, λo, - or.elim o (λh, by rw h; apply zero_mul) (λh, by rw h; apply mul_zero)⟩ - - lemma mul_ne_zero {a b : α} (h₁ : a ≠ 0) (h₂ : b ≠ 0) : a * b ≠ 0 := - λ h, or.elim (eq_zero_or_eq_zero_of_mul_eq_zero h) (assume h₃, h₁ h₃) (assume h₄, h₂ h₄) - - lemma eq_of_mul_eq_mul_right {a b c : α} (ha : a ≠ 0) (h : b * a = c * a) : b = c := - have b * a - c * a = 0, from sub_eq_zero_of_eq h, - have (b - c) * a = 0, by rw [mul_sub_right_distrib, this], - have b - c = 0, from (eq_zero_or_eq_zero_of_mul_eq_zero this).resolve_right ha, - eq_of_sub_eq_zero this - - lemma eq_of_mul_eq_mul_left {a b c : α} (ha : a ≠ 0) (h : a * b = a * c) : b = c := - have a * b - a * c = 0, from sub_eq_zero_of_eq h, - have a * (b - c) = 0, by rw [mul_sub_left_distrib, this], - have b - c = 0, from (eq_zero_or_eq_zero_of_mul_eq_zero this).resolve_left ha, - eq_of_sub_eq_zero this - - lemma eq_zero_of_mul_eq_self_right {a b : α} (h₁ : b ≠ 1) (h₂ : a * b = a) : a = 0 := - have hb : b - 1 ≠ 0, from - assume : b - 1 = 0, - have b = 0 + 1, from eq_add_of_sub_eq this, - have b = 1, by rwa zero_add at this, - h₁ this, - have a * b - a = 0, by simp [h₂], - have a * (b - 1) = 0, by rwa [mul_sub_left_distrib, mul_one], - show a = 0, from (eq_zero_or_eq_zero_of_mul_eq_zero this).resolve_right hb - - lemma eq_zero_of_mul_eq_self_left {a b : α} (h₁ : b ≠ 1) (h₂ : b * a = a) : a = 0 := - eq_zero_of_mul_eq_self_right h₁ (by rwa mul_comm at h₂) - - lemma mul_self_eq_mul_self_iff (a b : α) : a * a = b * b ↔ a = b ∨ a = -b := - iff.intro - (assume : a * a = b * b, - have (a - b) * (a + b) = 0, - by rewrite [mul_comm, ← mul_self_sub_mul_self_eq, this, sub_self], - have a - b = 0 ∨ a + b = 0, from eq_zero_or_eq_zero_of_mul_eq_zero this, - or.elim this - (assume : a - b = 0, or.inl (eq_of_sub_eq_zero this)) - (assume : a + b = 0, or.inr (eq_neg_of_add_eq_zero this))) - (assume : a = b ∨ a = -b, or.elim this - (assume : a = b, by rewrite this) - (assume : a = -b, by rewrite [this, neg_mul_neg])) - - lemma mul_self_eq_one_iff (a : α) : a * a = 1 ↔ a = 1 ∨ a = -1 := - have a * a = 1 * 1 ↔ a = 1 ∨ a = -1, from mul_self_eq_mul_self_iff a 1, - by rwa mul_one at this - -end integral_domain - -/- TODO(Leo): remove the following annotations as soon as we have support for arithmetic - in the SMT tactic framework -/ -attribute [ematch] add_zero zero_add mul_one one_mul mul_zero zero_mul diff --git a/library/init/data/array/slice.lean b/library/init/data/array/slice.lean index 4898a8a838..8b290af0ab 100644 --- a/library/init/data/array/slice.lean +++ b/library/init/data/array/slice.lean @@ -12,7 +12,7 @@ namespace array def slice (a : array n α) (k l : nat) (h₁ : k ≤ l) (h₂ : l ≤ n) : array (l - k) α := ⟨ λ ⟨ i, hi ⟩, a.read ⟨ i + k, - calc i + k < (l - k) + k : add_lt_add_right hi _ + calc i + k < (l - k) + k : nat.add_lt_add_right hi _ ... = l : nat.sub_add_cancel h₁ ... ≤ n : h₂⟩ ⟩ diff --git a/library/init/data/int/basic.lean b/library/init/data/int/basic.lean index bf43a4fc17..67c8a3358b 100644 --- a/library/init/data/int/basic.lean +++ b/library/init/data/int/basic.lean @@ -86,6 +86,14 @@ instance : has_neg ℤ := ⟨int.neg⟩ instance : has_add ℤ := ⟨int.add⟩ instance : has_mul ℤ := ⟨int.mul⟩ +-- defeq to algebra.sub which gives subtraction for arbitrary `add_group`s +protected def sub : ℤ → ℤ → ℤ := +λ m n, m + -n + +instance : has_sub ℤ := ⟨int.sub⟩ + +protected lemma neg_zero : -(0:ℤ) = 0 := rfl + lemma of_nat_add (n m : ℕ) : of_nat (n + m) = of_nat n + of_nat m := rfl lemma of_nat_mul (n m : ℕ) : of_nat (n * m) = of_nat n * of_nat m := rfl lemma of_nat_succ (n : ℕ) : of_nat (succ n) = of_nat n + 1 := rfl @@ -152,6 +160,18 @@ lemma neg_succ_of_nat_inj_iff {m n : ℕ} : neg_succ_of_nat m = neg_succ_of_nat lemma neg_succ_of_nat_eq (n : ℕ) : -[1+ n] = -(n + 1) := rfl +/- neg -/ + +protected lemma neg_neg : ∀ a : ℤ, -(-a) = a +| (of_nat 0) := rfl +| (of_nat (n+1)) := rfl +| -[1+ n] := rfl + +protected lemma neg_inj {a b : ℤ} (h : -a = -b) : a = b := +by rw [← int.neg_neg a, ← int.neg_neg b, h] + +protected lemma sub_eq_add_neg {a b : ℤ} : a - b = a + -b := rfl + /- basic properties of sub_nat_nat -/ lemma sub_nat_nat_elim (m n : ℕ) (P : ℕ → ℕ → ℤ → Prop) @@ -169,7 +189,7 @@ begin have h : m ≤ n, { exact nat.le_of_lt (nat.lt_of_sub_eq_succ heq) }, rw [nat.sub_eq_iff_eq_add h] at heq, - rw [heq, add_comm], + rw [heq, nat.add_comm], apply hn } }, delta sub_nat_nat, exact H _ rfl @@ -188,15 +208,15 @@ end private lemma sub_nat_nat_add_right {m n : ℕ} : sub_nat_nat m (m + n + 1) = neg_succ_of_nat n := calc sub_nat_nat._match_1 m (m + n + 1) (m + n + 1 - m) = - sub_nat_nat._match_1 m (m + n + 1) (m + (n + 1) - m) : by simp + sub_nat_nat._match_1 m (m + n + 1) (m + (n + 1) - m) : by rw [nat.add_assoc] ... = sub_nat_nat._match_1 m (m + n + 1) (n + 1) : by rw [nat.add_sub_cancel_left] ... = neg_succ_of_nat n : rfl private lemma sub_nat_nat_add_add (m n k : ℕ) : sub_nat_nat (m + k) (n + k) = sub_nat_nat m n := sub_nat_nat_elim m n (λm n i, sub_nat_nat (m + k) (n + k) = i) - (assume i n, have n + i + k = (n + k) + i, by simp [add_comm, add_left_comm], + (assume i n, have n + i + k = (n + k) + i, by simp [nat.add_comm, nat.add_left_comm], begin rw [this], exact sub_nat_nat_add_left end) - (assume i m, have m + i + 1 + k = (m + k) + i + 1, by simp [add_comm, add_left_comm], + (assume i m, have m + i + 1 + k = (m + k) + i + 1, by simp [nat.add_comm, nat.add_left_comm], begin rw [this], exact sub_nat_nat_add_right end) private lemma sub_nat_nat_of_ge {m n : ℕ} (h : m ≥ n) : sub_nat_nat m n = of_nat (m - n) := @@ -347,23 +367,23 @@ private lemma sub_nat_nat_add_neg_succ_of_nat (m n k : ℕ) : begin have h := le_or_gt n m, cases h with h' h', - { rw [sub_nat_nat_of_ge h'], simp, rw [sub_nat_nat_sub h', add_comm] }, + { rw [sub_nat_nat_of_ge h'], simp, rw [sub_nat_nat_sub h', nat.add_comm] }, have h₂ : m < n + succ k, exact nat.lt_of_lt_of_le h' (le_add_right _ _), have h₃ : m ≤ n + k, exact le_of_succ_le_succ h₂, - rw [sub_nat_nat_of_lt h', sub_nat_nat_of_lt h₂], simp [add_comm], + rw [sub_nat_nat_of_lt h', sub_nat_nat_of_lt h₂], simp [nat.add_comm], rw [← add_succ, succ_pred_eq_of_pos (nat.sub_pos_of_lt h'), add_succ, succ_sub h₃, pred_succ], - rw [add_comm n, nat.add_sub_assoc (le_of_lt h')] + rw [nat.add_comm n, nat.add_sub_assoc (le_of_lt h')] end private lemma add_assoc_aux1 (m n : ℕ) : ∀ c : ℤ, of_nat m + of_nat n + c = of_nat m + (of_nat n + c) -| (of_nat k) := by simp +| (of_nat k) := by simp [nat.add_assoc] | -[1+ k] := by simp [sub_nat_nat_add] private lemma add_assoc_aux2 (m n k : ℕ) : -[1+ m] + -[1+ n] + of_nat k = -[1+ m] + (-[1+ n] + of_nat k) := begin - simp [add_succ], rw [int.add_comm, sub_nat_nat_add_neg_succ_of_nat], simp [add_succ, succ_add, add_comm] + simp [add_succ], rw [int.add_comm, sub_nat_nat_add_neg_succ_of_nat], simp [add_succ, succ_add, nat.add_comm] end protected lemma add_assoc : ∀ a b c : ℤ, a + b + c = a + (b + c) @@ -378,7 +398,7 @@ protected lemma add_assoc : ∀ a b c : ℤ, a + b + c = a + (b + c) | (of_nat m) -[1+ n] -[1+ k] := by rw [int.add_comm, int.add_comm (of_nat m), int.add_comm (of_nat m), ← add_assoc_aux2, int.add_comm -[1+ k] ] -| -[1+ m] -[1+ n] -[1+ k] := by simp [add_succ, add_comm, add_left_comm, neg_of_nat_of_succ] +| -[1+ m] -[1+ n] -[1+ k] := by simp [add_succ, nat.add_comm, nat.add_left_comm, neg_of_nat_of_succ] /- negation -/ @@ -393,6 +413,9 @@ protected lemma add_left_neg : ∀ a : ℤ, -a + a = 0 | (of_nat (succ m)) := by simp | -[1+ m] := by simp +protected lemma add_right_neg (a : ℤ) : a + -a = 0 := +by rw [int.add_comm, int.add_left_neg] + /- multiplication -/ protected lemma mul_comm : ∀ a b : ℤ, a * b = b * a @@ -432,13 +455,6 @@ protected lemma mul_assoc : ∀ a b c : ℤ, a * b * c = a * (b * c) | -[1+ m] -[1+ n] (of_nat k) := by simp [nat.mul_assoc] | -[1+ m] -[1+ n] -[1+ k] := by simp [nat.mul_assoc] -protected lemma mul_one : ∀ (a : ℤ), a * 1 = a -| (of_nat m) := show of_nat m * of_nat 1 = of_nat m, by simp -| -[1+ m] := show -[1+ m] * of_nat 1 = -[1+ m], begin simp, reflexivity end - -protected lemma one_mul (a : ℤ) : 1 * a = a := -int.mul_comm a 1 ▸ int.mul_one a - protected lemma mul_zero : ∀ (a : ℤ), a * 0 = 0 | (of_nat m) := rfl | -[1+ m] := rfl @@ -470,7 +486,7 @@ begin rw [nat.mul_sub_left_distrib] }, have h₂ : of_nat 0 = 0, exact rfl, - subst h₀, simp [h₂, int.zero_mul] + subst h₀, simp [h₂, int.zero_mul, nat.zero_mul] end private lemma neg_of_nat_add (m n : ℕ) : @@ -479,7 +495,7 @@ begin cases m, { cases n, { simp, reflexivity }, - simp, reflexivity }, + simp [nat.zero_add], reflexivity }, cases n, { simp, reflexivity }, simp [nat.succ_add], reflexivity @@ -515,7 +531,7 @@ protected lemma distrib_left : ∀ a b c : ℤ, a * (b + c) = a * b + a * c | (of_nat m) -[1+ n] (of_nat k) := begin simp [neg_of_nat_eq_sub_nat_nat_zero], rw [int.add_comm, ← sub_nat_nat_add], reflexivity end | (of_nat m) -[1+ n] -[1+ k] := begin simp, rw [← nat.left_distrib, succ_add] end -| -[1+ m] (of_nat n) (of_nat k) := begin simp [mul_comm], rw [← nat.right_distrib, mul_comm] end +| -[1+ m] (of_nat n) (of_nat k) := begin simp [nat.mul_comm], rw [← nat.right_distrib, nat.mul_comm] end | -[1+ m] (of_nat n) -[1+ k] := begin simp [neg_of_nat_eq_sub_nat_nat_zero], rw [int.add_comm, ← sub_nat_nat_add], reflexivity end | -[1+ m] -[1+ n] (of_nat k) := begin simp [neg_of_nat_eq_sub_nat_nat_zero], @@ -525,45 +541,9 @@ protected lemma distrib_left : ∀ a b c : ℤ, a * (b + c) = a * b + a * c protected lemma distrib_right (a b c : ℤ) : (a + b) * c = a * c + b * c := begin rw [int.mul_comm, int.distrib_left], simp [int.mul_comm] end -instance : comm_ring int := -{ add := int.add, - add_assoc := int.add_assoc, - zero := int.zero, - zero_add := int.zero_add, - add_zero := int.add_zero, - neg := int.neg, - add_left_neg := int.add_left_neg, - add_comm := int.add_comm, - mul := int.mul, - mul_assoc := int.mul_assoc, - one := int.one, - one_mul := int.one_mul, - mul_one := int.mul_one, - left_distrib := int.distrib_left, - right_distrib := int.distrib_right, - mul_comm := int.mul_comm } - -/- Extra instances to short-circuit type class resolution -/ -instance : has_sub int := by apply_instance -instance : add_comm_monoid int := by apply_instance -instance : add_monoid int := by apply_instance -instance : monoid int := by apply_instance -instance : comm_monoid int := by apply_instance -instance : comm_semigroup int := by apply_instance -instance : semigroup int := by apply_instance -instance : add_comm_semigroup int := by apply_instance -instance : add_semigroup int := by apply_instance -instance : comm_semiring int := by apply_instance -instance : semiring int := by apply_instance -instance : ring int := by apply_instance -instance : distrib int := by apply_instance - protected lemma zero_ne_one : (0 : int) ≠ 1 := assume h : 0 = 1, succ_ne_zero _ (int.of_nat_inj h).symm -instance : zero_ne_one_class ℤ := -{ zero := 0, one := 1, zero_ne_one := int.zero_ne_one } - lemma of_nat_sub {n m : ℕ} (h : m ≤ n) : of_nat (n - m) = of_nat n - of_nat m := show of_nat (n - m) = of_nat n + neg_of_nat m, from match m, h with | 0, h := rfl @@ -571,18 +551,34 @@ show of_nat (n - m) = of_nat n + neg_of_nat m, from match m, h with by delta sub_nat_nat; rw sub_eq_zero_of_le h; refl end +protected lemma add_left_comm (a b c : ℤ) : a + (b + c) = b + (a + c) := +by rw [← int.add_assoc, int.add_comm a, int.add_assoc] + +protected lemma add_left_cancel {a b c : ℤ} (h : a + b = a + c) : b = c := +have -a + (a + b) = -a + (a + c), by rw h, +by rwa [← int.add_assoc, ← int.add_assoc, int.add_left_neg, int.zero_add, int.zero_add] at this + +protected lemma neg_add {a b : ℤ} : - (a + b) = -a + -b := +calc - (a + b) = -(a + b) + (a + b) + -a + -b : +begin + rw [int.add_assoc, int.add_comm (-a), int.add_assoc, int.add_assoc, ← int.add_assoc b], + rw [int.add_right_neg, int.zero_add, int.add_right_neg, int.add_zero], +end + ... = -a + -b : by { rw [int.add_left_neg, int.zero_add] } + lemma neg_succ_of_nat_coe' (n : ℕ) : -[1+ n] = -↑n - 1 := -by rw [sub_eq_add_neg, ← neg_add]; refl +by rw [int.sub_eq_add_neg, ← int.neg_add]; refl protected lemma coe_nat_sub {n m : ℕ} : n ≤ m → (↑(m - n) : ℤ) = ↑m - ↑n := of_nat_sub -local attribute [simp] sub_eq_add_neg +local attribute [simp] int.sub_eq_add_neg protected lemma sub_nat_nat_eq_coe {m n : ℕ} : sub_nat_nat m n = ↑m - ↑n := sub_nat_nat_elim m n (λm n i, i = ↑m - ↑n) - (λi n, by simp [int.coe_nat_add, add_left_comm]; refl) - (λi n, by simp [int.coe_nat_add, int.coe_nat_one, int.neg_succ_of_nat_eq, add_left_comm]; - apply congr_arg; rw[add_left_comm]; simp) + (λi n, by { simp [int.coe_nat_add, int.add_left_comm, int.add_assoc, int.add_right_neg], refl }) + (λi n, by { rw [int.coe_nat_add, int.coe_nat_add, int.coe_nat_one, int.neg_succ_of_nat_eq, + int.sub_eq_add_neg, int.neg_add, int.neg_add, int.neg_add, ← int.add_assoc, + ← int.add_assoc, int.add_right_neg, int.zero_add] }) def to_nat : ℤ → ℕ | (n : ℕ) := n @@ -592,14 +588,26 @@ theorem to_nat_sub (m n : ℕ) : to_nat (m - n) = m - n := by rw [← int.sub_nat_nat_eq_coe]; exact sub_nat_nat_elim m n (λm n i, to_nat i = m - n) (λi n, by rw [nat.add_sub_cancel_left]; refl) - (λi n, by rw [add_assoc, nat.sub_eq_zero_of_le (nat.le_add_right _ _)]; refl) + (λi n, by rw [nat.add_assoc, nat.sub_eq_zero_of_le (nat.le_add_right _ _)]; refl) -- Since mod x y is always nonnegative when y ≠ 0, we can make a nat version of it def nat_mod (m n : ℤ) : ℕ := (m % n).to_nat +protected lemma one_mul : ∀ (a : ℤ), (1 : ℤ) * a = a +| (of_nat n) := show of_nat (1 * n) = of_nat n, by rw nat.one_mul +| -[1+ n] := show -[1+ (1 * n)] = -[1+ n], by rw nat.one_mul + +protected lemma mul_one (a : ℤ) : a * 1 = a := +by rw [int.mul_comm, int.one_mul] + +protected lemma neg_eq_neg_one_mul : ∀ a : ℤ, -a = -1 * a +| (of_nat 0) := rfl +| (of_nat (n+1)) := show _ = -[1+ (1*n)+0], by { rw nat.one_mul, refl } +| -[1+ n] := show _ = of_nat _, by { rw nat.one_mul, refl } + theorem sign_mul_nat_abs : ∀ (a : ℤ), sign a * nat_abs a = a -| (n+1:ℕ) := one_mul _ +| (n+1:ℕ) := int.one_mul _ | 0 := rfl -| -[1+ n] := (neg_eq_neg_one_mul _).symm +| -[1+ n] := (int.neg_eq_neg_one_mul _).symm end int diff --git a/library/init/data/int/comp_lemmas.lean b/library/init/data/int/comp_lemmas.lean index 704c429d50..3b70e211d8 100644 --- a/library/init/data/int/comp_lemmas.lean +++ b/library/init/data/int/comp_lemmas.lean @@ -14,12 +14,12 @@ namespace int /- 1. Lemmas for reducing the problem to the case where the numerals are positive -/ protected lemma ne_neg_of_ne {a b : ℤ} : a ≠ b → -a ≠ -b := -λ h₁ h₂, absurd (neg_inj h₂) h₁ +λ h₁ h₂, absurd (int.neg_inj h₂) h₁ protected lemma neg_ne_zero_of_ne {a : ℤ} : a ≠ 0 → -a ≠ 0 := λ h₁ h₂, - have -a = -0, by rwa neg_zero, - have a = 0, from neg_inj this, + have -a = -0, by rwa int.neg_zero, + have a = 0, from int.neg_inj this, by contradiction protected lemma zero_ne_neg_of_ne {a : ℤ} (h : 0 ≠ a) : 0 ≠ -a := @@ -29,6 +29,8 @@ protected lemma neg_ne_of_pos {a b : ℤ} : a > 0 → b > 0 → -a ≠ b := λ h₁ h₂ h, begin rw [← h] at h₂, + change 0 < a at h₁, + have := le_of_lt h₁, exact absurd (le_of_lt h₁) (not_le_of_gt (neg_of_neg_pos h₂)) end @@ -37,23 +39,26 @@ protected lemma ne_neg_of_pos {a b : ℤ} : a > 0 → b > 0 → a ≠ -b := /- 2. Lemmas for proving that positive int numerals are nonneg and positive -/ +protected lemma int.zero_lt_one : (0:ℤ) < 1 := +dec_trivial + protected lemma one_pos : (1:int) > 0 := -zero_lt_one +int.zero_lt_one protected lemma bit0_pos {a : ℤ} : a > 0 → bit0 a > 0 := -λ h, add_pos h h +λ h, int.add_pos h h protected lemma bit1_pos {a : ℤ} : a ≥ 0 → bit1 a > 0 := -λ h, lt_add_of_le_of_pos (add_nonneg h h) zero_lt_one +λ h, int.lt_add_of_le_of_pos (int.add_nonneg h h) int.zero_lt_one protected lemma zero_nonneg : (0:int) ≥ 0 := le_refl 0 protected lemma one_nonneg : (1:int) ≥ 0 := -le_of_lt (zero_lt_one) +le_of_lt (int.zero_lt_one) protected lemma bit0_nonneg {a : ℤ} : a ≥ 0 → bit0 a ≥ 0 := -λ h, add_nonneg h h +λ h, int.add_nonneg h h protected lemma bit1_nonneg {a : ℤ} : a ≥ 0 → bit1 a ≥ 0 := λ h, le_of_lt (int.bit1_pos h) @@ -64,10 +69,11 @@ le_of_lt /- 3. nat_abs auxiliary lemmas -/ lemma neg_succ_of_nat_lt_zero (n : ℕ) : neg_succ_of_nat n < 0 := -@lt.intro _ _ n (by simp [neg_succ_of_nat_coe, int.coe_nat_succ, int.coe_nat_add, int.coe_nat_one, add_comm, add_left_comm]) +@lt.intro _ _ n (by simp [neg_succ_of_nat_coe, int.coe_nat_succ, int.coe_nat_add, int.coe_nat_one, + int.add_comm, int.add_left_comm, int.neg_add, int.add_right_neg, int.zero_add]) lemma of_nat_ge_zero (n : ℕ) : of_nat n ≥ 0 := -@le.intro _ _ n (by rw [zero_add, int.coe_nat_eq]) +@le.intro _ _ n (by rw [int.zero_add, int.coe_nat_eq]) lemma of_nat_nat_abs_eq_of_nonneg : ∀ {a : ℤ}, a ≥ 0 → of_nat (nat_abs a) = a | (of_nat n) h := rfl @@ -112,9 +118,9 @@ begin rw [← h], apply int.nat_abs_bit0 end protected lemma nat_abs_bit1_nonneg {a : int} (h : a ≥ 0) : nat_abs (bit1 a) = bit1 (nat_abs a) := show nat_abs (bit0 a + 1) = bit0 (nat_abs a) + nat_abs 1, from -by rw [int.nat_abs_add_nonneg (int.bit0_nonneg h) (le_of_lt (zero_lt_one)), int.nat_abs_bit0] +by rw [int.nat_abs_add_nonneg (int.bit0_nonneg h) (le_of_lt (int.zero_lt_one)), int.nat_abs_bit0] protected lemma nat_abs_bit1_nonneg_step {a : int} {n : nat} (h₁ : a ≥ 0) (h₂ : nat_abs a = n) : nat_abs (bit1 a) = bit1 n := begin rw [← h₂], apply int.nat_abs_bit1_nonneg h₁ end -end int +end int \ No newline at end of file diff --git a/library/init/data/int/order.lean b/library/init/data/int/order.lean index 28436c94cb..067eccfc22 100644 --- a/library/init/data/int/order.lean +++ b/library/init/data/int/order.lean @@ -8,8 +8,6 @@ The order relation on the integers. prelude import init.data.int.basic init.data.ordering.basic -local attribute [simp] sub_eq_add_neg - namespace int private def nonneg (a : ℤ) : Prop := int.cases_on a (assume n, true) (assume n, false) @@ -40,14 +38,17 @@ int.cases_on a (assume n, or.inl trivial) (assume n, or.inr trivial) lemma le.intro_sub {a b : ℤ} {n : ℕ} (h : b - a = n) : a ≤ b := show nonneg (b - a), by rw h; trivial +local attribute [simp] int.sub_eq_add_neg int.add_assoc int.add_right_neg int.add_left_neg + int.zero_add int.add_zero int.neg_add int.neg_neg int.neg_zero + lemma le.intro {a b : ℤ} {n : ℕ} (h : a + n = b) : a ≤ b := -le.intro_sub (by rw [← h, add_comm]; simp) +le.intro_sub (by rw [← h, int.add_comm]; simp) lemma le.dest_sub {a b : ℤ} (h : a ≤ b) : ∃ n : ℕ, b - a = n := nonneg.elim h lemma le.dest {a b : ℤ} (h : a ≤ b) : ∃ n : ℕ, a + n = b := match (le.dest_sub h) with -| ⟨n, h₁⟩ := exists.intro n begin rw [← h₁, add_comm], simp end +| ⟨n, h₁⟩ := exists.intro n begin rw [← h₁, int.add_comm], simp end end lemma le.elim {a b : ℤ} (h : a ≤ b) {P : Prop} (h' : ∀ n : ℕ, a + ↑n = b → P) : P := @@ -56,7 +57,7 @@ exists.elim (le.dest h) h' protected lemma le_total (a b : ℤ) : a ≤ b ∨ b ≤ a := or.imp_right (assume H : nonneg (-(b - a)), - have -(b - a) = a - b, by simp, + have -(b - a) = a - b, by simp [int.add_comm], show nonneg (a - b), from this ▸ H) (nonneg_or_nonneg_neg (b - a)) @@ -77,21 +78,21 @@ lemma coe_zero_le (n : ℕ) : 0 ≤ (↑n : ℤ) := coe_nat_le_coe_nat_of_le n.zero_le lemma eq_coe_of_zero_le {a : ℤ} (h : 0 ≤ a) : ∃ n : ℕ, a = n := -by have t := le.dest_sub h; simp at t; exact t +by { have t := le.dest_sub h, simp at t, exact t } lemma eq_succ_of_zero_lt {a : ℤ} (h : 0 < a) : ∃ n : ℕ, a = n.succ := let ⟨n, (h : ↑(1+n) = a)⟩ := le.dest h in -⟨n, by rw add_comm at h; exact h.symm⟩ +⟨n, by rw nat.add_comm at h; exact h.symm⟩ lemma lt_add_succ (a : ℤ) (n : ℕ) : a < a + ↑(nat.succ n) := -le.intro (show a + 1 + n = a + nat.succ n, begin simp [int.coe_nat_eq, add_comm, add_left_comm], reflexivity end) +le.intro (show a + 1 + n = a + nat.succ n, begin simp [int.coe_nat_eq, int.add_comm, int.add_left_comm], reflexivity end) lemma lt.intro {a b : ℤ} {n : ℕ} (h : a + nat.succ n = b) : a < b := h ▸ lt_add_succ a n lemma lt.dest {a b : ℤ} (h : a < b) : ∃ n : ℕ, a + ↑(nat.succ n) = b := le.elim h (assume n, assume hn : a + 1 + n = b, - exists.intro n begin rw [← hn, add_assoc, add_comm (1 : int)], reflexivity end) + exists.intro n begin rw [← hn, int.add_assoc, int.add_comm 1], reflexivity end) lemma lt.elim {a b : ℤ} (h : a < b) {P : Prop} (h' : ∀ n : ℕ, a + ↑(nat.succ n) = b → P) : P := exists.elim (lt.dest h) h' @@ -108,27 +109,27 @@ lemma coe_nat_lt_coe_nat_of_lt {m n : ℕ} (h : m < n) : (↑m : ℤ) < ↑n := /- show that the integers form an ordered additive group -/ protected lemma le_refl (a : ℤ) : a ≤ a := -le.intro (add_zero a) +le.intro (int.add_zero a) protected lemma le_trans {a b c : ℤ} (h₁ : a ≤ b) (h₂ : b ≤ c) : a ≤ c := le.elim h₁ (assume n, assume hn : a + n = b, le.elim h₂ (assume m, assume hm : b + m = c, -begin apply le.intro, rw [← hm, ← hn, add_assoc], reflexivity end)) +begin apply le.intro, rw [← hm, ← hn, int.add_assoc], reflexivity end)) protected lemma le_antisymm {a b : ℤ} (h₁ : a ≤ b) (h₂ : b ≤ a) : a = b := le.elim h₁ (assume n, assume hn : a + n = b, le.elim h₂ (assume m, assume hm : b + m = a, - have a + ↑(n + m) = a + 0, by rw [int.coe_nat_add, ← add_assoc, hn, hm, add_zero a], - have (↑(n + m) : ℤ) = 0, from add_left_cancel this, + have a + ↑(n + m) = a + 0, by rw [int.coe_nat_add, ← int.add_assoc, hn, hm, int.add_zero a], + have (↑(n + m) : ℤ) = 0, from int.add_left_cancel this, have n + m = 0, from int.coe_nat_inj this, have n = 0, from nat.eq_zero_of_add_eq_zero_right this, - show a = b, begin rw [← hn, this, int.coe_nat_zero, add_zero a] end)) + show a = b, begin rw [← hn, this, int.coe_nat_zero, int.add_zero a] end)) protected lemma lt_irrefl (a : ℤ) : ¬ a < a := assume : a < a, lt.elim this (assume n, assume hn : a + nat.succ n = a, - have a + nat.succ n = a + 0, by rw [hn, add_zero], - have nat.succ n = 0, from int.coe_nat_inj (add_left_cancel this), + have a + nat.succ n = a + 0, by rw [hn, int.add_zero], + have nat.succ n = 0, from int.coe_nat_inj (int.add_left_cancel this), show false, from nat.succ_ne_zero _ this) protected lemma ne_of_lt {a b : ℤ} (h : a < b) : a ≠ b := @@ -143,7 +144,7 @@ iff.intro (assume ⟨aleb, aneb⟩, le.elim aleb (assume n, assume hn : a + n = b, have n ≠ 0, - from (assume : n = 0, aneb begin rw [← hn, this, int.coe_nat_zero, add_zero] end), + from (assume : n = 0, aneb begin rw [← hn, this, int.coe_nat_zero, int.add_zero] end), have n = nat.succ (nat.pred n), from eq.symm (nat.succ_pred_eq_of_pos (nat.pos_of_ne_zero this)), lt.intro (begin rewrite this at hn, exact hn end))) @@ -153,18 +154,18 @@ int.le_refl (a + 1) protected lemma add_le_add_left {a b : ℤ} (h : a ≤ b) (c : ℤ) : c + a ≤ c + b := le.elim h (assume n, assume hn : a + n = b, - le.intro (show c + a + n = c + b, begin rw [add_assoc, hn] end)) + le.intro (show c + a + n = c + b, begin rw [int.add_assoc, hn] end)) protected lemma add_lt_add_left {a b : ℤ} (h : a < b) (c : ℤ) : c + a < c + b := iff.mpr (int.lt_iff_le_and_ne _ _) (and.intro (int.add_le_add_left (le_of_lt h) _) - (assume heq, int.lt_irrefl b begin rw add_left_cancel heq at h, exact h end)) + (assume heq, int.lt_irrefl b begin rw int.add_left_cancel heq at h, exact h end)) protected lemma mul_nonneg {a b : ℤ} (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a * b := le.elim ha (assume n, assume hn, le.elim hb (assume m, assume hm, - le.intro (show 0 + ↑n * ↑m = a * b, begin rw [← hn, ← hm], simp [zero_add] end))) + le.intro (show 0 + ↑n * ↑m = a * b, begin rw [← hn, ← hm], simp [int.zero_add] end))) protected lemma mul_pos {a b : ℤ} (ha : 0 < a) (hb : 0 < b) : 0 < a * b := lt.elim ha (assume n, assume hn, @@ -186,25 +187,17 @@ simp [int.lt_iff_le_and_ne], split; intro h, { intro h, simp [*] at * } } end -instance : decidable_linear_ordered_comm_ring int := +instance : decidable_linear_order int := { le := int.le, le_refl := int.le_refl, le_trans := @int.le_trans, le_antisymm := @int.le_antisymm, lt := int.lt, lt_iff_le_not_le := @int.lt_iff_le_not_le, - add_le_add_left := @int.add_le_add_left, - zero_ne_one := int.zero_ne_one, - mul_pos := @int.mul_pos, le_total := int.le_total, - zero_lt_one := int.zero_lt_one, decidable_eq := int.decidable_eq, decidable_le := int.decidable_le, - decidable_lt := int.decidable_lt, - ..int.comm_ring } - -instance : decidable_linear_ordered_add_comm_group int := -by apply_instance + decidable_lt := int.decidable_lt } lemma eq_nat_abs_of_zero_le {a : ℤ} (h : 0 ≤ a) : a = nat_abs a := let ⟨n, e⟩ := eq_coe_of_zero_le h in by rw e; refl @@ -221,6 +214,663 @@ lemma eq_neg_succ_of_lt_zero : ∀ {a : ℤ}, a < 0 → ∃ n : ℕ, a = -[1+ n] | (n : ℕ) h := absurd h (not_lt_of_ge (coe_zero_le _)) | -[1+ n] h := ⟨n, rfl⟩ +/- int is an ordered add comm group -/ + +protected lemma eq_neg_of_eq_neg {a b : ℤ} (h : a = -b) : b = -a := +by rw [h, int.neg_neg] + +protected lemma neg_add_cancel_left (a b : ℤ) : -a + (a + b) = b := +by rw [← int.add_assoc, int.add_left_neg, int.zero_add] + +protected lemma add_neg_cancel_left (a b : ℤ) : a + (-a + b) = b := +by rw [← int.add_assoc, int.add_right_neg, int.zero_add] + +protected lemma add_neg_cancel_right (a b : ℤ) : a + b + -b = a := +by rw [int.add_assoc, int.add_right_neg, int.add_zero] + +protected lemma neg_add_cancel_right (a b : ℤ) : a + -b + b = a := +by rw [int.add_assoc, int.add_left_neg, int.add_zero] + +lemma int.sub_self (a : ℤ) : a - a = 0 := +by rw [int.sub_eq_add_neg, int.add_right_neg] + +lemma sub_eq_zero_of_eq {a b : ℤ} (h : a = b) : a - b = 0 := +by rw [h, int.sub_self] + +lemma eq_of_sub_eq_zero {a b : ℤ} (h : a - b = 0) : a = b := +have 0 + b = b, by rw int.zero_add, +have (a - b) + b = b, by rwa h, +by rwa [int.sub_eq_add_neg, int.neg_add_cancel_right] at this + +lemma sub_eq_zero_iff_eq {a b : ℤ} : a - b = 0 ↔ a = b := +⟨int.eq_of_sub_eq_zero, sub_eq_zero_of_eq⟩ + +@[simp] lemma neg_eq_of_add_eq_zero {a b : ℤ} (h : a + b = 0) : -a = b := +by rw [← int.add_zero (-a), ←h, ←int.add_assoc, int.add_left_neg, int.zero_add] + +lemma neg_mul_eq_neg_mul (a b : ℤ) : -(a * b) = -a * b := +neg_eq_of_add_eq_zero + begin rw [← int.distrib_right, int.add_right_neg, int.zero_mul] end + +lemma neg_mul_eq_mul_neg (a b : ℤ) : -(a * b) = a * -b := +neg_eq_of_add_eq_zero + begin rw [← int.distrib_left, int.add_right_neg, int.mul_zero] end + +@[simp] lemma neg_mul_eq_neg_mul_symm (a b : ℤ) : - a * b = - (a * b) := +eq.symm (neg_mul_eq_neg_mul a b) + +@[simp] lemma mul_neg_eq_neg_mul_symm (a b : ℤ) : a * - b = - (a * b) := +eq.symm (neg_mul_eq_mul_neg a b) + +lemma neg_mul_neg (a b : ℤ) : -a * -b = a * b := +by simp + +lemma neg_mul_comm (a b : ℤ) : -a * b = a * -b := +by simp + +lemma mul_sub_left_distrib (a b c : ℤ) : a * (b - c) = a * b - a * c := +calc + a * (b - c) = a * b + a * -c : int.distrib_left a b (-c) + ... = a * b - a * c : by simp + +def mul_sub := @mul_sub_left_distrib + +lemma mul_sub_right_distrib (a b c : ℤ) : (a - b) * c = a * c - b * c := +calc + (a - b) * c = a * c + -b * c : int.distrib_right a (-b) c + ... = a * c - b * c : by simp + +def sub_mul := @mul_sub_right_distrib + +section + +protected lemma le_of_add_le_add_left {a b c : ℤ} (h : a + b ≤ a + c) : b ≤ c := +have -a + (a + b) ≤ -a + (a + c), from int.add_le_add_left h _, +begin simp [int.neg_add_cancel_left] at this, assumption end + +protected lemma lt_of_add_lt_add_left {a b c : ℤ} (h : a + b < a + c) : b < c := +have -a + (a + b) < -a + (a + c), from int.add_lt_add_left h _, +begin simp [int.neg_add_cancel_left] at this, assumption end + +protected lemma add_le_add_right {a b : ℤ} (h : a ≤ b) (c : ℤ) : a + c ≤ b + c := +int.add_comm c a ▸ int.add_comm c b ▸ int.add_le_add_left h c + +protected theorem add_lt_add_right {a b : ℤ} (h : a < b) (c : ℤ) : a + c < b + c := +begin + rw [int.add_comm a c, int.add_comm b c], + exact (int.add_lt_add_left h c) +end + +protected lemma add_le_add {a b c d : ℤ} (h₁ : a ≤ b) (h₂ : c ≤ d) : a + c ≤ b + d := +le_trans (int.add_le_add_right h₁ c) (int.add_le_add_left h₂ b) + +protected lemma le_add_of_nonneg_right {a b : ℤ} (h : b ≥ 0) : a ≤ a + b := +have a + b ≥ a + 0, from int.add_le_add_left h a, +by rwa int.add_zero at this + +protected lemma le_add_of_nonneg_left {a b : ℤ} (h : b ≥ 0) : a ≤ b + a := +have 0 + a ≤ b + a, from int.add_le_add_right h a, +by rwa int.zero_add at this + +protected lemma add_lt_add {a b c d : ℤ} (h₁ : a < b) (h₂ : c < d) : a + c < b + d := +lt_trans (int.add_lt_add_right h₁ c) (int.add_lt_add_left h₂ b) + +protected lemma add_lt_add_of_le_of_lt {a b c d : ℤ} (h₁ : a ≤ b) (h₂ : c < d) : a + c < b + d := +lt_of_le_of_lt (int.add_le_add_right h₁ c) (int.add_lt_add_left h₂ b) + +protected lemma add_lt_add_of_lt_of_le {a b c d : ℤ} (h₁ : a < b) (h₂ : c ≤ d) : a + c < b + d := +lt_of_lt_of_le (int.add_lt_add_right h₁ c) (int.add_le_add_left h₂ b) + +protected lemma lt_add_of_pos_right (a : ℤ) {b : ℤ} (h : b > 0) : a < a + b := +have a + 0 < a + b, from int.add_lt_add_left h a, +by rwa [int.add_zero] at this + +protected lemma lt_add_of_pos_left (a : ℤ) {b : ℤ} (h : b > 0) : a < b + a := +have 0 + a < b + a, from int.add_lt_add_right h a, +by rwa [int.zero_add] at this + +protected lemma le_of_add_le_add_right {a b c : ℤ} (h : a + b ≤ c + b) : a ≤ c := +int.le_of_add_le_add_left + (show b + a ≤ b + c, begin rw [int.add_comm b a, int.add_comm b c], assumption end) + +protected lemma lt_of_add_lt_add_right {a b c : ℤ} (h : a + b < c + b) : a < c := +int.lt_of_add_lt_add_left + (show b + a < b + c, begin rw [int.add_comm b a, int.add_comm b c], assumption end) + +-- here we start using properties of zero. +protected lemma add_nonneg {a b : ℤ} (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a + b := +int.zero_add (0:ℤ) ▸ (int.add_le_add ha hb) + +protected lemma add_pos {a b : ℤ} (ha : 0 < a) (hb : 0 < b) : 0 < a + b := + int.zero_add (0:ℤ) ▸ (int.add_lt_add ha hb) + +protected lemma add_pos_of_pos_of_nonneg {a b : ℤ} (ha : 0 < a) (hb : 0 ≤ b) : 0 < a + b := +int.zero_add (0:ℤ) ▸ (int.add_lt_add_of_lt_of_le ha hb) + +protected lemma add_pos_of_nonneg_of_pos {a b : ℤ} (ha : 0 ≤ a) (hb : 0 < b) : 0 < a + b := +int.zero_add (0:ℤ) ▸ (int.add_lt_add_of_le_of_lt ha hb) + +protected lemma add_nonpos {a b : ℤ} (ha : a ≤ 0) (hb : b ≤ 0) : a + b ≤ 0 := +int.zero_add (0:ℤ) ▸ (int.add_le_add ha hb) + +protected lemma add_neg {a b : ℤ} (ha : a < 0) (hb : b < 0) : a + b < 0 := +int.zero_add (0:ℤ) ▸ (int.add_lt_add ha hb) + +protected lemma add_neg_of_neg_of_nonpos {a b : ℤ} (ha : a < 0) (hb : b ≤ 0) : a + b < 0 := +int.zero_add (0:ℤ) ▸ (int.add_lt_add_of_lt_of_le ha hb) + +protected lemma add_neg_of_nonpos_of_neg {a b : ℤ} (ha : a ≤ 0) (hb : b < 0) : a + b < 0 := +int.zero_add (0:ℤ) ▸ (int.add_lt_add_of_le_of_lt ha hb) + +lemma lt_add_of_le_of_pos {a b c : ℤ} (hbc : b ≤ c) (ha : 0 < a) : b < c + a := +int.add_zero b ▸ int.add_lt_add_of_le_of_lt hbc ha + +lemma sub_add_cancel (a b : ℤ) : a - b + b = a := +int.neg_add_cancel_right a b + +lemma add_sub_cancel (a b : ℤ) : a + b - b = a := +int.add_neg_cancel_right a b + +lemma add_sub_assoc (a b c : ℤ) : a + b - c = a + (b - c) := +by rw [int.sub_eq_add_neg, int.add_assoc, ←int.sub_eq_add_neg] + +lemma neg_le_neg {a b : ℤ} (h : a ≤ b) : -b ≤ -a := +have 0 ≤ -a + b, from int.add_left_neg a ▸ int.add_le_add_left h (-a), +have 0 + -b ≤ -a + b + -b, from int.add_le_add_right this (-b), +by rwa [int.add_neg_cancel_right, int.zero_add] at this + +lemma le_of_neg_le_neg {a b : ℤ} (h : -b ≤ -a) : a ≤ b := +suffices -(-a) ≤ -(-b), from + begin simp [int.neg_neg] at this, assumption end, +neg_le_neg h + +lemma nonneg_of_neg_nonpos {a : ℤ} (h : -a ≤ 0) : 0 ≤ a := +have -a ≤ -0, by rwa int.neg_zero, +le_of_neg_le_neg this + +lemma neg_nonpos_of_nonneg {a : ℤ} (h : 0 ≤ a) : -a ≤ 0 := +have -a ≤ -0, from neg_le_neg h, +by rwa int.neg_zero at this + +lemma nonpos_of_neg_nonneg {a : ℤ} (h : 0 ≤ -a) : a ≤ 0 := +have -0 ≤ -a, by rwa int.neg_zero, +le_of_neg_le_neg this + +lemma neg_nonneg_of_nonpos {a : ℤ} (h : a ≤ 0) : 0 ≤ -a := +have -0 ≤ -a, from neg_le_neg h, +by rwa int.neg_zero at this + +lemma neg_lt_neg {a b : ℤ} (h : a < b) : -b < -a := +have 0 < -a + b, from int.add_left_neg a ▸ int.add_lt_add_left h (-a), +have 0 + -b < -a + b + -b, from int.add_lt_add_right this (-b), +by rwa [int.add_neg_cancel_right, int.zero_add] at this + +lemma lt_of_neg_lt_neg {a b : ℤ} (h : -b < -a) : a < b := +int.neg_neg a ▸ int.neg_neg b ▸ neg_lt_neg h + +lemma pos_of_neg_neg {a : ℤ} (h : -a < 0) : 0 < a := +have -a < -0, by rwa int.neg_zero, +lt_of_neg_lt_neg this + +lemma neg_neg_of_pos {a : ℤ} (h : 0 < a) : -a < 0 := +have -a < -0, from neg_lt_neg h, +by rwa int.neg_zero at this + +lemma neg_of_neg_pos {a : ℤ} (h : 0 < -a) : a < 0 := +have -0 < -a, by rwa int.neg_zero, +lt_of_neg_lt_neg this + +lemma neg_pos_of_neg {a : ℤ} (h : a < 0) : 0 < -a := +have -0 < -a, from neg_lt_neg h, +by rwa int.neg_zero at this + +lemma le_neg_of_le_neg {a b : ℤ} (h : a ≤ -b) : b ≤ -a := +begin + have h := neg_le_neg h, + rwa int.neg_neg at h +end + +lemma neg_le_of_neg_le {a b : ℤ} (h : -a ≤ b) : -b ≤ a := +begin + have h := neg_le_neg h, + rwa int.neg_neg at h +end + +lemma lt_neg_of_lt_neg {a b : ℤ} (h : a < -b) : b < -a := +begin + have h := neg_lt_neg h, + rwa int.neg_neg at h +end + +lemma neg_lt_of_neg_lt {a b : ℤ} (h : -a < b) : -b < a := +begin + have h := neg_lt_neg h, + rwa int.neg_neg at h +end + +lemma sub_nonneg_of_le {a b : ℤ} (h : b ≤ a) : 0 ≤ a - b := +begin + have h := int.add_le_add_right h (-b), + rwa int.add_right_neg at h +end + +lemma le_of_sub_nonneg {a b : ℤ} (h : 0 ≤ a - b) : b ≤ a := +begin + have h := int.add_le_add_right h b, + rwa [int.sub_add_cancel, int.zero_add] at h +end + +lemma sub_nonpos_of_le {a b : ℤ} (h : a ≤ b) : a - b ≤ 0 := +begin + have h := int.add_le_add_right h (-b), + rwa int.add_right_neg at h +end + +lemma le_of_sub_nonpos {a b : ℤ} (h : a - b ≤ 0) : a ≤ b := +begin + have h := int.add_le_add_right h b, + rwa [int.sub_add_cancel, int.zero_add] at h +end + +lemma sub_pos_of_lt {a b : ℤ} (h : b < a) : 0 < a - b := +begin + have h := int.add_lt_add_right h (-b), + rwa int.add_right_neg at h +end + +lemma lt_of_sub_pos {a b : ℤ} (h : 0 < a - b) : b < a := +begin + have h := int.add_lt_add_right h b, + rwa [int.sub_add_cancel, int.zero_add] at h +end + +lemma sub_neg_of_lt {a b : ℤ} (h : a < b) : a - b < 0 := +begin + have h := int.add_lt_add_right h (-b), + rwa int.add_right_neg at h +end + +lemma lt_of_sub_neg {a b : ℤ} (h : a - b < 0) : a < b := +begin + have h := int.add_lt_add_right h b, + rwa [int.sub_add_cancel, int.zero_add] at h +end + +lemma add_le_of_le_neg_add {a b c : ℤ} (h : b ≤ -a + c) : a + b ≤ c := +begin + have h := int.add_le_add_left h a, + rwa int.add_neg_cancel_left at h +end + +lemma le_neg_add_of_add_le {a b c : ℤ} (h : a + b ≤ c) : b ≤ -a + c := +begin + have h := int.add_le_add_left h (-a), + rwa int.neg_add_cancel_left at h +end + +lemma add_le_of_le_sub_left {a b c : ℤ} (h : b ≤ c - a) : a + b ≤ c := +begin + have h := int.add_le_add_left h a, + rwa [← int.add_sub_assoc, int.add_comm a c, int.add_sub_cancel] at h +end + +lemma le_sub_left_of_add_le {a b c : ℤ} (h : a + b ≤ c) : b ≤ c - a := +begin + have h := int.add_le_add_right h (-a), + rwa [int.add_comm a b, int.add_neg_cancel_right] at h +end + +lemma add_le_of_le_sub_right {a b c : ℤ} (h : a ≤ c - b) : a + b ≤ c := +begin + have h := int.add_le_add_right h b, + rwa sub_add_cancel at h +end + +lemma le_sub_right_of_add_le {a b c : ℤ} (h : a + b ≤ c) : a ≤ c - b := +begin + have h := int.add_le_add_right h (-b), + rwa int.add_neg_cancel_right at h +end + +lemma le_add_of_neg_add_le {a b c : ℤ} (h : -b + a ≤ c) : a ≤ b + c := +begin + have h := int.add_le_add_left h b, + rwa int.add_neg_cancel_left at h +end + +lemma neg_add_le_of_le_add {a b c : ℤ} (h : a ≤ b + c) : -b + a ≤ c := +begin + have h := int.add_le_add_left h (-b), + rwa int.neg_add_cancel_left at h +end + +lemma le_add_of_sub_left_le {a b c : ℤ} (h : a - b ≤ c) : a ≤ b + c := +begin + have h := int.add_le_add_right h b, + rwa [sub_add_cancel, int.add_comm] at h +end + +lemma sub_left_le_of_le_add {a b c : ℤ} (h : a ≤ b + c) : a - b ≤ c := +begin + have h := int.add_le_add_right h (-b), + rwa [int.add_comm b c, int.add_neg_cancel_right] at h +end + +lemma le_add_of_sub_right_le {a b c : ℤ} (h : a - c ≤ b) : a ≤ b + c := +begin + have h := int.add_le_add_right h c, + rwa sub_add_cancel at h +end + +lemma sub_right_le_of_le_add {a b c : ℤ} (h : a ≤ b + c) : a - c ≤ b := +begin + have h := int.add_le_add_right h (-c), + rwa int.add_neg_cancel_right at h +end + +lemma le_add_of_neg_add_le_left {a b c : ℤ} (h : -b + a ≤ c) : a ≤ b + c := +begin + rw int.add_comm at h, + exact le_add_of_sub_left_le h +end + +lemma neg_add_le_left_of_le_add {a b c : ℤ} (h : a ≤ b + c) : -b + a ≤ c := +begin + rw int.add_comm, + exact sub_left_le_of_le_add h +end + +lemma le_add_of_neg_add_le_right {a b c : ℤ} (h : -c + a ≤ b) : a ≤ b + c := +begin + rw int.add_comm at h, + exact le_add_of_sub_right_le h +end + +lemma neg_add_le_right_of_le_add {a b c : ℤ} (h : a ≤ b + c) : -c + a ≤ b := +begin + rw int.add_comm at h, + apply neg_add_le_left_of_le_add h +end + +lemma le_add_of_neg_le_sub_left {a b c : ℤ} (h : -a ≤ b - c) : c ≤ a + b := +le_add_of_neg_add_le_left (add_le_of_le_sub_right h) + +lemma neg_le_sub_left_of_le_add {a b c : ℤ} (h : c ≤ a + b) : -a ≤ b - c := +begin + have h := le_neg_add_of_add_le (sub_left_le_of_le_add h), + rwa int.add_comm at h +end + +lemma le_add_of_neg_le_sub_right {a b c : ℤ} (h : -b ≤ a - c) : c ≤ a + b := +le_add_of_sub_right_le (add_le_of_le_sub_left h) + +lemma neg_le_sub_right_of_le_add {a b c : ℤ} (h : c ≤ a + b) : -b ≤ a - c := +le_sub_left_of_add_le (sub_right_le_of_le_add h) + +lemma sub_le_of_sub_le {a b c : ℤ} (h : a - b ≤ c) : a - c ≤ b := +sub_left_le_of_le_add (le_add_of_sub_right_le h) + +lemma sub_le_sub_left {a b : ℤ} (h : a ≤ b) (c : ℤ) : c - b ≤ c - a := +int.add_le_add_left (neg_le_neg h) c + +lemma sub_le_sub_right {a b : ℤ} (h : a ≤ b) (c : ℤ) : a - c ≤ b - c := +int.add_le_add_right h (-c) + +lemma sub_le_sub {a b c d : ℤ} (hab : a ≤ b) (hcd : c ≤ d) : a - d ≤ b - c := +int.add_le_add hab (neg_le_neg hcd) + +lemma add_lt_of_lt_neg_add {a b c : ℤ} (h : b < -a + c) : a + b < c := +begin + have h := int.add_lt_add_left h a, + rwa int.add_neg_cancel_left at h +end + +lemma lt_neg_add_of_add_lt {a b c : ℤ} (h : a + b < c) : b < -a + c := +begin + have h := int.add_lt_add_left h (-a), + rwa int.neg_add_cancel_left at h +end + +lemma add_lt_of_lt_sub_left {a b c : ℤ} (h : b < c - a) : a + b < c := +begin + have h := int.add_lt_add_left h a, + rwa [← add_sub_assoc, int.add_comm a c, add_sub_cancel] at h +end + +lemma lt_sub_left_of_add_lt {a b c : ℤ} (h : a + b < c) : b < c - a := +begin + have h := int.add_lt_add_right h (-a), + rwa [int.add_comm a b, int.add_neg_cancel_right] at h +end + +lemma add_lt_of_lt_sub_right {a b c : ℤ} (h : a < c - b) : a + b < c := +begin + have h := int.add_lt_add_right h b, + rwa sub_add_cancel at h +end + +lemma lt_sub_right_of_add_lt {a b c : ℤ} (h : a + b < c) : a < c - b := +begin + have h := int.add_lt_add_right h (-b), + rwa int.add_neg_cancel_right at h +end + +lemma lt_add_of_neg_add_lt {a b c : ℤ} (h : -b + a < c) : a < b + c := +begin + have h := int.add_lt_add_left h b, + rwa int.add_neg_cancel_left at h +end + +lemma neg_add_lt_of_lt_add {a b c : ℤ} (h : a < b + c) : -b + a < c := +begin + have h := int.add_lt_add_left h (-b), + rwa int.neg_add_cancel_left at h +end + +lemma lt_add_of_sub_left_lt {a b c : ℤ} (h : a - b < c) : a < b + c := +begin + have h := int.add_lt_add_right h b, + rwa [sub_add_cancel, int.add_comm] at h +end + +lemma sub_left_lt_of_lt_add {a b c : ℤ} (h : a < b + c) : a - b < c := +begin + have h := int.add_lt_add_right h (-b), + rwa [int.add_comm b c, int.add_neg_cancel_right] at h +end + +lemma lt_add_of_sub_right_lt {a b c : ℤ} (h : a - c < b) : a < b + c := +begin + have h := int.add_lt_add_right h c, + rwa sub_add_cancel at h +end + +lemma sub_right_lt_of_lt_add {a b c : ℤ} (h : a < b + c) : a - c < b := +begin + have h := int.add_lt_add_right h (-c), + rwa int.add_neg_cancel_right at h +end + +lemma lt_add_of_neg_add_lt_left {a b c : ℤ} (h : -b + a < c) : a < b + c := +begin + rw int.add_comm at h, + exact lt_add_of_sub_left_lt h +end + +lemma neg_add_lt_left_of_lt_add {a b c : ℤ} (h : a < b + c) : -b + a < c := +begin + rw int.add_comm, + exact sub_left_lt_of_lt_add h +end + +lemma lt_add_of_neg_add_lt_right {a b c : ℤ} (h : -c + a < b) : a < b + c := +begin + rw int.add_comm at h, + exact lt_add_of_sub_right_lt h +end + +lemma neg_add_lt_right_of_lt_add {a b c : ℤ} (h : a < b + c) : -c + a < b := +begin + rw int.add_comm at h, + apply neg_add_lt_left_of_lt_add h +end + +lemma lt_add_of_neg_lt_sub_left {a b c : ℤ} (h : -a < b - c) : c < a + b := +lt_add_of_neg_add_lt_left (add_lt_of_lt_sub_right h) + +lemma neg_lt_sub_left_of_lt_add {a b c : ℤ} (h : c < a + b) : -a < b - c := +begin + have h := lt_neg_add_of_add_lt (sub_left_lt_of_lt_add h), + rwa int.add_comm at h +end + +lemma lt_add_of_neg_lt_sub_right {a b c : ℤ} (h : -b < a - c) : c < a + b := +lt_add_of_sub_right_lt (add_lt_of_lt_sub_left h) + +lemma neg_lt_sub_right_of_lt_add {a b c : ℤ} (h : c < a + b) : -b < a - c := +lt_sub_left_of_add_lt (sub_right_lt_of_lt_add h) + +lemma sub_lt_of_sub_lt {a b c : ℤ} (h : a - b < c) : a - c < b := +sub_left_lt_of_lt_add (lt_add_of_sub_right_lt h) + +lemma sub_lt_sub_left {a b : ℤ} (h : a < b) (c : ℤ) : c - b < c - a := +int.add_lt_add_left (neg_lt_neg h) c + +lemma sub_lt_sub_right {a b : ℤ} (h : a < b) (c : ℤ) : a - c < b - c := +int.add_lt_add_right h (-c) + +lemma sub_lt_sub {a b c d : ℤ} (hab : a < b) (hcd : c < d) : a - d < b - c := +int.add_lt_add hab (neg_lt_neg hcd) + +lemma sub_lt_sub_of_le_of_lt {a b c d : ℤ} (hab : a ≤ b) (hcd : c < d) : a - d < b - c := +int.add_lt_add_of_le_of_lt hab (neg_lt_neg hcd) + +lemma sub_lt_sub_of_lt_of_le {a b c d : ℤ} (hab : a < b) (hcd : c ≤ d) : a - d < b - c := +int.add_lt_add_of_lt_of_le hab (neg_le_neg hcd) + +lemma sub_le_self (a : ℤ) {b : ℤ} (h : b ≥ 0) : a - b ≤ a := +calc + a - b = a + -b : rfl + ... ≤ a + 0 : int.add_le_add_left (neg_nonpos_of_nonneg h) _ + ... = a : by rw int.add_zero + +lemma sub_lt_self (a : ℤ) {b : ℤ} (h : b > 0) : a - b < a := +calc + a - b = a + -b : rfl + ... < a + 0 : int.add_lt_add_left (neg_neg_of_pos h) _ + ... = a : by rw int.add_zero + +lemma add_le_add_three {a b c d e f : ℤ} (h₁ : a ≤ d) (h₂ : b ≤ e) (h₃ : c ≤ f) : + a + b + c ≤ d + e + f := +begin + apply le_trans, + apply int.add_le_add, + apply int.add_le_add, + assumption', + apply le_refl +end + +end + +/- missing facts -/ + +lemma mul_lt_mul_of_pos_left {a b c : ℤ} + (h₁ : a < b) (h₂ : 0 < c) : c * a < c * b := +have 0 < b - a, from sub_pos_of_lt h₁, +have 0 < c * (b - a), from int.mul_pos h₂ this, +begin + rw int.mul_sub_left_distrib at this, + apply lt_of_sub_pos this +end + +lemma mul_lt_mul_of_pos_right {a b c : ℤ} + (h₁ : a < b) (h₂ : 0 < c) : a * c < b * c := +have 0 < b - a, from sub_pos_of_lt h₁, +have 0 < (b - a) * c, from int.mul_pos this h₂, +begin + rw mul_sub_right_distrib at this, + apply lt_of_sub_pos this +end + +lemma mul_le_mul_of_nonneg_left {a b c : ℤ} (h₁ : a ≤ b) (h₂ : 0 ≤ c) : c * a ≤ c * b := +begin + by_cases hba : b ≤ a, { simp [le_antisymm hba h₁] }, + by_cases hc0 : c ≤ 0, { simp [le_antisymm hc0 h₂, int.zero_mul] }, + exact (le_not_le_of_lt (mul_lt_mul_of_pos_left (lt_of_le_not_le h₁ hba) (lt_of_le_not_le h₂ hc0))).left, +end + +lemma mul_le_mul_of_nonneg_right {a b c : ℤ} (h₁ : a ≤ b) (h₂ : 0 ≤ c) : a * c ≤ b * c := +begin + by_cases hba : b ≤ a, { simp [le_antisymm hba h₁] }, + by_cases hc0 : c ≤ 0, { simp [le_antisymm hc0 h₂, int.mul_zero] }, + exact (le_not_le_of_lt (mul_lt_mul_of_pos_right (lt_of_le_not_le h₁ hba) (lt_of_le_not_le h₂ hc0))).left, +end + +-- TODO: there are four variations, depending on which variables we assume to be nonneg +lemma mul_le_mul {a b c d : ℤ} (hac : a ≤ c) (hbd : b ≤ d) (nn_b : 0 ≤ b) (nn_c : 0 ≤ c) : a * b ≤ c * d := +calc + a * b ≤ c * b : mul_le_mul_of_nonneg_right hac nn_b + ... ≤ c * d : mul_le_mul_of_nonneg_left hbd nn_c + +lemma mul_nonpos_of_nonneg_of_nonpos {a b : ℤ} (ha : a ≥ 0) (hb : b ≤ 0) : a * b ≤ 0 := +have h : a * b ≤ a * 0, from mul_le_mul_of_nonneg_left hb ha, +by rwa int.mul_zero at h + +lemma mul_nonpos_of_nonpos_of_nonneg {a b : ℤ} (ha : a ≤ 0) (hb : b ≥ 0) : a * b ≤ 0 := +have h : a * b ≤ 0 * b, from mul_le_mul_of_nonneg_right ha hb, +by rwa int.zero_mul at h + +lemma mul_lt_mul {a b c d : ℤ} (hac : a < c) (hbd : b ≤ d) (pos_b : 0 < b) (nn_c : 0 ≤ c) : a * b < c * d := +calc + a * b < c * b : mul_lt_mul_of_pos_right hac pos_b + ... ≤ c * d : mul_le_mul_of_nonneg_left hbd nn_c + +lemma mul_lt_mul' {a b c d : ℤ} (h1 : a ≤ c) (h2 : b < d) (h3 : b ≥ 0) (h4 : c > 0) : + a * b < c * d := +calc + a * b ≤ c * b : mul_le_mul_of_nonneg_right h1 h3 + ... < c * d : mul_lt_mul_of_pos_left h2 h4 + +lemma mul_neg_of_pos_of_neg {a b : ℤ} (ha : a > 0) (hb : b < 0) : a * b < 0 := +have h : a * b < a * 0, from mul_lt_mul_of_pos_left hb ha, +by rwa int.mul_zero at h + +lemma mul_neg_of_neg_of_pos {a b : ℤ} (ha : a < 0) (hb : b > 0) : a * b < 0 := +have h : a * b < 0 * b, from mul_lt_mul_of_pos_right ha hb, +by rwa int.zero_mul at h + +lemma mul_le_mul_of_nonpos_right {a b c : ℤ} (h : b ≤ a) (hc : c ≤ 0) : a * c ≤ b * c := +have -c ≥ 0, from neg_nonneg_of_nonpos hc, +have b * -c ≤ a * -c, from mul_le_mul_of_nonneg_right h this, +have -(b * c) ≤ -(a * c), by rwa [← neg_mul_eq_mul_neg, ← neg_mul_eq_mul_neg] at this, +le_of_neg_le_neg this + +lemma mul_nonneg_of_nonpos_of_nonpos {a b : ℤ} (ha : a ≤ 0) (hb : b ≤ 0) : 0 ≤ a * b := +have 0 * b ≤ a * b, from mul_le_mul_of_nonpos_right ha hb, +by rwa int.zero_mul at this + +lemma mul_lt_mul_of_neg_left {a b c : ℤ} (h : b < a) (hc : c < 0) : c * a < c * b := +have -c > 0, from neg_pos_of_neg hc, +have -c * b < -c * a, from mul_lt_mul_of_pos_left h this, +have -(c * b) < -(c * a), by rwa [← neg_mul_eq_neg_mul, ← neg_mul_eq_neg_mul] at this, +lt_of_neg_lt_neg this + +lemma mul_lt_mul_of_neg_right {a b c : ℤ} (h : b < a) (hc : c < 0) : a * c < b * c := +have -c > 0, from neg_pos_of_neg hc, +have b * -c < a * -c, from mul_lt_mul_of_pos_right h this, +have -(b * c) < -(a * c), by rwa [← neg_mul_eq_mul_neg, ← neg_mul_eq_mul_neg] at this, +lt_of_neg_lt_neg this + +lemma mul_pos_of_neg_of_neg {a b : ℤ} (ha : a < 0) (hb : b < 0) : 0 < a * b := +have 0 * b < a * b, from mul_lt_mul_of_neg_right ha hb, +by rwa int.zero_mul at this + +lemma mul_self_le_mul_self {a b : ℤ} (h1 : 0 ≤ a) (h2 : a ≤ b) : a * a ≤ b * b := +mul_le_mul h2 h2 h1 (le_trans h1 h2) + +lemma mul_self_lt_mul_self {a b : ℤ} (h1 : 0 ≤ a) (h2 : a < b) : a * a < b * b := +mul_lt_mul' (le_of_lt h2) h2 h1 (lt_of_le_of_lt h1 h2) + /- more facts specific to int -/ theorem of_nat_nonneg (n : ℕ) : 0 ≤ of_nat n := trivial @@ -229,31 +879,24 @@ theorem coe_succ_pos (n : nat) : (nat.succ n : ℤ) > 0 := coe_nat_lt_coe_nat_of_lt (nat.succ_pos _) theorem exists_eq_neg_of_nat {a : ℤ} (H : a ≤ 0) : ∃n : ℕ, a = -n := -let ⟨n, h⟩ := eq_coe_of_zero_le (neg_nonneg_of_nonpos H) in -⟨n, eq_neg_of_eq_neg h.symm⟩ +let ⟨n, h⟩ := eq_coe_of_zero_le (int.neg_nonneg_of_nonpos H) in +⟨n, int.eq_neg_of_eq_neg h.symm⟩ theorem nat_abs_of_nonneg {a : ℤ} (H : a ≥ 0) : (nat_abs a : ℤ) = a := match a, eq_coe_of_zero_le H with ._, ⟨n, rfl⟩ := rfl end theorem of_nat_nat_abs_of_nonpos {a : ℤ} (H : a ≤ 0) : (nat_abs a : ℤ) = -a := -by rw [← nat_abs_neg, nat_abs_of_nonneg (neg_nonneg_of_nonpos H)] - -theorem abs_eq_nat_abs : ∀ a : ℤ, abs a = nat_abs a -| (n : ℕ) := abs_of_nonneg $ coe_zero_le _ -| -[1+ n] := abs_of_nonpos $ le_of_lt $ neg_succ_lt_zero _ - -theorem nat_abs_abs (a : ℤ) : nat_abs (abs a) = nat_abs a := -by rw [abs_eq_nat_abs]; refl +by rw [← nat_abs_neg, nat_abs_of_nonneg (int.neg_nonneg_of_nonpos H)] theorem lt_of_add_one_le {a b : ℤ} (H : a + 1 ≤ b) : a < b := H theorem add_one_le_of_lt {a b : ℤ} (H : a < b) : a + 1 ≤ b := H theorem lt_add_one_of_le {a b : ℤ} (H : a ≤ b) : a < b + 1 := -add_le_add_right H 1 +int.add_le_add_right H 1 theorem le_of_lt_add_one {a b : ℤ} (H : a < b + 1) : a ≤ b := -le_of_add_le_add_right H +int.le_of_add_le_add_right H theorem sub_one_le_of_lt {a b : ℤ} (H : a ≤ b) : a - 1 < b := sub_right_lt_of_lt_add $ lt_add_one_of_le H @@ -265,7 +908,7 @@ theorem le_sub_one_of_lt {a b : ℤ} (H : a < b) : a ≤ b - 1 := le_sub_right_of_add_le H theorem lt_of_le_sub_one {a b : ℤ} (H : a ≤ b - 1) : a < b := -add_le_of_le_sub_right H +int.add_le_of_le_sub_right H theorem sign_of_succ (n : nat) : sign (nat.succ n) = 1 := rfl @@ -295,13 +938,48 @@ theorem sign_eq_neg_one_iff_neg (a : ℤ) : sign a = -1 ↔ a < 0 := theorem sign_eq_zero_iff_zero (a : ℤ) : sign a = 0 ↔ a = 0 := ⟨eq_zero_of_sign_eq_zero, λ h, by rw [h, sign_zero]⟩ -theorem sign_mul_abs (a : ℤ) : sign a * abs a = a := -by rw [abs_eq_nat_abs, sign_mul_nat_abs] +lemma int.eq_zero_or_eq_zero_of_mul_eq_zero + {a b : ℤ} (h : a * b = 0) : a = 0 ∨ b = 0 := +match lt_trichotomy 0 a with +| or.inl hlt₁ := + match lt_trichotomy 0 b with + | or.inl hlt₂ := + have 0 < a * b, from int.mul_pos hlt₁ hlt₂, + begin rw h at this, exact absurd this (lt_irrefl _) end + | or.inr (or.inl heq₂) := or.inr heq₂.symm + | or.inr (or.inr hgt₂) := + have 0 > a * b, from mul_neg_of_pos_of_neg hlt₁ hgt₂, + begin rw h at this, exact absurd this (lt_irrefl _) end + end +| or.inr (or.inl heq₁) := or.inl heq₁.symm +| or.inr (or.inr hgt₁) := + match lt_trichotomy 0 b with + | or.inl hlt₂ := + have 0 > a * b, from mul_neg_of_neg_of_pos hgt₁ hlt₂, + begin rw h at this, exact absurd this (lt_irrefl _) end + | or.inr (or.inl heq₂) := or.inr heq₂.symm + | or.inr (or.inr hgt₂) := + have 0 < a * b, from mul_pos_of_neg_of_neg hgt₁ hgt₂, + begin rw h at this, exact absurd this (lt_irrefl _) end + end +end + +lemma eq_of_mul_eq_mul_right {a b c : ℤ} (ha : a ≠ 0) (h : b * a = c * a) : b = c := +have b * a - c * a = 0, from int.sub_eq_zero_of_eq h, +have (b - c) * a = 0, by rw [int.mul_sub_right_distrib, this], +have b - c = 0, from (int.eq_zero_or_eq_zero_of_mul_eq_zero this).resolve_right ha, +int.eq_of_sub_eq_zero this + +lemma eq_of_mul_eq_mul_left {a b c : ℤ} (ha : a ≠ 0) (h : a * b = a * c) : b = c := +have a * b - a * c = 0, from sub_eq_zero_of_eq h, +have a * (b - c) = 0, by rw [mul_sub_left_distrib, this], +have b - c = 0, from (int.eq_zero_or_eq_zero_of_mul_eq_zero this).resolve_left ha, +eq_of_sub_eq_zero this theorem eq_one_of_mul_eq_self_left {a b : ℤ} (Hpos : a ≠ 0) (H : b * a = a) : b = 1 := -eq_of_mul_eq_mul_right Hpos (by rw [one_mul, H]) +int.eq_of_mul_eq_mul_right Hpos (by rw [int.one_mul, H]) theorem eq_one_of_mul_eq_self_right {a b : ℤ} (Hpos : b ≠ 0) (H : b * a = b) : a = 1 := -eq_of_mul_eq_mul_left Hpos (by rw [mul_one, H]) +int.eq_of_mul_eq_mul_left Hpos (by rw [int.mul_one, H]) end int diff --git a/library/init/data/list/lemmas.lean b/library/init/data/list/lemmas.lean index baa54c9de1..226beffa0b 100644 --- a/library/init/data/list/lemmas.lean +++ b/library/init/data/list/lemmas.lean @@ -33,7 +33,11 @@ lemma length_cons (a : α) (l : list α) : length (a :: l) = length l + 1 := rfl @[simp] lemma length_append (s t : list α) : length (s ++ t) = length s + length t := -by induction s; simp [*, add_comm, add_left_comm] +begin + induction s, + { show length t = 0 + length t, by rw nat.zero_add }, + { simp [*, nat.add_comm, nat.add_left_comm] }, +end @[simp] lemma length_repeat (a : α) (n : ℕ) : length (repeat a n) = n := by induction n; simp [*]; refl @@ -186,7 +190,7 @@ by simp [min_le_left] theorem length_remove_nth : ∀ (l : list α) (i : ℕ), i < length l → length (remove_nth l i) = length l - 1 | [] _ h := rfl -| (x::xs) 0 h := by simp [remove_nth, -add_comm] +| (x::xs) 0 h := by simp [remove_nth] | (x::xs) (i+1) h := have i < length xs, from lt_of_succ_lt_succ h, by dsimp [remove_nth]; rw [length_remove_nth xs i this, nat.sub_add_cancel (lt_of_le_of_lt (nat.zero_le _) this)]; refl diff --git a/library/init/data/nat/basic.lean b/library/init/data/nat/basic.lean index 1043231589..b14a9775b7 100644 --- a/library/init/data/nat/basic.lean +++ b/library/init/data/nat/basic.lean @@ -41,6 +41,10 @@ instance : has_sub ℕ := instance : has_mul ℕ := ⟨nat.mul⟩ +-- defeq to the instance provided by comm_semiring +instance : has_dvd ℕ := +has_dvd.mk (λ a b, ∃ c, b = a * c) + instance : decidable_eq ℕ | zero zero := is_true rfl | (succ x) zero := is_false (λ h, nat.no_confusion h) diff --git a/library/init/data/nat/bitwise.lean b/library/init/data/nat/bitwise.lean index 6a3072d33c..dc201ffa53 100644 --- a/library/init/data/nat/bitwise.lean +++ b/library/init/data/nat/bitwise.lean @@ -61,7 +61,7 @@ end @[simp] lemma div2_succ (n : ℕ) : div2 (succ n) = cond (bodd n) (succ (div2 n)) (div2 n) := by unfold bodd div2 bodd_div2; cases bodd_div2 n; cases fst; refl -local attribute [simp] add_comm add_assoc add_left_comm mul_comm mul_assoc mul_left_comm +local attribute [simp] nat.add_comm nat.add_assoc nat.add_left_comm nat.mul_comm nat.mul_assoc theorem bodd_add_div2 : ∀ n, cond (bodd n) 1 0 + 2 * div2 n = n | 0 := rfl @@ -69,18 +69,23 @@ theorem bodd_add_div2 : ∀ n, cond (bodd n) 1 0 + 2 * div2 n = n simp, refine eq.trans _ (congr_arg succ (bodd_add_div2 n)), cases bodd n; simp [cond, bnot], - { rw add_comm; refl }, - { rw [succ_mul, add_comm 1] } + { rw [nat.add_comm, nat.zero_add], }, + { rw [succ_mul, nat.add_comm 1, nat.zero_add] } end theorem div2_val (n) : div2 n = n / 2 := -by refine eq_of_mul_eq_mul_left dec_trivial - (nat.add_left_cancel (eq.trans _ (mod_add_div n 2).symm)); - rw [mod_two_of_bodd, bodd_add_div2] +begin + refine eq_of_mul_eq_mul_left dec_trivial + (nat.add_left_cancel (eq.trans _ (nat.mod_add_div n 2).symm)), + rw [mod_two_of_bodd, bodd_add_div2] +end def bit (b : bool) : ℕ → ℕ := cond b bit1 bit0 -lemma bit0_val (n : nat) : bit0 n = 2 * n := (two_mul _).symm +lemma bit0_val (n : nat) : bit0 n = 2 * n := +calc n + n = 0 + n + n : by rw nat.zero_add + ... = n * 2 : rfl + ... = 2 * n : nat.mul_comm _ _ lemma bit1_val (n : nat) : bit1 n = 2 * n + 1 := congr_arg succ (bit0_val _) @@ -88,7 +93,7 @@ lemma bit_val (b n) : bit b n = 2 * n + cond b 1 0 := by { cases b, apply bit0_val, apply bit1_val } lemma bit_decomp (n : nat) : bit (bodd n) (div2 n) = n := -(bit_val _ _).trans $ (add_comm _ _).trans $ bodd_add_div2 _ +(bit_val _ _).trans $ (nat.add_comm _ _).trans $ bodd_add_div2 _ def bit_cases_on {C : nat → Sort u} (n) (h : ∀ b n, C (bit b n)) : C n := by rw [← bit_decomp n]; apply h @@ -117,7 +122,7 @@ def binary_rec {C : nat → Sort u} (z : C 0) (f : ∀ b n, C n → C (bit b n)) apply (div_lt_iff_lt_mul _ _ (succ_pos 1)).2, have := nat.mul_lt_mul_of_pos_left (lt_succ_self 1) (lt_of_le_of_ne (zero_le _) (ne.symm n0)), - rwa mul_one at this + rwa nat.mul_one at this end, by rw [← show bit (bodd n) n' = n, from bit_decomp n]; exact f (bodd n) n' (binary_rec n') @@ -148,7 +153,7 @@ lemma bodd_bit (b n) : bodd (bit b n) = b := by rw bit_val; simp; cases b; cases bodd n; refl lemma div2_bit (b n) : div2 (bit b n) = n := -by rw [bit_val, div2_val, add_comm, add_mul_div_left, div_eq_of_lt, zero_add]; +by rw [bit_val, div2_val, nat.add_comm, add_mul_div_left, div_eq_of_lt, nat.zero_add]; cases b; exact dec_trivial lemma shiftl'_add (b m n) : ∀ k, shiftl' b m (n + k) = shiftl' b (shiftl' b m n) k @@ -164,7 +169,7 @@ lemma shiftr_add (m n) : ∀ k, shiftr m (n + k) = shiftr (shiftr m n) k lemma shiftl'_sub (b m) : ∀ {n k}, k ≤ n → shiftl' b m (n - k) = shiftr (shiftl' b m n) k | n 0 h := rfl | (n+1) (k+1) h := begin - simp [shiftl'], rw [add_comm, shiftr_add], + simp [shiftl'], rw [nat.add_comm, shiftr_add], simp [shiftr, div2_bit], apply shiftl'_sub (nat.le_of_succ_le_succ h) end @@ -172,23 +177,24 @@ end lemma shiftl_sub : ∀ m {n k}, k ≤ n → shiftl m (n - k) = shiftr (shiftl m n) k := shiftl'_sub _ lemma shiftl_eq_mul_pow (m) : ∀ n, shiftl m n = m * 2 ^ n -| 0 := (mul_one _).symm -| (k+1) := show bit0 (shiftl m k) = m * (2^k * 2), by rw [bit0_val, shiftl_eq_mul_pow]; simp +| 0 := (nat.mul_one _).symm +| (k+1) := show bit0 (shiftl m k) = m * (2^k * 2), by rw [bit0_val, shiftl_eq_mul_pow, nat.mul_comm 2, nat.mul_assoc] lemma shiftl'_tt_eq_mul_pow (m) : ∀ n, shiftl' tt m n + 1 = (m + 1) * 2 ^ n -| 0 := by simp [shiftl, shiftl'] -| (k+1) := begin +| 0 := by simp [shiftl, shiftl', nat.pow_zero, nat.one_mul] +| (k+1) := +begin change bit1 (shiftl' tt m k) + 1 = (m + 1) * (2^k * 2), rw bit1_val, change 2 * (shiftl' tt m k + 1) = _, - rw shiftl'_tt_eq_mul_pow; simp + rw [shiftl'_tt_eq_mul_pow, nat.mul_comm 2, nat.mul_assoc] end lemma one_shiftl (n) : shiftl 1 n = 2 ^ n := -(shiftl_eq_mul_pow _ _).trans (one_mul _) +(shiftl_eq_mul_pow _ _).trans (nat.one_mul _) @[simp] lemma zero_shiftl (n) : shiftl 0 n = 0 := -(shiftl_eq_mul_pow _ _).trans (zero_mul _) +(shiftl_eq_mul_pow _ _).trans (nat.zero_mul _) lemma shiftr_eq_div_pow (m) : ∀ n, shiftr m n = m / 2 ^ n | 0 := (nat.div_one _).symm @@ -203,7 +209,7 @@ lemma shiftr_eq_div_pow (m) : ∀ n, shiftr m n = m / 2 ^ n lemma test_bit_succ (m b n) : test_bit (bit b n) (succ m) = test_bit n m := have bodd (shiftr (shiftr (bit b n) 1) m) = bodd (shiftr n m), by dsimp [shiftr]; rw div2_bit, -by rw [← shiftr_add, add_comm] at this; exact this +by rw [← shiftr_add, nat.add_comm] at this; exact this lemma binary_rec_eq {C : nat → Sort u} {z : C 0} {f : ∀ b n, C n → C (bit b n)} (h : f ff 0 z = z) (b n) : diff --git a/library/init/data/nat/gcd.lean b/library/init/data/nat/gcd.lean index 4c2f01320e..547dd8ae1d 100644 --- a/library/init/data/nat/gcd.lean +++ b/library/init/data/nat/gcd.lean @@ -53,4 +53,4 @@ def lcm (m n : ℕ) : ℕ := m * n / (gcd m n) @[reducible] def coprime (m n : ℕ) : Prop := gcd m n = 1 -end nat \ No newline at end of file +end nat diff --git a/library/init/data/nat/lemmas.lean b/library/init/data/nat/lemmas.lean index f346004588..ce52631b42 100644 --- a/library/init/data/nat/lemmas.lean +++ b/library/init/data/nat/lemmas.lean @@ -47,9 +47,6 @@ assume h, nat.no_confusion h protected lemma zero_ne_one : 0 ≠ (1 : ℕ) := assume h, nat.no_confusion h -instance : zero_ne_one_class ℕ := -{ zero := 0, one := 1, zero_ne_one := nat.zero_ne_one } - lemma eq_zero_of_add_eq_zero_right : ∀ {n m : ℕ}, n + m = 0 → n = 0 | 0 m := by simp [nat.zero_add] | (n+1) m := λ h, @@ -114,24 +111,6 @@ protected lemma mul_one : ∀ (n : ℕ), n * 1 = n := nat.zero_add protected lemma one_mul (n : ℕ) : 1 * n = n := by rw [nat.mul_comm, nat.mul_one] -instance : comm_semiring nat := -{add := nat.add, - add_assoc := nat.add_assoc, - zero := nat.zero, - zero_add := nat.zero_add, - add_zero := nat.add_zero, - add_comm := nat.add_comm, - mul := nat.mul, - mul_assoc := nat.mul_assoc, - one := nat.succ nat.zero, - one_mul := nat.one_mul, - mul_one := nat.mul_one, - left_distrib := nat.left_distrib, - right_distrib := nat.right_distrib, - zero_mul := nat.zero_mul, - mul_zero := nat.mul_zero, - mul_comm := nat.mul_comm} - /- properties of inequality -/ protected lemma le_of_eq {n m : ℕ} (p : n = m) : n ≤ m := @@ -268,6 +247,10 @@ nat.lt_of_le_and_ne (nat.le_of_add_le_add_left h') (λ heq, nat.lt_irrefl (k + m) begin rw heq at h, assumption end) +protected lemma lt_of_add_lt_add_right {a b c : ℕ} (h : a + b < c + b) : a < c := +nat.lt_of_add_lt_add_left $ +show b + a < b + c, by rwa [nat.add_comm b a, nat.add_comm b c] + protected lemma add_lt_add_left {n m : ℕ} (h : n < m) (k : ℕ) : k + n < k + m := lt_of_succ_le (add_succ k n ▸ nat.add_le_add_left (succ_le_of_lt h) k) @@ -278,7 +261,13 @@ protected lemma lt_add_of_pos_right {n k : ℕ} (h : k > 0) : n < n + k := nat.add_lt_add_left h n protected lemma lt_add_of_pos_left {n k : ℕ} (h : k > 0) : n < k + n := -by rw add_comm; exact nat.lt_add_of_pos_right h +by rw nat.add_comm; exact nat.lt_add_of_pos_right h + +protected lemma add_lt_add {a b c d : ℕ} (h₁ : a < b) (h₂ : c < d) : a + c < b + d := +lt_trans (nat.add_lt_add_right h₁ c) (nat.add_lt_add_left h₂ b) + +protected lemma add_le_add {a b c d : ℕ} (h₁ : a ≤ b) (h₂ : c ≤ d) : a + c ≤ b + d := +le_trans (nat.add_le_add_right h₁ c) (nat.add_le_add_left h₂ b) protected lemma zero_lt_one : 0 < (1:nat) := zero_lt_succ 0 @@ -286,53 +275,43 @@ zero_lt_succ 0 lemma mul_le_mul_left {n m : ℕ} (k : ℕ) (h : n ≤ m) : k * n ≤ k * m := match le.dest h with | ⟨l, hl⟩ := - have k * n + k * l = k * m, by rw [← left_distrib, hl], + have k * n + k * l = k * m, by rw [← nat.left_distrib, hl], le.intro this end lemma mul_le_mul_right {n m : ℕ} (k : ℕ) (h : n ≤ m) : n * k ≤ m * k := -mul_comm k m ▸ mul_comm k n ▸ mul_le_mul_left k h +nat.mul_comm k m ▸ nat.mul_comm k n ▸ mul_le_mul_left k h protected lemma mul_lt_mul_of_pos_left {n m k : ℕ} (h : n < m) (hk : k > 0) : k * n < k * m := nat.lt_of_lt_of_le (nat.lt_add_of_pos_right hk) (mul_succ k n ▸ nat.mul_le_mul_left k (succ_le_of_lt h)) protected lemma mul_lt_mul_of_pos_right {n m k : ℕ} (h : n < m) (hk : k > 0) : n * k < m * k := -mul_comm k m ▸ mul_comm k n ▸ nat.mul_lt_mul_of_pos_left h hk +nat.mul_comm k m ▸ nat.mul_comm k n ▸ nat.mul_lt_mul_of_pos_left h hk -instance : decidable_linear_ordered_semiring nat := -{ add_left_cancel := @nat.add_left_cancel, - add_right_cancel := @nat.add_right_cancel, - lt := nat.lt, +protected lemma le_of_mul_le_mul_left {a b c : ℕ} (h : c * a ≤ c * b) (hc : c > 0) : a ≤ b := +le_of_not_gt + (assume h1 : b < a, + have h2 : c * b < c * a, from nat.mul_lt_mul_of_pos_left h1 hc, + not_le_of_gt h2 h) + +instance : decidable_linear_order nat := +{ lt := nat.lt, le := nat.le, le_refl := nat.le_refl, le_trans := @nat.le_trans, le_antisymm := @nat.le_antisymm, le_total := @nat.le_total, lt_iff_le_not_le := @lt_iff_le_not_le _ _, - add_le_add_left := @nat.add_le_add_left, - le_of_add_le_add_left := @nat.le_of_add_le_add_left, - zero_lt_one := zero_lt_succ 0, - mul_lt_mul_of_pos_left := @nat.mul_lt_mul_of_pos_left, - mul_lt_mul_of_pos_right := @nat.mul_lt_mul_of_pos_right, decidable_lt := nat.decidable_lt, decidable_le := nat.decidable_le, - decidable_eq := nat.decidable_eq, - ..nat.comm_semiring } - --- all the fields are already included in the decidable_linear_ordered_semiring instance -instance : decidable_linear_ordered_cancel_add_comm_monoid ℕ := -{ add_left_cancel := @nat.add_left_cancel, - ..nat.decidable_linear_ordered_semiring } + decidable_eq := nat.decidable_eq } lemma le_of_lt_succ {m n : nat} : m < succ n → m ≤ n := le_of_succ_le_succ theorem eq_of_mul_eq_mul_left {m k n : ℕ} (Hn : n > 0) (H : n * m = n * k) : m = k := -le_antisymm (le_of_mul_le_mul_left (le_of_eq H) Hn) - (le_of_mul_le_mul_left (le_of_eq H.symm) Hn) - -theorem eq_of_mul_eq_mul_right {n m k : ℕ} (Hm : m > 0) (H : n * m = k * m) : n = k := -by rw [mul_comm n m, mul_comm k m] at H; exact eq_of_mul_eq_mul_left Hm H +le_antisymm (nat.le_of_mul_le_mul_left (le_of_eq H) Hn) + (nat.le_of_mul_le_mul_left (le_of_eq H.symm) Hn) /- sub properties -/ @@ -393,7 +372,8 @@ protected lemma bit0_inj : ∀ {n m : ℕ}, bit0 n = bit0 m → n = m | (n+1) 0 h := by contradiction | (n+1) (m+1) h := have succ (succ (n + n)) = succ (succ (m + m)), - begin unfold bit0 at h, simp [add_one, add_succ, succ_add] at h, rw h end, + by { unfold bit0 at h, simp [add_one, add_succ, succ_add] at h, + have aux : n + n = m + m := h, rw aux }, have n + n = m + m, by iterate { injection this with this }, have n = m, from bit0_inj this, by rw this @@ -441,19 +421,19 @@ protected lemma one_lt_bit0 : ∀ {n : nat}, n ≠ 0 → 1 < bit0 n end protected lemma bit0_lt {n m : nat} (h : n < m) : bit0 n < bit0 m := -add_lt_add h h +nat.add_lt_add h h protected lemma bit1_lt {n m : nat} (h : n < m) : bit1 n < bit1 m := -succ_lt_succ (add_lt_add h h) +succ_lt_succ (nat.add_lt_add h h) protected lemma bit0_lt_bit1 {n m : nat} (h : n ≤ m) : bit0 n < bit1 m := -lt_succ_of_le (add_le_add h h) +lt_succ_of_le (nat.add_le_add h h) protected lemma bit1_lt_bit0 : ∀ {n m : nat}, n < m → bit1 n < bit0 m | n 0 h := absurd h (not_lt_zero _) | n (succ m) h := have n ≤ m, from le_of_lt_succ h, - have succ (n + n) ≤ succ (m + m), from succ_le_succ (add_le_add this this), + have succ (n + n) ≤ succ (m + m), from succ_le_succ (nat.add_le_add this this), have succ (n + n) ≤ succ m + m, {rw succ_add, assumption}, show succ (n + n) < succ (succ m + m), from lt_succ_of_le this @@ -468,19 +448,6 @@ protected lemma one_le_bit0 : ∀ (n : ℕ), n ≠ 0 → 1 ≤ bit0 n eq.symm (nat.bit0_succ_eq n) ▸ this, succ_le_succ (zero_le (succ (bit0 n))) -/- Extra instances to short-circuit type class resolution -/ -instance : add_comm_monoid nat := by apply_instance -instance : add_monoid nat := by apply_instance -instance : monoid nat := by apply_instance -instance : comm_monoid nat := by apply_instance -instance : comm_semigroup nat := by apply_instance -instance : semigroup nat := by apply_instance -instance : add_comm_semigroup nat := by apply_instance -instance : add_semigroup nat := by apply_instance -instance : distrib nat := by apply_instance -instance : semiring nat := by apply_instance -instance : ordered_semiring nat := by apply_instance - /- subtraction -/ @[simp] protected theorem sub_zero (n : ℕ) : n - 0 = n := @@ -500,17 +467,17 @@ protected theorem sub_self : ∀ (n : ℕ), n - n = 0 arithmetic theory in the smt_stactic -/ @[ematch_lhs] protected theorem add_sub_add_right : ∀ (n k m : ℕ), (n + k) - (m + k) = n - m -| n 0 m := by rw [add_zero, add_zero] +| n 0 m := by rw [nat.add_zero, nat.add_zero] | n (succ k) m := by rw [add_succ, add_succ, succ_sub_succ, add_sub_add_right n k m] @[ematch_lhs] protected theorem add_sub_add_left (k n m : ℕ) : (k + n) - (k + m) = n - m := -by rw [add_comm k n, add_comm k m, nat.add_sub_add_right] +by rw [nat.add_comm k n, nat.add_comm k m, nat.add_sub_add_right] @[ematch_lhs] protected theorem add_sub_cancel (n m : ℕ) : n + m - m = n := suffices n + m - (0 + m) = n, from - by rwa [zero_add] at this, + by rwa [nat.zero_add] at this, by rw [nat.add_sub_add_right, nat.sub_zero] @[ematch_lhs] @@ -519,7 +486,7 @@ show n + m - (n + 0) = m, from by rw [nat.add_sub_add_left, nat.sub_zero] protected theorem sub_sub : ∀ (n m k : ℕ), n - m - k = n - (m + k) -| n m 0 := by rw [add_zero, nat.sub_zero] +| n m 0 := by rw [nat.add_zero, nat.sub_zero] | n m (succ k) := by rw [add_succ, nat.sub_succ, nat.sub_succ, sub_sub n m k] theorem le_of_le_of_sub_le_sub_right {n m k : ℕ} @@ -578,7 +545,7 @@ exists.elim (nat.le.dest h) protected theorem le_of_sub_eq_zero : ∀{n m : ℕ}, n - m = 0 → n ≤ m | n 0 H := begin rw [nat.sub_zero] at H, simp [H] end | 0 (m+1) H := zero_le _ -| (n+1) (m+1) H := add_le_add_right +| (n+1) (m+1) H := nat.add_le_add_right (le_of_sub_eq_zero begin simp [nat.add_sub_add_right] at H, exact H end) _ protected theorem sub_eq_zero_iff_le {n m : ℕ} : n - m = 0 ↔ n ≤ m := @@ -590,12 +557,12 @@ exists.elim (nat.le.dest h) by rw [← hk, nat.add_sub_cancel_left]) protected theorem sub_add_cancel {n m : ℕ} (h : n ≥ m) : n - m + m = n := -by rw [add_comm, add_sub_of_le h] +by rw [nat.add_comm, add_sub_of_le h] protected theorem add_sub_assoc {m k : ℕ} (h : k ≤ m) (n : ℕ) : n + m - k = n + (m - k) := exists.elim (nat.le.dest h) (assume l, assume hl : k + l = m, - by rw [← hl, nat.add_sub_cancel_left, add_comm k, ← add_assoc, nat.add_sub_cancel]) + by rw [← hl, nat.add_sub_cancel_left, nat.add_comm k, ← nat.add_assoc, nat.add_sub_cancel]) protected lemma sub_eq_iff_eq_add {a b c : ℕ} (ab : b ≤ a) : a - b = c ↔ a = c + b := ⟨assume c_eq, begin rw [c_eq.symm, nat.sub_add_cancel ab] end, @@ -731,17 +698,17 @@ begin { apply nat.sub_lt _ h.left, apply lt_of_lt_of_le h.left h.right }, rw [div_def, mod_def, if_pos h, if_pos h], - simp [left_distrib, IH _ h', add_comm, add_left_comm], - rw [← nat.add_sub_assoc h.right, nat.add_sub_cancel_left] }, + simp [nat.left_distrib, IH _ h', nat.add_comm, nat.add_left_comm], + rw [nat.add_comm, ← nat.add_sub_assoc h.right, nat.mul_one, nat.add_sub_cancel_left] }, -- ¬ (0 < k ∧ k ≤ m) - { rw [div_def, mod_def, if_neg h', if_neg h'], simp }, + { rw [div_def, mod_def, if_neg h', if_neg h', nat.mul_zero, nat.add_zero] }, end /- div -/ @[simp] protected lemma div_one (n : ℕ) : n / 1 = n := have n % 1 + 1 * (n / 1) = n, from mod_add_div _ _, -by simp [mod_one] at this; assumption +by { rwa [mod_one, nat.zero_add, nat.one_mul] at this } @[simp] protected lemma div_zero (n : ℕ) : n / 0 = 0 := begin rw [div_def], simp [lt_irrefl] end @@ -752,7 +719,7 @@ eq.trans (div_def 0 b) $ if_neg (and.rec not_le_of_gt) protected lemma div_le_of_le_mul {m n : ℕ} : ∀ {k}, m ≤ k * n → m / k ≤ n | 0 h := by simp [nat.div_zero]; apply zero_le | (succ k) h := - suffices succ k * (m / succ k) ≤ succ k * n, from le_of_mul_le_mul_left this (zero_lt_succ _), + suffices succ k * (m / succ k) ≤ succ k * n, from nat.le_of_mul_le_mul_left this (zero_lt_succ _), calc succ k * (m / succ k) ≤ m % succ k + succ k * (m / succ k) : le_add_left _ _ ... = m : by rw mod_add_div @@ -762,7 +729,7 @@ protected lemma div_le_self : ∀ (m n : ℕ), m / n ≤ m | m 0 := by simp [nat.div_zero]; apply zero_le | m (succ n) := have m ≤ succ n * m, from calc - m = 1 * m : by simp + m = 1 * m : by rw nat.one_mul ... ≤ succ n * m : mul_le_mul_right _ (succ_le_succ (zero_le _)), nat.div_le_of_le_mul this @@ -801,15 +768,15 @@ begin -- base case: y < k { rw [div_eq_of_lt h], cases x with x, - { simp [zero_mul, zero_le] }, - { simp [succ_mul, not_succ_le_zero, add_comm], + { simp [nat.zero_mul, zero_le] }, + { simp [succ_mul, not_succ_le_zero, nat.add_comm], apply not_le_of_gt, apply lt_of_lt_of_le h, apply le_add_right } }, -- step: k ≤ y { rw [div_eq_sub_div Hk h], cases x with x, - { simp [zero_mul, zero_le] }, + { simp [nat.zero_mul, zero_le] }, { have Hlt : y - k < y, { apply sub_lt_of_pos_le ; assumption }, rw [ ← add_one @@ -870,7 +837,7 @@ theorem sub_induction {P : ℕ → ℕ → Sort u} (H1 : ∀m, P 0 m) theorem succ_add_eq_succ_add (n m : ℕ) : succ n + m = n + succ m := by simp [succ_add, add_succ] -theorem one_add (n : ℕ) : 1 + n = succ n := by simp [add_comm] +-- theorem one_add (n : ℕ) : 1 + n = succ n := by simp [add_comm] protected theorem add_right_comm : ∀ (n m k : ℕ), n + m + k = n + k + m := right_comm nat.add nat.add_comm nat.add_assoc @@ -918,25 +885,6 @@ theorem lt_succ_of_lt {a b : nat} (h : a < b) : a < succ b := le_succ_of_le h def one_pos := nat.zero_lt_one -theorem mul_self_le_mul_self {n m : ℕ} (h : n ≤ m) : n * n ≤ m * m := -mul_le_mul h h (zero_le _) (zero_le _) - -theorem mul_self_lt_mul_self : Π {n m : ℕ}, n < m → n * n < m * m -| 0 m h := mul_pos h h -| (succ n) m h := mul_lt_mul h (le_of_lt h) (succ_pos _) (zero_le _) - -theorem mul_self_le_mul_self_iff {n m : ℕ} : n ≤ m ↔ n * n ≤ m * m := -⟨mul_self_le_mul_self, λh, decidable.by_contradiction $ - λhn, not_lt_of_ge h $ mul_self_lt_mul_self $ lt_of_not_ge hn⟩ - -theorem mul_self_lt_mul_self_iff {n m : ℕ} : n < m ↔ n * n < m * m := -iff.trans (lt_iff_not_ge _ _) $ iff.trans (not_iff_not_of_iff mul_self_le_mul_self_iff) $ - iff.symm (lt_iff_not_ge _ _) - -theorem le_mul_self : Π (n : ℕ), n ≤ n * n -| 0 := le_refl _ -| (n+1) := let t := mul_le_mul_left (n+1) (succ_pos n) in by simp at t; exact t - /- subtraction -/ protected theorem sub_le_sub_left {n m : ℕ} (k) (h : n ≤ m) : k - m ≤ k - n := @@ -946,28 +894,31 @@ theorem succ_sub_sub_succ (n m k : ℕ) : succ n - m - succ k = n - m - k := by rw [nat.sub_sub, nat.sub_sub, add_succ, succ_sub_succ] protected theorem sub.right_comm (m n k : ℕ) : m - n - k = m - k - n := -by rw [nat.sub_sub, nat.sub_sub, add_comm] +by rw [nat.sub_sub, nat.sub_sub, nat.add_comm] theorem mul_pred_left : ∀ (n m : ℕ), pred n * m = n * m - m -| 0 m := by simp [nat.zero_sub, pred_zero, zero_mul] +| 0 m := by simp [nat.zero_sub, pred_zero, nat.zero_mul] | (succ n) m := by rw [pred_succ, succ_mul, nat.add_sub_cancel] theorem mul_pred_right (n m : ℕ) : n * pred m = n * m - n := -by rw [mul_comm, mul_pred_left, mul_comm] +by rw [nat.mul_comm, mul_pred_left, nat.mul_comm] protected theorem mul_sub_right_distrib : ∀ (n m k : ℕ), (n - m) * k = n * k - m * k -| n 0 k := by simp [nat.sub_zero] +| n 0 k := by simp [nat.sub_zero, nat.zero_mul] | n (succ m) k := by rw [nat.sub_succ, mul_pred_left, mul_sub_right_distrib, succ_mul, nat.sub_sub] protected theorem mul_sub_left_distrib (n m k : ℕ) : n * (m - k) = n * m - n * k := -by rw [mul_comm, nat.mul_sub_right_distrib, mul_comm m n, mul_comm n k] +by rw [nat.mul_comm, nat.mul_sub_right_distrib, nat.mul_comm m n, nat.mul_comm n k] protected theorem mul_self_sub_mul_self_eq (a b : nat) : a * a - b * b = (a + b) * (a - b) := -by rw [nat.mul_sub_left_distrib, right_distrib, right_distrib, mul_comm b a, add_comm (a*a) (a*b), +by rw [nat.mul_sub_left_distrib, nat.right_distrib, nat.right_distrib, nat.mul_comm b a, nat.add_comm (a*a) (a*b), nat.add_sub_add_left] theorem succ_mul_succ_eq (a b : nat) : succ a * succ b = a*b + a + b + 1 := -begin rw [← add_one, ← add_one], simp [right_distrib, left_distrib, add_left_comm] end +begin + rw [← add_one, ← add_one], + simp [nat.right_distrib, nat.left_distrib, nat.add_left_comm, nat.mul_one, nat.one_mul, nat.add_assoc], +end theorem succ_sub {m n : ℕ} (h : m ≥ n) : succ m - n = succ (m - n) := exists.elim (nat.le.dest h) @@ -975,8 +926,8 @@ exists.elim (nat.le.dest h) by rw [← hk, nat.add_sub_cancel_left, ← add_succ, nat.add_sub_cancel_left]) protected theorem sub_pos_of_lt {m n : ℕ} (h : m < n) : n - m > 0 := -have 0 + m < n - m + m, begin rw [zero_add, nat.sub_add_cancel (le_of_lt h)], exact h end, -lt_of_add_lt_add_right this +have 0 + m < n - m + m, begin rw [nat.zero_add, nat.sub_add_cancel (le_of_lt h)], exact h end, +nat.lt_of_add_lt_add_right this protected theorem sub_sub_self {n m : ℕ} (h : m ≤ n) : n - (n - m) = m := (nat.sub_eq_iff_eq_add (nat.sub_le _ _)).2 (eq.symm (add_sub_of_le h)) @@ -989,7 +940,7 @@ theorem sub_one_sub_lt {n i} (h : i < n) : n - 1 - i < n := begin rw nat.sub_sub, apply nat.sub_lt, apply lt_of_lt_of_le (nat.zero_lt_succ _) h, - rw add_comm, + rw nat.add_comm, apply nat.zero_lt_succ end @@ -1046,25 +997,25 @@ or.elim (lt_or_ge x y) by rw [mod_eq_sub_mod (nat.le_add_left _ _), nat.add_sub_cancel] @[simp] theorem add_mod_left (x z : ℕ) : (x + z) % x = z % x := -by rw [add_comm, add_mod_right] +by rw [nat.add_comm, add_mod_right] @[simp] theorem add_mul_mod_self_left (x y z : ℕ) : (x + y * z) % y = x % y := -by {induction z with z ih, simp, rw[mul_succ, ← add_assoc, add_mod_right, ih]} +by {induction z with z ih, rw [nat.mul_zero, nat.add_zero], rw [mul_succ, ← nat.add_assoc, add_mod_right, ih]} @[simp] theorem add_mul_mod_self_right (x y z : ℕ) : (x + y * z) % z = x % z := -by rw [mul_comm, add_mul_mod_self_left] +by rw [nat.mul_comm, add_mul_mod_self_left] @[simp] theorem mul_mod_right (m n : ℕ) : (m * n) % m = 0 := -by rw [← zero_add (m*n), add_mul_mod_self_left, zero_mod] +by rw [← nat.zero_add (m*n), add_mul_mod_self_left, zero_mod] @[simp] theorem mul_mod_left (m n : ℕ) : (m * n) % n = 0 := -by rw [mul_comm, mul_mod_right] +by rw [nat.mul_comm, mul_mod_right] theorem mul_mod_mul_left (z x y : ℕ) : (z * x) % (z * y) = z * (x % y) := if y0 : y = 0 then - by rw [y0, mul_zero, mod_zero, mod_zero] + by rw [y0, nat.mul_zero, mod_zero, mod_zero] else if z0 : z = 0 then - by rw [z0, zero_mul, zero_mul, zero_mul, mod_zero] + by rw [z0, nat.zero_mul, nat.zero_mul, nat.zero_mul, mod_zero] else x.strong_induction_on $ λn IH, have y0 : y > 0, from nat.pos_of_ne_zero y0, have z0 : z > 0, from nat.pos_of_ne_zero z0, @@ -1074,23 +1025,23 @@ else x.strong_induction_on $ λn IH, mod_eq_sub_mod (mul_le_mul_left z yn), ← nat.mul_sub_left_distrib]; exact IH _ (sub_lt (lt_of_lt_of_le y0 yn) y0)) - (λyn, by rw [mod_eq_of_lt yn, mod_eq_of_lt (mul_lt_mul_of_pos_left yn z0)]) + (λyn, by rw [mod_eq_of_lt yn, mod_eq_of_lt (nat.mul_lt_mul_of_pos_left yn z0)]) theorem mul_mod_mul_right (z x y : ℕ) : (x * z) % (y * z) = (x % y) * z := -by rw [mul_comm x z, mul_comm y z, mul_comm (x % y) z]; apply mul_mod_mul_left +by rw [nat.mul_comm x z, nat.mul_comm y z, nat.mul_comm (x % y) z]; apply mul_mod_mul_left theorem cond_to_bool_mod_two (x : ℕ) [d : decidable (x % 2 = 1)] : cond (@to_bool (x % 2 = 1) d) 1 0 = x % 2 := begin by_cases h : x % 2 = 1, { simp! [*] }, - { cases mod_two_eq_zero_or_one x; simp! [*] } + { cases mod_two_eq_zero_or_one x; simp! [*, nat.zero_ne_one] } end theorem sub_mul_mod (x k n : ℕ) (h₁ : n*k ≤ x) : (x - n*k) % n = x % n := begin induction k with k, - { simp }, + { rw [nat.mul_zero, nat.sub_zero] }, { have h₂ : n * k ≤ x, { rw [mul_succ] at h₁, apply nat.le_trans _ h₁, @@ -1098,7 +1049,7 @@ begin have h₄ : x - n * k ≥ n, { apply @nat.le_of_add_le_add_right (n*k), rw [nat.sub_add_cancel h₂], - simp [mul_succ, add_comm] at h₁, simp [h₁] }, + simp [mul_succ, nat.add_comm] at h₁, simp [h₁] }, rw [mul_succ, ← nat.sub_sub, ← mod_eq_sub_mod h₄, k_ih h₂] } end @@ -1109,14 +1060,14 @@ begin cases eq_zero_or_pos n with h₀ h₀, { rw [h₀, nat.div_zero, nat.div_zero, nat.zero_sub] }, { induction p with p, - { simp }, + { rw [nat.mul_zero, nat.sub_zero, nat.sub_zero] }, { have h₂ : n*p ≤ x, { transitivity, { apply nat.mul_le_mul_left, apply le_succ }, { apply h₁ } }, have h₃ : x - n * p ≥ n, - { apply le_of_add_le_add_right, - rw [nat.sub_add_cancel h₂, add_comm], + { apply nat.le_of_add_le_add_right, + rw [nat.sub_add_cancel h₂, nat.add_comm], rw [mul_succ] at h₁, apply h₁ }, rw [sub_succ, ← p_ih h₂], @@ -1132,28 +1083,32 @@ theorem div_mul_le_self : ∀ (m n : ℕ), m / n * n ≤ m by rw [div_eq_sub_div H (nat.le_add_left _ _), nat.add_sub_cancel] @[simp] theorem add_div_left (x : ℕ) {z : ℕ} (H : z > 0) : (z + x) / z = succ (x / z) := -by rw [add_comm, add_div_right x H] +by rw [nat.add_comm, add_div_right x H] @[simp] theorem mul_div_right (n : ℕ) {m : ℕ} (H : m > 0) : m * n / m = n := -by {induction n; simp [*, mul_succ, -mul_comm]} +by {induction n; simp [*, mul_succ, nat.mul_zero] } @[simp] theorem mul_div_left (m : ℕ) {n : ℕ} (H : n > 0) : m * n / n = m := -by rw [mul_comm, mul_div_right _ H] +by rw [nat.mul_comm, mul_div_right _ H] protected theorem div_self {n : ℕ} (H : n > 0) : n / n = 1 := -let t := add_div_right 0 H in by rwa [zero_add, nat.zero_div] at t +let t := add_div_right 0 H in by rwa [nat.zero_add, nat.zero_div] at t theorem add_mul_div_left (x z : ℕ) {y : ℕ} (H : y > 0) : (x + y * z) / y = x / y + z := -by {induction z with z ih, simp, rw [mul_succ, ← add_assoc, add_div_right _ H, ih]} +begin + induction z with z ih, + { rw [nat.mul_zero, nat.add_zero, nat.add_zero] }, + { rw [mul_succ, ← nat.add_assoc, add_div_right _ H, ih] } +end theorem add_mul_div_right (x y : ℕ) {z : ℕ} (H : z > 0) : (x + y * z) / z = x / z + y := -by rw [mul_comm, add_mul_div_left _ _ H] +by rw [nat.mul_comm, add_mul_div_left _ _ H] protected theorem mul_div_cancel (m : ℕ) {n : ℕ} (H : n > 0) : m * n / n = m := -let t := add_mul_div_right 0 m H in by rwa [zero_add, nat.zero_div, zero_add] at t +let t := add_mul_div_right 0 m H in by rwa [nat.zero_add, nat.zero_div, nat.zero_add] at t protected theorem mul_div_cancel_left (m : ℕ) {n : ℕ} (H : n > 0) : n * m / n = m := -by rw [mul_comm, nat.mul_div_cancel _ H] +by rw [nat.mul_comm, nat.mul_div_cancel _ H] protected theorem div_eq_of_eq_mul_left {m n k : ℕ} (H1 : n > 0) (H2 : m = k * n) : m / n = k := @@ -1167,7 +1122,7 @@ protected theorem div_eq_of_lt_le {m n k : ℕ} (lo : k * n ≤ m) (hi : m < succ k * n) : m / n = k := have npos : n > 0, from (eq_zero_or_pos _).resolve_left $ λ hn, - by rw [hn, mul_zero] at hi lo; exact absurd lo (not_le_of_gt hi), + by rw [hn, nat.mul_zero] at hi lo; exact absurd lo (not_le_of_gt hi), le_antisymm (le_of_lt_succ ((nat.div_lt_iff_lt_mul _ _ npos).2 hi)) ((nat.le_div_iff_mul_le _ _ npos).2 lo) @@ -1175,32 +1130,36 @@ le_antisymm theorem mul_sub_div (x n p : ℕ) (h₁ : x < n*p) : (n * p - succ x) / n = p - succ (x / n) := begin have npos : n > 0 := (eq_zero_or_pos _).resolve_left (λ n0, - by rw [n0, zero_mul] at h₁; exact not_lt_zero _ h₁), + by rw [n0, nat.zero_mul] at h₁; exact not_lt_zero _ h₁), apply nat.div_eq_of_lt_le, - { rw [nat.mul_sub_right_distrib, mul_comm], + { rw [nat.mul_sub_right_distrib, nat.mul_comm], apply nat.sub_le_sub_left, exact (div_lt_iff_lt_mul _ _ npos).1 (lt_succ_self _) }, { change succ (pred (n * p - x)) ≤ (succ (pred (p - x / n))) * n, rw [succ_pred_eq_of_pos (nat.sub_pos_of_lt h₁), succ_pred_eq_of_pos (nat.sub_pos_of_lt _)], - { rw [nat.mul_sub_right_distrib, mul_comm], + { rw [nat.mul_sub_right_distrib, nat.mul_comm], apply nat.sub_le_sub_left, apply div_mul_le_self }, - { apply (div_lt_iff_lt_mul _ _ npos).2, rwa mul_comm } } + { apply (div_lt_iff_lt_mul _ _ npos).2, rwa nat.mul_comm } } end +lemma mul_pos {a b : ℕ} (ha : a > 0) (hb : b > 0) : a * b > 0 := +have h : 0 * b < a * b, from nat.mul_lt_mul_of_pos_right ha hb, +by rwa nat.zero_mul at h + protected theorem div_div_eq_div_mul (m n k : ℕ) : m / n / k = m / (n * k) := begin - cases eq_zero_or_pos k with k0 kpos, {rw [k0, mul_zero, nat.div_zero, nat.div_zero]}, - cases eq_zero_or_pos n with n0 npos, {rw [n0, zero_mul, nat.div_zero, nat.zero_div]}, + cases eq_zero_or_pos k with k0 kpos, {rw [k0, nat.mul_zero, nat.div_zero, nat.div_zero]}, + cases eq_zero_or_pos n with n0 npos, {rw [n0, nat.zero_mul, nat.div_zero, nat.zero_div]}, apply le_antisymm, { apply (le_div_iff_mul_le _ _ (mul_pos npos kpos)).2, - rw [mul_comm n k, ← mul_assoc], + rw [nat.mul_comm n k, ← nat.mul_assoc], apply (le_div_iff_mul_le _ _ npos).1, apply (le_div_iff_mul_le _ _ kpos).1, refl }, { apply (le_div_iff_mul_le _ _ kpos).2, apply (le_div_iff_mul_le _ _ npos).2, - rw [mul_assoc, mul_comm n k], + rw [nat.mul_assoc, nat.mul_comm n k], apply (le_div_iff_mul_le _ _ (mul_pos kpos npos)).1, refl } end @@ -1210,44 +1169,59 @@ by rw [← nat.div_div_eq_div_mul, nat.mul_div_cancel_left _ H] /- dvd -/ +@[simp] +protected theorem dvd_mul_right (a b : ℕ) : a ∣ a * b := ⟨b, rfl⟩ + +protected theorem dvd_trans {a b c : ℕ} (h₁ : a ∣ b) (h₂ : b ∣ c) : a ∣ c := +match h₁, h₂ with +| ⟨d, (h₃ : b = a * d)⟩, ⟨e, (h₄ : c = b * e)⟩ := + ⟨d * e, show c = a * (d * e), by simp [h₃, h₄, nat.mul_assoc]⟩ +end + +protected theorem eq_zero_of_zero_dvd {a : ℕ} (h : 0 ∣ a) : a = 0 := +exists.elim h (assume c, assume H' : a = 0 * c, eq.trans H' (nat.zero_mul c)) + +protected theorem dvd_add {a b c : ℕ} (h₁ : a ∣ b) (h₂ : a ∣ c) : a ∣ b + c := + exists.elim h₁ (λ d hd, exists.elim h₂ (λ e he, ⟨d + e, by simp [nat.left_distrib, hd, he]⟩)) + protected theorem dvd_add_iff_right {k m n : ℕ} (h : k ∣ m) : k ∣ n ↔ k ∣ m + n := -⟨dvd_add h, dvd.elim h $ λd hd, match m, hd with -| ._, rfl := λh₂, dvd.elim h₂ $ λe he, ⟨e - d, +⟨nat.dvd_add h, exists.elim h $ λd hd, match m, hd with +| ._, rfl := λh₂, exists.elim h₂ $ λe he, ⟨e - d, by rw [nat.mul_sub_left_distrib, ← he, nat.add_sub_cancel_left]⟩ end⟩ protected theorem dvd_add_iff_left {k m n : ℕ} (h : k ∣ n) : k ∣ m ↔ k ∣ m + n := -by rw add_comm; exact nat.dvd_add_iff_right h +by rw nat.add_comm; exact nat.dvd_add_iff_right h theorem dvd_sub {k m n : ℕ} (H : n ≤ m) (h₁ : k ∣ m) (h₂ : k ∣ n) : k ∣ m - n := (nat.dvd_add_iff_left h₂).2 $ by rw nat.sub_add_cancel H; exact h₁ theorem dvd_mod_iff {k m n : ℕ} (h : k ∣ n) : k ∣ m % n ↔ k ∣ m := -let t := @nat.dvd_add_iff_left _ (m % n) _ (dvd_trans h (dvd_mul_right n (m / n))) in +let t := @nat.dvd_add_iff_left _ (m % n) _ (nat.dvd_trans h (nat.dvd_mul_right n (m / n))) in by rwa mod_add_div at t theorem le_of_dvd {m n : ℕ} (h : n > 0) : m ∣ n → m ≤ n := λ⟨k, e⟩, by { revert h, rw e, refine k.cases_on _ _, exact λhn, absurd hn (lt_irrefl _), - exact λk _, let t := mul_le_mul_left m (succ_pos k) in by rwa mul_one at t } + exact λk _, let t := mul_le_mul_left m (succ_pos k) in by rwa nat.mul_one at t } theorem dvd_antisymm : Π {m n : ℕ}, m ∣ n → n ∣ m → m = n -| m 0 h₁ h₂ := eq_zero_of_zero_dvd h₂ -| 0 n h₁ h₂ := (eq_zero_of_zero_dvd h₁).symm +| m 0 h₁ h₂ := nat.eq_zero_of_zero_dvd h₂ +| 0 n h₁ h₂ := (nat.eq_zero_of_zero_dvd h₁).symm | (succ m) (succ n) h₁ h₂ := le_antisymm (le_of_dvd (succ_pos _) h₁) (le_of_dvd (succ_pos _) h₂) theorem pos_of_dvd_of_pos {m n : ℕ} (H1 : m ∣ n) (H2 : n > 0) : m > 0 := -nat.pos_of_ne_zero $ λm0, by rw m0 at H1; rw eq_zero_of_zero_dvd H1 at H2; exact lt_irrefl _ H2 +nat.pos_of_ne_zero $ λm0, by rw m0 at H1; rw nat.eq_zero_of_zero_dvd H1 at H2; exact lt_irrefl _ H2 theorem eq_one_of_dvd_one {n : ℕ} (H : n ∣ 1) : n = 1 := le_antisymm (le_of_dvd dec_trivial H) (pos_of_dvd_of_pos H dec_trivial) theorem dvd_of_mod_eq_zero {m n : ℕ} (H : n % m = 0) : m ∣ n := -dvd.intro (n / m) $ let t := mod_add_div n m in by simp [H] at t; exact t +⟨n / m, by { have t := (mod_add_div n m).symm, rwa [H, nat.zero_add] at t }⟩ theorem mod_eq_zero_of_dvd {m n : ℕ} (H : m ∣ n) : n % m = 0 := -dvd.elim H (λ z H1, by rw [H1, mul_mod_right]) +exists.elim H (λ z H1, by rw [H1, mul_mod_right]) theorem dvd_iff_mod_eq_zero (m n : ℕ) : m ∣ n ↔ n % m = 0 := ⟨mod_eq_zero_of_dvd, dvd_of_mod_eq_zero⟩ @@ -1256,26 +1230,59 @@ instance decidable_dvd : @decidable_rel ℕ (∣) := λm n, decidable_of_decidable_of_iff (by apply_instance) (dvd_iff_mod_eq_zero _ _).symm protected theorem mul_div_cancel' {m n : ℕ} (H : n ∣ m) : n * (m / n) = m := -let t := mod_add_div m n in by rwa [mod_eq_zero_of_dvd H, zero_add] at t +let t := mod_add_div m n in by rwa [mod_eq_zero_of_dvd H, nat.zero_add] at t protected theorem div_mul_cancel {m n : ℕ} (H : n ∣ m) : m / n * n = m := -by rw [mul_comm, nat.mul_div_cancel' H] +by rw [nat.mul_comm, nat.mul_div_cancel' H] protected theorem mul_div_assoc (m : ℕ) {n k : ℕ} (H : k ∣ n) : m * n / k = m * (n / k) := or.elim (eq_zero_or_pos k) - (λh, by rw [h, nat.div_zero, nat.div_zero, mul_zero]) + (λh, by rw [h, nat.div_zero, nat.div_zero, nat.mul_zero]) (λh, have m * n / k = m * (n / k * k) / k, by rw nat.div_mul_cancel H, - by rw[this, ← mul_assoc, nat.mul_div_cancel _ h]) + by rw[this, ← nat.mul_assoc, nat.mul_div_cancel _ h]) theorem dvd_of_mul_dvd_mul_left {m n k : ℕ} (kpos : k > 0) (H : k * m ∣ k * n) : m ∣ n := -dvd.elim H (λl H1, by rw mul_assoc at H1; exact ⟨_, eq_of_mul_eq_mul_left kpos H1⟩) +exists.elim H (λl H1, by rw nat.mul_assoc at H1; exact ⟨_, eq_of_mul_eq_mul_left kpos H1⟩) theorem dvd_of_mul_dvd_mul_right {m n k : ℕ} (kpos : k > 0) (H : m * k ∣ n * k) : m ∣ n := -by rw [mul_comm m k, mul_comm n k] at H; exact dvd_of_mul_dvd_mul_left kpos H +by rw [nat.mul_comm m k, nat.mul_comm n k] at H; exact dvd_of_mul_dvd_mul_left kpos H + +/- --- -/ + +protected lemma mul_le_mul_of_nonneg_left {a b c : ℕ} (h₁ : a ≤ b) (h₂ : 0 ≤ c) : c * a ≤ c * b := +begin + by_cases hba : b ≤ a, { simp [le_antisymm hba h₁] }, + by_cases hc0 : c ≤ 0, { simp [le_antisymm hc0 h₂, nat.zero_mul] }, + exact (le_not_le_of_lt (nat.mul_lt_mul_of_pos_left (lt_of_le_not_le h₁ hba) (lt_of_le_not_le h₂ hc0))).left, +end + +protected lemma mul_le_mul_of_nonneg_right {a b c : ℕ} (h₁ : a ≤ b) (h₂ : 0 ≤ c) : a * c ≤ b * c := +begin + by_cases hba : b ≤ a, { simp [le_antisymm hba h₁] }, + by_cases hc0 : c ≤ 0, { simp [le_antisymm hc0 h₂, nat.mul_zero] }, + exact (le_not_le_of_lt (nat.mul_lt_mul_of_pos_right (lt_of_le_not_le h₁ hba) (lt_of_le_not_le h₂ hc0))).left, +end + +protected lemma mul_lt_mul {a b c d : ℕ} (hac : a < c) (hbd : b ≤ d) (pos_b : 0 < b) (nn_c : 0 ≤ c) : a * b < c * d := +calc + a * b < c * b : nat.mul_lt_mul_of_pos_right hac pos_b + ... ≤ c * d : nat.mul_le_mul_of_nonneg_left hbd nn_c + +protected lemma mul_lt_mul' {a b c d : ℕ} (h1 : a ≤ c) (h2 : b < d) (h3 : b ≥ 0) (h4 : c > 0) : + a * b < c * d := +calc + a * b ≤ c * b : nat.mul_le_mul_of_nonneg_right h1 h3 + ... < c * d : nat.mul_lt_mul_of_pos_left h2 h4 + +-- TODO: there are four variations, depending on which variables we assume to be nonneg +lemma mul_le_mul {a b c d : ℕ} (hac : a ≤ c) (hbd : b ≤ d) (nn_b : 0 ≤ b) (nn_c : 0 ≤ c) : a * b ≤ c * d := +calc + a * b ≤ c * b : nat.mul_le_mul_of_nonneg_right hac nn_b + ... ≤ c * d : nat.mul_le_mul_of_nonneg_left hbd nn_c /- pow -/ -@[simp] theorem pow_one (b : ℕ) : b^1 = b := by simp [pow_succ] +@[simp] theorem pow_one (b : ℕ) : b^1 = b := by simp [pow_succ, nat.one_mul] theorem pow_le_pow_of_le_left {x y : ℕ} (H : x ≤ y) : ∀ i : ℕ, x^i ≤ y^i | 0 := le_refl _ @@ -1284,7 +1291,7 @@ theorem pow_le_pow_of_le_left {x y : ℕ} (H : x ≤ y) : ∀ i : ℕ, x^i ≤ y theorem pow_le_pow_of_le_right {x : ℕ} (H : x > 0) {i : ℕ} : ∀ {j}, i ≤ j → x^i ≤ x^j | 0 h := by rw eq_zero_of_le_zero h; apply le_refl | (succ j) h := (lt_or_eq_of_le h).elim - (λhl, by rw [pow_succ, ← mul_one (x^i)]; exact + (λhl, by rw [pow_succ, ← nat.mul_one (x^i)]; exact mul_le_mul (pow_le_pow_of_le_right $ le_of_lt_succ hl) H (zero_le _) (zero_le _)) (λe, by rw e; refl) @@ -1292,13 +1299,13 @@ theorem pos_pow_of_pos {b : ℕ} (n : ℕ) (h : 0 < b) : 0 < b^n := pow_le_pow_of_le_right h (zero_le _) theorem zero_pow {n : ℕ} (h : 0 < n) : 0^n = 0 := -by rw [← succ_pred_eq_of_pos h, pow_succ, mul_zero] +by rw [← succ_pred_eq_of_pos h, pow_succ, nat.mul_zero] theorem pow_lt_pow_of_lt_left {x y : ℕ} (H : x < y) {i} (h : i > 0) : x^i < y^i := begin cases i with i, { exact absurd h (not_lt_zero _) }, rw [pow_succ, pow_succ], - exact mul_lt_mul' (pow_le_pow_of_le_left (le_of_lt H) _) H (zero_le _) + exact nat.mul_lt_mul' (pow_le_pow_of_le_left (le_of_lt H) _) H (zero_le _) (pos_pow_of_pos _ $ lt_of_le_of_lt (zero_le _) H) end @@ -1306,13 +1313,13 @@ theorem pow_lt_pow_of_lt_right {x : ℕ} (H : x > 1) {i j : ℕ} (h : i < j) : x begin have xpos := lt_of_succ_lt H, refine lt_of_lt_of_le _ (pow_le_pow_of_le_right xpos h), - rw [← mul_one (x^i), pow_succ], + rw [← nat.mul_one (x^i), pow_succ], exact nat.mul_lt_mul_of_pos_left H (pos_pow_of_pos _ xpos) end /- mod / div / pow -/ -local attribute [simp] mul_comm +local attribute [simp] nat.mul_comm theorem mod_pow_succ {b : ℕ} (b_pos : b > 0) (w m : ℕ) : m % (b^succ w) = b * (m/b % b^w) + m % b := @@ -1327,7 +1334,7 @@ begin simp [pow_succ] at h₁, simp [h₁] }, rw [mod_eq_of_lt h₁, mod_eq_of_lt h₂], - simp [mod_add_div, add_comm] }, + simp [mod_add_div, nat.add_comm] }, -- step: p ≥ b^succ w { -- Generate condiition for induction principal have h₂ : p - b^succ w < p, @@ -1347,15 +1354,17 @@ begin rw [eq.symm (mod_eq_sub_mod p_b_ge)] } end + + lemma div_lt_self {n m : nat} : n > 0 → m > 1 → n / m < n := begin intros h₁ h₂, have m_pos : m > 0, { apply lt_trans _ h₂, comp_val }, suffices : 1 * n < m * n, { - simp at this, - exact iff.mpr (div_lt_iff_lt_mul n n m_pos) this + rw [nat.one_mul, nat.mul_comm] at this, + exact iff.mpr (nat.div_lt_iff_lt_mul n n m_pos) this }, - exact mul_lt_mul h₂ (le_refl _) h₁ (nat.zero_le _) + exact nat.mul_lt_mul h₂ (le_refl _) h₁ (nat.zero_le _) end end nat diff --git a/library/init/data/string/ops.lean b/library/init/data/string/ops.lean index 321d1c2666..6f2b1b6f5e 100644 --- a/library/init/data/string/ops.lean +++ b/library/init/data/string/ops.lean @@ -21,7 +21,7 @@ by cases it; cases it_snd; simp [iterator.next, iterator.next_to_string, string. lemma zero_lt_length_next_to_string_of_has_next {it : iterator} : it.has_next → 0 < it.next_to_string.length := -by cases it; cases it_snd; simp [iterator.has_next, iterator.next_to_string, string.length, nat.zero_lt_one_add, add_comm] +by cases it; cases it_snd; simp [iterator.has_next, iterator.next_to_string, string.length, nat.zero_lt_one_add, nat.add_comm] end iterator diff --git a/library/init/meta/well_founded_tactics.lean b/library/init/meta/well_founded_tactics.lean index 590dca1ef7..e31dbdbb7c 100644 --- a/library/init/meta/well_founded_tactics.lean +++ b/library/init/meta/well_founded_tactics.lean @@ -9,12 +9,12 @@ import init.data.list.qsort /- TODO(Leo): move this lemma, or delete it after we add algebraic normalizer. -/ lemma nat.lt_add_of_zero_lt_left (a b : nat) (h : 0 < b) : a < a + b := -suffices a + 0 < a + b, by {simp at this, assumption}, +show a + 0 < a + b, by {apply nat.add_lt_add_left, assumption} /- TODO(Leo): move this lemma, or delete it after we add algebraic normalizer. -/ lemma nat.zero_lt_one_add (a : nat) : 0 < 1 + a := -suffices 0 < a + 1, by {simp [add_comm], assumption}, +suffices 0 < a + 1, by {simp [nat.add_comm], assumption}, nat.zero_lt_succ _ /- TODO(Leo): move this lemma, or delete it after we add algebraic normalizer. -/ diff --git a/library/system/io.lean b/library/system/io.lean index 6a907d654d..a21992dde3 100644 --- a/library/system/io.lean +++ b/library/system/io.lean @@ -155,7 +155,7 @@ monad_io_file_system.write def get_char (h : handle) : io char := do b ← read h 1, - if h : b.size = 1 then return $ b.read ⟨0, h.symm ▸ zero_lt_one⟩ + if h : b.size = 1 then return $ b.read ⟨0, h.symm ▸ nat.zero_lt_one⟩ else io.fail "get_char failed" def get_line : handle → io char_buffer := diff --git a/src/library/CMakeLists.txt b/src/library/CMakeLists.txt index dff2e07482..25f0e13843 100644 --- a/src/library/CMakeLists.txt +++ b/src/library/CMakeLists.txt @@ -19,7 +19,7 @@ add_library(library OBJECT deep_copy.cpp expr_lt.cpp io_state.cpp library_task_builder.cpp eval_helper.cpp messages.cpp message_builder.cpp module_mgr.cpp comp_val.cpp - documentation.cpp check.cpp arith_instance.cpp parray.cpp process.cpp + documentation.cpp check.cpp parray.cpp process.cpp pipe.cpp handle.cpp profiling.cpp time_task.cpp abstract_context_cache.cpp context_cache.cpp unique_id.cpp persistent_context_cache.cpp elab_context.cpp) if(EMSCRIPTEN) diff --git a/src/library/app_builder.cpp b/src/library/app_builder.cpp index 0be58bfe3c..71a4d058c2 100644 --- a/src/library/app_builder.cpp +++ b/src/library/app_builder.cpp @@ -441,10 +441,6 @@ class app_builder { return ::lean::mk_app(mk_constant(get_eq_name(), {lvl}), A, a, b); } - expr mk_iff(expr const & a, expr const & b) { - return ::lean::mk_app(mk_constant(get_iff_name()), a, b); - } - expr mk_heq(expr const & a, expr const & b) { expr A = m_ctx.infer(a); expr B = m_ctx.infer(b); @@ -474,9 +470,6 @@ class app_builder { level lvl = get_level(A); return ::lean::mk_app(mk_constant(get_eq_refl_name(), {lvl}), A, a); } - expr mk_iff_refl(expr const & a) { - return ::lean::mk_app(mk_constant(get_iff_refl_name()), a); - } expr mk_heq_refl(expr const & a) { expr A = m_ctx.infer(a); level lvl = get_level(A); @@ -697,71 +690,6 @@ class app_builder { return mk_eq_rec(motive, minor, H); } - expr mk_partial_add(expr const & A) { - level lvl = get_level(A); - auto A_has_add = m_ctx.mk_class_instance(::lean::mk_app(mk_constant(get_has_add_name(), {lvl}), A)); - if (!A_has_add) { - trace_inst_failure(A, "has_add"); - throw app_builder_exception(); - } - return ::lean::mk_app(mk_constant(get_has_add_add_name(), {lvl}), A, *A_has_add); - } - - expr mk_partial_mul(expr const & A) { - level lvl = get_level(A); - auto A_has_mul = m_ctx.mk_class_instance(::lean::mk_app(mk_constant(get_has_mul_name(), {lvl}), A)); - if (!A_has_mul) { - trace_inst_failure(A, "has_mul"); - throw app_builder_exception(); - } - return ::lean::mk_app(mk_constant(get_has_mul_mul_name(), {lvl}), A, *A_has_mul); - } - - expr mk_zero(expr const & A) { - level lvl = get_level(A); - auto A_has_zero = m_ctx.mk_class_instance(::lean::mk_app(mk_constant(get_has_zero_name(), {lvl}), A)); - if (!A_has_zero) { - trace_inst_failure(A, "has_zero"); - throw app_builder_exception(); - } - return ::lean::mk_app(mk_constant(get_has_zero_zero_name(), {lvl}), A, *A_has_zero); - } - - expr mk_one(expr const & A) { - level lvl = get_level(A); - auto A_has_one = m_ctx.mk_class_instance(::lean::mk_app(mk_constant(get_has_one_name(), {lvl}), A)); - if (!A_has_one) { - trace_inst_failure(A, "has_one"); - throw app_builder_exception(); - } - return ::lean::mk_app(mk_constant(get_has_one_one_name(), {lvl}), A, *A_has_one); - } - - expr mk_partial_left_distrib(expr const & A) { - level lvl = get_level(A); - auto A_distrib = m_ctx.mk_class_instance(::lean::mk_app(mk_constant(get_distrib_name(), {lvl}), A)); - if (!A_distrib) { - trace_inst_failure(A, "distrib"); - throw app_builder_exception(); - } - return ::lean::mk_app(mk_constant(get_left_distrib_name(), {lvl}), A, *A_distrib); - } - - expr mk_partial_right_distrib(expr const & A) { - level lvl = get_level(A); - auto A_distrib = m_ctx.mk_class_instance(::lean::mk_app(mk_constant(get_distrib_name(), {lvl}), A)); - if (!A_distrib) { - trace_inst_failure(A, "distrib"); - throw app_builder_exception(); - } - return ::lean::mk_app(mk_constant(get_right_distrib_name(), {lvl}), A, *A_distrib); - } - - expr mk_ss_elim(expr const & A, expr const & ss_inst, expr const & old_e, expr const & new_e) { - level lvl = get_level(A); - return ::lean::mk_app(mk_constant(get_subsingleton_elim_name(), {lvl}), A, ss_inst, old_e, new_e); - } - expr mk_false_rec(expr const & c, expr const & H) { level c_lvl = get_level(c); return ::lean::mk_app(mk_constant(get_false_rec_name(), {c_lvl}), c, H); @@ -858,10 +786,6 @@ expr mk_eq(type_context_old & ctx, expr const & lhs, expr const & rhs) { return app_builder(ctx).mk_eq(lhs, rhs); } -expr mk_iff(type_context_old & ctx, expr const & lhs, expr const & rhs) { - return app_builder(ctx).mk_iff(lhs, rhs); -} - expr mk_heq(type_context_old & ctx, expr const & lhs, expr const & rhs) { return app_builder(ctx).mk_heq(lhs, rhs); } @@ -874,10 +798,6 @@ expr mk_eq_refl(type_context_old & ctx, expr const & a) { return app_builder(ctx).mk_eq_refl(a); } -expr mk_iff_refl(type_context_old & ctx, expr const & a) { - return app_builder(ctx).mk_iff_refl(a); -} - expr mk_heq_refl(type_context_old & ctx, expr const & a) { return app_builder(ctx).mk_heq_refl(a); } @@ -1020,16 +940,6 @@ expr lift_from_eq(type_context_old & ctx, name const & R, expr const & H) { return app_builder(ctx).lift_from_eq(R, H); } -expr mk_iff_false_intro(type_context_old & ctx, expr const & H) { - // TODO(Leo): implement custom version if bottleneck. - return mk_app(ctx, get_iff_false_intro_name(), {H}); -} - -expr mk_iff_true_intro(type_context_old & ctx, expr const & H) { - // TODO(Leo): implement custom version if bottleneck. - return mk_app(ctx, get_iff_true_intro_name(), {H}); -} - expr mk_eq_false_intro(type_context_old & ctx, expr const & H) { return app_builder(ctx).mk_eq_false_intro(H); } @@ -1051,71 +961,15 @@ expr mk_neq_of_not_iff(type_context_old & ctx, expr const & H) { return mk_app(ctx, get_neq_of_not_iff_name(), {H}); } -expr mk_not_of_iff_false(type_context_old & ctx, expr const & H) { - if (is_constant(get_app_fn(H), get_iff_false_intro_name())) { - // not_of_iff_false (iff_false_intro H) == H - return app_arg(H); - } - // TODO(Leo): implement custom version if bottleneck. - return mk_app(ctx, get_not_of_iff_false_name(), 2, {H}); -} - -expr mk_of_iff_true(type_context_old & ctx, expr const & H) { - if (is_constant(get_app_fn(H), get_iff_true_intro_name())) { - // of_iff_true (iff_true_intro H) == H - return app_arg(H); - } - // TODO(Leo): implement custom version if bottleneck. - return mk_app(ctx, get_of_iff_true_name(), {H}); -} - -expr mk_false_of_true_iff_false(type_context_old & ctx, expr const & H) { - // TODO(Leo): implement custom version if bottleneck. - return mk_app(ctx, get_false_of_true_iff_false_name(), {H}); -} - expr mk_false_of_true_eq_false(type_context_old & ctx, expr const & H) { // TODO(Leo): implement custom version if bottleneck. return mk_app(ctx, get_false_of_true_eq_false_name(), {H}); } -expr mk_not(type_context_old & ctx, expr const & H) { - // TODO(dhs): implement custom version if bottleneck. - return mk_app(ctx, get_not_name(), {H}); -} - expr mk_absurd(type_context_old & ctx, expr const & Hp, expr const & Hnp, expr const & b) { return mk_app(ctx, get_absurd_name(), {b, Hp, Hnp}); } -expr mk_partial_add(type_context_old & ctx, expr const & A) { - return app_builder(ctx).mk_partial_add(A); -} - -expr mk_partial_mul(type_context_old & ctx, expr const & A) { - return app_builder(ctx).mk_partial_mul(A); -} - -expr mk_zero(type_context_old & ctx, expr const & A) { - return app_builder(ctx).mk_zero(A); -} - -expr mk_one(type_context_old & ctx, expr const & A) { - return app_builder(ctx).mk_one(A); -} - -expr mk_partial_left_distrib(type_context_old & ctx, expr const & A) { - return app_builder(ctx).mk_partial_left_distrib(A); -} - -expr mk_partial_right_distrib(type_context_old & ctx, expr const & A) { - return app_builder(ctx).mk_partial_right_distrib(A); -} - -expr mk_ss_elim(type_context_old & ctx, expr const & A, expr const & ss_inst, expr const & old_e, expr const & new_e) { - return app_builder(ctx).mk_ss_elim(A, ss_inst, old_e, new_e); -} - expr mk_false_rec(type_context_old & ctx, expr const & c, expr const & H) { return app_builder(ctx).mk_false_rec(c, H); } diff --git a/src/library/app_builder.h b/src/library/app_builder.h index b17e79022e..7485657509 100644 --- a/src/library/app_builder.h +++ b/src/library/app_builder.h @@ -89,21 +89,18 @@ expr mk_heq(type_context_old & ctx, expr const & lhs, expr const & rhs); /** \brief Similar a reflexivity proof for the given relation */ expr mk_refl(type_context_old & ctx, name const & relname, expr const & a); expr mk_eq_refl(type_context_old & ctx, expr const & a); -expr mk_iff_refl(type_context_old & ctx, expr const & a); expr mk_heq_refl(type_context_old & ctx, expr const & a); /** \brief Similar a symmetry proof for the given relation */ expr mk_symm(type_context_old & ctx, name const & relname, expr const & H); expr mk_eq_symm(type_context_old & ctx, expr const & H); expr mk_eq_symm(type_context_old & ctx, expr const & a, expr const & b, expr const & H); -expr mk_iff_symm(type_context_old & ctx, expr const & H); expr mk_heq_symm(type_context_old & ctx, expr const & H); /** \brief Similar a transitivity proof for the given relation */ expr mk_trans(type_context_old & ctx, name const & relname, expr const & H1, expr const & H2); expr mk_eq_trans(type_context_old & ctx, expr const & H1, expr const & H2); expr mk_eq_trans(type_context_old & ctx, expr const & a, expr const & b, expr const & c, expr const & H1, expr const & H2); -expr mk_iff_trans(type_context_old & ctx, expr const & H1, expr const & H2); expr mk_heq_trans(type_context_old & ctx, expr const & H1, expr const & H2); /** \brief Create a (non-dependent) eq.rec application. @@ -137,16 +134,6 @@ expr mk_funext(type_context_old & ctx, expr const & lam_pf); build a proof for (R a b) */ expr lift_from_eq(type_context_old & ctx, name const & R, expr const & H); -/** \brief not p -> (p <-> false) */ -expr mk_iff_false_intro(type_context_old & ctx, expr const & H); -/** \brief p -> (p <-> true) */ -expr mk_iff_true_intro(type_context_old & ctx, expr const & H); -/** \brief (p <-> false) -> not p */ -expr mk_not_of_iff_false(type_context_old & ctx, expr const & H); -/** \brief (p <-> true) -> p */ -expr mk_of_iff_true(type_context_old & ctx, expr const & H); -/** \brief (true <-> false) -> false */ -expr mk_false_of_true_iff_false(type_context_old & ctx, expr const & H); /** \brief (true = false) -> false */ expr mk_false_of_true_eq_false(type_context_old & ctx, expr const & H); @@ -160,20 +147,9 @@ expr mk_neq_of_not_iff(type_context_old & ctx, expr const & H); expr mk_of_eq_true(type_context_old & ctx, expr const & H); expr mk_not_of_eq_false(type_context_old & ctx, expr const & H); -expr mk_not(type_context_old & ctx, expr const & H); - /** p -> not p -> b */ expr mk_absurd(type_context_old & ctx, expr const & Hp, expr const & Hnp, expr const & b); -expr mk_partial_add(type_context_old & ctx, expr const & A); -expr mk_partial_mul(type_context_old & ctx, expr const & A); -expr mk_zero(type_context_old & ctx, expr const & A); -expr mk_one(type_context_old & ctx, expr const & A); -expr mk_partial_left_distrib(type_context_old & ctx, expr const & A); -expr mk_partial_right_distrib(type_context_old & ctx, expr const & A); - -expr mk_ss_elim(type_context_old & ctx, expr const & A, expr const & ss_inst, expr const & old_e, expr const & new_e); - /** \brief False elimination */ expr mk_false_rec(type_context_old & ctx, expr const & c, expr const & H); diff --git a/src/library/arith_instance.cpp b/src/library/arith_instance.cpp deleted file mode 100644 index 72910ab89c..0000000000 --- a/src/library/arith_instance.cpp +++ /dev/null @@ -1,168 +0,0 @@ -/* -Copyright (c) 2017 Microsoft Corporation. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. - -Author: Leonardo de Moura -*/ -#include "util/sstream.h" -#include "library/util.h" -#include "library/constants.h" -#include "library/arith_instance.h" -#include "library/num.h" - -namespace lean { -// TODO(Leo): pre compute arith_instance_info for nat, int and real - -arith_instance_info_ptr mk_arith_instance_info(expr const & type, level const & lvl) { - return std::make_shared(type, lvl); -} - -arith_instance::arith_instance(type_context_old & ctx, expr const & type, level const & level): - m_ctx(&ctx), m_info(mk_arith_instance_info(type, level)) {} - -arith_instance::arith_instance(type_context_old & ctx, expr const & type): - m_ctx(&ctx) { - set_type(type); -} - -void arith_instance::set_type(expr const & type) { - if (optional lvl = dec_level(get_level(*m_ctx, type))) - m_info = mk_arith_instance_info(type, *lvl); - else - throw exception("failed to infer universe level"); -} - -expr arith_instance::mk_op(name const & op, name const & s, optional & r) { - if (r) return *r; - if (m_ctx) { - expr inst_type = mk_app(mk_constant(s, m_info->m_levels), m_info->m_type); - if (auto inst = m_ctx->mk_class_instance(inst_type)) { - r = mk_app(mk_constant(op, m_info->m_levels), m_info->m_type, *inst); - return *r; - } - } - throw exception(sstream() << "failed to synthesize '" << s << "'"); -} - -expr arith_instance::mk_structure(name const & s, optional & r) { - if (r) return *r; - if (m_ctx) { - expr inst_type = mk_app(mk_constant(s, m_info->m_levels), m_info->m_type); - if (auto inst = m_ctx->mk_class_instance(inst_type)) { - r = *inst; - return *r; - } - } - throw exception(sstream() << "failed to synthesize '" << s << "'"); -} - -expr arith_instance::mk_bit1() { - if (!m_info->m_bit1) - m_info->m_bit1 = mk_app(mk_constant(get_bit1_name(), m_info->m_levels), m_info->m_type, mk_has_one(), mk_has_add()); - return *m_info->m_bit1; -} - -expr arith_instance::mk_zero() { return mk_op(get_has_zero_zero_name(), get_has_zero_name(), m_info->m_zero); } -expr arith_instance::mk_one() { return mk_op(get_has_one_one_name(), get_has_one_name(), m_info->m_one); } -expr arith_instance::mk_add() { return mk_op(get_has_add_add_name(), get_has_add_name(), m_info->m_add); } -expr arith_instance::mk_sub() { return mk_op(get_has_sub_sub_name(), get_has_sub_name(), m_info->m_sub); } -expr arith_instance::mk_neg() { return mk_op(get_has_neg_neg_name(), get_has_neg_name(), m_info->m_neg); } -expr arith_instance::mk_mul() { return mk_op(get_has_mul_mul_name(), get_has_mul_name(), m_info->m_mul); } -expr arith_instance::mk_div() { return mk_op(get_has_div_div_name(), get_has_div_name(), m_info->m_div); } -expr arith_instance::mk_inv() { return mk_op(get_has_inv_inv_name(), get_has_inv_name(), m_info->m_inv); } -expr arith_instance::mk_lt() { return mk_op(get_has_lt_lt_name(), get_has_lt_name(), m_info->m_lt); } -expr arith_instance::mk_le() { return mk_op(get_has_le_le_name(), get_has_le_name(), m_info->m_le); } - -expr arith_instance::mk_bit0() { return mk_op(get_bit0_name(), get_has_add_name(), m_info->m_bit0); } - -expr arith_instance::mk_partial_order() { return mk_structure(get_partial_order_name(), m_info->m_partial_order); } -expr arith_instance::mk_add_comm_semigroup() { return mk_structure(get_add_comm_semigroup_name(), m_info->m_add_comm_semigroup); } -expr arith_instance::mk_monoid() { return mk_structure(get_monoid_name(), m_info->m_monoid); } -expr arith_instance::mk_add_monoid() { return mk_structure(get_add_monoid_name(), m_info->m_add_monoid); } -expr arith_instance::mk_add_group() { return mk_structure(get_add_group_name(), m_info->m_add_group); } -expr arith_instance::mk_add_comm_group() { return mk_structure(get_add_comm_group_name(), m_info->m_add_comm_group); } -expr arith_instance::mk_distrib() { return mk_structure(get_distrib_name(), m_info->m_distrib); } -expr arith_instance::mk_mul_zero_class() { return mk_structure(get_mul_zero_class_name(), m_info->m_mul_zero_class); } -expr arith_instance::mk_semiring() { return mk_structure(get_semiring_name(), m_info->m_semiring); } -expr arith_instance::mk_linear_ordered_semiring() { return mk_structure(get_linear_ordered_semiring_name(), m_info->m_linear_ordered_semiring); } -expr arith_instance::mk_ring() { return mk_structure(get_ring_name(), m_info->m_ring); } -expr arith_instance::mk_linear_ordered_ring() { return mk_structure(get_linear_ordered_ring_name(), m_info->m_linear_ordered_ring); } -expr arith_instance::mk_field() { return mk_structure(get_field_name(), m_info->m_field); } - -expr arith_instance::mk_pos_num(mpz const & n) { - lean_assert(n > 0); - if (n == 1) - return mk_one(); - else if (n % mpz(2) == 1) - return mk_app(mk_bit1(), mk_pos_num(n/2)); - else - return mk_app(mk_bit0(), mk_pos_num(n/2)); -} - -expr arith_instance::mk_num(mpz const & n) { - if (n < 0) { - return mk_app(mk_neg(), mk_pos_num(0 - n)); - } else if (n == 0) { - return mk_zero(); - } else { - return mk_pos_num(n); - } -} - -expr arith_instance::mk_num(mpq const & q) { - mpz numer = q.get_numerator(); - mpz denom = q.get_denominator(); - lean_assert(denom >= 0); - if (denom == 1 || numer == 0) { - return mk_num(numer); - } else if (numer > 0) { - return mk_app(mk_div(), mk_num(numer), mk_num(denom)); - } else { - return mk_app(mk_neg(), mk_app(mk_div(), mk_num(neg(numer)), mk_num(denom))); - } -} - -bool arith_instance::is_nat() { - return is_constant(m_info->m_type, get_nat_name()); -} - -optional arith_instance::eval(expr const & e) { - buffer args; - expr f = get_app_args(e, args); - if (!is_constant(f)) { - throw exception("cannot find num of nonconstant"); - } else if (const_name(f) == get_has_add_add_name() && args.size() == 4) { - if (auto r1 = eval(args[2])) - if (auto r2 = eval(args[3])) - return optional(*r1 + *r2); - } else if (const_name(f) == get_has_mul_mul_name() && args.size() == 4) { - if (auto r1 = eval(args[2])) - if (auto r2 = eval(args[3])) - return optional(*r1 * *r2); - } else if (const_name(f) == get_has_sub_sub_name() && args.size() == 4) { - if (auto r1 = eval(args[2])) - if (auto r2 = eval(args[3])) { - if (is_nat() && *r2 > *r1) - return optional(0); - else - return optional(*r1 - *r2); - } - } else if (const_name(f) == get_has_div_div_name() && args.size() == 4) { - if (auto r1 = eval(args[2])) - if (auto r2 = eval(args[3])) { - if (is_nat()) - return optional(); // not supported yet - else if (*r2 == 0) - return optional(); // division by zero, add support for x/0 = 0 - else - return optional(*r1 / *r2); - } - } else if (const_name(f) == get_has_neg_neg_name() && args.size() == 3) { - if (auto r1 = eval(args[2])) - return optional(neg(*r1)); - } else if (auto r = to_num(e)) { - return optional(*r); - } - return optional(); -} -} diff --git a/src/library/arith_instance.h b/src/library/arith_instance.h deleted file mode 100644 index 43fdecd9af..0000000000 --- a/src/library/arith_instance.h +++ /dev/null @@ -1,144 +0,0 @@ -/* -Copyright (c) 2017 Microsoft Corporation. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. - -Author: Leonardo de Moura -*/ -#pragma once -#include "util/numerics/mpq.h" -#include "library/type_context.h" - -namespace lean { -/* - Given a type `α`, this structure stores instances and partial - applications for arithmetic-related instances. The data is - constructed "on demand" by the helper class `arith_instance`. - - The current design allows multiple `arith_instance` to share - the same `arith_instance_info` IF they are all in the same - execution thread. - - This code is currently used by - - norm_num (numeric normalizer) - Remark: the proofs created by `norm_num` try to use the most general - structure for applying each auxiliary lemma. In retrospect, I think this is overkill. - In practice, `norm_num` is used only for: `semiring`, `linear_ordered_semiring`, `ring`, `linear_ordered_ring`, - `field`, `linerar_ordered_field`. Moreover, we want to use the unbundled approach for structures - such as `monoid` and `group`. - - - It was also used by mpq_macro (which is used only by the SMT2 frontend) - Remark: the SMT2 frontend was originally built to test the performance of - a blast tactic that Leo and Daniel were developing. This tactic does not - exist anymore. Moreover, SMT2 benchmarks are far from ideal for testing - a system like Lean. AFAICT, nobody uses the SMT2 frontend. - So, we have deleted `mpq_macro` and the SMT2 frontend. Motivation: less stuff to maintain. - - Plan: - - - Reduce the number of structures used by `norm_num`. We just need to change - the lemmas used by `norm_num` and adjust the C++ code. An additional motivation - is that we can replace semi-bundled type classes such as `monoid` and `group` with - unbundled type classes such as `is_monoid` and `is_group` that are parametrized - by operations too. -*/ -class arith_instance_info { - friend class arith_instance; - expr m_type; - levels m_levels; - - /* Partial applications */ - optional m_zero, m_one; - optional m_add, m_sub, m_neg; - optional m_mul, m_div, m_inv; - optional m_lt, m_le; - optional m_bit0, m_bit1; - - /* Structures */ - optional m_partial_order; - optional m_add_comm_semigroup; - optional m_monoid, m_add_monoid; - optional m_add_group, m_add_comm_group; - optional m_distrib, m_mul_zero_class; - optional m_semiring, m_linear_ordered_semiring; - optional m_ring, m_linear_ordered_ring; - optional m_field; -public: - arith_instance_info(expr const & type, level const & lvl):m_type(type), m_levels(lvl) {} -}; - -typedef std::shared_ptr arith_instance_info_ptr; -arith_instance_info_ptr mk_arith_instance_info(expr const & type, level const & lvl); - -class arith_instance { - type_context_old * m_ctx; - arith_instance_info_ptr m_info; - - expr mk_structure(name const & s, optional & r); - expr mk_op(name const & op, name const & s, optional & r); - - expr mk_pos_num(mpz const & n); - -public: - arith_instance(type_context_old & ctx, arith_instance_info_ptr const & info):m_ctx(&ctx), m_info(info) {} - arith_instance(type_context_old & ctx, expr const & type, level const & level); - arith_instance(type_context_old & ctx, expr const & type); - arith_instance(arith_instance_info_ptr const & info):m_ctx(nullptr), m_info(info) {} - arith_instance(type_context_old & ctx):m_ctx(&ctx) {} - - void set_info(arith_instance_info_ptr const & info) { m_info = info; } - /* The following method creates a fresh `arith_instance_info` for the given type. - - Missing optimization: it should do nothing if `type` is and `m_info->m_type` - are equal. */ - void set_type(expr const & type); - - expr const & get_type() const { return m_info->m_type; } - levels const & get_levels() const { return m_info->m_levels; } - - bool is_nat(); - - expr mk_zero(); - expr mk_one(); - expr mk_add(); - expr mk_sub(); - expr mk_neg(); - expr mk_mul(); - expr mk_div(); - expr mk_inv(); - expr mk_lt(); - expr mk_le(); - - expr mk_bit0(); - expr mk_bit1(); - - expr mk_has_zero() { return app_arg(mk_zero()); } - expr mk_has_one() { return app_arg(mk_one()); } - expr mk_has_add() { return app_arg(mk_add()); } - expr mk_has_sub() { return app_arg(mk_sub()); } - expr mk_has_neg() { return app_arg(mk_neg()); } - expr mk_has_mul() { return app_arg(mk_mul()); } - expr mk_has_div() { return app_arg(mk_div()); } - expr mk_has_inv() { return app_arg(mk_inv()); } - expr mk_has_lt() { return app_arg(mk_lt()); } - expr mk_has_le() { return app_arg(mk_le()); } - - expr mk_partial_order(); - expr mk_add_comm_semigroup(); - expr mk_monoid(); - expr mk_add_monoid(); - expr mk_add_group(); - expr mk_add_comm_group(); - expr mk_distrib(); - expr mk_mul_zero_class(); - expr mk_semiring(); - expr mk_linear_ordered_semiring(); - expr mk_ring(); - expr mk_linear_ordered_ring(); - expr mk_field(); - - expr mk_num(mpz const & n); - expr mk_num(mpq const & n); - - optional eval(expr const & e); -}; -} diff --git a/src/library/constants.cpp b/src/library/constants.cpp index 0efb7e5a2a..b8070bd720 100644 --- a/src/library/constants.cpp +++ b/src/library/constants.cpp @@ -6,10 +6,6 @@ namespace lean{ name const * g_absurd = nullptr; name const * g_acc_cases_on = nullptr; name const * g_acc_rec = nullptr; -name const * g_add_comm_group = nullptr; -name const * g_add_comm_semigroup = nullptr; -name const * g_add_group = nullptr; -name const * g_add_monoid = nullptr; name const * g_and = nullptr; name const * g_and_cases_on = nullptr; name const * g_and_elim_left = nullptr; @@ -42,7 +38,6 @@ name const * g_congr_arg = nullptr; name const * g_congr_fun = nullptr; name const * g_decidable = nullptr; name const * g_decidable_to_bool = nullptr; -name const * g_distrib = nullptr; name const * g_dite = nullptr; name const * g_empty = nullptr; name const * g_eq = nullptr; @@ -67,7 +62,6 @@ name const * g_false = nullptr; name const * g_false_rec = nullptr; name const * g_false_of_true_eq_false = nullptr; name const * g_false_of_true_iff_false = nullptr; -name const * g_field = nullptr; name const * g_fin_mk = nullptr; name const * g_fin_ne_of_vne = nullptr; name const * g_forall_congr = nullptr; @@ -169,15 +163,11 @@ name const * g_is_commutative_comm = nullptr; name const * g_is_valid_char_range_1 = nullptr; name const * g_is_valid_char_range_2 = nullptr; name const * g_ite = nullptr; -name const * g_le_refl = nullptr; name const * g_lean_parser = nullptr; name const * g_lean_parser_pexpr = nullptr; name const * g_lean_parser_reflectable_expr = nullptr; name const * g_lean_parser_tk = nullptr; name const * g_left_comm = nullptr; -name const * g_left_distrib = nullptr; -name const * g_linear_ordered_ring = nullptr; -name const * g_linear_ordered_semiring = nullptr; name const * g_list = nullptr; name const * g_list_cons = nullptr; name const * g_list_nil = nullptr; @@ -192,10 +182,6 @@ name const * g_monad_io_net_system_impl = nullptr; name const * g_monad_io_process_impl = nullptr; name const * g_monad_io_random_impl = nullptr; name const * g_monad_io_terminal_impl = nullptr; -name const * g_monoid = nullptr; -name const * g_mul_one = nullptr; -name const * g_mul_zero = nullptr; -name const * g_mul_zero_class = nullptr; name const * g_name_anonymous = nullptr; name const * g_name_mk_numeral = nullptr; name const * g_name_mk_string = nullptr; @@ -267,10 +253,7 @@ name const * g_reflected = nullptr; name const * g_reflected_subst = nullptr; name const * g_repr = nullptr; name const * g_rfl = nullptr; -name const * g_right_distrib = nullptr; -name const * g_ring = nullptr; name const * g_scope_trace = nullptr; -name const * g_semiring = nullptr; name const * g_set_of = nullptr; name const * g_sizeof = nullptr; name const * g_string = nullptr; @@ -312,17 +295,10 @@ name const * g_well_founded_tactics = nullptr; name const * g_well_founded_tactics_dec_tac = nullptr; name const * g_well_founded_tactics_default = nullptr; name const * g_well_founded_tactics_rel_tac = nullptr; -name const * g_zero_le_one = nullptr; -name const * g_zero_lt_one = nullptr; -name const * g_zero_mul = nullptr; void initialize_constants() { g_absurd = new name{"absurd"}; g_acc_cases_on = new name{"acc", "cases_on"}; g_acc_rec = new name{"acc", "rec"}; - g_add_comm_group = new name{"add_comm_group"}; - g_add_comm_semigroup = new name{"add_comm_semigroup"}; - g_add_group = new name{"add_group"}; - g_add_monoid = new name{"add_monoid"}; g_and = new name{"and"}; g_and_cases_on = new name{"and", "cases_on"}; g_and_elim_left = new name{"and", "elim_left"}; @@ -355,7 +331,6 @@ void initialize_constants() { g_congr_fun = new name{"congr_fun"}; g_decidable = new name{"decidable"}; g_decidable_to_bool = new name{"decidable", "to_bool"}; - g_distrib = new name{"distrib"}; g_dite = new name{"dite"}; g_empty = new name{"empty"}; g_eq = new name{"eq"}; @@ -380,7 +355,6 @@ void initialize_constants() { g_false_rec = new name{"false", "rec"}; g_false_of_true_eq_false = new name{"false_of_true_eq_false"}; g_false_of_true_iff_false = new name{"false_of_true_iff_false"}; - g_field = new name{"field"}; g_fin_mk = new name{"fin", "mk"}; g_fin_ne_of_vne = new name{"fin", "ne_of_vne"}; g_forall_congr = new name{"forall_congr"}; @@ -482,15 +456,11 @@ void initialize_constants() { g_is_valid_char_range_1 = new name{"is_valid_char_range_1"}; g_is_valid_char_range_2 = new name{"is_valid_char_range_2"}; g_ite = new name{"ite"}; - g_le_refl = new name{"le_refl"}; g_lean_parser = new name{"lean", "parser"}; g_lean_parser_pexpr = new name{"lean", "parser", "pexpr"}; g_lean_parser_reflectable_expr = new name{"lean", "parser", "reflectable", "expr"}; g_lean_parser_tk = new name{"lean", "parser", "tk"}; g_left_comm = new name{"left_comm"}; - g_left_distrib = new name{"left_distrib"}; - g_linear_ordered_ring = new name{"linear_ordered_ring"}; - g_linear_ordered_semiring = new name{"linear_ordered_semiring"}; g_list = new name{"list"}; g_list_cons = new name{"list", "cons"}; g_list_nil = new name{"list", "nil"}; @@ -505,10 +475,6 @@ void initialize_constants() { g_monad_io_process_impl = new name{"monad_io_process_impl"}; g_monad_io_random_impl = new name{"monad_io_random_impl"}; g_monad_io_terminal_impl = new name{"monad_io_terminal_impl"}; - g_monoid = new name{"monoid"}; - g_mul_one = new name{"mul_one"}; - g_mul_zero = new name{"mul_zero"}; - g_mul_zero_class = new name{"mul_zero_class"}; g_name_anonymous = new name{"name", "anonymous"}; g_name_mk_numeral = new name{"name", "mk_numeral"}; g_name_mk_string = new name{"name", "mk_string"}; @@ -580,10 +546,7 @@ void initialize_constants() { g_reflected_subst = new name{"reflected", "subst"}; g_repr = new name{"repr"}; g_rfl = new name{"rfl"}; - g_right_distrib = new name{"right_distrib"}; - g_ring = new name{"ring"}; g_scope_trace = new name{"scope_trace"}; - g_semiring = new name{"semiring"}; g_set_of = new name{"set_of"}; g_sizeof = new name{"sizeof"}; g_string = new name{"string"}; @@ -625,18 +588,11 @@ void initialize_constants() { g_well_founded_tactics_dec_tac = new name{"well_founded_tactics", "dec_tac"}; g_well_founded_tactics_default = new name{"well_founded_tactics", "default"}; g_well_founded_tactics_rel_tac = new name{"well_founded_tactics", "rel_tac"}; - g_zero_le_one = new name{"zero_le_one"}; - g_zero_lt_one = new name{"zero_lt_one"}; - g_zero_mul = new name{"zero_mul"}; } void finalize_constants() { delete g_absurd; delete g_acc_cases_on; delete g_acc_rec; - delete g_add_comm_group; - delete g_add_comm_semigroup; - delete g_add_group; - delete g_add_monoid; delete g_and; delete g_and_cases_on; delete g_and_elim_left; @@ -669,7 +625,6 @@ void finalize_constants() { delete g_congr_fun; delete g_decidable; delete g_decidable_to_bool; - delete g_distrib; delete g_dite; delete g_empty; delete g_eq; @@ -694,7 +649,6 @@ void finalize_constants() { delete g_false_rec; delete g_false_of_true_eq_false; delete g_false_of_true_iff_false; - delete g_field; delete g_fin_mk; delete g_fin_ne_of_vne; delete g_forall_congr; @@ -796,15 +750,11 @@ void finalize_constants() { delete g_is_valid_char_range_1; delete g_is_valid_char_range_2; delete g_ite; - delete g_le_refl; delete g_lean_parser; delete g_lean_parser_pexpr; delete g_lean_parser_reflectable_expr; delete g_lean_parser_tk; delete g_left_comm; - delete g_left_distrib; - delete g_linear_ordered_ring; - delete g_linear_ordered_semiring; delete g_list; delete g_list_cons; delete g_list_nil; @@ -819,10 +769,6 @@ void finalize_constants() { delete g_monad_io_process_impl; delete g_monad_io_random_impl; delete g_monad_io_terminal_impl; - delete g_monoid; - delete g_mul_one; - delete g_mul_zero; - delete g_mul_zero_class; delete g_name_anonymous; delete g_name_mk_numeral; delete g_name_mk_string; @@ -894,10 +840,7 @@ void finalize_constants() { delete g_reflected_subst; delete g_repr; delete g_rfl; - delete g_right_distrib; - delete g_ring; delete g_scope_trace; - delete g_semiring; delete g_set_of; delete g_sizeof; delete g_string; @@ -939,17 +882,10 @@ void finalize_constants() { delete g_well_founded_tactics_dec_tac; delete g_well_founded_tactics_default; delete g_well_founded_tactics_rel_tac; - delete g_zero_le_one; - delete g_zero_lt_one; - delete g_zero_mul; } name const & get_absurd_name() { return *g_absurd; } name const & get_acc_cases_on_name() { return *g_acc_cases_on; } name const & get_acc_rec_name() { return *g_acc_rec; } -name const & get_add_comm_group_name() { return *g_add_comm_group; } -name const & get_add_comm_semigroup_name() { return *g_add_comm_semigroup; } -name const & get_add_group_name() { return *g_add_group; } -name const & get_add_monoid_name() { return *g_add_monoid; } name const & get_and_name() { return *g_and; } name const & get_and_cases_on_name() { return *g_and_cases_on; } name const & get_and_elim_left_name() { return *g_and_elim_left; } @@ -982,7 +918,6 @@ name const & get_congr_arg_name() { return *g_congr_arg; } name const & get_congr_fun_name() { return *g_congr_fun; } name const & get_decidable_name() { return *g_decidable; } name const & get_decidable_to_bool_name() { return *g_decidable_to_bool; } -name const & get_distrib_name() { return *g_distrib; } name const & get_dite_name() { return *g_dite; } name const & get_empty_name() { return *g_empty; } name const & get_eq_name() { return *g_eq; } @@ -1007,7 +942,6 @@ name const & get_false_name() { return *g_false; } name const & get_false_rec_name() { return *g_false_rec; } name const & get_false_of_true_eq_false_name() { return *g_false_of_true_eq_false; } name const & get_false_of_true_iff_false_name() { return *g_false_of_true_iff_false; } -name const & get_field_name() { return *g_field; } name const & get_fin_mk_name() { return *g_fin_mk; } name const & get_fin_ne_of_vne_name() { return *g_fin_ne_of_vne; } name const & get_forall_congr_name() { return *g_forall_congr; } @@ -1109,15 +1043,11 @@ name const & get_is_commutative_comm_name() { return *g_is_commutative_comm; } name const & get_is_valid_char_range_1_name() { return *g_is_valid_char_range_1; } name const & get_is_valid_char_range_2_name() { return *g_is_valid_char_range_2; } name const & get_ite_name() { return *g_ite; } -name const & get_le_refl_name() { return *g_le_refl; } name const & get_lean_parser_name() { return *g_lean_parser; } name const & get_lean_parser_pexpr_name() { return *g_lean_parser_pexpr; } name const & get_lean_parser_reflectable_expr_name() { return *g_lean_parser_reflectable_expr; } name const & get_lean_parser_tk_name() { return *g_lean_parser_tk; } name const & get_left_comm_name() { return *g_left_comm; } -name const & get_left_distrib_name() { return *g_left_distrib; } -name const & get_linear_ordered_ring_name() { return *g_linear_ordered_ring; } -name const & get_linear_ordered_semiring_name() { return *g_linear_ordered_semiring; } name const & get_list_name() { return *g_list; } name const & get_list_cons_name() { return *g_list_cons; } name const & get_list_nil_name() { return *g_list_nil; } @@ -1132,10 +1062,6 @@ name const & get_monad_io_net_system_impl_name() { return *g_monad_io_net_system name const & get_monad_io_process_impl_name() { return *g_monad_io_process_impl; } name const & get_monad_io_random_impl_name() { return *g_monad_io_random_impl; } name const & get_monad_io_terminal_impl_name() { return *g_monad_io_terminal_impl; } -name const & get_monoid_name() { return *g_monoid; } -name const & get_mul_one_name() { return *g_mul_one; } -name const & get_mul_zero_name() { return *g_mul_zero; } -name const & get_mul_zero_class_name() { return *g_mul_zero_class; } name const & get_name_anonymous_name() { return *g_name_anonymous; } name const & get_name_mk_numeral_name() { return *g_name_mk_numeral; } name const & get_name_mk_string_name() { return *g_name_mk_string; } @@ -1207,10 +1133,7 @@ name const & get_reflected_name() { return *g_reflected; } name const & get_reflected_subst_name() { return *g_reflected_subst; } name const & get_repr_name() { return *g_repr; } name const & get_rfl_name() { return *g_rfl; } -name const & get_right_distrib_name() { return *g_right_distrib; } -name const & get_ring_name() { return *g_ring; } name const & get_scope_trace_name() { return *g_scope_trace; } -name const & get_semiring_name() { return *g_semiring; } name const & get_set_of_name() { return *g_set_of; } name const & get_sizeof_name() { return *g_sizeof; } name const & get_string_name() { return *g_string; } @@ -1252,7 +1175,4 @@ name const & get_well_founded_tactics_name() { return *g_well_founded_tactics; } name const & get_well_founded_tactics_dec_tac_name() { return *g_well_founded_tactics_dec_tac; } name const & get_well_founded_tactics_default_name() { return *g_well_founded_tactics_default; } name const & get_well_founded_tactics_rel_tac_name() { return *g_well_founded_tactics_rel_tac; } -name const & get_zero_le_one_name() { return *g_zero_le_one; } -name const & get_zero_lt_one_name() { return *g_zero_lt_one; } -name const & get_zero_mul_name() { return *g_zero_mul; } } diff --git a/src/library/constants.h b/src/library/constants.h index 45d73f4fe8..48b24026a5 100644 --- a/src/library/constants.h +++ b/src/library/constants.h @@ -8,10 +8,6 @@ void finalize_constants(); name const & get_absurd_name(); name const & get_acc_cases_on_name(); name const & get_acc_rec_name(); -name const & get_add_comm_group_name(); -name const & get_add_comm_semigroup_name(); -name const & get_add_group_name(); -name const & get_add_monoid_name(); name const & get_and_name(); name const & get_and_cases_on_name(); name const & get_and_elim_left_name(); @@ -44,7 +40,6 @@ name const & get_congr_arg_name(); name const & get_congr_fun_name(); name const & get_decidable_name(); name const & get_decidable_to_bool_name(); -name const & get_distrib_name(); name const & get_dite_name(); name const & get_empty_name(); name const & get_eq_name(); @@ -69,7 +64,6 @@ name const & get_false_name(); name const & get_false_rec_name(); name const & get_false_of_true_eq_false_name(); name const & get_false_of_true_iff_false_name(); -name const & get_field_name(); name const & get_fin_mk_name(); name const & get_fin_ne_of_vne_name(); name const & get_forall_congr_name(); @@ -171,15 +165,11 @@ name const & get_is_commutative_comm_name(); name const & get_is_valid_char_range_1_name(); name const & get_is_valid_char_range_2_name(); name const & get_ite_name(); -name const & get_le_refl_name(); name const & get_lean_parser_name(); name const & get_lean_parser_pexpr_name(); name const & get_lean_parser_reflectable_expr_name(); name const & get_lean_parser_tk_name(); name const & get_left_comm_name(); -name const & get_left_distrib_name(); -name const & get_linear_ordered_ring_name(); -name const & get_linear_ordered_semiring_name(); name const & get_list_name(); name const & get_list_cons_name(); name const & get_list_nil_name(); @@ -194,10 +184,6 @@ name const & get_monad_io_net_system_impl_name(); name const & get_monad_io_process_impl_name(); name const & get_monad_io_random_impl_name(); name const & get_monad_io_terminal_impl_name(); -name const & get_monoid_name(); -name const & get_mul_one_name(); -name const & get_mul_zero_name(); -name const & get_mul_zero_class_name(); name const & get_name_anonymous_name(); name const & get_name_mk_numeral_name(); name const & get_name_mk_string_name(); @@ -269,10 +255,7 @@ name const & get_reflected_name(); name const & get_reflected_subst_name(); name const & get_repr_name(); name const & get_rfl_name(); -name const & get_right_distrib_name(); -name const & get_ring_name(); name const & get_scope_trace_name(); -name const & get_semiring_name(); name const & get_set_of_name(); name const & get_sizeof_name(); name const & get_string_name(); @@ -314,7 +297,4 @@ name const & get_well_founded_tactics_name(); name const & get_well_founded_tactics_dec_tac_name(); name const & get_well_founded_tactics_default_name(); name const & get_well_founded_tactics_rel_tac_name(); -name const & get_zero_le_one_name(); -name const & get_zero_lt_one_name(); -name const & get_zero_mul_name(); } diff --git a/src/library/constants.txt b/src/library/constants.txt index 550e21b7fa..a4283453b2 100644 --- a/src/library/constants.txt +++ b/src/library/constants.txt @@ -1,10 +1,6 @@ absurd acc.cases_on acc.rec -add_comm_group -add_comm_semigroup -add_group -add_monoid and and.cases_on and.elim_left @@ -37,7 +33,6 @@ congr_arg congr_fun decidable decidable.to_bool -distrib dite empty eq @@ -62,7 +57,6 @@ false false.rec false_of_true_eq_false false_of_true_iff_false -field fin.mk fin.ne_of_vne forall_congr @@ -164,15 +158,11 @@ is_commutative.comm is_valid_char_range_1 is_valid_char_range_2 ite -le_refl lean.parser lean.parser.pexpr lean.parser.reflectable.expr lean.parser.tk left_comm -left_distrib -linear_ordered_ring -linear_ordered_semiring list list.cons list.nil @@ -187,10 +177,6 @@ monad_io_net_system_impl monad_io_process_impl monad_io_random_impl monad_io_terminal_impl -monoid -mul_one -mul_zero -mul_zero_class name.anonymous name.mk_numeral name.mk_string @@ -262,10 +248,7 @@ reflected reflected.subst repr rfl -right_distrib -ring scope_trace -semiring set_of sizeof string @@ -307,6 +290,3 @@ well_founded_tactics well_founded_tactics.dec_tac well_founded_tactics.default well_founded_tactics.rel_tac -zero_le_one -zero_lt_one -zero_mul diff --git a/src/library/equations_compiler/elim_match.cpp b/src/library/equations_compiler/elim_match.cpp index a090271ef2..d717c7ae06 100644 --- a/src/library/equations_compiler/elim_match.cpp +++ b/src/library/equations_compiler/elim_match.cpp @@ -923,7 +923,7 @@ struct elim_match_fn { unsigned idx = length(eqn.m_hs) + 1; for (unsigned i = 0; i < values.size(); i++) { expr eq = mk_eq(ctx, p, values[i]); - expr ne = mk_not(ctx, eq); + expr ne = mk_not(eq); expr H = ctx.push_local(name("_h").append_after(idx), ne); idx++; new_eqn.m_hs = cons(H, new_eqn.m_hs); diff --git a/tests/lean/123-2.lean b/tests/lean/123-2.lean index d458594303..ec11ba2d19 100644 --- a/tests/lean/123-2.lean +++ b/tests/lean/123-2.lean @@ -1,5 +1,11 @@ open function +class semiring (R : Type*) extends has_mul R, has_add R, has_one R, has_zero R. + +class comm_semiring (R : Type*) extends semiring R. + +class comm_ring (R : Type*) extends comm_semiring R. + class has_scalar' (R : Type*) (A : Type*) := (smul : R → A → A) infixr ` • `:73 := has_scalar'.smul diff --git a/tests/lean/123-2.lean.expected.out b/tests/lean/123-2.lean.expected.out index 5349aad58c..7bd583446d 100644 --- a/tests/lean/123-2.lean.expected.out +++ b/tests/lean/123-2.lean.expected.out @@ -1,13 +1,9 @@ -123-2.lean:48:15: error: type mismatch at field 'commutes'' +123-2.lean:54:15: error: type mismatch at field 'commutes'' ?m_1 has type - ∀ (r : R), (λ (b : B), ?m_1[b] b) (⇑(algebra_map' R B) r) = ⇑(algebra_map' R C) r + ∀ (r : R), (λ (b : B), ?m_1[b]) (⇑(algebra_map' R B) r) = ⇑(algebra_map' R C) r but is expected to have type ∀ (r : R), - {to_fun := λ (b : B), ?m_1[b] b, - map_one' := ?map_one', - map_mul' := ?map_mul', - map_zero' := ?map_zero', - map_add' := ?map_add'}.to_fun + {to_fun := λ (b : B), ?m_1[b], map_one' := ?m_2, map_mul' := ?m_3, map_zero' := ?m_4, map_add' := ?m_5}.to_fun (⇑(algebra_map' R B) r) = ⇑(algebra_map' R C) r diff --git a/tests/lean/1862.lean b/tests/lean/1862.lean index f6bfab2eb3..f6fd57a703 100644 --- a/tests/lean/1862.lean +++ b/tests/lean/1862.lean @@ -1,10 +1,13 @@ +class test_neg_neg (R : Type) extends has_neg R, has_one R := +(neg_neg : ∀ r : R, -(-r) = r) + variable R : Type -variable [ring R] +variable [test_neg_neg R] example : -(-(1:R)) = 1 := begin trace_state, - exact neg_neg 1, + exact test_neg_neg.neg_neg 1, end #check - -(1:R) diff --git a/tests/lean/1862.lean.expected.out b/tests/lean/1862.lean.expected.out index 5baaadd5a5..8705fb4bc7 100644 --- a/tests/lean/1862.lean.expected.out +++ b/tests/lean/1862.lean.expected.out @@ -1,4 +1,4 @@ R : Type, -_inst_1 : ring R +_inst_1 : test_neg_neg R ⊢ - -1 = 1 - -1 : R diff --git a/tests/lean/1898.lean b/tests/lean/1898.lean index 1a329b76a2..c1c2cbc8b5 100644 --- a/tests/lean/1898.lean +++ b/tests/lean/1898.lean @@ -1 +1 @@ -def X (R : Type) [H : comm_ring R] := H.0 +def X (R : Type) [H : has_zero R] := H.0 diff --git a/tests/lean/1898.lean.expected.out b/tests/lean/1898.lean.expected.out index f7fd3dce29..b1b85dbe31 100644 --- a/tests/lean/1898.lean.expected.out +++ b/tests/lean/1898.lean.expected.out @@ -1,6 +1,6 @@ -1898.lean:1:39: error: invalid projection, index must be greater than 0 +1898.lean:1:38: error: invalid projection, index must be greater than 0 1898.lean:1:4: error: don't know how to synthesize placeholder context: R : Type, -H : comm_ring R +H : has_zero R ⊢ Sort ? diff --git a/tests/lean/1952.lean b/tests/lean/1952.lean index e21dcaff4c..5a6aa28dd8 100644 --- a/tests/lean/1952.lean +++ b/tests/lean/1952.lean @@ -13,4 +13,4 @@ set_option trace.type_context.is_def_eq_detail true def bla : foo := { fn_ax := λ x, rfl } -instance foo2 (α : Type) : group α := { mul_assoc := λ x y z, rfl } +instance foo2 (α : Type) : preorder α := { le_trans := λ x y z, rfl } diff --git a/tests/lean/1952.lean.expected.out b/tests/lean/1952.lean.expected.out index 7fda685f51..e485082aa3 100644 --- a/tests/lean/1952.lean.expected.out +++ b/tests/lean/1952.lean.expected.out @@ -5,15 +5,11 @@ has type ∀ (x : ℕ), ?m_2[x] = ?m_2[x] but is expected to have type ∀ (a : ℕ), ⁇ a = a -1952.lean:16:38: error: invalid structure value { ... }, field 'mul' was not provided -1952.lean:16:38: error: invalid structure value { ... }, field 'one' was not provided -1952.lean:16:38: error: invalid structure value { ... }, field 'one_mul' was not provided -1952.lean:16:38: error: invalid structure value { ... }, field 'mul_one' was not provided -1952.lean:16:38: error: invalid structure value { ... }, field 'inv' was not provided -1952.lean:16:38: error: invalid structure value { ... }, field 'mul_left_inv' was not provided -1952.lean:16:53: error: type mismatch at field 'mul_assoc' +1952.lean:16:41: error: invalid structure value { ... }, field 'le' was not provided +1952.lean:16:41: error: invalid structure value { ... }, field 'le_refl' was not provided +1952.lean:16:55: error: type mismatch at field 'le_trans' λ (x y z : α), rfl has type ∀ (x y z : α), ?m_2[x, y, z] = ?m_2[x, y, z] but is expected to have type - ∀ (a b c : α), a * b * c = a * (b * c) + ∀ (a b c : α), a ≤ b → b ≤ c → a ≤ c diff --git a/tests/lean/bad_end_error_pos.lean b/tests/lean/bad_end_error_pos.lean index 4d495c50d8..cf4c7a84cf 100644 --- a/tests/lean/bad_end_error_pos.lean +++ b/tests/lean/bad_end_error_pos.lean @@ -1,13 +1,10 @@ -example (a b c : nat) (f : nat → nat) : f (a + b + c) = f (b + c + a) := -by ac_refl +example (a b : nat) (f : nat → nat) : f (a + b) = f (b + a) := +by rw nat.add_comm -example (a b c : nat) (f : nat → nat) : f (a + b + (c * b * a)) = f (b + (a * c * b) + a) := -by ac_refl +example (a b : nat) (f : nat → nat) : f (a * b) = f (b * a) := +by rw nat.mul_comm end -example (a b c : nat) (f : nat → nat → nat) : f (b * c) (c * b * a) = f (c * b) (a * c * b) := -by ac_refl - -example (a b c : nat) (f : nat → nat) : f (a + (b * c) + (c * b * a)) = f ((c * b) + (a * c * b) + a) := -by ac_refl +example (a b c : nat) (f : nat → nat → nat) : f (b * c) (a * b * c) = f (c * b) (a * (b * c)) := +by rw [nat.mul_assoc, nat.mul_comm] diff --git a/tests/lean/field_type_mismatch.lean b/tests/lean/field_type_mismatch.lean index 505fe2579f..6371cbb214 100644 --- a/tests/lean/field_type_mismatch.lean +++ b/tests/lean/field_type_mismatch.lean @@ -3,6 +3,9 @@ namespace test instance : has_add nat := {add := nat.succ} +class semigroup (α : Type) extends has_mul α := +(mul_assoc : ∀ x y z : α, x * y * z = x * (y * z)) + instance : semigroup nat := {mul := nat.add, mul_assoc := trivial } diff --git a/tests/lean/field_type_mismatch.lean.expected.out b/tests/lean/field_type_mismatch.lean.expected.out index 8c8b6b0fba..6a942de3bc 100644 --- a/tests/lean/field_type_mismatch.lean.expected.out +++ b/tests/lean/field_type_mismatch.lean.expected.out @@ -4,9 +4,9 @@ has type ℕ → ℕ but is expected to have type ℕ → ℕ → ℕ -field_type_mismatch.lean:8:14: error: type mismatch at field 'mul_assoc' +field_type_mismatch.lean:11:14: error: type mismatch at field 'mul_assoc' trivial has type true but is expected to have type - ∀ (a b c : ℕ), a * b * c = a * (b * c) + ∀ (x y z : ℕ), x * y * z = x * (y * z) diff --git a/tests/lean/get_unused_name.lean b/tests/lean/get_unused_name.lean index 5be4eb45f9..5548ba28ce 100644 --- a/tests/lean/get_unused_name.lean +++ b/tests/lean/get_unused_name.lean @@ -10,4 +10,4 @@ by do n5 ← get_unused_name `a, trace n1 >> trace n2 >> trace n3 >> trace n4 >> trace n5, get_local `a >>= subst, - `[apply add_comm] + `[apply nat.add_comm] diff --git a/tests/lean/interactive/goal_info.lean b/tests/lean/interactive/goal_info.lean index d0dc0a32b9..06692eba45 100644 --- a/tests/lean/interactive/goal_info.lean +++ b/tests/lean/interactive/goal_info.lean @@ -9,7 +9,7 @@ begin intros n m, induction m with m' ih, --^ "command": "info" - { change n + 0 = 0 + n, simp [zadd] }, + { change n + 0 = 0 + n, simp [zadd, nat.add_zero, nat.zero_add] }, --^ "command": "info" { change succ (n + m') = succ m' + n, rw [succ_add, ih] @@ -21,7 +21,7 @@ example : ∀ n m : ℕ, n + m = m + n := begin intros n m, induction m with m' ih, - { change n + 0 = 0 + n, simp [zadd] }, + { change n + 0 = 0 + n, simp [zadd, nat.add_zero, nat.zero_add] }, --^ "command": "info" { change succ (n + m') = succ m' + n, rw [succ_add, ih] @@ -32,8 +32,8 @@ example : ∀ n m : ℕ, n + m = m + n := begin intros n m, induction m with m' ih, - { change n + 0 = 0 + n, simp [zadd] }, - --^ "command": "info" + { change n + 0 = 0 + n, simp [zadd, nat.add_zero, nat.zero_add] }, + --^ "command": "info" { change succ (n + m') = succ m' + n, rw [succ_add, ih] } diff --git a/tests/lean/nested_match.lean b/tests/lean/nested_match.lean index e9e33961f9..7d1fd3b088 100644 --- a/tests/lean/nested_match.lean +++ b/tests/lean/nested_match.lean @@ -1,4 +1,4 @@ -local attribute [simp] add_comm add_left_comm +local attribute [simp] nat.add_comm nat.add_left_comm namespace ex1 def f : ℕ → ℕ | n := diff --git a/tests/lean/out_param_proj.lean b/tests/lean/out_param_proj.lean index a970a314f1..dfa9d64161 100644 --- a/tests/lean/out_param_proj.lean +++ b/tests/lean/out_param_proj.lean @@ -1,4 +1,9 @@ universes u v + +class ring (α : Type u) := (fld : α) + +class add_comm_group (β : Type v) := (fld : β) + class module (α : out_param $ Type u) (β : Type v) [out_param $ ring α] extends add_comm_group β := (foo : β → nat) diff --git a/tests/lean/quote_error_pos.lean b/tests/lean/quote_error_pos.lean index 138d9ed4af..e1ef36df03 100644 --- a/tests/lean/quote_error_pos.lean +++ b/tests/lean/quote_error_pos.lean @@ -1,5 +1,11 @@ open tactic +class add_monoid (α : Type) extends has_zero α, has_add α := +(zero_add : ∀ a : α, 0 + a = a) + +lemma zero_add {α : Type} [add_monoid α] (a : α) : (0 : α) + a = a := +add_monoid.zero_add a + meta def apply_zero_add (a : pexpr) : tactic unit := to_expr ``(zero_add %%a) >>= exact diff --git a/tests/lean/quote_error_pos.lean.expected.out b/tests/lean/quote_error_pos.lean.expected.out index 5ee037f139..2fb42c219f 100644 --- a/tests/lean/quote_error_pos.lean.expected.out +++ b/tests/lean/quote_error_pos.lean.expected.out @@ -1,10 +1,10 @@ -quote_error_pos.lean:8:2: error: failed to synthesize type class instance for +quote_error_pos.lean:14:2: error: failed to synthesize type class instance for a : ℕ ⊢ add_monoid bool state: a : ℕ ⊢ 0 + a = a -quote_error_pos.lean:16:2: error: failed to synthesize type class instance for +quote_error_pos.lean:22:2: error: failed to synthesize type class instance for a : ℕ ⊢ add_monoid bool state: diff --git a/tests/lean/rquote.lean b/tests/lean/rquote.lean index c419edc653..0338276e58 100644 --- a/tests/lean/rquote.lean +++ b/tests/lean/rquote.lean @@ -14,11 +14,11 @@ open foo boo #check ``g -open nat +open int #check ``has_add.add -#check ``gcd +#check ``nat_abs #check `f #check `foo.f diff --git a/tests/lean/rquote.lean.expected.out b/tests/lean/rquote.lean.expected.out index a6c428db7a..92bb4ab3cf 100644 --- a/tests/lean/rquote.lean.expected.out +++ b/tests/lean/rquote.lean.expected.out @@ -1,7 +1,7 @@ rquote.lean:13:7: error: invalid resolved quoted symbol, it is ambiguous, possible interpretations: boo.f foo.f (solution: use fully qualified names) name.mk_string "g" (name.mk_string "foo" name.anonymous) : name name.mk_string "add" (name.mk_string "has_add" name.anonymous) : name -name.mk_string "gcd" (name.mk_string "nat" name.anonymous) : name +name.mk_string "nat_abs" (name.mk_string "int" name.anonymous) : name name.mk_string "f" name.anonymous : name name.mk_string "f" (name.mk_string "foo" name.anonymous) : name rquote.lean:31:9: error: invalid quoted symbol, failed to resolve it (solution: use ` to bypass name resolution) diff --git a/tests/lean/run/1442.lean b/tests/lean/run/1442.lean index d22c036f19..e23576db6d 100644 --- a/tests/lean/run/1442.lean +++ b/tests/lean/run/1442.lean @@ -4,6 +4,10 @@ protected def rel : ℤ × ℤ → ℤ × ℤ → Prop private def mul' : ℤ × ℤ → ℤ × ℤ → ℤ × ℤ | ⟨n₁, d₁⟩ ⟨n₂, d₂⟩ := ⟨n₁ * n₂, d₁ * d₂⟩ +instance a : is_associative ℤ (*) := ⟨int.mul_assoc⟩ + +instance c : is_commutative ℤ (*) := ⟨int.mul_comm⟩ + example : ∀(a b c d : ℤ × ℤ), rel a c → rel b d → rel (mul' a b) (mul' c d) := λ⟨n₁, d₁⟩ ⟨n₂, d₂⟩ ⟨n₃, d₃⟩ ⟨n₄, d₄⟩, assume (h₁ : n₁ * d₃ = n₃ * d₁) (h₂ : n₂ * d₄ = n₄ * d₂), diff --git a/tests/lean/run/1675.lean b/tests/lean/run/1675.lean index 6b07612312..4101e23446 100644 --- a/tests/lean/run/1675.lean +++ b/tests/lean/run/1675.lean @@ -1,7 +1,7 @@ def foo (a b : nat) : Prop := a = 0 ∧ b = 0 -attribute [simp] foo +attribute [simp] foo nat.zero_add example (p : nat → Prop) (a b : nat) : foo a b → p (a + b) → p 0 := begin diff --git a/tests/lean/run/1685.lean b/tests/lean/run/1685.lean index 0116898038..196fbf9aa9 100644 --- a/tests/lean/run/1685.lean +++ b/tests/lean/run/1685.lean @@ -1,4 +1,4 @@ -local attribute [simp] add_comm add_left_comm +local attribute [simp] nat.add_comm nat.add_left_comm /- This test assumes the total order on terms used by simp compares local constants using the order they appear in the local context. -/ example (m : ℕ) : ∀ n k, m + n = k → n + m = k := by intros; simp; assumption diff --git a/tests/lean/run/236c.lean b/tests/lean/run/236c.lean index 9709d4acd8..217bc8bba8 100644 --- a/tests/lean/run/236c.lean +++ b/tests/lean/run/236c.lean @@ -1,10 +1,10 @@ -constant foo_rec (n : ℕ) (k : Type) [group k] : Prop +constant foo_rec (n : ℕ) (k : Type) [has_one k] : Prop -lemma stupid (k : Type) [group k] (n : ℕ) : +lemma stupid (k : Type) [has_one k] (n : ℕ) : foo_rec nat.zero k ↔ foo_rec nat.zero k := by simp only [nat.nat_zero_eq_zero] open tactic #eval do cgr ← mk_congr_lemma_simp `(foo_rec), -type_check cgr.proof \ No newline at end of file +type_check cgr.proof diff --git a/tests/lean/run/ac_refl1.lean b/tests/lean/run/ac_refl1.lean index 835cb0256f..0eb4cd0a98 100644 --- a/tests/lean/run/ac_refl1.lean +++ b/tests/lean/run/ac_refl1.lean @@ -1,3 +1,8 @@ +instance aa : is_associative ℕ (+) := ⟨nat.add_assoc⟩ +instance ac : is_commutative ℕ (+) := ⟨nat.add_comm⟩ +instance ma : is_associative ℕ (*) := ⟨nat.mul_assoc⟩ +instance mc : is_commutative ℕ (*) := ⟨nat.mul_comm⟩ + example (a b c : nat) (f : nat → nat) : f (a + b + c) = f (b + c + a) := by ac_refl diff --git a/tests/lean/run/add_semi.lean b/tests/lean/run/add_semi.lean index e2ffeb2660..3a9d504491 100644 --- a/tests/lean/run/add_semi.lean +++ b/tests/lean/run/add_semi.lean @@ -1,3 +1,8 @@ +class add_semigroup (A : Type*) extends has_add A := +(add_assoc : ∀ a b c : A, a + b + c = a + (b + c)) +class add_comm_semigroup (A : Type*) extends add_semigroup A := +(add_comm : ∀ a b : A, a + b = b + a) + section universe variables u variable {A : Type u} diff --git a/tests/lean/run/aexp.lean b/tests/lean/run/aexp.lean index ffd23647a5..ad1068af7a 100644 --- a/tests/lean/run/aexp.lean +++ b/tests/lean/run/aexp.lean @@ -13,14 +13,14 @@ inductive aexp instance : decidable_eq aexp := by mk_dec_eq_instance -@[reducible] -def value := nat +-- @[reducible] +-- def value := nat -def state := uname → value +def state := uname → nat open aexp -def aval : aexp → state → value +def aval : aexp → state → nat | (val n) s := n | (var x) s := s x | (plus a₁ a₂) s := aval a₁ s + aval a₂ s @@ -29,7 +29,7 @@ def aval : aexp → state → value example : aval (plus (val 3) (var "x")) (λ x, 0) = 3 := rfl -def updt (s : state) (x : uname) (v : value) : state := +def updt (s : state) (x : uname) (v : nat) : state := λ y, if x = y then v else s y def asimp_const : aexp → aexp @@ -51,10 +51,7 @@ rfl attribute [ematch] asimp_const aval --- set_option trace.smt.ematch true - -meta def not_done : tactic unit := fail_if_success done - +set_option trace.smt.ematch true lemma aval_asimp_const (a : aexp) (s : state) : aval (asimp_const a) s = aval a s := begin [smt] induction a, diff --git a/tests/lean/run/auto_param_in_structures.lean b/tests/lean/run/auto_param_in_structures.lean index d069655f4c..affc3c0d46 100644 --- a/tests/lean/run/auto_param_in_structures.lean +++ b/tests/lean/run/auto_param_in_structures.lean @@ -2,7 +2,7 @@ namespace test open tactic meta def my_tac : tactic unit := abstract (intros >> `[simp]) -local attribute [simp] add_assoc mul_assoc +local attribute [simp] nat.add_assoc nat.mul_assoc structure monoid (α : Type) := (op : α → α → α) diff --git a/tests/lean/run/auto_quote1.lean b/tests/lean/run/auto_quote1.lean index 1600871c3e..572e481274 100644 --- a/tests/lean/run/auto_quote1.lean +++ b/tests/lean/run/auto_quote1.lean @@ -54,7 +54,7 @@ begin induction m with m' ih, { -- Remark: Used change here to make sure nat.zero is replaced with polymorphic zero. -- dsimp tactic should fix that in the future. - change n + 0 = 0 + n, simp [zadd] }, + change n + 0 = 0 + n, simp [zadd, nat.add_zero] }, { change succ (n + m') = succ m' + n, rw [succ_add, ih] } end @@ -70,7 +70,7 @@ begin induction m with m' ih, show n + 0 = 0 + n, begin - change n + 0 = 0 + n, simp [zadd] + change n + 0 = 0 + n, simp [zadd, nat.add_zero] end, show n + succ m' = succ m' + n, { change succ (n + m') = succ m' + n, diff --git a/tests/lean/run/bin_tree.lean b/tests/lean/run/bin_tree.lean index f0aca6ebe9..71ce1f6ab4 100644 --- a/tests/lean/run/bin_tree.lean +++ b/tests/lean/run/bin_tree.lean @@ -1,5 +1,5 @@ namespace Ex -local attribute [simp] add_comm add_left_comm +local attribute [simp] nat.add_comm nat.add_left_comm def pairs_with_sum' : Π (m n) {d}, m + n = d → list {p : ℕ × ℕ // p.1 + p.2 = d} | 0 n d h := [⟨(0, n), h⟩] | (m+1) n d h := ⟨(m+1, n), h⟩ :: pairs_with_sum' m (n+1) (by simp at h; simp [h]) diff --git a/tests/lean/run/cc_ac1.lean b/tests/lean/run/cc_ac1.lean index fcbef5aef0..ae31fd2b04 100644 --- a/tests/lean/run/cc_ac1.lean +++ b/tests/lean/run/cc_ac1.lean @@ -1,5 +1,10 @@ open tactic +instance aa : is_associative ℕ (+) := ⟨nat.add_assoc⟩ +instance ac : is_commutative ℕ (+) := ⟨nat.add_comm⟩ +instance ma : is_associative ℕ (*) := ⟨nat.mul_assoc⟩ +instance mc : is_commutative ℕ (*) := ⟨nat.mul_comm⟩ + example (a b c : nat) (f : nat → nat) : f (a + b + c) = f (c + b + a) := by cc diff --git a/tests/lean/run/cc_ac2.lean b/tests/lean/run/cc_ac2.lean index 97f989f066..ba0fe2dc8d 100644 --- a/tests/lean/run/cc_ac2.lean +++ b/tests/lean/run/cc_ac2.lean @@ -1,4 +1,9 @@ open tactic +instance aa : is_associative ℕ (+) := ⟨nat.add_assoc⟩ +instance ac : is_commutative ℕ (+) := ⟨nat.add_comm⟩ +instance ma : is_associative ℕ (*) := ⟨nat.mul_assoc⟩ +instance mc : is_commutative ℕ (*) := ⟨nat.mul_comm⟩ + example (a b c d : nat) (f : nat → nat → nat) : b + a = d → f (a + b + c) a = f (c + d) a := by cc diff --git a/tests/lean/run/cc_ac3.lean b/tests/lean/run/cc_ac3.lean index de3bd032fd..adc3c77b55 100644 --- a/tests/lean/run/cc_ac3.lean +++ b/tests/lean/run/cc_ac3.lean @@ -1,29 +1,16 @@ open tactic +instance aa : is_associative ℕ (+) := ⟨nat.add_assoc⟩ +instance ac : is_commutative ℕ (+) := ⟨nat.add_comm⟩ +instance ma : is_associative ℕ (*) := ⟨nat.mul_assoc⟩ +instance mc : is_commutative ℕ (*) := ⟨nat.mul_comm⟩ + example (a b c d e : nat) (f : nat → nat → nat) : b + a = d → b + c = e → f (a + b + c) (a + b + c) = f (c + d) (a + e) := by cc example (a b c d e : nat) (f : nat → nat → nat) : b + a = d + d → b + c = e + e → f (a + b + c) (a + b + c) = f (c + d + d) (e + a + e) := by cc -section - universe variable u - variables {α : Type u} - variable [comm_semiring α] - - example (a b c d e : α) (f : α → α → α) : b + a = d + d → b + c = e + e → f (a + b + c) (a + b + c) = f (c + d + d) (e + a + e) := - by cc -end - -section - universe variable u - variables {α : Type u} - variable [comm_ring α] - - example (a b c d e : α) (f : α → α → α) : b + a = d + d → b + c = e + e → f (a + b + c) (a + b + c) = f (c + d + d) (e + a + e) := - by cc -end - section universe variable u variables {α : Type u} diff --git a/tests/lean/run/cc_ac5.lean b/tests/lean/run/cc_ac5.lean index 5f08a40d28..5d4c652e0f 100644 --- a/tests/lean/run/cc_ac5.lean +++ b/tests/lean/run/cc_ac5.lean @@ -1,8 +1,23 @@ universe variables u + +class comm_ring (α : Type u) extends has_mul α, has_add α, has_zero α, has_one α. + variables {α : Type u} variables [comm_ring α] open tactic +instance aa : is_associative α (+) := ⟨sorry⟩ +instance ac : is_commutative α (+) := ⟨sorry⟩ +instance ma : is_associative α (*) := ⟨sorry⟩ +instance mc : is_commutative α (*) := ⟨sorry⟩ +instance lc : is_left_cancel α (+) := ⟨sorry⟩ +instance rc : is_right_cancel α (+) := ⟨sorry⟩ +instance ld : is_left_distrib α (*) (+) := ⟨sorry⟩ +instance rd : is_right_distrib α (*) (+) := ⟨sorry⟩ +instance l0a : is_left_id α (*) 0 := ⟨sorry⟩ +instance r0a : is_right_id α (*) 0 := ⟨sorry⟩ +instance l0m : is_left_null α (*) 0 := ⟨sorry⟩ +instance r0m : is_right_null α (*) 0 := ⟨sorry⟩ example (x1 x2 x3 x4 x5 x6 : α) : x1*x4 = x1 → x3*x6 = x5*x5 → x5 = x4 → x6 = x2 → x1 = x1*(x6*x3) := by cc diff --git a/tests/lean/run/cc_ac_bug.lean b/tests/lean/run/cc_ac_bug.lean index 386f8fb533..a55367e870 100644 --- a/tests/lean/run/cc_ac_bug.lean +++ b/tests/lean/run/cc_ac_bug.lean @@ -1,2 +1,7 @@ +instance aa : is_associative ℕ (+) := ⟨nat.add_assoc⟩ +instance ac : is_commutative ℕ (+) := ⟨nat.add_comm⟩ +instance ma : is_associative ℕ (*) := ⟨nat.mul_assoc⟩ +instance mc : is_commutative ℕ (*) := ⟨nat.mul_comm⟩ + example (a b c : nat) (f : nat → nat → nat) : f (b * c) (c * b * a) = f (c * b) (a * c * b) := by ac_refl diff --git a/tests/lean/run/check_constants.lean b/tests/lean/run/check_constants.lean index 1f99b7d203..2182c29933 100644 --- a/tests/lean/run/check_constants.lean +++ b/tests/lean/run/check_constants.lean @@ -6,10 +6,6 @@ do env ← get_env, (env^.get n >> return ()) <|> (guard $ env^.is_namespace n) run_cmd script_check_id `absurd run_cmd script_check_id `acc.cases_on run_cmd script_check_id `acc.rec -run_cmd script_check_id `add_comm_group -run_cmd script_check_id `add_comm_semigroup -run_cmd script_check_id `add_group -run_cmd script_check_id `add_monoid run_cmd script_check_id `and run_cmd script_check_id `and.cases_on run_cmd script_check_id `and.elim_left @@ -42,7 +38,6 @@ run_cmd script_check_id `congr_arg run_cmd script_check_id `congr_fun run_cmd script_check_id `decidable run_cmd script_check_id `decidable.to_bool -run_cmd script_check_id `distrib run_cmd script_check_id `dite run_cmd script_check_id `empty run_cmd script_check_id `eq @@ -67,7 +62,6 @@ run_cmd script_check_id `false run_cmd script_check_id `false.rec run_cmd script_check_id `false_of_true_eq_false run_cmd script_check_id `false_of_true_iff_false -run_cmd script_check_id `field run_cmd script_check_id `fin.mk run_cmd script_check_id `fin.ne_of_vne run_cmd script_check_id `forall_congr @@ -169,15 +163,11 @@ run_cmd script_check_id `is_commutative.comm run_cmd script_check_id `is_valid_char_range_1 run_cmd script_check_id `is_valid_char_range_2 run_cmd script_check_id `ite -run_cmd script_check_id `le_refl run_cmd script_check_id `lean.parser run_cmd script_check_id `lean.parser.pexpr run_cmd script_check_id `lean.parser.reflectable.expr run_cmd script_check_id `lean.parser.tk run_cmd script_check_id `left_comm -run_cmd script_check_id `left_distrib -run_cmd script_check_id `linear_ordered_ring -run_cmd script_check_id `linear_ordered_semiring run_cmd script_check_id `list run_cmd script_check_id `list.cons run_cmd script_check_id `list.nil @@ -192,10 +182,6 @@ run_cmd script_check_id `monad_io_net_system_impl run_cmd script_check_id `monad_io_process_impl run_cmd script_check_id `monad_io_random_impl run_cmd script_check_id `monad_io_terminal_impl -run_cmd script_check_id `monoid -run_cmd script_check_id `mul_one -run_cmd script_check_id `mul_zero -run_cmd script_check_id `mul_zero_class run_cmd script_check_id `name.anonymous run_cmd script_check_id `name.mk_numeral run_cmd script_check_id `name.mk_string @@ -267,10 +253,7 @@ run_cmd script_check_id `reflected run_cmd script_check_id `reflected.subst run_cmd script_check_id `repr run_cmd script_check_id `rfl -run_cmd script_check_id `right_distrib -run_cmd script_check_id `ring run_cmd script_check_id `scope_trace -run_cmd script_check_id `semiring run_cmd script_check_id `set_of run_cmd script_check_id `sizeof run_cmd script_check_id `string @@ -312,6 +295,3 @@ run_cmd script_check_id `well_founded_tactics run_cmd script_check_id `well_founded_tactics.dec_tac run_cmd script_check_id `well_founded_tactics.default run_cmd script_check_id `well_founded_tactics.rel_tac -run_cmd script_check_id `zero_le_one -run_cmd script_check_id `zero_lt_one -run_cmd script_check_id `zero_mul diff --git a/tests/lean/run/conv_tac1.lean b/tests/lean/run/conv_tac1.lean index ab9b442909..583c14979c 100644 --- a/tests/lean/run/conv_tac1.lean +++ b/tests/lean/run/conv_tac1.lean @@ -1,4 +1,4 @@ -local attribute [simp] add_comm add_left_comm +local attribute [simp] nat.add_comm nat.add_left_comm example (a b : nat) : (λ x, a + x) 0 = b + 1 + a := begin conv in (_ + 1) { change nat.succ b }, @@ -67,20 +67,20 @@ end example (x y : nat) (f : nat → nat) (h : f (0 + x + y) = 0 + y) : f (x + y) = 0 + y := begin -- use conv to rewrite subterm of a hypothesis - conv at h in (0 + _) { rw [zero_add] }, + conv at h in (0 + _) { rw [nat.zero_add] }, assumption end example (x y : nat) (f : nat → nat) (h : f (0 + x + y) = 0 + y) : f (0 + x + y) = y := begin -- use conv to rewrite rhs a hypothesis - conv at h { to_rhs, rw [zero_add] }, + conv at h { to_rhs, rw [nat.zero_add] }, assumption end example (x : nat) (f : nat → nat) (h₁ : x = 0) (h₂ : ∀ x, f x = x + x) : f x = x := begin - conv { to_rhs, rw [h₁, <- add_zero 0, <- h₁], }, + conv { to_rhs, rw [h₁, <- nat.add_zero 0, <- h₁], }, exact h₂ x end diff --git a/tests/lean/run/cpdt.lean b/tests/lean/run/cpdt.lean deleted file mode 100644 index bad54fd477..0000000000 --- a/tests/lean/run/cpdt.lean +++ /dev/null @@ -1,43 +0,0 @@ -/- "Proving in the Large" chapter of CPDT -/ - -inductive exp : Type -| Const (n : nat) : exp -| Plus (e1 e2 : exp) : exp -| Mult (e1 e2 : exp) : exp - -open exp - -def eeval : exp → nat -| (Const n) := n -| (Plus e1 e2) := eeval e1 + eeval e2 -| (Mult e1 e2) := eeval e1 * eeval e2 - -def times (k : nat) : exp → exp -| (Const n) := Const (k * n) -| (Plus e1 e2) := Plus (times e1) (times e2) -| (Mult e1 e2) := Mult (times e1) e2 - -def reassoc : exp → exp -| (Const n) := (Const n) -| (Plus e1 e2) := - let e1' := reassoc e1 in - let e2' := reassoc e2 in - match e2' with - | (Plus e21 e22) := Plus (Plus e1' e21) e22 - | _ := Plus e1' e2' - end -| (Mult e1 e2) := - let e1' := reassoc e1 in - let e2' := reassoc e2 in - match e2' with - | (Mult e21 e22) := Mult (Mult e1' e21) e22 - | _ := Mult e1' e2' - end - -attribute [simp] mul_add times reassoc eeval mul_comm mul_assoc mul_left_comm - -theorem eeval_times (k e) : eeval (times k e) = k * eeval e := -by induction e; simp [*] - -theorem reassoc_correct (e) : eeval (reassoc e) = eeval e := -by induction e; simp [*]; cases (reassoc e_e2); rsimp diff --git a/tests/lean/run/dsimp_options.lean b/tests/lean/run/dsimp_options.lean index d8e95dda44..464b4ac31c 100644 --- a/tests/lean/run/dsimp_options.lean +++ b/tests/lean/run/dsimp_options.lean @@ -76,5 +76,5 @@ end example (a b : nat) : a + b = b + a := begin fail_if_success{dsimp}, -- will not unfold has_add.add applications - apply add_comm + apply nat.add_comm end diff --git a/tests/lean/run/dsimp_proj.lean b/tests/lean/run/dsimp_proj.lean index 5e97c89ccf..8c98c5b1f1 100644 --- a/tests/lean/run/dsimp_proj.lean +++ b/tests/lean/run/dsimp_proj.lean @@ -2,7 +2,7 @@ example (a b : nat) : a + b = b + a := begin dsimp [has_add.add], guard_target nat.add a b = nat.add b a, - apply add_comm + apply nat.add_comm end example (f g : nat → nat) : (f ∘ g) = (λ x, f (g x)) := diff --git a/tests/lean/run/ematch2.lean b/tests/lean/run/ematch2.lean index e967184913..3a2390ca66 100644 --- a/tests/lean/run/ematch2.lean +++ b/tests/lean/run/ematch2.lean @@ -1,3 +1,16 @@ +class add_comm_monoid (α : Type*) extends has_zero α, has_add α. + +section +variables {α : Type*} [add_comm_monoid α] (a b c : α) + +lemma add_assoc : a + b + c = a + (b + c) := sorry +lemma add_comm : a + b = b + a := sorry + +instance aa : is_associative α (+) := ⟨sorry⟩ +instance ac : is_commutative α (+) := ⟨sorry⟩ + +end + namespace foo universe variables u variables {α : Type u} diff --git a/tests/lean/run/ematch_attr_to_defs.lean b/tests/lean/run/ematch_attr_to_defs.lean deleted file mode 100644 index 9129af179b..0000000000 --- a/tests/lean/run/ematch_attr_to_defs.lean +++ /dev/null @@ -1,35 +0,0 @@ -universe variables u -variable {α : Type u} - -def app : list α → list α → list α -| [] l := l -| (h::t) l := h :: app t l - -/- Mark the app equational lemmas as ematching rules -/ -attribute [ematch] app - -@[ematch] lemma app_nil_right (l : list α) : app l [] = l := -begin [smt] - induction l, - ematch, -end - -@[ematch] lemma app_assoc (l₁ l₂ l₃ : list α) : app (app l₁ l₂) l₃ = app l₁ (app l₂ l₃) := -begin [smt] - induction l₁, - ematch, - ematch -end - -def len : list α → nat -| [] := 0 -| (a :: l) := len l + 1 - -attribute [ematch] len add_zero zero_add - -@[simp] lemma len_app (l₁ l₂ : list α) : len (app l₁ l₂) = len l₁ + len l₂ := -begin [smt] - induction l₁, - {ematch, ematch}, - {ematch, ematch} -end diff --git a/tests/lean/run/eq_cases_on.lean b/tests/lean/run/eq_cases_on.lean index 1cfa9a4dc4..5289ee58d2 100644 --- a/tests/lean/run/eq_cases_on.lean +++ b/tests/lean/run/eq_cases_on.lean @@ -1,5 +1,5 @@ def g {n m : nat} (v : array (n + m) nat) : array (m + n) nat := -eq.rec_on (add_comm n m) v -- Worked before +eq.rec_on (nat.add_comm n m) v -- Worked before def f {n m : nat} (v : array (n + m) nat) : array (m + n) nat := -eq.cases_on (add_comm n m) v -- eq.cases_on was not being erased +eq.cases_on (nat.add_comm n m) v -- eq.cases_on was not being erased diff --git a/tests/lean/run/funext_tactic.lean b/tests/lean/run/funext_tactic.lean index 85d8290914..4ea093d02c 100644 --- a/tests/lean/run/funext_tactic.lean +++ b/tests/lean/run/funext_tactic.lean @@ -1,56 +1,56 @@ example : (λ x y : nat, x + y) = (λ x y : nat, y + x) := begin funext, - apply add_comm x y + apply nat.add_comm x y end example : (λ x y : nat, x + y) = (λ x y : nat, y + x) := begin funext z w, - apply add_comm z w + apply nat.add_comm z w end example : (λ x y : nat, x + y) = (λ x y : nat, y + x) := begin funext z, funext w, - apply add_comm z w + apply nat.add_comm z w end example : (λ x y : nat, x + y) = (λ x y : nat, y + x) := begin funext _, funext _, - apply add_comm x y + apply nat.add_comm x y end example : (λ x y : nat, x + y) = (λ x y : nat, y + x) := begin funext _ _, - apply add_comm x y + apply nat.add_comm x y end example : (λ x y : nat, x + 0) = (λ x y : nat, 0 + x) := begin funext _ _, - apply add_comm x 0 + apply nat.add_comm x 0 end example : (λ x y : nat, x + 0) = (λ x y : nat, 0 + x) := begin funext z _, - apply add_comm z 0 + apply nat.add_comm z 0 end example : (λ x y : nat, x + 0) = (λ x y : nat, 0 + x) := begin funext _ z, - apply add_comm x 0 + apply nat.add_comm x 0 end example : (λ x y : nat, x + 0) = (λ x y : nat, 0 + x) := begin funext z, funext _, - apply add_comm z 0 + apply nat.add_comm z 0 end diff --git a/tests/lean/run/handthen.lean b/tests/lean/run/handthen.lean index 4386e0e70c..c73939cc54 100644 --- a/tests/lean/run/handthen.lean +++ b/tests/lean/run/handthen.lean @@ -1,5 +1,7 @@ open tactic +local attribute [simp] nat.add_zero nat.zero_add + lemma ex1 (a b c : nat) : a + 0 = 0 + a ∧ b = b := begin -- We use `(` to go to regular tactic mode. diff --git a/tests/lean/run/hinst_lemma1.lean b/tests/lean/run/hinst_lemma1.lean index c94537ea51..be7574cfe9 100644 --- a/tests/lean/run/hinst_lemma1.lean +++ b/tests/lean/run/hinst_lemma1.lean @@ -13,7 +13,7 @@ do h ← hinst_lemma.mk_from_decl n, example : true := by do - pp_lemma `add_assoc, + pp_lemma `nat.add_assoc, pp_lemma `foo, pp_lemma `boo, constructor diff --git a/tests/lean/run/hinst_lemmas1.lean b/tests/lean/run/hinst_lemmas1.lean index d94d631e48..c9c67dc23b 100644 --- a/tests/lean/run/hinst_lemmas1.lean +++ b/tests/lean/run/hinst_lemmas1.lean @@ -2,8 +2,8 @@ run_cmd do tactic.trace "hinst_lemmas example:", hs ← return $ hinst_lemmas.mk, - h₁ ← hinst_lemma.mk_from_decl `add_zero, - h₂ ← hinst_lemma.mk_from_decl `zero_add, - h₃ ← hinst_lemma.mk_from_decl `add_comm, + h₁ ← hinst_lemma.mk_from_decl `nat.add_zero, + h₂ ← hinst_lemma.mk_from_decl `nat.zero_add, + h₃ ← hinst_lemma.mk_from_decl `nat.add_comm, hs ← return $ ((hs^.add h₁)^.add h₂)^.add h₃, hs^.pp >>= tactic.trace diff --git a/tests/lean/run/interactive1.lean b/tests/lean/run/interactive1.lean index e0f42688e5..941642014b 100644 --- a/tests/lean/run/interactive1.lean +++ b/tests/lean/run/interactive1.lean @@ -11,7 +11,7 @@ rfl example (a b c : nat) : b = 0 → c = 1 → a + b + f c = g (f a) := begin intros h1 h2, - simp [h1, h2, g_def, nat.add_comm 1 a] + simp [h1, h2, g_def, nat.add_comm 1 a, nat.add_zero] end example (b c : nat) : b = 0 → c = b + 1 → c = 1 := diff --git a/tests/lean/run/intros_defeq_canonizer_bug.lean b/tests/lean/run/intros_defeq_canonizer_bug.lean index fd05d03606..1983055868 100644 --- a/tests/lean/run/intros_defeq_canonizer_bug.lean +++ b/tests/lean/run/intros_defeq_canonizer_bug.lean @@ -1,3 +1,4 @@ +class ring (α : Type*) extends has_zero α. constant {u} f {α : Type u} : α → α → α → α axiom {u} fax {α : Type u} [ring α] (a b : α) : f a b a = 0 @@ -5,5 +6,7 @@ attribute [ematch] fax universe variables u +class field (α : Type*) extends ring α, has_add α. + lemma ex {α : Type u} [field α] (x y : α) : f (x + y) (y + x) (x + y) = 0 := begin [smt] ematch end diff --git a/tests/lean/run/local_attribute.lean b/tests/lean/run/local_attribute.lean index cf36cce450..77724b80e1 100644 --- a/tests/lean/run/local_attribute.lean +++ b/tests/lean/run/local_attribute.lean @@ -4,7 +4,7 @@ local attribute [instance, priority 0] classical.prop_decidable open tactic run_cmd do - (p,_) ← has_attribute `instance ``nat.monoid, + (p,_) ← has_attribute `instance ``nat.has_add, guard p, (p,_) ← has_attribute `instance ``classical.prop_decidable, guard (¬ p), diff --git a/tests/lean/run/mario_type_context.lean b/tests/lean/run/mario_type_context.lean index 560c24e308..2fcdb12cff 100644 --- a/tests/lean/run/mario_type_context.lean +++ b/tests/lean/run/mario_type_context.lean @@ -2,6 +2,18 @@ set_option profiler true open tactic +constant semiring : Type → Type +constant comm_semiring : Type → Type +constant ring : Type → Type +constant comm_ring : Type → Type + +attribute [class] semiring comm_semiring ring comm_ring + +constant comm_ring.to_comm_semiring {α : Type} [comm_ring α] : comm_semiring α +constant comm_semiring.to_semiring {α : Type} [comm_semiring α] : semiring α + +attribute [instance] comm_ring.to_comm_semiring comm_semiring.to_semiring + def bar (α) [semiring α] : α := sorry lemma foo (α) [comm_ring α] diff --git a/tests/lean/run/mrw.lean b/tests/lean/run/mrw.lean index 6b8130151b..1d31aa4c1a 100644 --- a/tests/lean/run/mrw.lean +++ b/tests/lean/run/mrw.lean @@ -1,6 +1,6 @@ example (n : nat) : ∃ x, x + n = n + 1 := begin constructor, - fail_if_success {rw [zero_add] {unify := ff}}, - rw [add_comm] + fail_if_success {rw [nat.zero_add] {unify := ff}}, + rw [nat.add_comm] end diff --git a/tests/lean/run/name_resolution_with_params_bug.lean b/tests/lean/run/name_resolution_with_params_bug.lean index 27f232ca87..9b49d121d6 100644 --- a/tests/lean/run/name_resolution_with_params_bug.lean +++ b/tests/lean/run/name_resolution_with_params_bug.lean @@ -3,7 +3,7 @@ section parameters x y : nat def z := x + y - lemma h0 : z = y + x := add_comm _ _ + lemma h0 : z = y + x := nat.add_comm _ _ open tactic diff --git a/tests/lean/run/nat_sub_ematch.lean b/tests/lean/run/nat_sub_ematch.lean index 41a794ac20..b92e94b20f 100644 --- a/tests/lean/run/nat_sub_ematch.lean +++ b/tests/lean/run/nat_sub_ematch.lean @@ -1,6 +1,6 @@ set_option trace.smt.ematch true -example (a b c d : nat) (f : nat → nat) : f d = a + b → f d - a + c = c + b := +example (a b c d : nat) (f : nat → nat) : f d = a + b → f d - a + c = b + c := begin [smt] intros, eblast diff --git a/tests/lean/run/psum_wf_rec.lean b/tests/lean/run/psum_wf_rec.lean index 8e4e40b991..9b849e4553 100644 --- a/tests/lean/run/psum_wf_rec.lean +++ b/tests/lean/run/psum_wf_rec.lean @@ -6,7 +6,7 @@ def sum_has_sizeof_2 {α β} [has_sizeof α] [has_sizeof β] : has_sizeof (psum ⟨psum.alt.sizeof⟩ local attribute [instance] sum_has_sizeof_2 -local attribute [simp] add_comm add_left_comm add_assoc mul_assoc mul_comm mul_left_comm +local attribute [simp] nat.add_comm nat.add_left_comm nat.add_assoc nat.mul_assoc nat.mul_comm nat.one_mul mutual def f, g with f : ℕ → ℕ @@ -18,7 +18,7 @@ with g : ℕ → ℕ We will be able to delete it as soon as we have decision procedures for arithmetic -/ have 2 + n * 2 < 1 + 2 * (n + 1), from begin - rw [left_distrib], simp, + rw [nat.left_distrib], simp, well_founded_tactics.cancel_nat_add_lt, tactic.comp_val end, diff --git a/tests/lean/run/rw1.lean b/tests/lean/run/rw1.lean index cede0eb480..2812a3f867 100644 --- a/tests/lean/run/rw1.lean +++ b/tests/lean/run/rw1.lean @@ -1,3 +1,5 @@ +local attribute [simp] nat.zero_add + namespace Ex1 variables diff --git a/tests/lean/run/sebastien_coe_simp.lean b/tests/lean/run/sebastien_coe_simp.lean index 06ae3b2fcb..ff8c24ad43 100644 --- a/tests/lean/run/sebastien_coe_simp.lean +++ b/tests/lean/run/sebastien_coe_simp.lean @@ -13,8 +13,8 @@ def my_equiv2 : my_equiv α := @[simp] lemma one_eq_two : my_equiv1 α = my_equiv2 α := rfl -lemma other (x : ℕ) : my_equiv1 ℕ (x + 0) = my_equiv2 ℕ x := by simp -- does not fail +lemma other (x : ℕ) : my_equiv1 ℕ (x + 0) = my_equiv2 ℕ x := by simp [nat.add_zero] -- does not fail @[simp] lemma two_apply (x : α) : my_equiv2 α x = x := rfl -lemma one_apply (x : α) : my_equiv1 α x = x := by simp -- does not fail \ No newline at end of file +lemma one_apply (x : α) : my_equiv1 α x = x := by simp -- does not fail diff --git a/tests/lean/run/show_goal.lean b/tests/lean/run/show_goal.lean index 6480a347a8..fe02592e3e 100644 --- a/tests/lean/run/show_goal.lean +++ b/tests/lean/run/show_goal.lean @@ -1,27 +1,29 @@ open tactic +local attribute [simp] nat.add_zero nat.zero_add + lemma ex1 (a b c : nat) : a + 0 = 0 + a ∧ 0 + b = b ∧ c + b = b + c := begin repeat {any_goals {constructor}}, - show c + b = b + c, { apply add_comm }, + show c + b = b + c, { apply nat.add_comm }, show a + 0 = 0 + a, { simp }, - show 0 + b = b, { rw [zero_add] } + show 0 + b = b, { rw [nat.zero_add] } end /- Same example, but the local context of each goal is different -/ lemma ex3 : (∀ a : nat, a + 0 = 0 + a) ∧ (∀ b : nat, 0 + b = b) ∧ (∀ b c : nat, c + b = b + c) := begin repeat {any_goals {constructor}}, all_goals {intros}, - show c + b = b + c, { apply add_comm }, + show c + b = b + c, { apply nat.add_comm }, show a + 0 = 0 + a, { simp }, - show 0 + b = b, { rw [zero_add] } + show 0 + b = b, { rw [nat.zero_add] } end /- Same example, but the local context of each goal is different -/ lemma ex4 : (∀ a : nat, a + 0 = 0 + a) ∧ (∀ b : nat, 0 + b = b) ∧ (∀ b c : nat, c + b = b + c) := begin repeat {any_goals {constructor}}, all_goals {intros}, - show c + b = _, { apply add_comm }, + show c + b = _, { apply nat.add_comm }, show a + _ = 0 + a, { simp }, - show _ = b, { rw [zero_add] } + show _ = b, { rw [nat.zero_add] } end diff --git a/tests/lean/run/simp_lemma_issue.lean b/tests/lean/run/simp_lemma_issue.lean index 8ab5da1773..d39fc1f816 100644 --- a/tests/lean/run/simp_lemma_issue.lean +++ b/tests/lean/run/simp_lemma_issue.lean @@ -1,15 +1,23 @@ universe variables u +class comm_semiring (α : Type*) extends has_zero α, has_add α, has_one α, has_mul α. + +lemma zero_add {α : Type*} [comm_semiring α] (a : α) : (0:α) + a = a := sorry +lemma add_zero {α : Type*} [comm_semiring α] (a : α) : a + 0 = a := sorry + +instance foo : comm_semiring nat := +{ zero := 0, one := 1, add := (+), mul := (*) } + def ex {α : Type u} [comm_semiring α] (a : α) : 0 + a = a := zero_add a -local attribute [-simp] zero_add add_zero +-- local attribute [-simp] zero_add add_zero attribute [simp] ex example (a b : nat) : 0 + 0 + a = a := by simp -local attribute [-ematch] zero_add add_zero +-- local attribute [-ematch] zero_add add_zero attribute [ematch] ex example (a b : nat) : 0 + 0 + a = a := diff --git a/tests/lean/run/simp_lemmas_with_mvars.lean b/tests/lean/run/simp_lemmas_with_mvars.lean index b60d75b33e..57476d750a 100644 --- a/tests/lean/run/simp_lemmas_with_mvars.lean +++ b/tests/lean/run/simp_lemmas_with_mvars.lean @@ -13,19 +13,19 @@ end example (a b c : nat) : a + b + c = b + a + c := begin - simp only [add_comm _ b] + simp only [nat.add_comm _ b] end example (a b c : nat) (h : c = 0) : a + b + 0 = b + a + c := begin - simp only [add_comm _ b], + simp only [nat.add_comm _ b], guard_target b + a + 0 = b + a + c, rw h end example (a b c : nat) (h : c = 0) : 0 + (a + b) = b + a + c := begin - simp only [add_comm _ c, add_comm a _], + simp only [nat.add_comm _ c, nat.add_comm a _], guard_target 0 + (b + a) = c + (b + a), rw h end diff --git a/tests/lean/run/simp_tc_err.lean b/tests/lean/run/simp_tc_err.lean index f728247647..41c1932796 100644 --- a/tests/lean/run/simp_tc_err.lean +++ b/tests/lean/run/simp_tc_err.lean @@ -1,6 +1,8 @@ def c : ℕ := default _ def d : ℕ := default _ +local attribute [simp] nat.add_zero + class foo (α : Type) -- type class resolution for [foo α] will always time out instance foo.foo {α} [foo α] : foo α := ‹foo α› diff --git a/tests/lean/run/simp_zeta.lean b/tests/lean/run/simp_zeta.lean index e3ebedb8db..082e3d20e5 100644 --- a/tests/lean/run/simp_zeta.lean +++ b/tests/lean/run/simp_zeta.lean @@ -1,3 +1,5 @@ +local attribute [simp] nat.zero_add + example (n : ℕ) : let m := 0 + n in m = n := begin intro, diff --git a/tests/lean/run/smt_assert_define.lean b/tests/lean/run/smt_assert_define.lean index f24446b574..819df0f814 100644 --- a/tests/lean/run/smt_assert_define.lean +++ b/tests/lean/run/smt_assert_define.lean @@ -4,9 +4,11 @@ constant p : nat → nat → Prop constant f : nat → nat axiom pf (a : nat) : p (f a) (f a) → p a a +local attribute [ematch] nat.add_zero + lemma ex1 (a b c : nat) : a = b + 0 → a + c = b + c := by using_smt $ do - pr ← tactic.to_expr ```(add_zero b), + pr ← tactic.to_expr ```(nat.add_zero b), note `h none pr, trace_state, return () diff --git a/tests/lean/run/smt_ematch1.lean b/tests/lean/run/smt_ematch1.lean index 7046a0d2fa..23d0d718f7 100644 --- a/tests/lean/run/smt_ematch1.lean +++ b/tests/lean/run/smt_ematch1.lean @@ -45,7 +45,7 @@ lemma ex6 (a b c d e : nat) : (∀ x, g x (f x) = 0) → a = f b → g b a + 0 = begin [smt] intros, have h : ∀ x, g x (f x) = 0, - add_lemma [h, fax, add_zero], + add_lemma [h, fax, nat.add_zero], ematch end @@ -53,10 +53,10 @@ lemma ex7 (a b c d e : nat) : (∀ x, g x (f x) = 0) → a = f b → g b a + 0 = begin [smt] intros, have h : ∀ x, g x (f x) = 0, - ematch_using [h, fax, add_zero] + ematch_using [h, fax, nat.add_zero] end -local attribute [ematch] fax add_zero +local attribute [ematch] fax nat.add_zero open smt_tactic diff --git a/tests/lean/run/smt_ematch2.lean b/tests/lean/run/smt_ematch2.lean deleted file mode 100644 index a1e2de83cb..0000000000 --- a/tests/lean/run/smt_ematch2.lean +++ /dev/null @@ -1,109 +0,0 @@ -universe variables u -namespace foo -variables {α : Type u} - -open smt_tactic -meta def no_ac : smt_config := -{ cc_cfg := { ac := ff }} - -meta def blast : tactic unit := -using_smt_with no_ac $ intros >> iterate (ematch >> try close) - -section add_comm_monoid -variables [add_comm_monoid α] -attribute [ematch] add_comm add_assoc - -theorem add_comm_three (a b c : α) : a + b + c = c + b + a := -by blast - -theorem add.comm4 : ∀ (n m k l : α), n + m + (k + l) = n + k + (m + l) := -by blast -end add_comm_monoid - - -section group -variable [group α] -attribute [ematch] mul_assoc mul_left_inv one_mul - -theorem inv_mul_cancel_left (a b : α) : a⁻¹ * (a * b) = b := -by blast -end group - - -namespace subt -constant subt : nat → nat → Prop -axiom subt_trans {a b c : nat} : subt a b → subt b c → subt a c -attribute [ematch] subt_trans - -lemma ex (a b c d : nat) : subt a b → subt b c → subt c d → subt a d := -by blast -end subt - - -section ring -variables [ring α] (a b : α) -attribute [ematch] zero_mul -lemma ex2 : a = 0 → a * b = 0 := -by blast - -definition ex1 (a b : int) : a = 0 → a * b = 0 := -by blast -end ring - - -namespace cast1 -constant C : nat → Type -constant f : ∀ n, C n → C n -axiom fax (n : nat) (a : C (2*n)) : (: f (2*n) a :) = a -attribute [ematch] fax - -lemma ex3 (n m : nat) (a : C n) : n = 2*m → f n a = a := -by blast -end cast1 - - -namespace cast2 -constant C : nat → Type -constant f : ∀ n, C n → C n -constant g : ∀ n, C n → C n → C n -axiom gffax (n : nat) (a b : C n) : (: g n (f n a) (f n b) :) = a -attribute [ematch] gffax - -lemma ex4 (n m : nat) (a c : C n) (b : C m) : n = m → a == f m b → g n a (f n c) == b := -by blast -end cast2 - - -namespace cast3 -constant C : nat → Type -constant f : ∀ n, C n → C n -constant g : ∀ n, C n → C n → C n -axiom gffax (n : nat) (a b : C n) : (: g n a b :) = a -attribute [ematch] gffax - -lemma ex5 (n m : nat) (a c : C n) (b : C m) (e : m = n) : a == b → g n a a == b := -by blast -end cast3 - -namespace tuple -constant {α} tuple: Type α → nat → Type α -constant nil {α : Type u} : tuple α 0 -constant append {α : Type u} {n m : nat} : tuple α n → tuple α m → tuple α (n + m) -infix ` ++ ` := append -axiom append_assoc {α : Type u} {n₁ n₂ n₃ : nat} (v₁ : tuple α n₁) (v₂ : tuple α n₂) (v₃ : tuple α n₃) : - (v₁ ++ v₂) ++ v₃ == v₁ ++ (v₂ ++ v₃) -attribute [ematch] append_assoc - -variables {p m n q : nat} -variables {xs : tuple α m} -variables {ys : tuple α n} -variables {zs : tuple α p} -variables {ws : tuple α q} -lemma ex6 : p = m + n → zs == xs ++ ys → zs ++ ws == xs ++ (ys ++ ws) := -by blast - -def ex : p = n + m → zs == xs ++ ys → zs ++ ws == xs ++ (ys ++ ws) := -by blast -end tuple - -end foo diff --git a/tests/lean/run/smt_ematch3.lean b/tests/lean/run/smt_ematch3.lean deleted file mode 100644 index 3a15b3733e..0000000000 --- a/tests/lean/run/smt_ematch3.lean +++ /dev/null @@ -1,47 +0,0 @@ -namespace Ex -open nat -notation `⟦`:max a `⟧`:0 := cast (by simp) a - -inductive vector (α : Type) : nat → Type -| nil {} : vector 0 -| cons : Π {n}, α → vector n → vector (succ n) - -namespace vector -local attribute [simp] add_succ succ_add add_comm - -variable {α : Type} - -def app : Π {n m : nat}, vector α n → vector α m → vector α (n + m) -| 0 m nil w := ⟦ w ⟧ -| (succ n) m (cons a v) w := ⟦ cons a (app v w) ⟧ - -lemma app_nil_right {n : nat} (v : vector α n) : app v nil == v := -begin induction v, reflexivity, {[smt] ematch_using [app, add_comm, zero_add, add_zero] }, end - -def smt_cfg : smt_config := -{ cc_cfg := {ac := ff}} - -lemma app_assoc {n₁ n₂ n₃ : nat} (v₁ : vector α n₁) (v₂ : vector α n₂) (v₃ : vector α n₃) : - app v₁ (app v₂ v₃) == app (app v₁ v₂) v₃ := -begin - intros, - induction v₁, - {[smt] ematch_using [app, zero_add] }, - {[smt] with smt_cfg, iterate { ematch_using [app, add_succ, succ_add, add_comm, add_assoc] }} -end - -def rev : Π {n : nat}, vector α n → vector α n -| 0 nil := nil -| (n+1) (cons x xs) := app (rev xs) (cons x nil) - -lemma rev_app : ∀ {n₁ n₂ : nat} (v₁ : vector α n₁) (v₂ : vector α n₂), - rev (app v₁ v₂) == app (rev v₂) (rev v₁) := -begin - intros, - induction v₁, - {[smt] iterate {ematch_using [app, rev, zero_add, add_zero, add_comm, app_nil_right]}}, - {[smt] iterate {ematch_using [app, rev, zero_add, add_zero, add_comm, app_assoc, add_one]} } -end - -end vector -end Ex diff --git a/tests/lean/run/smt_ematch_alg_issue.lean b/tests/lean/run/smt_ematch_alg_issue.lean index e549ca7c4d..3c5a7dd5de 100644 --- a/tests/lean/run/smt_ematch_alg_issue.lean +++ b/tests/lean/run/smt_ematch_alg_issue.lean @@ -1,3 +1,7 @@ +class ring (α : Type*) extends has_zero α, has_add α, has_one α, has_mul α. + +lemma add_comm {α : Type*} [ring α] (a b : α) : a + b = b + a := sorry + lemma {u} ring_add_comm {α : Type u} [ring α] : ∀ (a b : α), (: a + b :) = b + a := add_comm @@ -5,6 +9,8 @@ open smt_tactic meta def no_ac : smt_config := { cc_cfg := { ac := ff }} +class field (α : Type*) extends ring α, has_inv α. + lemma ex {α : Type} [field α] (a b : α) : a + b = b + a := begin [smt] with no_ac, ematch_using [ring_add_comm] diff --git a/tests/lean/run/smt_tests.lean b/tests/lean/run/smt_tests.lean index c4a4c59ed4..8d33e6fc11 100644 --- a/tests/lean/run/smt_tests.lean +++ b/tests/lean/run/smt_tests.lean @@ -1,4 +1,4 @@ -attribute [pre_smt] add_zero zero_add mul_one one_mul +attribute [pre_smt] nat.add_zero nat.zero_add nat.mul_one nat.one_mul constant p : nat → nat → Prop constants a b : nat @@ -24,7 +24,7 @@ def foo : nat → nat lemma ex1 (n : nat) : n = 0 → foo (n+1) = 2*0 := begin [smt] intros, - add_lemma [mul_zero, zero_mul], + add_lemma [nat.mul_zero, nat.zero_mul], add_eqn_lemmas foo, ematch end @@ -32,7 +32,7 @@ end lemma ex2 (n : nat) : n = 0 → foo (n+1) = 2*0 := begin [smt] intros, - ematch_using [foo, mul_zero, zero_mul], + ematch_using [foo, nat.mul_zero, nat.zero_mul], end lemma ex3 (n : nat) : n = 0 → foo n = 0 := diff --git a/tests/lean/run/term_app2.lean b/tests/lean/run/term_app2.lean index 0c9583dd9b..506df05a97 100644 --- a/tests/lean/run/term_app2.lean +++ b/tests/lean/run/term_app2.lean @@ -1,17 +1,17 @@ -local attribute [simp] add_comm add_left_comm +local attribute [simp] nat.add_comm nat.add_left_comm lemma nat.lt_add_of_lt {a b c : nat} : a < b → a < c + b := begin intro h, have aux₁ := nat.le_add_right b c, have aux₂ := lt_of_lt_of_le h aux₁, - rwa [add_comm] at aux₂ + rwa [nat.add_comm] at aux₂ end lemma nat.lt_one_add_of_lt {a b : nat} : a < b → a < 1 + b := begin intro h, have aux := lt.trans h (nat.lt_succ_self _), - rwa [<- nat.add_one, add_comm] at aux + rwa [<- nat.add_one, nat.add_comm] at aux end namespace list diff --git a/tests/lean/run/u_eq_max_u_v.lean b/tests/lean/run/u_eq_max_u_v.lean index 132f33e372..35395e1b73 100644 --- a/tests/lean/run/u_eq_max_u_v.lean +++ b/tests/lean/run/u_eq_max_u_v.lean @@ -2,6 +2,9 @@ universe variables u v u1 u2 v1 v2 set_option pp.universes true +class semigroup (α : Type u) extends has_mul α := +(mul_assoc : ∀ a b c : α, a * b * c = a * (b * c)) + open smt_tactic meta def blast : tactic unit := using_smt $ intros >> add_lemmas_from_facts >> iterate_at_most 3 ematch notation `♮` := by blast @@ -26,7 +29,7 @@ attribute [simp] semigroup_morphism.multiplicative multiplicative := begin intros, simp [coe_fn] end } -local attribute [simp] mul_comm mul_assoc mul_left_comm +local attribute [simp] semigroup.mul_assoc @[reducible] definition semigroup_product { α β : Type u } ( s : semigroup α ) ( t: semigroup β ) : semigroup (α × β) := { mul := λ p q, (p^.fst * q^.fst, p^.snd * q^.snd), diff --git a/tests/lean/run/using_smt2.lean b/tests/lean/run/using_smt2.lean index b09ca63a89..bf0c31e0bf 100644 --- a/tests/lean/run/using_smt2.lean +++ b/tests/lean/run/using_smt2.lean @@ -33,8 +33,8 @@ by using_smt $ intros lemma ex11 (p q r s : Prop) : (p ∨ q → not (r ∨ s)) → p → not r := by using_smt $ intros -lemma ex12 (p q r : Prop) (a b c : nat): (p → q ∧ r ∧ a = b + c) → p → (c + b = a ∧ r) := -by using_smt $ intros +-- lemma ex12 (p q r : Prop) (a b c : nat): (p → q ∧ r ∧ a = b + c) → p → (c + b = a ∧ r) := +-- by using_smt $ intros lemma ex13 (a b c d : nat) : b = d → c = d → (if a > 10 then b else c) = b := by using_smt $ intros diff --git a/tests/lean/simp_symm.lean b/tests/lean/simp_symm.lean index 4cd31e1304..7e65699c37 100644 --- a/tests/lean/simp_symm.lean +++ b/tests/lean/simp_symm.lean @@ -33,6 +33,6 @@ def op : nat → nat → nat := sorry @[simp] lemma op_assoc (a b c : nat) : op (op a b) c = op a (op b c) := sorry example (a b c : nat) : op (op a b) c = op a (op b c) := by tactic.try_for 1000 `[ simp [← op_assoc] ] -example (a b c : nat) : a + b + c = a + (b + c) := by tactic.try_for 1000 `[ simp [← add_assoc] ] +example (a b c : nat) : a + b + c = a + (b + c) := by tactic.try_for 1000 `[ simp [← nat.add_assoc] ] end reverse_conflict diff --git a/tests/lean/task.lean b/tests/lean/task.lean index 8f1b91f3d8..cee0460f9e 100644 --- a/tests/lean/task.lean +++ b/tests/lean/task.lean @@ -1,3 +1,5 @@ +local attribute [simp] nat.zero_add + run_cmd tactic.run_async (tactic.trace "trace message from a different task") diff --git a/tests/lean/type_context.lean b/tests/lean/type_context.lean index c2cc9c56db..b9e49f8ad6 100644 --- a/tests/lean/type_context.lean +++ b/tests/lean/type_context.lean @@ -57,7 +57,7 @@ run_cmd do -- should fail with a 'deep recursion' trace m₂ run_cmd do - x : pexpr ← resolve_name `eq_mul_inv_of_mul_eq, + x : pexpr ← resolve_name `int.eq_neg_of_eq_neg, x ← to_expr x, y ← infer_type x, (t,us,es) ← type_context.run $ type_context.to_tmp_mvars y, diff --git a/tests/lean/type_context.lean.expected.out b/tests/lean/type_context.lean.expected.out index 6b9f053d23..bf1c0635b1 100644 --- a/tests/lean/type_context.lean.expected.out +++ b/tests/lean/type_context.lean.expected.out @@ -11,9 +11,9 @@ type_context.lean:35:0: error: deep recursion was detected at 'expression replac tt type_context.lean:42:0: error: deep recursion was detected at 'expression replacer' (potential solution: increase stack space in your system) type_context.lean:50:0: error: deep recursion was detected at 'expression replacer' (potential solution: increase stack space in your system) -?x_2 * ?x_3 = ?x_4 → ?x_2 = ?x_4 * ?x_3⁻¹ -[?7.0] -[?x_0, ?x_1, ?x_2, ?x_3, ?x_4] +?x_0 = -?x_1 → ?x_1 = -?x_0 +[] +[?x_0, ?x_1] ℕ theorem my_intro_test : ∀ (x : ℕ), x = x := λ (x : ℕ), eq.refl x diff --git a/tests/lean/vm_override.lean b/tests/lean/vm_override.lean index 4f109fa7ff..e5a2b394df 100644 --- a/tests/lean/vm_override.lean +++ b/tests/lean/vm_override.lean @@ -160,7 +160,7 @@ lemma succ_pred_bit1 : ∀ p : pos, succ (pred $ bit1 p) = bit1 p | (bit1 p) := rfl lemma sizeof_pred_bit0_lt : ∀ p : pos, sizeof' (pred (bit0 p)) < sizeof' (bit0 p) -| one := nat.one_lt_bit0 (by dsimp [pos.sizeof]; apply one_ne_zero) +| one := nat.one_lt_bit0 (by dsimp [pos.sizeof]; apply nat.one_ne_zero) | (bit0 p) := nat.bit1_lt_bit0 $ sizeof_pred_bit0_lt p | (bit1 p) := nat.bit1_lt_bit0 $ nat.bit0_lt_bit1 $ le_refl _