/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad

! This file was ported from Lean 3 source module init.data.int.basic
! leanprover-community/mathlib commit 4a03bdeb31b3688c31d02d7ff8e0ff2e5d6174db
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
prelude
import Leanbin.Init.Data.Nat.Lemmas
import Leanbin.Init.Data.Nat.Gcd

open Nat

/-!
# The integers, with addition, multiplication, and subtraction.

the type, coercions, and notation -/

#print Int /-
inductive Int : Type
  | of_nat : Nat → Int
  | neg_succ_of_nat : Nat → Int
  deriving DecidableEq
#align int Int
-/

instance : Coe Nat Int :=
  ⟨Int.ofNat⟩

#print Int.repr /-
protected def Int.repr : Int → String
  | Int.ofNat n => repr n
  | Int.negSucc n => "-" ++ repr (succ n)
#align int.repr Int.repr
-/

instance : Repr Int :=
  ⟨Int.repr⟩

instance : ToString Int :=
  ⟨Int.repr⟩

namespace Int

protected theorem coe_nat_eq (n : ℕ) : ↑n = Int.ofNat n :=
  rfl
#align int.coe_nat_eq Int.coe_nat_eq

#print Int.zero /-
protected def zero : ℤ :=
  ofNat 0
#align int.zero Int.zero
-/

#print Int.one /-
protected def one : ℤ :=
  ofNat 1
#align int.one Int.one
-/

instance : Zero ℤ :=
  ⟨Int.zero⟩

instance : One ℤ :=
  ⟨Int.one⟩

#print Int.ofNat_zero /-
theorem ofNat_zero : ofNat (0 : Nat) = (0 : Int) :=
  rfl
#align int.of_nat_zero Int.ofNat_zero
-/

#print Int.ofNat_one /-
theorem ofNat_one : ofNat (1 : Nat) = (1 : Int) :=
  rfl
#align int.of_nat_one Int.ofNat_one
-/

/-! definitions of basic functions -/

#print Int.negOfNat /-
def negOfNat : ℕ → ℤ
  | 0 => 0
  | succ m => -[m+1]
#align int.neg_of_nat Int.negOfNat
-/

#print Int.subNatNat /-
def subNatNat (m n : ℕ) : ℤ :=
  match (n - m : Nat) with
  | 0 => ofNat (m - n)
  |-- m ≥ n
      succ
      k =>
    -[k+1]
#align int.sub_nat_nat Int.subNatNat
-/

#print Int.subNatNat_of_sub_eq_zero /-
-- m < n, and n - m = succ k
theorem subNatNat_of_sub_eq_zero {m n : ℕ} (h : n - m = 0) : subNatNat m n = ofNat (m - n) := by
  unfold sub_nat_nat; rw [h]; unfold sub_nat_nat._match_1
#align int.sub_nat_nat_of_sub_eq_zero Int.subNatNat_of_sub_eq_zero
-/

#print Int.subNatNat_of_sub_eq_succ /-
theorem subNatNat_of_sub_eq_succ {m n k : ℕ} (h : n - m = succ k) : subNatNat m n = -[k+1] := by
  unfold sub_nat_nat; rw [h]; unfold sub_nat_nat._match_1
#align int.sub_nat_nat_of_sub_eq_succ Int.subNatNat_of_sub_eq_succ
-/

#print Int.neg /-
protected def neg : ℤ → ℤ
  | of_nat n => negOfNat n
  | -[n+1] => succ n
#align int.neg Int.neg
-/

#print Int.add /-
protected def add : ℤ → ℤ → ℤ
  | of_nat m, of_nat n => ofNat (m + n)
  | of_nat m, -[n+1] => subNatNat m (succ n)
  | -[m+1], of_nat n => subNatNat n (succ m)
  | -[m+1], -[n+1] => -[succ (m + n)+1]
#align int.add Int.add
-/

#print Int.mul /-
protected def mul : ℤ → ℤ → ℤ
  | of_nat m, of_nat n => ofNat (m * n)
  | of_nat m, -[n+1] => negOfNat (m * succ n)
  | -[m+1], of_nat n => negOfNat (succ m * n)
  | -[m+1], -[n+1] => ofNat (succ m * succ n)
#align int.mul Int.mul
-/

instance : Neg ℤ :=
  ⟨Int.neg⟩

instance : Add ℤ :=
  ⟨Int.add⟩

instance : Mul ℤ :=
  ⟨Int.mul⟩

#print Int.sub /-
-- defeq to algebra.sub which gives subtraction for arbitrary `add_group`s
protected def sub : ℤ → ℤ → ℤ := fun m n => m + -n
#align int.sub Int.sub
-/

instance : Sub ℤ :=
  ⟨Int.sub⟩

#print Int.neg_zero /-
protected theorem neg_zero : -(0 : ℤ) = 0 :=
  rfl
#align int.neg_zero Int.neg_zero
-/

#print Int.ofNat_add /-
theorem ofNat_add (n m : ℕ) : ofNat (n + m) = ofNat n + ofNat m :=
  rfl
#align int.of_nat_add Int.ofNat_add
-/

#print Int.ofNat_mul /-
theorem ofNat_mul (n m : ℕ) : ofNat (n * m) = ofNat n * ofNat m :=
  rfl
#align int.of_nat_mul Int.ofNat_mul
-/

#print Int.ofNat_succ /-
theorem ofNat_succ (n : ℕ) : ofNat (succ n) = ofNat n + 1 :=
  rfl
#align int.of_nat_succ Int.ofNat_succ
-/

#print Int.neg_ofNat_zero /-
theorem neg_ofNat_zero : -ofNat 0 = 0 :=
  rfl
#align int.neg_of_nat_zero Int.neg_ofNat_zero
-/

#print Int.neg_ofNat_succ /-
theorem neg_ofNat_succ (n : ℕ) : -ofNat (succ n) = -[n+1] :=
  rfl
#align int.neg_of_nat_of_succ Int.neg_ofNat_succ
-/

#print Int.neg_negSucc /-
theorem neg_negSucc (n : ℕ) : - -[n+1] = ofNat (succ n) :=
  rfl
#align int.neg_neg_of_nat_succ Int.neg_negSucc
-/

#print Int.ofNat_eq_coe /-
theorem ofNat_eq_coe (n : ℕ) : ofNat n = ↑n :=
  rfl
#align int.of_nat_eq_coe Int.ofNat_eq_coe
-/

#print Int.negSucc_coe /-
theorem negSucc_coe (n : ℕ) : -[n+1] = -↑(n + 1) :=
  rfl
#align int.neg_succ_of_nat_coe Int.negSucc_coe
-/

/- warning: int.coe_nat_add clashes with int.of_nat_add -> Int.ofNat_add
Case conversion may be inaccurate. Consider using '#align int.coe_nat_add Int.ofNat_addₓ'. -/
#print Int.ofNat_add /-
protected theorem ofNat_add (m n : ℕ) : (↑(m + n) : ℤ) = ↑m + ↑n :=
  rfl
#align int.coe_nat_add Int.ofNat_add
-/

/- warning: int.coe_nat_mul clashes with int.of_nat_mul -> Int.ofNat_mul
Case conversion may be inaccurate. Consider using '#align int.coe_nat_mul Int.ofNat_mulₓ'. -/
#print Int.ofNat_mul /-
protected theorem ofNat_mul (m n : ℕ) : (↑(m * n) : ℤ) = ↑m * ↑n :=
  rfl
#align int.coe_nat_mul Int.ofNat_mul
-/

/- warning: int.coe_nat_zero clashes with int.of_nat_zero -> Int.ofNat_zero
Case conversion may be inaccurate. Consider using '#align int.coe_nat_zero Int.ofNat_zeroₓ'. -/
#print Int.ofNat_zero /-
protected theorem ofNat_zero : ↑(0 : ℕ) = (0 : ℤ) :=
  rfl
#align int.coe_nat_zero Int.ofNat_zero
-/

/- warning: int.coe_nat_one clashes with int.of_nat_one -> Int.ofNat_one
Case conversion may be inaccurate. Consider using '#align int.coe_nat_one Int.ofNat_oneₓ'. -/
#print Int.ofNat_one /-
protected theorem ofNat_one : ↑(1 : ℕ) = (1 : ℤ) :=
  rfl
#align int.coe_nat_one Int.ofNat_one
-/

/- warning: int.coe_nat_succ clashes with int.of_nat_succ -> Int.ofNat_succ
Case conversion may be inaccurate. Consider using '#align int.coe_nat_succ Int.ofNat_succₓ'. -/
#print Int.ofNat_succ /-
protected theorem ofNat_succ (n : ℕ) : (↑(succ n) : ℤ) = ↑n + 1 :=
  rfl
#align int.coe_nat_succ Int.ofNat_succ
-/

#print Int.ofNat_add_out /-
protected theorem ofNat_add_out (m n : ℕ) : ↑m + ↑n = (m + n : ℤ) :=
  rfl
#align int.coe_nat_add_out Int.ofNat_add_out
-/

#print Int.ofNat_mul_out /-
protected theorem ofNat_mul_out (m n : ℕ) : ↑m * ↑n = (↑(m * n) : ℤ) :=
  rfl
#align int.coe_nat_mul_out Int.ofNat_mul_out
-/

#print Int.ofNat_add_one_out /-
protected theorem ofNat_add_one_out (n : ℕ) : ↑n + (1 : ℤ) = ↑(succ n) :=
  rfl
#align int.coe_nat_add_one_out Int.ofNat_add_one_out
-/

/-! these are only for internal use -/

#print Int.ofNat_add_ofNat /-
theorem ofNat_add_ofNat (m n : Nat) : ofNat m + ofNat n = ofNat (m + n) :=
  rfl
#align int.of_nat_add_of_nat Int.ofNat_add_ofNat
-/

#print Int.ofNat_add_negSucc /-
theorem ofNat_add_negSucc (m n : Nat) : ofNat m + -[n+1] = subNatNat m (succ n) :=
  rfl
#align int.of_nat_add_neg_succ_of_nat Int.ofNat_add_negSucc
-/

#print Int.negSucc_add_ofNat /-
theorem negSucc_add_ofNat (m n : Nat) : -[m+1] + ofNat n = subNatNat n (succ m) :=
  rfl
#align int.neg_succ_of_nat_add_of_nat Int.negSucc_add_ofNat
-/

#print Int.negSucc_add_negSucc /-
theorem negSucc_add_negSucc (m n : Nat) : -[m+1] + -[n+1] = -[succ (m + n)+1] :=
  rfl
#align int.neg_succ_of_nat_add_neg_succ_of_nat Int.negSucc_add_negSucc
-/

#print Int.ofNat_mul_ofNat /-
theorem ofNat_mul_ofNat (m n : Nat) : ofNat m * ofNat n = ofNat (m * n) :=
  rfl
#align int.of_nat_mul_of_nat Int.ofNat_mul_ofNat
-/

#print Int.ofNat_mul_negSucc' /-
theorem ofNat_mul_negSucc' (m n : Nat) : ofNat m * -[n+1] = negOfNat (m * succ n) :=
  rfl
#align int.of_nat_mul_neg_succ_of_nat Int.ofNat_mul_negSucc'
-/

#print Int.negSucc_mul_ofNat' /-
theorem negSucc_mul_ofNat' (m n : Nat) : -[m+1] * ofNat n = negOfNat (succ m * n) :=
  rfl
#align int.neg_succ_of_nat_of_nat Int.negSucc_mul_ofNat'
-/

#print Int.negSucc_mul_negSucc' /-
theorem negSucc_mul_negSucc' (m n : Nat) : -[m+1] * -[n+1] = ofNat (succ m * succ n) :=
  rfl
#align int.mul_neg_succ_of_nat_neg_succ_of_nat Int.negSucc_mul_negSucc'
-/

attribute [local simp]
  of_nat_add_of_nat of_nat_mul_of_nat neg_of_nat_zero neg_of_nat_of_succ neg_neg_of_nat_succ of_nat_add_neg_succ_of_nat neg_succ_of_nat_add_of_nat neg_succ_of_nat_add_neg_succ_of_nat of_nat_mul_neg_succ_of_nat neg_succ_of_nat_of_nat mul_neg_succ_of_nat_neg_succ_of_nat

/-!  some basic functions and properties -/

#print Int.ofNat.inj /-
protected theorem Int.ofNat.inj {m n : ℕ} (h : (↑m : ℤ) = ↑n) : m = n :=
  Int.ofNat.inj h
#align int.coe_nat_inj Int.ofNat.inj
-/

#print Int.ofNat_inj /-
theorem ofNat_inj (m n : ℕ) : ofNat m = ofNat n ↔ m = n :=
  Iff.intro Int.ofNat.inj (congr_arg _)
#align int.of_nat_eq_of_nat_iff Int.ofNat_inj
-/

/- warning: int.coe_nat_eq_coe_nat_iff clashes with int.of_nat_eq_of_nat_iff -> Int.ofNat_inj
Case conversion may be inaccurate. Consider using '#align int.coe_nat_eq_coe_nat_iff Int.ofNat_injₓ'. -/
#print Int.ofNat_inj /-
protected theorem ofNat_inj (m n : ℕ) : (↑m : ℤ) = ↑n ↔ m = n :=
  ofNat_inj m n
#align int.coe_nat_eq_coe_nat_iff Int.ofNat_inj
-/

#print Int.negSucc_inj /-
theorem negSucc_inj {m n : ℕ} : negSucc m = negSucc n ↔ m = n :=
  ⟨negSucc.inj, fun H => by simp [H]⟩
#align int.neg_succ_of_nat_inj_iff Int.negSucc_inj
-/

#print Int.negSucc_eq /-
theorem negSucc_eq (n : ℕ) : -[n+1] = -(n + 1) :=
  rfl
#align int.neg_succ_of_nat_eq Int.negSucc_eq
-/

/-! neg -/

#print Int.neg_neg /-
protected theorem neg_neg : ∀ a : ℤ, - -a = a
  | of_nat 0 => rfl
  | of_nat (n + 1) => rfl
  | -[n+1] => rfl
#align int.neg_neg Int.neg_neg
-/

#print Int.neg_eq_neg /-
protected theorem neg_eq_neg {a b : ℤ} (h : -a = -b) : a = b := by
  rw [← Int.neg_neg a, ← Int.neg_neg b, h]
#align int.neg_inj Int.neg_eq_neg
-/

#print Int.sub_eq_add_neg /-
protected theorem sub_eq_add_neg {a b : ℤ} : a - b = a + -b :=
  rfl
#align int.sub_eq_add_neg Int.sub_eq_add_neg
-/

/-! basic properties of sub_nat_nat -/

#print Int.subNatNat_elim /-
theorem subNatNat_elim (m n : ℕ) (P : ℕ → ℕ → ℤ → Prop) (hp : ∀ i n, P (n + i) n (ofNat i))
    (hn : ∀ i m, P m (m + i + 1) -[i+1]) : P m n (subNatNat m n) :=
  by
  have H : ∀ k, n - m = k → P m n (Nat.casesOn k (of_nat (m - n)) fun a => -[a+1]) :=
    by
    intro k
    cases k
    · intro e
      cases' Nat.le.dest (Nat.le_of_sub_eq_zero e) with k h
      rw [h.symm, Nat.add_sub_cancel_left]
      apply hp
    · intro heq
      have h : m ≤ n := Nat.le_of_lt (Nat.lt_of_sub_eq_succ HEq)
      rw [Nat.sub_eq_iff_eq_add h] at heq
      rw [HEq, Nat.add_comm]
      apply hn
  delta sub_nat_nat
  exact H _ rfl
#align int.sub_nat_nat_elim Int.subNatNat_elim
-/

#print Int.subNatNat_add_left /-
theorem subNatNat_add_left {m n : ℕ} : subNatNat (m + n) m = ofNat n :=
  by
  dsimp only [sub_nat_nat]
  rw [Nat.sub_eq_zero_of_le]
  dsimp only [sub_nat_nat._match_1]
  rw [Nat.add_sub_cancel_left]
  apply Nat.le_add_right
#align int.sub_nat_nat_add_left Int.subNatNat_add_left
-/

#print Int.subNatNat_add_right /-
theorem subNatNat_add_right {m n : ℕ} : subNatNat m (m + n + 1) = negSucc n :=
  calc
    SubNatNat._match1 m (m + n + 1) (m + n + 1 - m) =
        SubNatNat._match1 m (m + n + 1) (m + (n + 1) - m) :=
      by rw [Nat.add_assoc]
    _ = SubNatNat._match1 m (m + n + 1) (n + 1) := by rw [Nat.add_sub_cancel_left]
    _ = negSucc n := rfl

#align int.sub_nat_nat_add_right Int.subNatNat_add_right
-/

#print Int.subNatNat_add_add /-
theorem subNatNat_add_add (m n k : ℕ) : subNatNat (m + k) (n + k) = subNatNat m n :=
  subNatNat_elim m n (fun m n i => subNatNat (m + k) (n + k) = i)
    (fun i n =>
      by
      have : n + i + k = n + k + i := by simp [Nat.add_comm, Nat.add_left_comm]
      rw [this]
      exact sub_nat_nat_add_left)
    fun i m =>
    by
    have : m + i + 1 + k = m + k + i + 1 := by simp [Nat.add_comm, Nat.add_left_comm]
    rw [this]
    exact sub_nat_nat_add_right
#align int.sub_nat_nat_add_add Int.subNatNat_add_add
-/

#print Int.subNatNat_of_le /-
theorem subNatNat_of_le {m n : ℕ} (h : n ≤ m) : subNatNat m n = ofNat (m - n) :=
  subNatNat_of_sub_eq_zero (Nat.sub_eq_zero_of_le h)
#align int.sub_nat_nat_of_le Int.subNatNat_of_le
-/

#print Int.subNatNat_of_lt /-
theorem subNatNat_of_lt {m n : ℕ} (h : m < n) : subNatNat m n = -[pred (n - m)+1] :=
  by
  have : n - m = succ (pred (n - m)) := Eq.symm (succ_pred_eq_of_pos (Nat.sub_pos_of_lt h))
  rw [sub_nat_nat_of_sub_eq_succ this]
#align int.sub_nat_nat_of_lt Int.subNatNat_of_lt
-/

/-! nat_abs -/

#print Int.natAbs /-
@[simp]
def natAbs : ℤ → ℕ
  | of_nat m => m
  | -[m+1] => succ m
#align int.nat_abs Int.natAbs
-/

#print Int.natAbs_ofNat /-
theorem natAbs_ofNat (n : ℕ) : natAbs ↑n = n :=
  rfl
#align int.nat_abs_of_nat Int.natAbs_ofNat
-/

#print Int.eq_zero_of_natAbs_eq_zero /-
theorem eq_zero_of_natAbs_eq_zero : ∀ {a : ℤ}, natAbs a = 0 → a = 0
  | of_nat m, H => congr_arg ofNat H
  | -[m'+1], H => absurd H (succ_ne_zero _)
#align int.eq_zero_of_nat_abs_eq_zero Int.eq_zero_of_natAbs_eq_zero
-/

#print Int.natAbs_pos_of_ne_zero /-
theorem natAbs_pos_of_ne_zero {a : ℤ} (h : a ≠ 0) : 0 < natAbs a :=
  (Nat.eq_zero_or_pos _).resolve_left <| mt eq_zero_of_natAbs_eq_zero h
#align int.nat_abs_pos_of_ne_zero Int.natAbs_pos_of_ne_zero
-/

#print Int.natAbs_zero /-
theorem natAbs_zero : natAbs (0 : Int) = (0 : Nat) :=
  rfl
#align int.nat_abs_zero Int.natAbs_zero
-/

#print Int.natAbs_one /-
theorem natAbs_one : natAbs (1 : Int) = (1 : Nat) :=
  rfl
#align int.nat_abs_one Int.natAbs_one
-/

#print Int.natAbs_mul_self /-
theorem natAbs_mul_self : ∀ {a : ℤ}, ↑(natAbs a * natAbs a) = a * a
  | of_nat m => rfl
  | -[m'+1] => rfl
#align int.nat_abs_mul_self Int.natAbs_mul_self
-/

#print Int.natAbs_neg /-
@[simp]
theorem natAbs_neg (a : ℤ) : natAbs (-a) = natAbs a :=
  by
  cases' a with n n
  cases n <;> rfl
  rfl
#align int.nat_abs_neg Int.natAbs_neg
-/

#print Int.natAbs_eq /-
theorem natAbs_eq : ∀ a : ℤ, a = natAbs a ∨ a = -natAbs a
  | of_nat m => Or.inl rfl
  | -[m'+1] => Or.inr rfl
#align int.nat_abs_eq Int.natAbs_eq
-/

#print Int.eq_nat_or_neg /-
theorem eq_nat_or_neg (a : ℤ) : ∃ n : ℕ, a = n ∨ a = -n :=
  ⟨_, natAbs_eq a⟩
#align int.eq_coe_or_neg Int.eq_nat_or_neg
-/

/-! sign -/

#print Int.sign /-
def sign : ℤ → ℤ
  | (n + 1 : ℕ) => 1
  | 0 => 0
  | -[n+1] => -1
#align int.sign Int.sign
-/

#print Int.sign_zero /-
@[simp]
theorem sign_zero : sign 0 = 0 :=
  rfl
#align int.sign_zero Int.sign_zero
-/

#print Int.sign_one /-
@[simp]
theorem sign_one : sign 1 = 1 :=
  rfl
#align int.sign_one Int.sign_one
-/

#print Int.sign_neg_one /-
@[simp]
theorem sign_neg_one : sign (-1) = -1 :=
  rfl
#align int.sign_neg_one Int.sign_neg_one
-/

/-! Quotient and remainder -/

#print Int.ediv /-
-- There are three main conventions for integer division,
-- referred here as the E, F, T rounding conventions.
-- All three pairs satisfy the identity x % y + (x / y) * y = x
-- unconditionally.
-- E-rounding: This pair satisfies 0 ≤ mod x y < nat_abs y for y ≠ 0
protected def ediv : ℤ → ℤ → ℤ
  | (m : ℕ), (n : ℕ) => ofNat (m / n)
  | (m : ℕ), -[n+1] => -ofNat (m / succ n)
  | -[m+1], 0 => 0
  | -[m+1], (n + 1 : ℕ) => -[m / succ n+1]
  | -[m+1], -[n+1] => ofNat (succ (m / succ n))
#align int.div Int.ediv
-/

#print Int.emod /-
protected def emod : ℤ → ℤ → ℤ
  | (m : ℕ), n => (m % natAbs n : ℕ)
  | -[m+1], n => subNatNat (natAbs n) (succ (m % natAbs n))
#align int.mod Int.emod
-/

#print Int.fdiv /-
-- F-rounding: This pair satisfies fdiv x y = floor (x / y)
def fdiv : ℤ → ℤ → ℤ
  | 0, _ => 0
  | (m : ℕ), (n : ℕ) => ofNat (m / n)
  | (m + 1 : ℕ), -[n+1] => -[m / succ n+1]
  | -[m+1], 0 => 0
  | -[m+1], (n + 1 : ℕ) => -[m / succ n+1]
  | -[m+1], -[n+1] => ofNat (succ m / succ n)
#align int.fdiv Int.fdiv
-/

#print Int.fmod /-
def fmod : ℤ → ℤ → ℤ
  | 0, _ => 0
  | (m : ℕ), (n : ℕ) => ofNat (m % n)
  | (m + 1 : ℕ), -[n+1] => subNatNat (m % succ n) n
  | -[m+1], (n : ℕ) => subNatNat n (succ (m % n))
  | -[m+1], -[n+1] => -ofNat (succ m % succ n)
#align int.fmod Int.fmod
-/

#print Int.div /-
-- T-rounding: This pair satisfies quot x y = round_to_zero (x / y)
def div : ℤ → ℤ → ℤ
  | of_nat m, of_nat n => ofNat (m / n)
  | of_nat m, -[n+1] => -ofNat (m / succ n)
  | -[m+1], of_nat n => -ofNat (succ m / n)
  | -[m+1], -[n+1] => ofNat (succ m / succ n)
#align int.quot Int.div
-/

#print Int.mod /-
def mod : ℤ → ℤ → ℤ
  | of_nat m, of_nat n => ofNat (m % n)
  | of_nat m, -[n+1] => ofNat (m % succ n)
  | -[m+1], of_nat n => -ofNat (succ m % n)
  | -[m+1], -[n+1] => -ofNat (succ m % succ n)
#align int.rem Int.mod
-/

instance : Div ℤ :=
  ⟨Int.ediv⟩

instance : Mod ℤ :=
  ⟨Int.emod⟩

/-! gcd -/

#print Int.gcd /-
def gcd (m n : ℤ) : ℕ :=
  gcd (natAbs m) (natAbs n)
#align int.gcd Int.gcd
-/

/-! addition -/

#print Int.add_comm /-
/-
   int is a ring
-/
protected theorem add_comm : ∀ a b : ℤ, a + b = b + a
  | of_nat n, of_nat m => by simp [Nat.add_comm]
  | of_nat n, -[m+1] => rfl
  | -[n+1], of_nat m => rfl
  | -[n+1], -[m+1] => by simp [Nat.add_comm]
#align int.add_comm Int.add_comm
-/

#print Int.add_zero /-
protected theorem add_zero : ∀ a : ℤ, a + 0 = a
  | of_nat n => rfl
  | -[n+1] => rfl
#align int.add_zero Int.add_zero
-/

#print Int.zero_add /-
protected theorem zero_add (a : ℤ) : 0 + a = a :=
  Int.add_comm a 0 ▸ Int.add_zero a
#align int.zero_add Int.zero_add
-/

theorem subNatNat_sub {m n : ℕ} (h : n ≤ m) (k : ℕ) : subNatNat (m - n) k = subNatNat m (k + n) :=
  calc
    subNatNat (m - n) k = subNatNat (m - n + n) (k + n) := by rw [sub_nat_nat_add_add]
    _ = subNatNat m (k + n) := by rw [Nat.sub_add_cancel h]

#align int.sub_nat_nat_sub Int.subNatNat_subₓ

#print Int.subNatNat_add /-
theorem subNatNat_add (m n k : ℕ) : subNatNat (m + n) k = ofNat m + subNatNat n k :=
  by
  have h := le_or_lt k n
  cases' h with h' h'
  · rw [sub_nat_nat_of_le h']
    have h₂ : k ≤ m + n := le_trans h' (Nat.le_add_left _ _)
    rw [sub_nat_nat_of_le h₂]
    simp
    rw [Nat.add_sub_assoc h']
  rw [sub_nat_nat_of_lt h']; simp; rw [succ_pred_eq_of_pos (Nat.sub_pos_of_lt h')]
  trans; rw [← Nat.sub_add_cancel (le_of_lt h')]
  apply sub_nat_nat_add_add
#align int.sub_nat_nat_add Int.subNatNat_add
-/

#print Int.subNatNat_add_negSucc /-
theorem subNatNat_add_negSucc (m n k : ℕ) : subNatNat m n + -[k+1] = subNatNat m (n + succ k) :=
  by
  have h := le_or_lt n m
  cases' h with h' h'
  · rw [sub_nat_nat_of_le h']
    simp
    rw [sub_nat_nat_sub h', Nat.add_comm]
  have h₂ : m < n + succ k := Nat.lt_of_lt_of_le h' (Nat.le_add_right _ _)
  have h₃ : m ≤ n + k := le_of_succ_le_succ h₂
  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 [Nat.add_comm n, Nat.add_sub_assoc (le_of_lt h')]
#align int.sub_nat_nat_add_neg_succ_of_nat Int.subNatNat_add_negSucc
-/

#print Int.add_assoc.aux1 /-
theorem Int.add_assoc.aux1 (m n : ℕ) : ∀ c : ℤ, ofNat m + ofNat n + c = ofNat m + (ofNat n + c)
  | of_nat k => by simp [Nat.add_assoc]
  | -[k+1] => by simp [sub_nat_nat_add]
#align int.add_assoc_aux1 Int.add_assoc.aux1
-/

#print Int.add_assoc.aux2 /-
theorem Int.add_assoc.aux2 (m n k : ℕ) : -[m+1] + -[n+1] + ofNat k = -[m+1] + (-[n+1] + ofNat k) :=
  by simp [add_succ]; rw [Int.add_comm, sub_nat_nat_add_neg_succ_of_nat];
  simp [add_succ, succ_add, Nat.add_comm]
#align int.add_assoc_aux2 Int.add_assoc.aux2
-/

#print Int.add_assoc /-
protected theorem add_assoc : ∀ a b c : ℤ, a + b + c = a + (b + c)
  | of_nat m, of_nat n, c => Int.add_assoc.aux1 _ _ _
  | of_nat m, b, of_nat k => by
    rw [Int.add_comm, ← add_assoc_aux1, Int.add_comm (of_nat k), add_assoc_aux1, Int.add_comm b]
  | a, of_nat n, of_nat k => by
    rw [Int.add_comm, Int.add_comm a, ← add_assoc_aux1, Int.add_comm a, Int.add_comm (of_nat k)]
  | -[m+1], -[n+1], of_nat k => Int.add_assoc.aux2 _ _ _
  | -[m+1], of_nat n, -[k+1] => by
    rw [Int.add_comm, ← add_assoc_aux2, Int.add_comm (of_nat n), ← add_assoc_aux2,
      Int.add_comm -[m+1]]
  | of_nat m, -[n+1], -[k+1] => by
    rw [Int.add_comm, Int.add_comm (of_nat m), Int.add_comm (of_nat m), ← add_assoc_aux2,
      Int.add_comm -[k+1]]
  | -[m+1], -[n+1], -[k+1] => by
    simp [add_succ, Nat.add_comm, Nat.add_left_comm, neg_of_nat_of_succ]
#align int.add_assoc Int.add_assoc
-/

/-! negation -/

#print Int.subNatNat_self /-
theorem subNatNat_self : ∀ n, subNatNat n n = 0
  | 0 => rfl
  | succ m => by rw [sub_nat_nat_of_sub_eq_zero, Nat.sub_self, of_nat_zero]; rw [Nat.sub_self]
#align int.sub_nat_self Int.subNatNat_self
-/

attribute [local simp] sub_nat_self

#print Int.add_left_neg /-
protected theorem add_left_neg : ∀ a : ℤ, -a + a = 0
  | of_nat 0 => rfl
  | of_nat (succ m) => by simp
  | -[m+1] => by simp
#align int.add_left_neg Int.add_left_neg
-/

#print Int.add_right_neg /-
protected theorem add_right_neg (a : ℤ) : a + -a = 0 := by rw [Int.add_comm, Int.add_left_neg]
#align int.add_right_neg Int.add_right_neg
-/

/-! multiplication -/

#print Int.mul_comm /-
protected theorem mul_comm : ∀ a b : ℤ, a * b = b * a
  | of_nat m, of_nat n => by simp [Nat.mul_comm]
  | of_nat m, -[n+1] => by simp [Nat.mul_comm]
  | -[m+1], of_nat n => by simp [Nat.mul_comm]
  | -[m+1], -[n+1] => by simp [Nat.mul_comm]
#align int.mul_comm Int.mul_comm
-/

#print Int.ofNat_mul_negOfNat /-
theorem ofNat_mul_negOfNat (m : ℕ) : ∀ n, ofNat m * negOfNat n = negOfNat (m * n)
  | 0 => rfl
  | succ n => by unfold neg_of_nat; simp
#align int.of_nat_mul_neg_of_nat Int.ofNat_mul_negOfNat
-/

#print Int.negOfNat_mul_ofNat /-
theorem negOfNat_mul_ofNat (m n : ℕ) : negOfNat m * ofNat n = negOfNat (m * n) := by
  rw [Int.mul_comm]; simp [of_nat_mul_neg_of_nat, Nat.mul_comm]
#align int.neg_of_nat_mul_of_nat Int.negOfNat_mul_ofNat
-/

#print Int.negSucc_mul_negOfNat /-
theorem negSucc_mul_negOfNat (m : ℕ) : ∀ n, -[m+1] * negOfNat n = ofNat (succ m * n)
  | 0 => rfl
  | succ n => by unfold neg_of_nat; simp
#align int.neg_succ_of_nat_mul_neg_of_nat Int.negSucc_mul_negOfNat
-/

#print Int.negOfNat_mul_negSucc /-
theorem negOfNat_mul_negSucc (m n : ℕ) : negOfNat n * -[m+1] = ofNat (n * succ m) := by
  rw [Int.mul_comm]; simp [neg_succ_of_nat_mul_neg_of_nat, Nat.mul_comm]
#align int.neg_of_nat_mul_neg_succ_of_nat Int.negOfNat_mul_negSucc
-/

attribute [local simp]
  of_nat_mul_neg_of_nat neg_of_nat_mul_of_nat neg_succ_of_nat_mul_neg_of_nat neg_of_nat_mul_neg_succ_of_nat

#print Int.mul_assoc /-
protected theorem mul_assoc : ∀ a b c : ℤ, a * b * c = a * (b * c)
  | of_nat m, of_nat n, of_nat k => by simp [Nat.mul_assoc]
  | of_nat m, of_nat n, -[k+1] => by simp [Nat.mul_assoc]
  | of_nat m, -[n+1], of_nat k => by simp [Nat.mul_assoc]
  | of_nat m, -[n+1], -[k+1] => by simp [Nat.mul_assoc]
  | -[m+1], of_nat n, of_nat k => by simp [Nat.mul_assoc]
  | -[m+1], of_nat n, -[k+1] => by simp [Nat.mul_assoc]
  | -[m+1], -[n+1], of_nat k => by simp [Nat.mul_assoc]
  | -[m+1], -[n+1], -[k+1] => by simp [Nat.mul_assoc]
#align int.mul_assoc Int.mul_assoc
-/

#print Int.mul_zero /-
protected theorem mul_zero : ∀ a : ℤ, a * 0 = 0
  | of_nat m => rfl
  | -[m+1] => rfl
#align int.mul_zero Int.mul_zero
-/

#print Int.zero_mul /-
protected theorem zero_mul (a : ℤ) : 0 * a = 0 :=
  Int.mul_comm a 0 ▸ Int.mul_zero a
#align int.zero_mul Int.zero_mul
-/

#print Int.negOfNat_eq_subNatNat_zero /-
theorem negOfNat_eq_subNatNat_zero : ∀ n, negOfNat n = subNatNat 0 n
  | 0 => rfl
  | succ n => rfl
#align int.neg_of_nat_eq_sub_nat_nat_zero Int.negOfNat_eq_subNatNat_zero
-/

#print Int.ofNat_mul_subNatNat /-
theorem ofNat_mul_subNatNat (m n k : ℕ) : ofNat m * subNatNat n k = subNatNat (m * n) (m * k) :=
  by
  have h₀ : m > 0 ∨ 0 = m := Decidable.lt_or_eq_of_le m.zero_le
  cases' h₀ with h₀ h₀
  · have h := Nat.lt_or_ge n k
    cases' h with h h
    · have h' : m * n < m * k := Nat.mul_lt_mul_of_pos_left h h₀
      rw [sub_nat_nat_of_lt h, sub_nat_nat_of_lt h']
      simp
      rw [succ_pred_eq_of_pos (Nat.sub_pos_of_lt h)]
      rw [← neg_of_nat_of_succ, Nat.mul_sub_left_distrib]
      rw [← succ_pred_eq_of_pos (Nat.sub_pos_of_lt h')]
      rfl
    have h' : m * k ≤ m * n := Nat.mul_le_mul_left _ h
    rw [sub_nat_nat_of_le h, sub_nat_nat_of_le h']
    simp
    rw [Nat.mul_sub_left_distrib]
  have h₂ : of_nat 0 = 0 := rfl
  subst h₀
  simp [h₂, Int.zero_mul, Nat.zero_mul]
#align int.of_nat_mul_sub_nat_nat Int.ofNat_mul_subNatNat
-/

#print Int.negOfNat_add /-
theorem negOfNat_add (m n : ℕ) : negOfNat m + negOfNat n = negOfNat (m + n) :=
  by
  cases m
  · cases n
    · simp
      rfl
    simp [Nat.zero_add]
    rfl
  cases n
  · simp
    rfl
  simp [Nat.succ_add]; rfl
#align int.neg_of_nat_add Int.negOfNat_add
-/

#print Int.negSucc_mul_subNatNat /-
theorem negSucc_mul_subNatNat (m n k : ℕ) :
    -[m+1] * subNatNat n k = subNatNat (succ m * k) (succ m * n) :=
  by
  have h := Nat.lt_or_ge n k
  cases' h with h h
  · have h' : succ m * n < succ m * k := Nat.mul_lt_mul_of_pos_left h (Nat.succ_pos m)
    rw [sub_nat_nat_of_lt h, sub_nat_nat_of_le (le_of_lt h')]
    simp [succ_pred_eq_of_pos (Nat.sub_pos_of_lt h), Nat.mul_sub_left_distrib]
  have h' : n > k ∨ k = n := Decidable.lt_or_eq_of_le h
  cases' h' with h' h'
  · have h₁ : succ m * n > succ m * k := Nat.mul_lt_mul_of_pos_left h' (Nat.succ_pos m)
    rw [sub_nat_nat_of_le h, sub_nat_nat_of_lt h₁]
    simp [Nat.mul_sub_left_distrib, Nat.mul_comm]
    rw [Nat.mul_comm k, Nat.mul_comm n, ← succ_pred_eq_of_pos (Nat.sub_pos_of_lt h₁), ←
      neg_of_nat_of_succ]
    rfl
  subst h'
  simp
  rfl
#align int.neg_succ_of_nat_mul_sub_nat_nat Int.negSucc_mul_subNatNat
-/

attribute [local simp] of_nat_mul_sub_nat_nat neg_of_nat_add neg_succ_of_nat_mul_sub_nat_nat

#print Int.mul_add /-
protected theorem mul_add : ∀ a b c : ℤ, a * (b + c) = a * b + a * c
  | of_nat m, of_nat n, of_nat k => by simp [Nat.left_distrib]
  | of_nat m, of_nat n, -[k+1] =>
    by
    simp [neg_of_nat_eq_sub_nat_nat_zero]
    rw [← sub_nat_nat_add]; rfl
  | of_nat m, -[n+1], of_nat k =>
    by
    simp [neg_of_nat_eq_sub_nat_nat_zero]
    rw [Int.add_comm, ← sub_nat_nat_add]; rfl
  | of_nat m, -[n+1], -[k+1] => by simp; rw [← Nat.left_distrib, add_succ, succ_add]
  | -[m+1], of_nat n, of_nat k => by simp [Nat.mul_comm]; rw [← Nat.right_distrib, Nat.mul_comm]
  | -[m+1], of_nat n, -[k+1] => by
    simp [neg_of_nat_eq_sub_nat_nat_zero]
    rw [Int.add_comm, ← sub_nat_nat_add]; rfl
  | -[m+1], -[n+1], of_nat k => by
    simp [neg_of_nat_eq_sub_nat_nat_zero]
    rw [← sub_nat_nat_add]; rfl
  | -[m+1], -[n+1], -[k+1] => by simp; rw [← Nat.left_distrib, add_succ, succ_add]
#align int.distrib_left Int.mul_add
-/

#print Int.add_mul /-
protected theorem add_mul (a b c : ℤ) : (a + b) * c = a * c + b * c := by
  rw [Int.mul_comm, Int.mul_add]; simp [Int.mul_comm]
#align int.distrib_right Int.add_mul
-/

#print Int.zero_ne_one /-
protected theorem zero_ne_one : (0 : Int) ≠ 1 := fun h : 0 = 1 =>
  succ_ne_zero _ (Int.ofNat.inj h).symm
#align int.zero_ne_one Int.zero_ne_one
-/

theorem ofNat_sub {n m : ℕ} (h : m ≤ n) : ofNat (n - m) = ofNat n - ofNat m :=
  show ofNat (n - m) = ofNat n + negOfNat m from
    match m, h with
    | 0, h => rfl
    | succ m, h =>
      show ofNat (n - succ m) = subNatNat n (succ m) by
        delta sub_nat_nat <;> rw [Nat.sub_eq_zero_of_le h] <;> rfl
#align int.of_nat_sub Int.ofNat_subₓ

#print Int.add_left_comm /-
protected theorem add_left_comm (a b c : ℤ) : a + (b + c) = b + (a + c) := by
  rw [← Int.add_assoc, Int.add_comm a, Int.add_assoc]
#align int.add_left_comm Int.add_left_comm
-/

#print Int.add_left_cancel /-
protected theorem add_left_cancel {a b c : ℤ} (h : a + b = a + c) : b = c :=
  by
  have : -a + (a + b) = -a + (a + c) := by rw [h]
  rwa [← Int.add_assoc, ← Int.add_assoc, Int.add_left_neg, Int.zero_add, Int.zero_add] at this
#align int.add_left_cancel Int.add_left_cancel
-/

#print Int.neg_add /-
protected theorem neg_add {a b : ℤ} : -(a + b) = -a + -b :=
  calc
    -(a + b) = -(a + b) + (a + b) + -a + -b :=
      by
      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]
    _ = -a + -b := by rw [Int.add_left_neg, Int.zero_add]

#align int.neg_add Int.neg_add
-/

#print Int.negSucc_coe' /-
theorem negSucc_coe' (n : ℕ) : -[n+1] = -↑n - 1 := by rw [Int.sub_eq_add_neg, ← Int.neg_add] <;> rfl
#align int.neg_succ_of_nat_coe' Int.negSucc_coe'
-/

#print Int.ofNat_sub /-
protected theorem ofNat_sub {n m : ℕ} : n ≤ m → (↑(m - n) : ℤ) = ↑m - ↑n :=
  ofNat_sub
#align int.coe_nat_sub Int.ofNat_sub
-/

attribute [local simp] Int.sub_eq_add_neg

#print Int.subNatNat_eq_coe /-
protected theorem subNatNat_eq_coe {m n : ℕ} : subNatNat m n = ↑m - ↑n :=
  subNatNat_elim m n (fun m n i => i = ↑m - ↑n)
    (fun i n =>
      by
      simp [Int.ofNat_add, Int.add_left_comm, Int.add_assoc, Int.add_right_neg]
      rfl)
    fun i n => by
    rw [Int.ofNat_add, Int.ofNat_add, Int.ofNat_one, Int.negSucc_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]
#align int.sub_nat_nat_eq_coe Int.subNatNat_eq_coe
-/

#print Int.toNat /-
def toNat : ℤ → ℕ
  | (n : ℕ) => n
  | -[n+1] => 0
#align int.to_nat Int.toNat
-/

#print Int.toNat_sub /-
theorem toNat_sub (m n : ℕ) : toNat (m - n) = m - n := by
  rw [← Int.subNatNat_eq_coe] <;>
    exact
      sub_nat_nat_elim m n (fun m n i => to_nat i = m - n)
        (fun i n => by rw [Nat.add_sub_cancel_left] <;> rfl) fun i n => by
        rw [Nat.add_assoc, Nat.sub_eq_zero_of_le (Nat.le_add_right _ _)] <;> rfl
#align int.to_nat_sub Int.toNat_sub
-/

#print Int.natMod /-
-- Since mod x y is always nonnegative when y ≠ 0, we can make a nat version of it
def natMod (m n : ℤ) : ℕ :=
  (m % n).toNat
#align int.nat_mod Int.natMod
-/

#print Int.one_mul /-
protected theorem one_mul : ∀ a : ℤ, (1 : ℤ) * a = a
  | of_nat n => show ofNat (1 * n) = ofNat n by rw [Nat.one_mul]
  | -[n+1] => show -[1 * n+1] = -[n+1] by rw [Nat.one_mul]
#align int.one_mul Int.one_mul
-/

#print Int.mul_one /-
protected theorem mul_one (a : ℤ) : a * 1 = a := by rw [Int.mul_comm, Int.one_mul]
#align int.mul_one Int.mul_one
-/

#print Int.neg_eq_neg_one_mul /-
protected theorem neg_eq_neg_one_mul : ∀ a : ℤ, -a = -1 * a
  | of_nat 0 => rfl
  | of_nat (n + 1) =>
    show _ = -[1 * n + 0+1] by
      rw [Nat.one_mul]
      rfl
  | -[n+1] =>
    show _ = ofNat _ by
      rw [Nat.one_mul]
      rfl
#align int.neg_eq_neg_one_mul Int.neg_eq_neg_one_mul
-/

#print Int.sign_mul_natAbs /-
theorem sign_mul_natAbs : ∀ a : ℤ, sign a * natAbs a = a
  | (n + 1 : ℕ) => Int.one_mul _
  | 0 => rfl
  | -[n+1] => (Int.neg_eq_neg_one_mul _).symm
#align int.sign_mul_nat_abs Int.sign_mul_natAbs
-/

end Int


import tactic

namespace fol

@[reducible] def var := ℕ

structure Language :=
(functions : ℕ → Type)
(relations : ℕ → Type)

section

variable (L : Language)

def Language.constants := L.functions 0

inductive preterm : ℕ → Type
| var : var → preterm 0
| func {l : ℕ} : L.functions l → preterm l
| app {l : ℕ} : preterm (l + 1) → preterm 0 → preterm l

@[reducible] def term := preterm L 0

namespace term

def fv {L : Language} : ∀ {l : ℕ}, preterm L l → set var
| l (preterm.var x) := {x}
| l (preterm.func f) := ∅
| l (preterm.app t₁ t₂) := fv t₁ ∪ fv t₂

instance (l : ℕ) (x : var) (t : preterm L l) : decidable (x ∈ fv t) :=
begin
  induction t with y l' f l' t₁ t₂ ih₁ ih₂,
  { change decidable (x = y),
    apply_instance },
  { clear l,
    rename l' l,
    change decidable (x ∈ ∅),
    change decidable false,
    exact decidable.false },
  { clear l,
    rename l' l,
    change decidable (x ∈ fv t₁ ∪ fv t₂),
    change decidable (x ∈ fv t₁ ∨ x ∈ fv t₂),
    exact @or.decidable _ _ ih₁ ih₂ }
end

end term

inductive preformula : ℕ → Type
| eq : term L → term L → preformula 0
| rel {l : ℕ} : L.relations l → preformula l
| app {l : ℕ} : preformula (l + 1) → term L → preformula l
| not : preformula 0 → preformula 0
| or : preformula 0 → preformula 0 → preformula 0
| all : var → preformula 0 → preformula 0

@[reducible] def formula := preformula L 0

namespace formula

def fv {L : Language} : ∀ {l : ℕ}, preformula L l → set var
| l (preformula.eq t₁ t₂) := term.fv t₁ ∪ term.fv t₂
| l (preformula.rel r) := ∅
| l (preformula.app f t) := fv f ∪ term.fv t
| l (preformula.not f) := fv f
| l (preformula.or f₁ f₂) := fv f₁ ∪ fv f₂
| l (preformula.all x f) := fv f \ {x}

instance (l : ℕ) (x : var) (φ : preformula L l) : decidable (x ∈ fv φ) :=
begin
  induction φ with t₁ t₂ l' r l' φ t ih φ ih φ₁ φ₂ ih₁ ih₂ y φ ih,
  { change decidable (x ∈ term.fv t₁ ∪ term.fv t₂),
    change decidable (x ∈ term.fv t₁ ∨ x ∈ term.fv t₂),
    exact or.decidable },
  { clear l,
    rename l' l,
    change decidable (x ∈ ∅),
    change decidable false,
    exact decidable.false },
  { clear l,
    rename l' l,
    change decidable (x ∈ fv φ ∪ term.fv t),
    change decidable (x ∈ fv φ ∨ x ∈ term.fv t),
    exact @or.decidable _ _ ih _ },
  { change decidable (x ∈ fv φ),
    assumption },
  { change decidable (x ∈ fv φ₁ ∪ fv φ₂),
    change decidable (x ∈ fv φ₁ ∨ x ∈ fv φ₂),
    exact @or.decidable _ _ ih₁ ih₂ },
  { change decidable (x ∈ fv φ \ {y}),
    change decidable (x ∈ fv φ ∧ x ≠ y),
    exact @and.decidable _ _ ih (ne.decidable _ _) }
end

end formula

@[reducible] def sentence := {φ : formula L // formula.fv φ = ∅}

end

section

local notation h ` :: ` t := vector.cons h t

structure Structure (L : Language) :=
(carrier : Type)
(functions {n : ℕ} : L.functions n → vector carrier n → carrier)
(relations {n : ℕ} : L.relations n → vector carrier n → Prop)

instance (L : Language) : has_coe_to_sort (Structure L) Type :=
⟨λ A, A.carrier⟩

variables {L : Language} {A : Structure L}

def subst (s : var → A) (x : var) (a : A) : var → A :=
λ y, if x = y then a else s y

notation s `[`:95 x ` // `:95 a `]`:0 := subst s x a

def realize_preterm (s : var → A) : ∀ {l : ℕ}, vector A l → preterm L l → A
| l args (preterm.var x) := s x
| l args (preterm.func f) := A.functions f args
| l args (preterm.app t₁ t₂) := realize_preterm (realize_preterm vector.nil t₂ :: args) t₁

def realize_term (s : var → A) : term L → A :=
realize_preterm s vector.nil

-- Lemma 1.7.6. Suppose that s1 and s2 are variable assignment functions into a
-- structure A such that s1(v) = s2(v) for every variable v in the term t. Then
-- s1(t) = s2(t).
lemma realize_preterm_eq (s₁ s₂ : var → A) {l : ℕ} (args : vector A l) (t : preterm L l) :
  (∀ x ∈ term.fv t, s₁ x = s₂ x) → realize_preterm s₁ args t = realize_preterm s₂ args t :=
begin
  induction t with y l f l t₁ t₂ ih₁ ih₂ generalizing args; intro h,
  { change s₁ y = s₂ y,
    change ∀ x, x = y → s₁ x = s₂ x at h,
    rwa forall_eq at h },
  { refl },
  { unfold realize_preterm,
    rw ih₂ vector.nil (λ x hx, h x (or.inr hx)),
    exact ih₁ _ (λ x hx, h x (or.inl hx)) }
end

lemma realize_term_eq (s₁ s₂ : var → A) (t : term L) :
  (∀ x ∈ term.fv t, s₁ x = s₂ x) → realize_term s₁ t = realize_term s₂ t :=
realize_preterm_eq _ _ _ _

def realize_preformula : (var → A) → ∀ {l : ℕ}, vector A l → preformula L l → Prop
| s l args (preformula.eq t₁ t₂) := realize_term s t₁ = realize_term s t₂
| s l args (preformula.rel r) := A.relations r args
| s l args (preformula.app φ t) := realize_preformula s (realize_term s t :: args) φ
| s l args (preformula.not φ) := ¬ realize_preformula s args φ
| s l args (preformula.or φ₁ φ₂) := realize_preformula s args φ₁ ∨ realize_preformula s args φ₂
| s l args (preformula.all x φ) := ∀ a, realize_preformula (s[x // a]) args φ

def realize_formula (s : var → A) : formula L → Prop :=
realize_preformula s vector.nil

infix ` ⊨ `:51 := realize_formula

-- Proposition 1.7.7. Suppose that s₁ and s₂ are variable assignment functions
-- into a structure A such that s₁(v) = s₂(v) for every free variable v in the
-- formula φ. Then A ⊨ φ[s₁] if and only if A ⊨ φ[s₂].
lemma realize_preformula_iff (s₁ s₂ : var → A) {l : ℕ} (args : vector A l) (φ : preformula L l)
  : (∀ x ∈ formula.fv φ, s₁ x = s₂ x) →
    (realize_preformula s₁ args φ ↔ realize_preformula s₂ args φ) :=
begin
  induction φ with t₁ t₂ l r l φ t ih φ ih φ₁ φ₂ ih₁ ih₂ x φ ih generalizing s₁ s₂ args;
  intro h; unfold realize_preformula,
  { have h₁ := realize_term_eq s₁ s₂ t₁ (λ x hx, h x (or.inl hx)),
    have h₂ := realize_term_eq s₁ s₂ t₂ (λ x hx, h x (or.inr hx)),
    rw [h₁, h₂] },
  { rw realize_term_eq s₁ s₂ t (λ x hx, h x (or.inr hx)),
    exact ih _ _ _ (λ x hx, h x (or.inl hx)) },
  { rw not_iff_not,
    exact ih _ _ _ h },
  { have h₁ := ih₁ _ _ _ (λ x hx, h x (or.inl hx)),
    have h₂ := ih₂ _ _ _ (λ x hx, h x (or.inr hx)),
    exact or_congr h₁ h₂ },
  { refine forall_congr (λ a, ih _ _ _ (λ y hy, _)),
    by_cases this : x = y; unfold subst,
    { simp [this] },
    { simp [this, h _ (and.intro hy (ne.symm this))] } }
end

lemma realize_formula_iff (s₁ s₂ : var → A) (φ : formula L)
  : (∀ x ∈ formula.fv φ, s₁ x = s₂ x) → (s₁ ⊨ φ ↔ s₂ ⊨ φ) :=
realize_preformula_iff _ _ _ _

end

end fol


import mynat.definition -- import Peano's definition of the natural numbers {0,1,2,3,4,...}

namespace mynat

lemma example3 (a b : mynat) (h : succ a = b) : succ(succ(a)) = succ(b) :=
begin [nat_num_game]
  rw h,
  refl,
end

end mynat


import data.finset.basic
import data.finset.lattice
import data.nat.basic
import data.nat.gcd.basic
import data.pnat.basic

/-

Indian Mathematical Olympiad 1998, Problem 8.

Let M be a positive integer and consider the set

    S = { n ∈ ℕ : M² ≤ n < (M + 1)² }.

Prove that the products of the form a * b with a,b ∈ S are all distinct.

-/

theorem lemma_1
  (M : ℕ)
  (hM : 0 < M)
  (a b c d : {x : ℕ // M^2 ≤ x ∧ x < (M + 1)^2})
  (h_ne : ({a, b}: finset ℕ) ≠ {c, d})
  (h_wlog : a < c ∧ a < d)
  : a.val * b.val ≠ c.val * d.val :=
begin
  intro heq,
  let p := nat.gcd a c,
  -- let q = a / p and r = c / p
  -- then gcd(q,r) = 1
  -- Since q ∣(ab/p) = cd / p = rd, we have q∣d.
  -- Now let s = d/q so that b = cd /a = rs.
  -- Therefore, a = pq, b = rs, c = pr, d = qs for some positive integers p,q,r,s.

  -- Since c > a, r > q, and r ≥ q + 1.
  -- Since d > a, s > p, and s ≥ p + 1.
  -- Therefore,,
  --    b = rs ≥ (p + 1)(q + 1) = pq + p + q + 1
  --           ≥ pq + 2 sqrt(pq) + 1 = a + 2 sqrt(a) + 1
  --           ≥ M^2 + 2 M + 1 = (M + 1)^2
  -- Then b is not in S, a contradiction.
  sorry
end

theorem india1998_q8
  (M : ℕ)
  (hM : 0 < M)
  (a b c d : {x : ℕ // M^2 ≤ x ∧ x < (M + 1)^2})
  (h_ne : ({a, b}: finset ℕ) ≠ {c, d})
  : a.val * b.val ≠ c.val * d.val :=
begin
  let m : option ℕ := finset.min {a,b,c,d},

  -- delegate to lemma_1 ...
  sorry,
end


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Johannes Hölzl

Linear structures on function with finit support `α →₀ β` and multivariate polynomials.
-/
import data.finsupp data.mv_polynomial
import linear_algebra.dimension
noncomputable theory

local attribute [instance, priority 0] classical.prop_decidable

open lattice set linear_map submodule

namespace finsupp

section module
variables {α : Type*} {β : Type*} {γ : Type*}
variables [decidable_eq α] [decidable_eq β] [ring γ] [add_comm_group β] [module γ β]

instance : module γ (α →₀ β) := finsupp.to_module α β

def lsingle (a : α) : β →ₗ[γ] (α →₀ β) :=
⟨single a, assume a b, single_add, assume c b, (smul_single _ _ _).symm⟩

def lapply (a : α) : (α →₀ β) →ₗ[γ] β := ⟨λg, g a, assume a b, rfl, assume a b, rfl⟩

section lmap_domain
variables {α' : Type*} [decidable_eq α']

def lmap_domain (i : α → α') : (α →₀ β) →ₗ[γ] (α' →₀ β) :=
⟨map_domain i, assume a b, map_domain_add, map_domain_smul⟩

lemma lmap_domain_apply (i : α → α') (f : α →₀ β) :
  (lmap_domain i : (α →₀ β) →ₗ[γ] (α' →₀ β)) f = map_domain i f := rfl

end lmap_domain

protected def dom_lcongr
  {α₁ : Type*} {α₂ : Type*} [decidable_eq α₁] [decidable_eq α₂] (e : α₁ ≃ α₂) :
  (α₁ →₀ β) ≃ₗ[γ] (α₂ →₀ β) :=
(finsupp.dom_congr e).to_linear_equiv
begin
  change is_linear_map γ (lmap_domain e : (α₁ →₀ β) →ₗ[γ] (α₂ →₀ β)),
  exact linear_map.is_linear _
end

section lsubtype_domain
variables (s : set α) [decidable_pred (λx, x ∈ s)]

def lsubtype_domain : (α →₀ β) →ₗ[γ] (s →₀ β) :=
⟨subtype_domain (λx, x ∈ s), assume a b, subtype_domain_add, assume c a, ext $ assume a, rfl⟩

lemma lsubtype_domain_apply (f : α →₀ β) :
  (lsubtype_domain s : (α →₀ β) →ₗ[γ] (s →₀ β)) f = subtype_domain (λx, x ∈ s) f := rfl

end lsubtype_domain

lemma lsingle_apply (a : α) (b : β) : (lsingle a : β →ₗ[γ] (α →₀ β)) b = single a b  :=
rfl

lemma lapply_apply (a : α) (f : α →₀ β) : (lapply a : (α →₀ β) →ₗ[γ] β) f = f a  :=
rfl

lemma ker_lsingle (a : α) : (lsingle a : β →ₗ[γ] (α →₀ β)).ker = ⊥ :=
ker_eq_bot.2 (injective_single a)

lemma lsingle_range_le_ker_lapply (s t : set α) (h : disjoint s t) :
  (⨆a∈s, (lsingle a : β →ₗ[γ] (α →₀ β)).range) ≤ (⨅a∈t, ker (lapply a)) :=
begin
  refine supr_le (assume a₁, supr_le $ assume h₁, range_le_iff_comap.2 _),
  simp only [(ker_comp _ _).symm, eq_top_iff, le_def', mem_ker, comap_infi, mem_infi],
  assume b hb a₂ h₂,
  have : a₁ ≠ a₂ := assume eq, h ⟨h₁, eq.symm ▸ h₂⟩,
  exact single_eq_of_ne this
end

lemma infi_ker_lapply_le_bot : (⨅a, ker (lapply a : (α →₀ β) →ₗ[γ] β)) ≤ ⊥ :=
begin
  simp only [le_def', mem_infi, mem_ker, mem_bot, lapply_apply],
  exact assume a h, finsupp.ext h
end

lemma supr_lsingle_range : (⨆a, (lsingle a : β →ₗ[γ] (α →₀ β)).range) = ⊤ :=
begin
  refine (eq_top_iff.2 $ le_def'.2 $ assume f _, _),
  rw [← sum_single f],
  refine sum_mem _ (assume a ha, submodule.mem_supr_of_mem _ a $ set.mem_image_of_mem _ trivial)
end

lemma disjoint_lsingle_lsingle (s t : set α) (hs : disjoint s t) :
  disjoint (⨆a∈s, (lsingle a : β →ₗ[γ] (α →₀ β)).range) (⨆a∈t, (lsingle a).range) :=
begin
  refine disjoint_mono
    (lsingle_range_le_ker_lapply _ _ $ disjoint_compl s)
    (lsingle_range_le_ker_lapply _ _ $ disjoint_compl t)
    (le_trans (le_infi $ assume i, _) infi_ker_lapply_le_bot),
  classical,
  by_cases his : i ∈ s,
  { by_cases hit : i ∈ t,
    { exact (hs ⟨his, hit⟩).elim },
    exact inf_le_right_of_le (infi_le_of_le i $ infi_le _ hit) },
  exact inf_le_left_of_le (infi_le_of_le i $ infi_le _ his)
end

lemma span_single_image (s : set β) (a : α) :
  submodule.span γ (single a '' s) = (submodule.span γ s).map (lsingle a) :=
by rw ← span_image; refl

lemma linear_independent_single {f : α → set β}
  (hf : ∀a, linear_independent γ (f a)) : linear_independent γ (⋃a, single a '' f a) :=
begin
  refine linear_independent_Union_finite _ _ ,
  { refine assume a, @linear_independent.image _ _ _ _ _ _ _ _ _ (lsingle a) (hf a) _,
    rw ker_lsingle,
    exact disjoint_bot_right },
  { assume a s hs hat,
    have : ∀a, span γ (single a '' f a) ≤ range (lsingle a),
    { simp only [span_single_image],
      exact assume a, map_mono le_top },
    refine disjoint_mono _ _ (disjoint_lsingle_lsingle {a} s _),
    { simp only [supr_singleton, this] },
    { exact supr_le_supr (assume a, supr_le_supr (assume ha, this a)) },
    { rwa [disjoint_singleton_left] } }
end

section
variables (β γ)

def restrict_dom (s : set α) : submodule γ (α →₀ β) :=
begin
  refine ⟨ {p | ↑p.support ⊆ s }, _, _, _ ⟩,
  { simp only [subset_def, finset.mem_coe, set.mem_set_of_eq, mem_support_iff, zero_apply],
    assume h ha, exact (ha rfl).elim },
  { assume p q hp hq,
    refine subset.trans
      (subset.trans (finset.coe_subset.2 support_add) _) (union_subset hp hq),
    rw [finset.coe_union] },
  { assume a p hp,
    refine subset.trans (finset.coe_subset.2 support_smul) hp }
end

lemma mem_restrict_dom {s : set α} (p : α →₀ β) : p ∈ (restrict_dom β γ s) ↔ ↑p.support ⊆ s :=
iff.rfl

section
set_option class.instance_max_depth 37
def restrict_dom_equiv_finsupp (s : set α) [decidable_pred (λ (x : α), x ∈ s)] :
  (restrict_dom β γ s) ≃ₗ[γ] (s →₀ β) :=
(restrict_support_equiv s).to_linear_equiv
begin
  show is_linear_map γ ((lsubtype_domain s : (α →₀ β) →ₗ[γ] (s →₀ β)).comp
      (submodule.subtype (restrict_dom β γ s))),
  exact linear_map.is_linear _
end
end

end

end module

section vector_space
variables {α : Type*} {β : Type*} {γ : Type*}
variables [decidable_eq α] [decidable_eq β] [discrete_field γ] [add_comm_group β] [vector_space γ β]

open linear_map submodule

instance : vector_space γ (α →₀ β) :=
{ to_module := finsupp.module }

lemma is_basis_single {f : α → set β} (hf : ∀a, is_basis γ (f a)) :
  is_basis γ (⋃a, single a '' f a) :=
⟨linear_independent_single $ assume a, (hf a).1,
  by simp only [span_Union, span_single_image, (hf _).2, map_top, supr_lsingle_range]⟩

end vector_space

section dim
universes u v
variables {α : Type u} {β : Type u} {γ : Type v}
variables [decidable_eq α] [decidable_eq β] [discrete_field γ] [add_comm_group β] [vector_space γ β]

lemma dim_eq : vector_space.dim γ (α →₀ β) = cardinal.mk α * vector_space.dim γ β :=
begin
  rcases exists_is_basis γ β with ⟨bs, hbs⟩,
  rw [← hbs.mk_eq_dim, ← (is_basis_single (λa:α, hbs)).mk_eq_dim, cardinal.mk_Union_eq_sum_mk],
  { simp only [cardinal.mk_eq_of_injective (injective_single.{u u} _), cardinal.sum_const] },
  { refine assume i j h, disjoint_image_image (assume b hb c hc, _),
    simp only [(≠), single_eq_single_iff, not_or_distrib, not_and_distrib],
    have : (0:β) ∉ bs := zero_not_mem_of_linear_independent (zero_ne_one : (0:γ) ≠ 1) hbs.1,
    exact ⟨or.inl h, or.inl (assume eq, this $ eq ▸ hb)⟩ }
end

end dim

end finsupp

namespace lc
universes u v w
variables (α : Type v) {β : Type u} {γ : Type w}
variables [ring α]
variables [add_comm_group β] [module α β]
variables [add_comm_group γ] [module α γ]

noncomputable def congr (s : set β) (t : set γ) (e : s ≃ t) : supported α s ≃ₗ[α] supported α t :=
begin
  show (finsupp.restrict_dom α α s) ≃ₗ[α] (finsupp.restrict_dom α α t),
  refine linear_equiv.trans (finsupp.restrict_dom_equiv_finsupp α α s)
    (linear_equiv.trans _ (finsupp.restrict_dom_equiv_finsupp α α t).symm),
  exact finsupp.dom_lcongr e
end

-- TODO: this is bad, we need to fix the decidability instances
noncomputable def supported_equiv [decidable_eq β] (s : set β) :
  lc.supported α s ≃ₗ[α] (s →₀ α) :=
begin
  have eq : _inst_6 = (λa b : β, classical.prop_decidable (a = b)) := subsingleton.elim _ _,
  unfreezeI, subst eq,
  refine (finsupp.restrict_dom_equiv_finsupp α α s)
end

end lc

section vector_space
universes u v
variables {α : Type u} {β γ : Type v}
variables [discrete_field α]
variables [add_comm_group β] [vector_space α β]
variables [add_comm_group γ] [vector_space α γ]

open vector_space

set_option class.instance_max_depth 100

lemma equiv_of_dim_eq_dim (h : dim α β = dim α γ) : nonempty (β ≃ₗ[α] γ) :=
begin
  rcases exists_is_basis α β with ⟨b, hb⟩,
  rcases exists_is_basis α γ with ⟨c, hc⟩,
  rw [← hb.mk_eq_dim, ← hc.mk_eq_dim] at h,
  rcases quotient.exact h with ⟨e⟩,
  exact ⟨ (module_equiv_lc hb).trans (linear_equiv.trans (lc.congr α b c e) (module_equiv_lc hc).symm) ⟩
end

lemma eq_bot_iff_dim_eq_zero (p : submodule α β) (h : dim α p = 0) : p = ⊥ :=
begin
  have : dim α p = dim α (⊥ : submodule α β) := by rwa [dim_bot],
  rcases equiv_of_dim_eq_dim this with ⟨e⟩,
  exact e.eq_bot_of_equiv _
end

lemma injective_of_surjective (f : β →ₗ[α] γ)
  (hβ : dim α β < cardinal.omega) (heq : dim α γ = dim α β) (hf : f.range = ⊤) : f.ker = ⊥ :=
have hk : dim α f.ker < cardinal.omega := lt_of_le_of_lt (dim_submodule_le _) hβ,
begin
  rcases cardinal.lt_omega.1 hβ with ⟨d₁, eq₁⟩,
  rcases cardinal.lt_omega.1 hk with ⟨d₂, eq₂⟩,
  have : 0 = d₂,
  { have := dim_eq_surjective f (linear_map.range_eq_top.1 hf),
    rw [heq, eq₁, eq₂, ← nat.cast_add, cardinal.nat_cast_inj] at this,
    exact nat.add_left_cancel this },
  refine eq_bot_iff_dim_eq_zero _ _,
  rw [eq₂, ← this, nat.cast_zero]
end

end vector_space

section vector_space
universes u

open vector_space
set_option class.instance_max_depth 100

lemma cardinal_mk_eq_cardinal_mk_field_pow_dim
  {α β : Type u} [discrete_field α] [add_comm_group β] [vector_space α β]
  (h : dim α β < cardinal.omega) : cardinal.mk β = cardinal.mk α ^ dim α β  :=
begin
  rcases exists_is_basis α β with ⟨s, hs⟩,
  have : nonempty (fintype s),
  { rwa [← cardinal.lt_omega_iff_fintype, hs.mk_eq_dim] },
  cases this with hsf, letI := hsf,
  calc cardinal.mk β = cardinal.mk (↥(lc.supported α s)) :
    quotient.sound ⟨(module_equiv_lc hs).to_equiv⟩
    ... = cardinal.mk (s →₀ α) :
    begin
      refine quotient.sound ⟨@linear_equiv.to_equiv α _ _ _ _ _ _ _ _⟩,
      convert @lc.supported_equiv α β _ _ _ _ s,
      { funext, exact subsingleton.elim _ _ },
    end
    ... = cardinal.mk (s → α) : quotient.sound ⟨finsupp.equiv_fun_on_fintype⟩
    ... = _ : by rw [← hs.mk_eq_dim, cardinal.power_def]
end

lemma cardinal_lt_omega_of_dim_lt_omega
  {α β : Type u} [discrete_field α] [add_comm_group β] [vector_space α β] [fintype α]
  (h : dim α β < cardinal.omega) : cardinal.mk β < cardinal.omega :=
begin
  rw [cardinal_mk_eq_cardinal_mk_field_pow_dim h],
  exact cardinal.power_lt_omega (cardinal.lt_omega_iff_fintype.2 ⟨infer_instance⟩) h
end

end vector_space

namespace mv_polynomial
universes u v
variables {σ : Type u} {α : Type v} [decidable_eq σ]

instance [discrete_field α] : vector_space α (mv_polynomial σ α) :=
finsupp.vector_space

section
variables (σ α) [discrete_field α] (m : ℕ)
def restrict_total_degree : submodule α (mv_polynomial σ α) :=
finsupp.restrict_dom _ _ {n | n.sum (λn e, e) ≤ m }

lemma mem_restrict_total_degree (p : mv_polynomial σ α) :
  p ∈ restrict_total_degree σ α m ↔ p.total_degree ≤ m :=
begin
  rw [total_degree, finset.sup_le_iff],
  refl
end

end

noncomputable instance decidable_restrict_degree (m : ℕ) :
  decidable_pred (λn, n ∈ {n : σ →₀ ℕ | ∀i, n i ≤ m }) :=
assume n, classical.prop_decidable _

section
variables (σ α)
def restrict_degree (m : ℕ) [discrete_field α] : submodule α (mv_polynomial σ α) :=
finsupp.restrict_dom _ _ {n | ∀i, n i ≤ m }
end

lemma mem_restrict_degree [discrete_field α] (p : mv_polynomial σ α) (n : ℕ) :
  p ∈ restrict_degree σ α n ↔ (∀s ∈ p.support, ∀i, (s : σ →₀ ℕ) i ≤ n) :=
begin
  rw [restrict_degree, finsupp.mem_restrict_dom],
  refl
end

lemma mem_restrict_degree_iff_sup [discrete_field α] (p : mv_polynomial σ α) (n : ℕ) :
  p ∈ restrict_degree σ α n ↔ ∀i, p.degrees.count i ≤ n :=
begin
  simp only [mem_restrict_degree, degrees, multiset.count_sup, finsupp.count_to_multiset,
    finset.sup_le_iff],
  exact ⟨assume h n s hs, h s hs n, assume h s hs n, h n s hs⟩
end

lemma map_range_eq_map {β : Type*}
  [decidable_eq α] [comm_ring α] [decidable_eq β] [comm_ring β] (p : mv_polynomial σ α)
  (f : α → β) [is_semiring_hom f]:
  finsupp.map_range f (is_semiring_hom.map_zero f) p = p.map f :=
begin
  rw [← finsupp.sum_single p, finsupp.sum, finsupp.map_range_finset_sum,
    ← finset.sum_hom (map f)],
  { refine finset.sum_congr rfl (assume n _, _),
    rw [finsupp.map_range_single, ← monomial, ← monomial, map_monomial] },
  apply_instance
end

section
variables (σ α)
lemma is_basis_monomials [discrete_field α] :
  is_basis α (range (λs, monomial s 1) : set (mv_polynomial σ α)) :=
suffices is_basis α (⋃i, (monomial i : α → mv_polynomial σ α) '' {1}),
  by simpa only [range_eq_Union, image_singleton],
finsupp.is_basis_single (assume s, is_basis_singleton_one α)
end

end mv_polynomial

namespace mv_polynomial
universe u
variables (σ : Type u) (α : Type u) [decidable_eq σ] [discrete_field α]

lemma dim_mv_polynomial : vector_space.dim α (mv_polynomial σ α) = cardinal.mk (σ →₀ ℕ) :=
begin
  rw [← (is_basis_monomials σ α).mk_eq_dim, ← set.image_univ, cardinal.mk_eq_of_injective,
    cardinal.mk_univ],
  assume a b h,
  rcases (finsupp.single_eq_single_iff _ _ _ _).1 h with ⟨rfl, _⟩ | ⟨h, _⟩,
  { refl },
  { exact (zero_ne_one.symm h).elim }
end

end mv_polynomial


/-
Copyright (c) 2019 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.real.basic
import Mathlib.PostPort

namespace Mathlib

/-!
# The extended reals [-∞, ∞].

This file defines `ereal`, the real numbers together with a top and bottom element,
referred to as ⊤ and ⊥. It is implemented as `with_top (with_bot ℝ)`

Addition and multiplication are problematic in the presence of ±∞, but
negation has a natural definition and satisfies the usual properties.
An addition is derived, but `ereal` is not even a monoid (there is no identity).

`ereal` is a `complete_lattice`; this is now deduced by type class inference from
the fact that `with_top (with_bot L)` is a complete lattice if `L` is
a conditionally complete lattice.

## Tags

real, ereal, complete lattice

## TODO

abs : ereal → ennreal

In Isabelle they define + - * and / (making junk choices for things like -∞ + ∞)
and then prove whatever bits of the ordered ring/field axioms still hold. They
also do some limits stuff (liminf/limsup etc).
See https://isabelle.in.tum.de/dist/library/HOL/HOL-Library/Extended_Real.html
-/

/-- ereal : The type `[-∞, ∞]` -/
def ereal :=
  with_top (with_bot ℝ)

namespace ereal

protected instance has_coe : has_coe ℝ ereal :=
  has_coe.mk (some ∘ some)

@[simp] protected theorem coe_real_le {x : ℝ} {y : ℝ} : ↑x ≤ ↑y ↔ x ≤ y := sorry

@[simp] protected theorem coe_real_lt {x : ℝ} {y : ℝ} : ↑x < ↑y ↔ x < y := sorry

@[simp] protected theorem coe_real_inj' {x : ℝ} {y : ℝ} : ↑x = ↑y ↔ x = y := sorry

protected instance has_zero : HasZero ereal :=
  { zero := ↑0 }

protected instance inhabited : Inhabited ereal :=
  { default := 0 }

/-! ### Negation -/

/-- negation on ereal -/
protected def neg : ereal → ereal :=
  sorry

protected instance has_neg : Neg ereal :=
  { neg := ereal.neg }

protected theorem neg_def (x : ℝ) : ↑(-x) = -↑x :=
  rfl

/-- - -a = a on ereal -/
protected theorem neg_neg (a : ereal) : --a = a := sorry

theorem neg_inj (a : ereal) (b : ereal) (h : -a = -b) : a = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a = b)) (Eq.symm (ereal.neg_neg a))))
    (eq.mpr (id (Eq._oldrec (Eq.refl ( --a = b)) h))
      (eq.mpr (id (Eq._oldrec (Eq.refl ( --b = b)) (ereal.neg_neg b))) (Eq.refl b)))

/-- Even though ereal is not an additive group, -a = b ↔ -b = a still holds -/
theorem neg_eq_iff_neg_eq {a : ereal} {b : ereal} : -a = b ↔ -b = a :=
  { mp := fun (h : -a = b) => eq.mpr (id (Eq._oldrec (Eq.refl (-b = a)) (Eq.symm h))) (ereal.neg_neg a),
    mpr := fun (h : -b = a) => eq.mpr (id (Eq._oldrec (Eq.refl (-a = b)) (Eq.symm h))) (ereal.neg_neg b) }

/-- if -a ≤ b then -b ≤ a on ereal -/
protected theorem neg_le_of_neg_le {a : ereal} {b : ereal} (h : -a ≤ b) : -b ≤ a := sorry

/-- -a ≤ b ↔ -b ≤ a on ereal-/
protected theorem neg_le {a : ereal} {b : ereal} : -a ≤ b ↔ -b ≤ a :=
  { mp := ereal.neg_le_of_neg_le, mpr := ereal.neg_le_of_neg_le }

/-- a ≤ -b → b ≤ -a on ereal -/
theorem le_neg_of_le_neg {a : ereal} {b : ereal} (h : a ≤ -b) : b ≤ -a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (b ≤ -a)) (Eq.symm (ereal.neg_neg b))))
    (eq.mpr (id (Eq._oldrec (Eq.refl ( --b ≤ -a)) (propext ereal.neg_le)))
      (eq.mpr (id (Eq._oldrec (Eq.refl ( --a ≤ -b)) (ereal.neg_neg a))) h))


import tactic

open_locale classical -- assume the law of the excluded middle
noncomputable theory -- because Lean can't calculate with an arbitrary field

-- "let k be a field"
variables {k : Type} [field k]

def disc (a1 a2 a3 a4 a6 : k) : k :=
-a6*a1^6 + a4*a3*a1^5 + ((-a3^2 - 12*a6)*a2 + a4^2)*a1^4 +
(8*a4*a3*a2 + (a3^3 + 36*a6*a3))*a1^3 + ((-8*a3^2 - 48*a6)*a2^2 + 8*a4^2*a2 +
(-30*a4*a3^2 + 72*a6*a4))*a1^2 + (16*a4*a3*a2^2 + (36*a3^3 + 144*a6*a3)*a2 - 96*a4^2*a3)*a1
 + ((-16*a3^2 - 64*a6)*a2^3 + 16*a4^2*a2^2 + (72*a4*a3^2 + 288*a6*a4)*a2 +
 (-27*a3^4 - 216*a6*a3^2 + (-64*a4^3 - 432*a6^2)))

/-- An elliptic curve over a field -/
structure elliptic_curve (k : Type) [field k] :=
(a1 a2 a3 a4 a6 : k)
(disc_nonzero : disc a1 a2 a3 a4 a6 ≠ 0)

namespace elliptic_curve

/-- The set of points on an elliptic curve, considered as the affine
  solutions plus an extra term "none" -/
def points (E : elliptic_curve k) := with_zero {P : k × k // let ⟨x, y⟩ := P in
  y^2 + E.a1*x*y + E.a3*y = x^3 + E.a2*x^2 + E.a4*x + E.a6}

-- "let E be an elliptic curve over k"
variable (E : elliptic_curve k)

/-- notation 0 for the "extra point" we added -/
instance : has_zero (points E) := with_zero.has_zero

def scale (E : elliptic_curve k) (d : k) (hd : d ≠ 0) :
  elliptic_curve k :=
{ a1 := d*E.a1,
  a2 := d^2*E.a2,
  a3 := d^3*E.a3,
  a4 := d^4*E.a4,
  a6 := d^6*E.a6,
  disc_nonzero := begin
    have hE : disc E.a1 E.a2 E.a3 E.a4 E.a6 ≠ 0,
      exact E.disc_nonzero,
    have h12 : d^12*disc E.a1 E.a2 E.a3 E.a4 E.a6 ≠ 0,
      refine mul_ne_zero _ hE,
      exact pow_ne_zero 12 hd,
    convert h12,
    unfold disc,
    ring,
  end }

def to_scale (E : elliptic_curve k) (d : k) (hd : d ≠ 0) : points E → points (scale E d hd)
| 0 := 0
| (some P) :=
let ⟨⟨x, y⟩, h⟩ := P in
some ⟨⟨d*d*x, d*d*d*y⟩, begin
  change y^2 + E.a1*x*y + E.a3*y = x^3 + E.a2*x^2 + E.a4*x + E.a6 at h,
  replace h := congr_arg (λ t, d^6*t) h,
  dsimp at h,
  change _ = _,
  unfold scale,
  dsimp,
  convert h,
    ring_exp,
    ring_exp,
end⟩

@[simp] lemma helper (a b : k) (h : b ≠ 0) : (a * b⁻¹) * b = a :=
begin
  rw mul_assoc,
  rw inv_mul_cancel h,
  rw mul_one,
end

def of_scale (E : elliptic_curve k) (d : k) (hd : d ≠ 0) : points (scale E d hd) → points E
| 0 := 0
| (some P) :=
let ⟨⟨x, y⟩, h⟩ := P in
let F := (scale E d hd) in
some ⟨⟨d⁻¹ * d⁻¹ * x, d⁻¹ * d⁻¹ * d⁻¹ * y⟩, begin
  change y^2 + F.a1*x*y + F.a3*y = x^3 + F.a2*x^2 + F.a4*x + F.a6 at h,
  replace h := congr_arg (λ t, d⁻¹^6*t) h,
  dsimp at h,
  change _ = _,
  simp only [F, scale] at h,
  have hdd : d * d⁻¹ = 1,
    exact mul_inv_cancel hd,
  convert h,
  { ring_exp,
    rw (show d⁻¹ ^ 6 = d⁻¹ * (d⁻¹ * d⁻¹ * d⁻¹^3), by ring),
    repeat {rw ←mul_assoc},
    rw hdd,
    rw (show d ^ 3 * d⁻¹ * d⁻¹ * d⁻¹ = d * ( d * ( d * d⁻¹) * d⁻¹) * d⁻¹, by ring),
    rw [hdd, mul_one, hdd, mul_one, hdd],
    ring },
  { repeat {rw pow_succ},
    repeat {rw pow_zero},
    repeat {rw mul_one},
--    rw (show d⁻¹ ^ 6 = (d⁻¹ * d⁻¹ * d⁻¹ * d⁻¹ * d⁻¹ * d⁻¹), by ring),
    repeat {rw mul_add},
    repeat {rw ←mul_assoc},
    repeat {rw helper _ d hd},
    rw inv_mul_cancel hd,
    ring_exp}
end⟩.

def scale_points (E : elliptic_curve k) (d : k) (hd : d ≠ 0) :
  points E ≃ points (scale E d hd) :=
{ to_fun := to_scale E d hd,
  inv_fun := of_scale E d hd,
  left_inv := begin
    intro P,
    cases P,
      refl,
    rcases P with ⟨⟨x, y⟩, h⟩,
    simp only [to_scale, of_scale],
    congr',
    { repeat {rw ←mul_assoc},
      simp [hd] },
    { repeat {rw ←mul_assoc},
      simp [hd] },
  end,
  right_inv := begin
    intro P,
    cases P,
      refl,
    rcases P with ⟨⟨x, y⟩, h⟩,
    simp only [to_scale, of_scale],
    congr',
    { repeat {rw ←mul_assoc},
      simp [hd] },
    { repeat {rw ←mul_assoc},
      simp [hd] },
  end }

def neg : points E → points E
| 0 := 0
| (some P) :=
  let ⟨⟨x, y⟩, hP⟩ := P in
  some ⟨(x, -E.a1*x-E.a3-y), begin
    -- need to prove point is on the curve
    change y^2 + E.a1*x*y + E.a3*y = x^3 + E.a2*x^2 + E.a4*x + E.a6 at hP,
    change (-E.a1*x-E.a3-y)^2 + E.a1*x*(-E.a1*x-E.a3-y)+E.a3*(-E.a1*x-E.a3-y)
      = x^3 + E.a2*x^2 + E.a4*x + E.a6,
    -- our hypothesis is y^2+...=x^3+...
    -- want : (a₁x-a₃-y)^2+...=x^3+...
    -- I claim that our hypothesis equals what we want
    convert hP using 1,
    -- RHS's are equal, so it suffices to prove LHS's are equal
    ring,
  end⟩

theorem neg_to_scale (d : k) (hd : d ≠ 0) (P : points E) :
  (scale E d hd).neg (to_scale E d hd P) = to_scale E d hd (E.neg P) :=
begin
  cases P,
    refl,
  rcases P with ⟨⟨x, y⟩, h⟩,
  simp [scale, to_scale, neg],
  congr',
  ring,
end

lemma pow_three {R : Type} [comm_ring R] (x : R) :
x^3=x*x*x := by ring

theorem neg_of_scale (d : k) (hd : d ≠ 0) (P : points (scale E d hd)) :
  E.neg (of_scale E d hd P) = of_scale E d hd ((scale E d hd).neg P) :=
begin
  cases P,
    refl,
  rcases P with ⟨⟨x, y⟩, h⟩,
  simp [scale, of_scale, neg],
  congr',
  rw pow_three,
  repeat {rw ←mul_assoc},
  simp [hd],
  repeat {rw mul_sub},
  repeat {rw ←mul_assoc},
  simp [hd],
  repeat {rw ←mul_assoc},
  simp [hd],
  ring,
end

theorem neg_neg : function.involutive (neg E) :=
begin
  rintros (_|⟨⟨x, y⟩, h⟩),
  { refl },
  { simp only [elliptic_curve.neg],
    congr,
    ring }
end

def double : points E → points E
| 0 := 0
| (some P) :=
let ⟨⟨x, y⟩, h⟩ := P in
if h2 : 2*y+E.a1*x+E.a3 = 0 then 0 else
  let d := 2*y+E.a1*x+E.a3 in
  let sd := (3*x^2+2*E.a2*x+E.a4-E.a1*y) in
  let td := y*d-sd*x in
  let x₂dd := sd^2+E.a1*sd*d-E.a2*d*d-2*x*d*d in
  let y₂ddd := sd*x₂dd+td*d*d in
  let y₂ddd' := y*d*d*d-sd*(x*d*d-x₂dd) in
  let P2d : points (scale E d h2) := some ⟨⟨x₂dd, y₂ddd⟩, begin
    unfold points._match_1 at h ⊢,
    simp [y₂ddd, x₂dd, td, sd, scale, d] at h ⊢,
  rw ←sub_eq_zero at h ⊢,
  -- thank you sagemath!
  have key : (y ^ 2 + E.a1 * x * y + E.a3 * y - (x ^ 3 + E.a2 * x ^ 2 + E.a4 * x + E.a6)) *
(64*y^6 + (192*E.a1*x + 192*E.a3)*y^5 + (240*E.a1^2*x^2 + 480*E.a1*E.a3*x + 240*E.a3^2)*y^4 +
(160*E.a1^3*x^3 + 480*E.a1^2*E.a3*x^2 + 480*E.a1*E.a3^2*x + 160*E.a3^3)*y^3 +
(60*E.a1^4*x^4 + 240*E.a1^3*E.a3*x^3 + 360*E.a1^2*E.a3^2*x^2 + 240*E.a1*E.a3^3*x +
60*E.a3^4)*y^2 + (12*E.a1^5*x^5 + 60*E.a1^4*E.a3*x^4 + 120*E.a1^3*E.a3^2*x^3 +
120*E.a1^2*E.a3^3*x^2 + 60*E.a1*E.a3^4*x + 12*E.a3^5)*y + E.a1^6*x^6 +
6*E.a1^5*E.a3*x^5 + 15*E.a1^4*E.a3^2*x^4 + 20*E.a1^3*E.a3^3*x^3 +
15*E.a1^2*E.a3^4*x^2 + 6*E.a1*E.a3^5*x + E.a3^6) = 0,
    { simp [h] },
  convert key,
    ring,
  end⟩ in
  E.neg (of_scale E d h2 P2d).

def add : points E → points E → points E
| 0 P := P
| P 0 := P
| (some P) (some Q) :=
let ⟨⟨x1, y1⟩, h1⟩ := P in
let ⟨⟨x2, y2⟩, h2⟩ := Q in
if hd : x1 = x2 then (if y1 = y2 then double E (some P) else 0) else
  let d := (x1 - x2) in
  let sd := (y1 - y2) in
  let td := y1*d-sd*x1 in
  let x3dd := sd^2+E.a1*sd*d-E.a2*d*d-(x1+x2)*d*d in
  let y3ddd := sd*x3dd+td*d*d in
  let q1 := ((-2*x1^3 + 6*x1^2*x2 - 6*x1*x2^2 + 2*x2^3)*y1 - E.a1*x1^4 +
3*E.a1*x1^3*x2 - 3*E.a1*x1^2*x2^2 + E.a1*x1*x2^3 - E.a3*x1^3 +
3*E.a3*x1^2*x2 - 3*E.a3*x1*x2^2 + E.a3*x2^3)*y2 + (x1^3 - 3*x1^2*x2 +
3*x1*x2^2 - x2^3)*y1^2 + (E.a1*x1^4 - 4*E.a1*x1^3*x2 +
6*E.a1*x1^2*x2^2 - 4*E.a1*x1*x2^3 + E.a1*x2^4)*y1 - E.a2*x1^5 - x1^6 +
5*E.a2*x1^4*x2 + 3*x1^5*x2 - 9*E.a2*x1^3*x2^2 + 7*E.a2*x1^2*x2^3 -
9*x1^3*x2^3 - 2*E.a2*x1*x2^4 + 12*x1^2*x2^4 - 6*x1*x2^5 + x2^6 +
E.a4*x1^3*x2 - 3*E.a4*x1^2*x2^2 + 3*E.a4*x1*x2^3 - E.a4*x2^4 +
E.a6*x1^3 - 3*E.a6*x1^2*x2 + 3*E.a6*x1*x2^2 - E.a6*x2^3 in

  let q2 := (-x1^3 + 3*x1^2*x2 - 3*x1*x2^2 + x2^3)*y2^2 + ((2*x1^3 -
6*x1^2*x2 + 6*x1*x2^2 - 2*x2^3)*y1 + E.a1*x1^4 - 4*E.a1*x1^3*x2 +
6*E.a1*x1^2*x2^2 - 4*E.a1*x1*x2^3 + E.a1*x2^4)*y2 + (E.a1*x1^3*x2 -
3*E.a1*x1^2*x2^2 + 3*E.a1*x1*x2^3 - E.a1*x2^4 + E.a3*x1^3 -
3*E.a3*x1^2*x2 + 3*E.a3*x1*x2^2 - E.a3*x2^3)*y1 + x1^6 -
2*E.a2*x1^4*x2 - 6*x1^5*x2 + 7*E.a2*x1^3*x2^2 + 12*x1^4*x2^2 -
9*E.a2*x1^2*x2^3 - 9*x1^3*x2^3 + 5*E.a2*x1*x2^4 - E.a2*x2^5 +
3*x1*x2^5 - x2^6 - E.a4*x1^4 + 3*E.a4*x1^3*x2 - 3*E.a4*x1^2*x2^2 +
E.a4*x1*x2^3 - E.a6*x1^3 + 3*E.a6*x1^2*x2 - 3*E.a6*x1*x2^2 + E.a6*x2^3 in
  let P3 : points (scale E d (sub_ne_zero.2 hd)) :=
  some ⟨⟨x3dd, y3ddd⟩, begin
    unfold points._match_1 at h1 h2 ⊢,
    simp [y3ddd, x3dd, td, sd, scale, d] at ⊢,
    rw ←sub_eq_zero at h1 h2 ⊢,
    have : q1 * (y1 ^ 2 + E.a1 * x1 * y1 + E.a3 * y1 - (x1 ^ 3 + E.a2 * x1 ^ 2 + E.a4 * x1 + E.a6))
      + q2 * (y2 ^ 2 + E.a1 * x2 * y2 + E.a3 * y2 - (x2 ^ 3 + E.a2 * x2 ^ 2 + E.a4 * x2 + E.a6)) = 0,
    { rw h1,
      rw h2,
      simp

    },
    convert this,
    simp only [q1, q2],
    ring,
  end⟩ in
  E.neg (of_scale E d (sub_ne_zero.2 hd) P3).

end elliptic_curve