import for_mathlib.nnreal_nat_binary

def nat.equiv_le_int (d : ℤ) : ℕ ≃ ({n : ℤ | d ≤ n} : set ℤ) :=
  { to_fun := λ m, ⟨m + d, by simp⟩,
    inv_fun := λ n, ((n : ℤ) - d).nat_abs,
    left_inv := λ m, by simp,
    right_inv := begin rintro ⟨n, hn⟩,
      have hdn : 0 ≤ n - d := sub_nonneg.mpr hn,
      simp [hn, int.nat_abs_of_nonneg hdn] end }

def nat.equiv_int_lt_compl (d : ℤ) : ℕ ≃ ({n : ℤ | n < d}ᶜ : set ℤ) :=
  { to_fun := λ m, ⟨m + d, by simp⟩,
    inv_fun := λ n, ((n : ℤ) - d).nat_abs,
    left_inv := λ m, by simp,
    right_inv := begin rintro ⟨n, hn : ¬ (n < d)⟩,
      have hn := le_of_not_lt hn,
      have hdn : 0 ≤ n - d := sub_nonneg.mpr hn,
      simp [hn, int.nat_abs_of_nonneg hdn] end }

def nat.equiv_le_int_compl (d : ℤ) : ℕ ≃ ({n : ℤ | d ≤ n}ᶜ : set ℤ) :=
  { to_fun := λ m, ⟨d - (m + 1), show ¬ d ≤ d - (m + 1), by push_neg;
      exact sub_lt_self d (by linarith)⟩,
    inv_fun := λ n, (d - ((n : ℤ) + 1)).nat_abs,
    left_inv := λ m, by simp; ring_nf, -- `ring` is noisy for some reason?
    right_inv := begin rintro ⟨n, hn : ¬ d ≤ n⟩,
      simp,
      rw int.nat_abs_of_nonneg, ring, linarith
    end }

lemma int.summable_iff_nat_summable_and_nat_summable {α : Type*} [add_comm_group α]
  [uniform_space α] [uniform_add_group α] [complete_space α] (d : ℤ) (f : ℤ → α) :
  summable f ↔ summable (λ n : ℕ, f (n + d)) ∧ summable (λ n : ℕ, f (d - (n + 1))) :=
begin
  refine (@summable_subtype_and_compl α _ _ _ _ _ _ {z : ℤ | d ≤ z}).symm.trans _,
  apply and_congr,
  { rw ← (nat.equiv_le_int d).summable_iff,
    refl, },
  { rw ← (nat.equiv_le_int_compl d).summable_iff,
    refl, },
end

-- is this worthy of mathlib?
theorem int.tsum_eq_nat_tsum_of_bdd_below {α : Type*} [add_comm_monoid α] [topological_space α]
  [has_continuous_add α] [t2_space α] (f : ℤ → α) (d : ℤ) (hd : ∀ n, n < d → f n = 0)
  (hsum : summable (λ (n : ℕ), f (n + d))) :
∑' m, f m = ∑' (n : ℕ), f (n + d) :=
begin
  have summable_small : summable (λ n : {n : ℤ | n < d}, (f ∘ (coe : _ → ℤ)) n),
  { convert summable_zero,
    ext ⟨n, hn⟩,
    exact hd n hn, },
  have tsum_small : ∑' n : {n : ℤ | n < d}, f n = 0,
  { convert tsum_zero,
    ext ⟨n, hn⟩,
    exact hd n hn,
    apply_instance,
  },
  have summable_big : summable (λ n : {n : ℤ | n < d}ᶜ, (f ∘ (coe : _ → ℤ)) n),
  { rwa ← (nat.equiv_int_lt_compl d).summable_iff },
  rw [← tsum_add_tsum_compl summable_small summable_big, tsum_small, zero_add,
    ← (nat.equiv_int_lt_compl d).tsum_eq],
  refl, apply_instance,
end

open_locale nnreal

/-
zpow_le_zpow' :
  ∀ {α : Type u_1} [_inst_1 : ordered_comm_group α] {n : ℤ} {a b : α}, 0 ≤ n → a ≤ b → a ^ n ≤ b ^ n
-/

def nnreal.zpow_le_zpow' {n : ℤ} {a b : ℝ≥0} (hn : 0 ≤ n) (hab : a ≤ b) : a ^ n ≤ b ^ n :=
begin
  let m := n.nat_abs,
  rw int.eq_nat_abs_of_zero_le hn,
  suffices : a ^ m ≤ b ^ m,
    assumption_mod_cast,
  generalize : m = d,
  induction d with d hd, -- I can't believe I'm doing this. Where is this??
  { refl, },
  { rw [pow_succ, pow_succ],
    exact mul_le_mul' hab hd, }
end

-- lemma is false if w = 1 and n = any and r = 0
-- lemma is false if w = 0 and n ≠ 0 and r = 2⁻¹
lemma nnreal.zpow_le_iff_log {w r : ℝ≥0} (hw : 0 < w) (hr : 0 < r) {n : ℤ} :
  w^n ≤ r ↔ (w : ℝ).log * n ≤ (r : ℝ).log :=
begin
  rw [mul_comm, ←real.log_zpow],
  rw (show w ^ n ≤ r ↔ (w : ℝ) ^ n ≤ (r : ℝ), by norm_cast),
  rw real.log_le_log; norm_cast,
  { exact nnreal.zpow_pos hw.ne.symm _ },
  { exact hr },
end

-- → is false if w = 1 and n = any and r = 0
-- ← is false if w = 0 and n ≠ 0 and r = 2⁻¹
lemma nnreal.lt_zpow_iff_log {w r : ℝ≥0} (hw : 0 < w) (hr : 0 < r) {n : ℤ} :
  r < w ^ n ↔ (r : ℝ).log < (w : ℝ).log * n :=
begin
  rw [mul_comm, ←real.log_zpow],
  rw real.log_lt_log_iff,
  { norm_cast },
  { assumption_mod_cast },
  { apply zpow_pos_of_pos,
    assumption_mod_cast },
end

-- the useful lower and upper bounds on 2⁻¹ ^ ⌈z.log / (2⁻¹ : ℝ).log⌉
lemma pow_d_le_z {z : ℝ≥0} (hz : 0 < z) : (2⁻¹ : ℝ≥0) ^ ⌈(z : ℝ).log / (2⁻¹ : ℝ).log⌉ ≤ z :=
begin
    { rw nnreal.zpow_le_iff_log (by norm_num : (0 : ℝ≥0) < 2⁻¹) hz,
    rw ← div_le_iff_of_neg',
    { convert int.le_ceil _ },
    { apply real.log_neg; norm_num } },
end

lemma int.ceil_sub_one_lt {α : Type*} [linear_ordered_ring α] [floor_ring α]
(a : α) : (⌈a⌉ : α) - 1 < a :=
sub_lt_iff_lt_add.mpr (int.ceil_lt_add_one a)

lemma z_lt_pow_d_succ {z : ℝ≥0} (hz : 0 < z) : z < (2⁻¹ : ℝ≥0) ^ (⌈(z : ℝ).log / (2⁻¹ : ℝ).log⌉ - 1) :=
begin
  { rw nnreal.lt_zpow_iff_log (by norm_num : (0 : ℝ≥0) < 2⁻¹) (hz),
    rw ← lt_div_iff_of_neg',
    { push_cast,
      convert int.ceil_sub_one_lt _ },
    { apply real.log_neg; norm_num } },
end

namespace nnreal

namespace int

/-- The stream of 0s and 1s (always 0 for n<<0, not always 1 for n>>0)
such that r = ∑ (binary r n) * 2⁻¹ ^ n -/
noncomputable def binary (r : ℝ≥0) : ℤ → ℕ := if r = 0 then 0 else
λ n, let d : ℤ := ⌈(r : ℝ).log / (2⁻¹ : ℝ).log⌉ in
if n < d then 0 else nnreal.nat.digit (r * 2 ^ d) (n - d).nat_abs

example (n m : ℤ) : n ≤ m ↔ n < m + 1 := int.lt_add_one_iff.symm

theorem binary_le_one (r : ℝ≥0) (n : ℤ) : binary r n ≤ 1 :=
begin
  let d : ℤ := ⌈(r : ℝ).log / (2⁻¹ : ℝ).log⌉,
  rw [binary], split_ifs with hr hn, exact zero_le_one, exact zero_le_one,
  push_neg at hn,
  rcases lt_or_eq_of_le hn with (h1 | h2),
  { rw [int.lt_iff_add_one_le, le_iff_exists_nonneg_add] at h1,
    rcases h1 with ⟨c, hc1, rfl⟩,
    convert nnreal.nat.digit.succ_le_one (r * 2 ^ d) c.nat_abs,
    suffices : (c + 1).nat_abs = c.nat_abs + 1,
    { convert this, ring },
    exact int.nat_abs_add_nonneg hc1 zero_le_one },
  { clear hn,
    rw ← h2,
    rw [nat.digit, sub_self, int.nat_abs_zero, nat.binary.zero_fst_def, ← nat.lt_add_one_iff],
    rw nat.floor_lt', swap, norm_num,
    have := z_lt_pow_d_succ ((zero_lt_iff.mpr hr)),
    have h : (2⁻¹ : ℝ≥0) ≠ 0, norm_num,
    rw [zpow_sub_one₀ h, inv_inv] at this,
    replace this := inv_mul_lt_of_lt_mul₀ this,
    rw [mul_comm] at this, simpa },
end

@[simp] theorem binary_zero (z : ℤ) : binary 0 z = 0 :=
begin
  rw [binary, if_pos];
  refl,
end

-- d = ⌈real.log r / real.log (2⁻¹ : ℝ≥0)⌉ is
-- the unique solution to 2^{-d} ≤ r < 2^{1-d} if r>0
-- and hence the point beyond with all digits are 0
theorem binary_eq_zero (r : ℝ≥0) (n : ℤ) (hsmall : n < ⌈real.log r / real.log (2⁻¹ : ℝ≥0)⌉) :
  binary r n = 0 :=
begin
  rw [binary],
  split_ifs;
  refl,
end

theorem binary_summable (r : ℝ≥0) {s : ℝ≥0} (hs : s < 1) :
  summable (λ (n : ℤ), (binary r n : ℝ≥0) * s ^ n) :=
begin
  rcases eq_or_ne s 0 with (rfl | hspos),
  { apply summable_of_ne_finset_zero,
    rintro n (hn : n ∉ ({0} : finset ℤ)),
    rw finset.not_mem_singleton at hn,
    simp [zero_zpow n hn], },
  rw ← nnreal.summable_coe,
  let d := ⌈real.log r / real.log (2⁻¹ : ℝ≥0)⌉,
  rw int.summable_iff_nat_summable_and_nat_summable d (_ : _ → ℝ),
  split,
  {
    simp_rw [zpow_add₀ hspos, ← mul_assoc],
    norm_cast,
    apply summable.mul_right,
    refine summable_of_le (λ b, _) (summable_geometric hs),
    refine mul_le_of_le_one_left (pow_nonneg zero_le' _) _,
    norm_cast,
    apply binary_le_one, },
  { convert summable_zero, ext k,
    norm_cast,
    convert zero_mul _,
    norm_cast,
    convert binary_eq_zero r _ _,
    apply sub_lt_self,
    norm_cast,
    apply nat.succ_pos,
  }
end

lemma tsum_add_tsum_compl' {β : Type*} {f : β → ℝ≥0} (s : set β) (hf : summable f) :
  ∑' (x : ↥s), f ↑x + ∑' (x : ↥sᶜ), f ↑x = ∑' (x : β), f x :=
begin
  apply tsum_add_tsum_compl;
  apply summable_comp_injective hf;
  exact subtype.coe_injective,
end

theorem binary_sum (r : ℝ≥0) : ∑' (n : ℤ), (binary r n : ℝ≥0) * 2⁻¹ ^ n = r :=
begin
  let d := ⌈real.log r / real.log (2⁻¹ : ℝ≥0)⌉,
  rw ← tsum_add_tsum_compl' {n : ℤ | n < d} (binary_summable _ two_inv_lt_one),
  convert zero_add r,
  { convert (tsum_zero : _ = (0 : ℝ≥0)),
    ext ⟨b, hb : b < d⟩,
    simp [binary_eq_zero r b hb], },
  { rw ← (nat.equiv_int_lt_compl d).tsum_eq, swap, apply_instance,
    simp only [nat.equiv_int_lt_compl, binary, equiv.coe_fn_mk, subtype.coe_mk, neg_add_rev,
    zpow_add₀ (show (2⁻¹ : ℝ≥0) ≠ 0, by norm_num), ← mul_assoc, tsum_mul_right],
    split_ifs with hr hr,
    { subst hr,
      convert (tsum_zero : ∑' (n : ℕ), _ = (0 : ℝ≥0)),
      ext n, simp },
    {
      rw ← eq_div_iff (zpow_ne_zero _ (show (2⁻¹ : ℝ≥0) ≠ 0, by norm_num)),
      convert nnreal.nat.digit.tsum (r * 2 ^ d),
      { ext n,
        rw if_neg,
        { norm_cast,
          congr',
          convert int.nat_abs_of_nat n,
          exact add_sub_cancel _ d, },
        { push_neg,
          change d ≤ n + d,
          linarith, } },
      { rw [inv_zpow, nnreal.div_inv], }
    },
  }
end

end int

end nnreal


lemma add_assoc (a b c : mynat) : (a + b) + c = a + (b + c) :=
begin
induction c with d hd,
rw add_zero,
rw add_zero,
refl,
rw add_succ,
rw add_succ,
rw add_succ,
rw hd,
refl,
end


/-
Copyright (c) 2021 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn

! This file was ported from Lean 3 source module algebra.order.nonneg.floor
! leanprover-community/mathlib commit b3f4f007a962e3787aa0f3b5c7942a1317f7d88e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Order.Nonneg.Ring
import Mathbin.Algebra.Order.Archimedean

/-!
# Nonnegative elements are archimedean

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This file defines instances and prove some properties about the nonnegative elements
`{x : α // 0 ≤ x}` of an arbitrary type `α`.

This is used to derive algebraic structures on `ℝ≥0` and `ℚ≥0` automatically.

## Main declarations

* `{x : α // 0 ≤ x}` is a `floor_semiring` if `α` is.
-/

namespace Nonneg

variable {α : Type _}

/- warning: nonneg.archimedean -> Nonneg.archimedean is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : OrderedAddCommMonoid.{u1} α] [_inst_2 : Archimedean.{u1} α _inst_1], Archimedean.{u1} (Subtype.{succ u1} α (fun (x : α) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedAddCommMonoid.toPartialOrder.{u1} α _inst_1))) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (AddZeroClass.toHasZero.{u1} α (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α (OrderedAddCommMonoid.toAddCommMonoid.{u1} α _inst_1))))))) x)) (Nonneg.orderedAddCommMonoid.{u1} α _inst_1)
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : OrderedAddCommMonoid.{u1} α] [_inst_2 : Archimedean.{u1} α _inst_1], Archimedean.{u1} (Subtype.{succ u1} α (fun (x : α) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedAddCommMonoid.toPartialOrder.{u1} α _inst_1))) (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (AddMonoid.toZero.{u1} α (AddCommMonoid.toAddMonoid.{u1} α (OrderedAddCommMonoid.toAddCommMonoid.{u1} α _inst_1))))) x)) (Nonneg.orderedAddCommMonoid.{u1} α _inst_1)
Case conversion may be inaccurate. Consider using '#align nonneg.archimedean Nonneg.archimedeanₓ'. -/
instance archimedean [OrderedAddCommMonoid α] [Archimedean α] : Archimedean { x : α // 0 ≤ x } :=
  ⟨fun x y hy =>
    let ⟨n, hr⟩ := Archimedean.arch (x : α) (hy : (0 : α) < y)
    ⟨n, show (x : α) ≤ (n • y : { x : α // 0 ≤ x }) by simp [*, -nsmul_eq_mul, nsmul_coe]⟩⟩
#align nonneg.archimedean Nonneg.archimedean

/- warning: nonneg.floor_semiring -> Nonneg.floorSemiring is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : OrderedSemiring.{u1} α] [_inst_2 : FloorSemiring.{u1} α _inst_1], FloorSemiring.{u1} (Subtype.{succ u1} α (fun (r : α) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedAddCommMonoid.toPartialOrder.{u1} α (OrderedSemiring.toOrderedAddCommMonoid.{u1} α _inst_1)))) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (OrderedSemiring.toSemiring.{u1} α _inst_1)))))))) r)) (Nonneg.orderedSemiring.{u1} α _inst_1)
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : OrderedSemiring.{u1} α] [_inst_2 : FloorSemiring.{u1} α _inst_1], FloorSemiring.{u1} (Subtype.{succ u1} α (fun (r : α) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedSemiring.toPartialOrder.{u1} α _inst_1))) (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (MonoidWithZero.toZero.{u1} α (Semiring.toMonoidWithZero.{u1} α (OrderedSemiring.toSemiring.{u1} α _inst_1))))) r)) (Nonneg.orderedSemiring.{u1} α _inst_1)
Case conversion may be inaccurate. Consider using '#align nonneg.floor_semiring Nonneg.floorSemiringₓ'. -/
instance floorSemiring [OrderedSemiring α] [FloorSemiring α] : FloorSemiring { r : α // 0 ≤ r }
    where
  floor a := ⌊(a : α)⌋₊
  ceil a := ⌈(a : α)⌉₊
  floor_of_neg a ha := FloorSemiring.floor_of_neg ha
  gc_floor a n ha :=
    by
    refine' (FloorSemiring.gc_floor (show 0 ≤ (a : α) from ha)).trans _
    rw [← Subtype.coe_le_coe, Nonneg.coe_nat_cast]
  gc_ceil a n := by
    refine' (FloorSemiring.gc_ceil (a : α) n).trans _
    rw [← Subtype.coe_le_coe, Nonneg.coe_nat_cast]
#align nonneg.floor_semiring Nonneg.floorSemiring

/- warning: nonneg.nat_floor_coe -> Nonneg.nat_floor_coe is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : OrderedSemiring.{u1} α] [_inst_2 : FloorSemiring.{u1} α _inst_1] (a : Subtype.{succ u1} α (fun (r : α) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedAddCommMonoid.toPartialOrder.{u1} α (OrderedSemiring.toOrderedAddCommMonoid.{u1} α _inst_1)))) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (OrderedSemiring.toSemiring.{u1} α _inst_1)))))))) r)), Eq.{1} Nat (Nat.floor.{u1} α _inst_1 _inst_2 ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Subtype.{succ u1} α (fun (r : α) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedAddCommMonoid.toPartialOrder.{u1} α (OrderedSemiring.toOrderedAddCommMonoid.{u1} α _inst_1)))) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (OrderedSemiring.toSemiring.{u1} α _inst_1)))))))) r)) α (HasLiftT.mk.{succ u1, succ u1} (Subtype.{succ u1} α (fun (r : α) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedAddCommMonoid.toPartialOrder.{u1} α (OrderedSemiring.toOrderedAddCommMonoid.{u1} α _inst_1)))) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (OrderedSemiring.toSemiring.{u1} α _inst_1)))))))) r)) α (CoeTCₓ.coe.{succ u1, succ u1} (Subtype.{succ u1} α (fun (r : α) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedAddCommMonoid.toPartialOrder.{u1} α (OrderedSemiring.toOrderedAddCommMonoid.{u1} α _inst_1)))) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (OrderedSemiring.toSemiring.{u1} α _inst_1)))))))) r)) α (coeBase.{succ u1, succ u1} (Subtype.{succ u1} α (fun (r : α) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedAddCommMonoid.toPartialOrder.{u1} α (OrderedSemiring.toOrderedAddCommMonoid.{u1} α _inst_1)))) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (OrderedSemiring.toSemiring.{u1} α _inst_1)))))))) r)) α (coeSubtype.{succ u1} α (fun (r : α) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedAddCommMonoid.toPartialOrder.{u1} α (OrderedSemiring.toOrderedAddCommMonoid.{u1} α _inst_1)))) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (OrderedSemiring.toSemiring.{u1} α _inst_1)))))))) r))))) a)) (Nat.floor.{u1} (Subtype.{succ u1} α (fun (r : α) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedAddCommMonoid.toPartialOrder.{u1} α (OrderedSemiring.toOrderedAddCommMonoid.{u1} α _inst_1)))) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (OrderedSemiring.toSemiring.{u1} α _inst_1)))))))) r)) (Nonneg.orderedSemiring.{u1} α _inst_1) (Nonneg.floorSemiring.{u1} α _inst_1 _inst_2) a)
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : OrderedSemiring.{u1} α] [_inst_2 : FloorSemiring.{u1} α _inst_1] (a : Subtype.{succ u1} α (fun (r : α) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedSemiring.toPartialOrder.{u1} α _inst_1))) (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (MonoidWithZero.toZero.{u1} α (Semiring.toMonoidWithZero.{u1} α (OrderedSemiring.toSemiring.{u1} α _inst_1))))) r)), Eq.{1} Nat (Nat.floor.{u1} α _inst_1 _inst_2 (Subtype.val.{succ u1} α (fun (r : α) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedSemiring.toPartialOrder.{u1} α _inst_1))) (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (MonoidWithZero.toZero.{u1} α (Semiring.toMonoidWithZero.{u1} α (OrderedSemiring.toSemiring.{u1} α _inst_1))))) r) a)) (Nat.floor.{u1} (Subtype.{succ u1} α (fun (r : α) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedSemiring.toPartialOrder.{u1} α _inst_1))) (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (MonoidWithZero.toZero.{u1} α (Semiring.toMonoidWithZero.{u1} α (OrderedSemiring.toSemiring.{u1} α _inst_1))))) r)) (Nonneg.orderedSemiring.{u1} α _inst_1) (Nonneg.floorSemiring.{u1} α _inst_1 _inst_2) a)
Case conversion may be inaccurate. Consider using '#align nonneg.nat_floor_coe Nonneg.nat_floor_coeₓ'. -/
@[norm_cast]
theorem nat_floor_coe [OrderedSemiring α] [FloorSemiring α] (a : { r : α // 0 ≤ r }) :
    ⌊(a : α)⌋₊ = ⌊a⌋₊ :=
  rfl
#align nonneg.nat_floor_coe Nonneg.nat_floor_coe

/- warning: nonneg.nat_ceil_coe -> Nonneg.nat_ceil_coe is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : OrderedSemiring.{u1} α] [_inst_2 : FloorSemiring.{u1} α _inst_1] (a : Subtype.{succ u1} α (fun (r : α) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedAddCommMonoid.toPartialOrder.{u1} α (OrderedSemiring.toOrderedAddCommMonoid.{u1} α _inst_1)))) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (OrderedSemiring.toSemiring.{u1} α _inst_1)))))))) r)), Eq.{1} Nat (Nat.ceil.{u1} α _inst_1 _inst_2 ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Subtype.{succ u1} α (fun (r : α) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedAddCommMonoid.toPartialOrder.{u1} α (OrderedSemiring.toOrderedAddCommMonoid.{u1} α _inst_1)))) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (OrderedSemiring.toSemiring.{u1} α _inst_1)))))))) r)) α (HasLiftT.mk.{succ u1, succ u1} (Subtype.{succ u1} α (fun (r : α) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedAddCommMonoid.toPartialOrder.{u1} α (OrderedSemiring.toOrderedAddCommMonoid.{u1} α _inst_1)))) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (OrderedSemiring.toSemiring.{u1} α _inst_1)))))))) r)) α (CoeTCₓ.coe.{succ u1, succ u1} (Subtype.{succ u1} α (fun (r : α) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedAddCommMonoid.toPartialOrder.{u1} α (OrderedSemiring.toOrderedAddCommMonoid.{u1} α _inst_1)))) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (OrderedSemiring.toSemiring.{u1} α _inst_1)))))))) r)) α (coeBase.{succ u1, succ u1} (Subtype.{succ u1} α (fun (r : α) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedAddCommMonoid.toPartialOrder.{u1} α (OrderedSemiring.toOrderedAddCommMonoid.{u1} α _inst_1)))) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (OrderedSemiring.toSemiring.{u1} α _inst_1)))))))) r)) α (coeSubtype.{succ u1} α (fun (r : α) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedAddCommMonoid.toPartialOrder.{u1} α (OrderedSemiring.toOrderedAddCommMonoid.{u1} α _inst_1)))) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (OrderedSemiring.toSemiring.{u1} α _inst_1)))))))) r))))) a)) (Nat.ceil.{u1} (Subtype.{succ u1} α (fun (r : α) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedAddCommMonoid.toPartialOrder.{u1} α (OrderedSemiring.toOrderedAddCommMonoid.{u1} α _inst_1)))) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (OrderedSemiring.toSemiring.{u1} α _inst_1)))))))) r)) (Nonneg.orderedSemiring.{u1} α _inst_1) (Nonneg.floorSemiring.{u1} α _inst_1 _inst_2) a)
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : OrderedSemiring.{u1} α] [_inst_2 : FloorSemiring.{u1} α _inst_1] (a : Subtype.{succ u1} α (fun (r : α) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedSemiring.toPartialOrder.{u1} α _inst_1))) (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (MonoidWithZero.toZero.{u1} α (Semiring.toMonoidWithZero.{u1} α (OrderedSemiring.toSemiring.{u1} α _inst_1))))) r)), Eq.{1} Nat (Nat.ceil.{u1} α _inst_1 _inst_2 (Subtype.val.{succ u1} α (fun (r : α) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedSemiring.toPartialOrder.{u1} α _inst_1))) (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (MonoidWithZero.toZero.{u1} α (Semiring.toMonoidWithZero.{u1} α (OrderedSemiring.toSemiring.{u1} α _inst_1))))) r) a)) (Nat.ceil.{u1} (Subtype.{succ u1} α (fun (r : α) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedSemiring.toPartialOrder.{u1} α _inst_1))) (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (MonoidWithZero.toZero.{u1} α (Semiring.toMonoidWithZero.{u1} α (OrderedSemiring.toSemiring.{u1} α _inst_1))))) r)) (Nonneg.orderedSemiring.{u1} α _inst_1) (Nonneg.floorSemiring.{u1} α _inst_1 _inst_2) a)
Case conversion may be inaccurate. Consider using '#align nonneg.nat_ceil_coe Nonneg.nat_ceil_coeₓ'. -/
@[norm_cast]
theorem nat_ceil_coe [OrderedSemiring α] [FloorSemiring α] (a : { r : α // 0 ≤ r }) :
    ⌈(a : α)⌉₊ = ⌈a⌉₊ :=
  rfl
#align nonneg.nat_ceil_coe Nonneg.nat_ceil_coe

end Nonneg


/-
Copyright (c) 2019 Seul Baek. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Seul Baek

! This file was ported from Lean 3 source module tactic.omega.int.preterm
! leanprover-community/mathlib commit a0735864ba72769da4b378673d3dbe2453924fde
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.Omega.Term

/-
Linear integer arithmetic terms in pre-normalized form.
-/
namespace Omega

namespace Int

/-- The shadow syntax for arithmetic terms. All constants are reified to `cst`
(e.g., `-5` is reified to `cst -5`) and all other atomic terms are reified to
`exp` (e.g., `-5 * (gcd 14 -7)` is reified to `exp -5 \`(gcd 14 -7)`).
`exp` accepts a coefficient of type `int` as its first argument because
multiplication by constant is allowed by the omega test. -/
unsafe inductive exprterm : Type
  | cst : Int → exprterm
  | exp : Int → expr → exprterm
  | add : exprterm → exprterm → exprterm
#align omega.int.exprterm omega.int.exprterm

/-- Similar to `exprterm`, except that all exprs are now replaced with
de Brujin indices of type `nat`. This is akin to generalizing over
the terms represented by the said exprs. -/
inductive Preterm : Type
  | cst : Int → preterm
  | var : Int → Nat → preterm
  | add : preterm → preterm → preterm
  deriving has_reflect, Inhabited
#align omega.int.preterm Omega.Int.Preterm

-- mathport name: preterm.cst
scoped notation "&" k => Omega.Int.Preterm.cst k

-- mathport name: preterm.var
scoped infixl:300 " ** " => Omega.Int.Preterm.var

-- mathport name: preterm.add
scoped notation t " +* " s => Omega.Int.Preterm.add t s

namespace Preterm

/-- Preterm evaluation -/
@[simp]
def val (v : Nat → Int) : Preterm → Int
  | &i => i
  | i ** n => if i = 1 then v n else if i = -1 then -v n else v n * i
  | t1 +* t2 => t1.val + t2.val
#align omega.int.preterm.val Omega.Int.Preterm.val

/-- Fresh de Brujin index not used by any variable in argument -/
def freshIndex : Preterm → Nat
  | &_ => 0
  | i ** n => n + 1
  | t1 +* t2 => max t1.freshIndex t2.freshIndex
#align omega.int.preterm.fresh_index Omega.Int.Preterm.freshIndex

@[simp]
def addOne (t : Preterm) : Preterm :=
  t +* &1
#align omega.int.preterm.add_one Omega.Int.Preterm.addOne

def repr : Preterm → String
  | &i => i.repr
  | i ** n => i.repr ++ "*x" ++ n.repr
  | t1 +* t2 => "(" ++ t1.repr ++ " + " ++ t2.repr ++ ")"
#align omega.int.preterm.repr Omega.Int.Preterm.repr

end Preterm

open List.Func

-- get notation for list.func.set
/-- Return a term (which is in canonical form by definition)
    that is equivalent to the input preterm -/
@[simp]
def canonize : Preterm → Term
  | &i => ⟨i, []⟩
  | i ** n => ⟨0, [] {n ↦ i}⟩
  | t1 +* t2 => Term.add (canonize t1) (canonize t2)
#align omega.int.canonize Omega.Int.canonize

@[simp]
theorem val_canonize {v : Nat → Int} : ∀ {t : Preterm}, (canonize t).val v = t.val v
  | &i => by simp only [preterm.val, add_zero, term.val, canonize, coeffs.val_nil]
  | i ** n => by
    simp only [coeffs.val_set, canonize, preterm.val, zero_add, term.val]
    split_ifs with h1 h2
    · simp only [one_mul, h1]
    · simp only [neg_mul, one_mul, h2]
    · rw [mul_comm]
  | t +* s => by simp only [canonize, val_canonize, term.val_add, preterm.val]
#align omega.int.val_canonize Omega.Int.val_canonize

end Int

end Omega


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Mario Carneiro, Johan Commelin, Amelia Livingston, Anne Baanen

! This file was ported from Lean 3 source module ring_theory.localization.at_prime
! leanprover-community/mathlib commit b86c528d08a52a1fdb50d999232408e1c7e85d7d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.Ideal.LocalRing
import Mathbin.RingTheory.Localization.Ideal

/-!
# Localizations of commutative rings at the complement of a prime ideal

## Main definitions

 * `is_localization.at_prime (I : ideal R) [is_prime I] (S : Type*)` expresses that `S` is a
   localization at (the complement of) a prime ideal `I`, as an abbreviation of
   `is_localization I.prime_compl S`

## Main results

 * `is_localization.at_prime.local_ring`: a theorem (not an instance) stating a localization at the
   complement of a prime ideal is a local ring

## Implementation notes

See `src/ring_theory/localization/basic.lean` for a design overview.

## Tags
localization, ring localization, commutative ring localization, characteristic predicate,
commutative ring, field of fractions
-/

variable {R : Type _} [CommSemiring R] (M : Submonoid R) (S : Type _) [CommSemiring S]

variable [Algebra R S] {P : Type _} [CommSemiring P]

section AtPrime

variable (I : Ideal R) [hp : I.IsPrime]

include hp

namespace Ideal

/-- The complement of a prime ideal `I ⊆ R` is a submonoid of `R`. -/
def primeCompl : Submonoid R where
  carrier := (Iᶜ : Set R)
  one_mem' := by convert I.ne_top_iff_one.1 hp.1 <;> rfl
  mul_mem' x y hnx hny hxy := Or.cases_on (hp.mem_or_mem hxy) hnx hny
#align ideal.prime_compl Ideal.primeCompl

theorem primeCompl_le_nonZeroDivisors [NoZeroDivisors R] : I.primeCompl ≤ nonZeroDivisors R :=
  le_nonZeroDivisors_of_noZeroDivisors <| not_not_intro I.zero_mem
#align ideal.prime_compl_le_non_zero_divisors Ideal.primeCompl_le_nonZeroDivisors

end Ideal

variable (S)

/-- Given a prime ideal `P`, the typeclass `is_localization.at_prime S P` states that `S` is
isomorphic to the localization of `R` at the complement of `P`. -/
protected abbrev IsLocalization.AtPrime :=
  IsLocalization I.primeCompl S
#align is_localization.at_prime IsLocalization.AtPrime

/-- Given a prime ideal `P`, `localization.at_prime S P` is a localization of
`R` at the complement of `P`, as a quotient type. -/
protected abbrev Localization.AtPrime :=
  Localization I.primeCompl
#align localization.at_prime Localization.AtPrime

namespace IsLocalization

theorem AtPrime.nontrivial [IsLocalization.AtPrime S I] : Nontrivial S :=
  nontrivial_of_ne (0 : S) 1 fun hze =>
    by
    rw [← (algebraMap R S).map_one, ← (algebraMap R S).map_zero] at hze
    obtain ⟨t, ht⟩ := (eq_iff_exists I.prime_compl S).1 hze
    have htz : (t : R) = 0 := by simpa using ht.symm
    exact t.2 (htz.symm ▸ I.zero_mem : ↑t ∈ I)
#align is_localization.at_prime.nontrivial IsLocalization.AtPrime.nontrivial

attribute [local instance] at_prime.nontrivial

theorem AtPrime.localRing [IsLocalization.AtPrime S I] : LocalRing S :=
  LocalRing.of_nonunits_add
    (by
      intro x y hx hy hu
      cases' isUnit_iff_exists_inv.1 hu with z hxyz
      have : ∀ {r : R} {s : I.prime_compl}, mk' S r s ∈ nonunits S → r ∈ I :=
        fun (r : R) (s : I.prime_compl) =>
        not_imp_comm.1 fun nr =>
          isUnit_iff_exists_inv.2 ⟨mk' S ↑s (⟨r, nr⟩ : I.prime_compl), mk'_mul_mk'_eq_one' _ _ nr⟩
      rcases mk'_surjective I.prime_compl x with ⟨rx, sx, hrx⟩
      rcases mk'_surjective I.prime_compl y with ⟨ry, sy, hry⟩
      rcases mk'_surjective I.prime_compl z with ⟨rz, sz, hrz⟩
      rw [← hrx, ← hry, ← hrz, ← mk'_add, ← mk'_mul, ← mk'_self S I.prime_compl.one_mem] at hxyz
      rw [← hrx] at hx
      rw [← hry] at hy
      obtain ⟨t, ht⟩ := IsLocalization.eq.1 hxyz
      simp only [mul_one, one_mul, Submonoid.coe_mul, Subtype.coe_mk] at ht
      suffices : ↑t * (↑sx * ↑sy * ↑sz) ∈ I
      exact
        not_or_of_not (mt hp.mem_or_mem <| not_or_of_not sx.2 sy.2) sz.2
          (hp.mem_or_mem <| (hp.mem_or_mem this).resolve_left t.2)
      rw [← ht]
      exact
        I.mul_mem_left _
          (I.mul_mem_right _
            (I.add_mem (I.mul_mem_right _ <| this hx) (I.mul_mem_right _ <| this hy))))
#align is_localization.at_prime.local_ring IsLocalization.AtPrime.localRing

end IsLocalization

namespace Localization

/-- The localization of `R` at the complement of a prime ideal is a local ring. -/
instance AtPrime.localRing : LocalRing (Localization I.primeCompl) :=
  IsLocalization.AtPrime.localRing (Localization I.primeCompl) I
#align localization.at_prime.local_ring Localization.AtPrime.localRing

end Localization

end AtPrime

namespace IsLocalization

variable {A : Type _} [CommRing A] [IsDomain A]

/-- The localization of an integral domain at the complement of a prime ideal is an integral domain.
-/
instance isDomain_of_local_atPrime {P : Ideal A} (hp : P.IsPrime) :
    IsDomain (Localization.AtPrime P) :=
  isDomain_localization P.primeCompl_le_nonZeroDivisors
#align is_localization.is_domain_of_local_at_prime IsLocalization.isDomain_of_local_atPrime

namespace AtPrime

variable (I : Ideal R) [hI : I.IsPrime] [IsLocalization.AtPrime S I]

include hI

theorem isUnit_to_map_iff (x : R) : IsUnit ((algebraMap R S) x) ↔ x ∈ I.primeCompl :=
  ⟨fun h hx =>
    (isPrime_of_isPrime_disjoint I.primeCompl S I hI disjoint_compl_left).ne_top <|
      (Ideal.map (algebraMap R S) I).eq_top_of_isUnit_mem (Ideal.mem_map_of_mem _ hx) h,
    fun h => map_units S ⟨x, h⟩⟩
#align is_localization.at_prime.is_unit_to_map_iff IsLocalization.AtPrime.isUnit_to_map_iff

-- Can't use typeclasses to infer the `local_ring` instance, so use an `opt_param` instead
-- (since `local_ring` is a `Prop`, there should be no unification issues.)
theorem to_map_mem_maximal_iff (x : R) (h : LocalRing S := localRing S I) :
    algebraMap R S x ∈ LocalRing.maximalIdeal S ↔ x ∈ I :=
  not_iff_not.mp <| by
    simpa only [LocalRing.mem_maximalIdeal, mem_nonunits_iff, Classical.not_not] using
      is_unit_to_map_iff S I x
#align is_localization.at_prime.to_map_mem_maximal_iff IsLocalization.AtPrime.to_map_mem_maximal_iff

theorem comap_maximalIdeal (h : LocalRing S := localRing S I) :
    (LocalRing.maximalIdeal S).comap (algebraMap R S) = I :=
  Ideal.ext fun x => by simpa only [Ideal.mem_comap] using to_map_mem_maximal_iff _ I x
#align is_localization.at_prime.comap_maximal_ideal IsLocalization.AtPrime.comap_maximalIdeal

theorem isUnit_mk'_iff (x : R) (y : I.primeCompl) : IsUnit (mk' S x y) ↔ x ∈ I.primeCompl :=
  ⟨fun h hx => mk'_mem_iff.mpr ((to_map_mem_maximal_iff S I x).mpr hx) h, fun h =>
    isUnit_iff_exists_inv.mpr ⟨mk' S ↑y ⟨x, h⟩, mk'_mul_mk'_eq_one ⟨x, h⟩ y⟩⟩
#align is_localization.at_prime.is_unit_mk'_iff IsLocalization.AtPrime.isUnit_mk'_iff

theorem mk'_mem_maximal_iff (x : R) (y : I.primeCompl) (h : LocalRing S := localRing S I) :
    mk' S x y ∈ LocalRing.maximalIdeal S ↔ x ∈ I :=
  not_iff_not.mp <| by
    simpa only [LocalRing.mem_maximalIdeal, mem_nonunits_iff, Classical.not_not] using
      is_unit_mk'_iff S I x y
#align is_localization.at_prime.mk'_mem_maximal_iff IsLocalization.AtPrime.mk'_mem_maximal_iff

end AtPrime

end IsLocalization

namespace Localization

open IsLocalization

attribute [local instance] Classical.propDecidable

variable (I : Ideal R) [hI : I.IsPrime]

include hI

variable {I}

/-- The unique maximal ideal of the localization at `I.prime_compl` lies over the ideal `I`. -/
theorem AtPrime.comap_maximalIdeal :
    Ideal.comap (algebraMap R (Localization.AtPrime I))
        (LocalRing.maximalIdeal (Localization I.primeCompl)) =
      I :=
  AtPrime.comap_maximalIdeal _ _
#align localization.at_prime.comap_maximal_ideal Localization.AtPrime.comap_maximalIdeal

/-- The image of `I` in the localization at `I.prime_compl` is a maximal ideal, and in particular
it is the unique maximal ideal given by the local ring structure `at_prime.local_ring` -/
theorem AtPrime.map_eq_maximalIdeal :
    Ideal.map (algebraMap R (Localization.AtPrime I)) I =
      LocalRing.maximalIdeal (Localization I.primeCompl) :=
  by
  convert congr_arg (Ideal.map _) at_prime.comap_maximal_ideal.symm
  rw [map_comap I.prime_compl]
#align localization.at_prime.map_eq_maximal_ideal Localization.AtPrime.map_eq_maximalIdeal

theorem le_comap_primeCompl_iff {J : Ideal P} [hJ : J.IsPrime] {f : R →+* P} :
    I.primeCompl ≤ J.primeCompl.comap f ↔ J.comap f ≤ I :=
  ⟨fun h x hx => by
    contrapose! hx
    exact h hx, fun h x hx hfxJ => hx (h hfxJ)⟩
#align localization.le_comap_prime_compl_iff Localization.le_comap_primeCompl_iff

variable (I)

/-- For a ring hom `f : R →+* S` and a prime ideal `J` in `S`, the induced ring hom from the
localization of `R` at `J.comap f` to the localization of `S` at `J`.

To make this definition more flexible, we allow any ideal `I` of `R` as input, together with a proof
that `I = J.comap f`. This can be useful when `I` is not definitionally equal to `J.comap f`.
 -/
noncomputable def localRingHom (J : Ideal P) [hJ : J.IsPrime] (f : R →+* P) (hIJ : I = J.comap f) :
    Localization.AtPrime I →+* Localization.AtPrime J :=
  IsLocalization.map (Localization.AtPrime J) f (le_comap_primeCompl_iff.mpr (ge_of_eq hIJ))
#align localization.local_ring_hom Localization.localRingHom

theorem localRingHom_to_map (J : Ideal P) [hJ : J.IsPrime] (f : R →+* P) (hIJ : I = J.comap f)
    (x : R) : localRingHom I J f hIJ (algebraMap _ _ x) = algebraMap _ _ (f x) :=
  map_eq _ _
#align localization.local_ring_hom_to_map Localization.localRingHom_to_map

theorem localRingHom_mk' (J : Ideal P) [hJ : J.IsPrime] (f : R →+* P) (hIJ : I = J.comap f) (x : R)
    (y : I.primeCompl) :
    localRingHom I J f hIJ (IsLocalization.mk' _ x y) =
      IsLocalization.mk' (Localization.AtPrime J) (f x)
        (⟨f y, le_comap_primeCompl_iff.mpr (ge_of_eq hIJ) y.2⟩ : J.primeCompl) :=
  map_mk' _ _ _
#align localization.local_ring_hom_mk' Localization.localRingHom_mk'

instance isLocalRingHom_localRingHom (J : Ideal P) [hJ : J.IsPrime] (f : R →+* P)
    (hIJ : I = J.comap f) : IsLocalRingHom (localRingHom I J f hIJ) :=
  IsLocalRingHom.mk fun x hx =>
    by
    rcases IsLocalization.mk'_surjective I.prime_compl x with ⟨r, s, rfl⟩
    rw [local_ring_hom_mk'] at hx
    rw [at_prime.is_unit_mk'_iff] at hx⊢
    exact fun hr => hx ((set_like.ext_iff.mp hIJ r).mp hr)
#align localization.is_local_ring_hom_local_ring_hom Localization.isLocalRingHom_localRingHom

theorem localRingHom_unique (J : Ideal P) [hJ : J.IsPrime] (f : R →+* P) (hIJ : I = J.comap f)
    {j : Localization.AtPrime I →+* Localization.AtPrime J}
    (hj : ∀ x : R, j (algebraMap _ _ x) = algebraMap _ _ (f x)) : localRingHom I J f hIJ = j :=
  map_unique _ _ hj
#align localization.local_ring_hom_unique Localization.localRingHom_unique

@[simp]
theorem localRingHom_id : localRingHom I I (RingHom.id R) (Ideal.comap_id I).symm = RingHom.id _ :=
  localRingHom_unique _ _ _ _ fun x => rfl
#align localization.local_ring_hom_id Localization.localRingHom_id

@[simp]
theorem localRingHom_comp {S : Type _} [CommSemiring S] (J : Ideal S) [hJ : J.IsPrime] (K : Ideal P)
    [hK : K.IsPrime] (f : R →+* S) (hIJ : I = J.comap f) (g : S →+* P) (hJK : J = K.comap g) :
    localRingHom I K (g.comp f) (by rw [hIJ, hJK, Ideal.comap_comap f g]) =
      (localRingHom J K g hJK).comp (localRingHom I J f hIJ) :=
  localRingHom_unique _ _ _ _ fun r => by
    simp only [Function.comp_apply, RingHom.coe_comp, local_ring_hom_to_map]
#align localization.local_ring_hom_comp Localization.localRingHom_comp

end Localization


/-
Copyright © 2020 Nicolò Cavalleri. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nicolò Cavalleri, Sebastien Gouezel
-/

import topology.topological_fiber_bundle
import topology.algebra.module
import linear_algebra.dual

/-!
# Topological vector bundles

In this file we define topological vector bundles.

Let `B` be the base space. In our formalism, a topological vector bundle is by definition the type
`bundle.total_space E` where `E : B → Type*` is a function associating to
`x : B` the fiber over `x`. This type `bundle.total_space E` is just a type synonym for
`Σ (x : B), E x`, with the interest that one can put another topology than on `Σ (x : B), E x`
which has the disjoint union topology.

To have a topological vector bundle structure on `bundle.total_space E`,
one should addtionally have the following data:

* `F` should be a topological space and a module over a semiring `R`;
* There should be a topology on `bundle.total_space E`, for which the projection to `B` is
a topological fiber bundle with fiber `F` (in particular, each fiber `E x` is homeomorphic to `F`);
* For each `x`, the fiber `E x` should be a topological vector space over `R`, and the injection
from `E x` to `bundle.total_space F E` should be an embedding;
* The most important condition: around each point, there should be a bundle trivialization which
is a continuous linear equiv in the fibers.

If all these conditions are satisfied, we register the typeclass
`topological_vector_bundle R F E`. We emphasize that the data is provided by other classes, and
that the `topological_vector_bundle` class is `Prop`-valued.

The point of this formalism is that it is unbundled in the sense that the total space of the bundle
is a type with a topology, with which one can work or put further structure, and still one can
perform operations on topological vector bundles (which are yet to be formalized). For instance,
assume that `E₁ : B → Type*` and `E₂ : B → Type*` define two topological vector bundles over `R`
with fiber models `F₁` and `F₂` which are normed spaces. Then one can construct the vector bundle of
continuous linear maps from `E₁ x` to `E₂ x` with fiber `E x := (E₁ x →L[R] E₂ x)` (and with the
topology inherited from the norm-topology on `F₁ →L[R] F₂`, without the need to define the strong
topology on continuous linear maps between general topological vector spaces). Let
`vector_bundle_continuous_linear_map R F₁ E₁ F₂ E₂ (x : B)` be a type synonym for `E₁ x →L[R] E₂ x`.
Then one can endow
`bundle.total_space (vector_bundle_continuous_linear_map R F₁ E₁ F₂ E₂)`
with a topology and a topological vector bundle structure.

Similar constructions can be done for tensor products of topological vector bundles, exterior
algebras, and so on, where the topology can be defined using a norm on the fiber model if this
helps.
-/

noncomputable theory

open bundle set

variables (R : Type*) {B : Type*} (F : Type*) (E : B → Type*)
[semiring R] [∀ x, add_comm_monoid (E x)] [∀ x, module R (E x)]
[topological_space F] [add_comm_monoid F] [module R F]
[topological_space (total_space E)] [topological_space B]

section

/-- Local trivialization for vector bundles. -/
@[nolint has_inhabited_instance]
structure topological_vector_bundle.trivialization extends bundle_trivialization F (proj E) :=
(linear : ∀ x ∈ base_set, is_linear_map R (λ y : (E x), (to_fun y).2))

instance : has_coe_to_fun (topological_vector_bundle.trivialization R F E) :=
⟨λ _, (total_space E → B × F), λ e, e.to_bundle_trivialization⟩

instance : has_coe (topological_vector_bundle.trivialization R F E)
  (bundle_trivialization F (proj E)) :=
⟨topological_vector_bundle.trivialization.to_bundle_trivialization⟩

namespace topological_vector_bundle

variables {R F E}

lemma trivialization.mem_source (e : trivialization R F E)
  {x : total_space E} : x ∈ e.source ↔ proj E x ∈ e.base_set := bundle_trivialization.mem_source e

end topological_vector_bundle

end

variables [∀ x, topological_space (E x)]

/-- The space `total_space E` (for `E : B → Type*` such that each `E x` is a topological vector
space) has a topological vector space structure with fiber `F` (denoted with
`topological_vector_bundle R F E`) if around every point there is a fiber bundle trivialization
which is linear in the fibers. -/
class topological_vector_bundle : Prop :=
(inducing [] : ∀ (b : B), inducing (λ x : (E b), (id ⟨b, x⟩ : total_space E)))
(locally_trivial [] : ∀ b : B, ∃ e : topological_vector_bundle.trivialization R F E, b ∈ e.base_set)

variable [topological_vector_bundle R F E]

namespace topological_vector_bundle

/-- `trivialization_at R F E b` is some choice of trivialization of a vector bundle whose base set
contains a given point `b`. -/
def trivialization_at : Π b : B, trivialization R F E :=
λ b, classical.some (topological_vector_bundle.locally_trivial R F E b)

@[simp, mfld_simps] lemma mem_base_set_trivialization_at (b : B) :
  b ∈ (trivialization_at R F E b).base_set :=
classical.some_spec (topological_vector_bundle.locally_trivial R F E b)

@[simp, mfld_simps] lemma mem_source_trivialization_at (z : total_space E) :
  z ∈ (trivialization_at R F E z.1).source :=
by { rw bundle_trivialization.mem_source, apply mem_base_set_trivialization_at }

variables {R F E}

/-- In a topological vector bundle, a trivialization in the fiber (which is a priori only linear)
is in fact a continuous linear equiv between the fibers and the model fiber. -/
def trivialization.continuous_linear_equiv_at (e : trivialization R F E) (b : B)
  (hb : b ∈ e.base_set) : E b ≃L[R] F :=
{ to_fun := λ y, (e ⟨b, y⟩).2,
  inv_fun := λ z, begin
    have : ((e.to_local_homeomorph.symm) (b, z)).fst = b :=
      bundle_trivialization.proj_symm_apply' _ hb,
    have C : E ((e.to_local_homeomorph.symm) (b, z)).fst = E b, by rw this,
    exact cast C (e.to_local_homeomorph.symm (b, z)).2
  end,
  left_inv := begin
    assume v,
    rw [← heq_iff_eq],
    apply (cast_heq _ _).trans,
    have A : (b, (e ⟨b, v⟩).snd) = e ⟨b, v⟩,
    { refine prod.ext _ rfl,
      symmetry,
      exact bundle_trivialization.coe_fst' _ hb },
    have B : e.to_local_homeomorph.symm (e ⟨b, v⟩) = ⟨b, v⟩,
    { apply local_homeomorph.left_inv_on,
      rw bundle_trivialization.mem_source,
      exact hb },
    rw [A, B],
  end,
  right_inv := begin
    assume v,
    have B : e (e.to_local_homeomorph.symm (b, v)) = (b, v),
    { apply local_homeomorph.right_inv_on,
      rw bundle_trivialization.mem_target,
      exact hb },
    have C : (e (e.to_local_homeomorph.symm (b, v))).2 = v, by rw [B],
    conv_rhs { rw ← C },
    dsimp,
    congr,
    ext,
    { exact (bundle_trivialization.proj_symm_apply' _ hb).symm },
    { exact (cast_heq _ _).trans (by refl) },
  end,
  map_add' := λ v w, (e.linear _ hb).map_add v w,
  map_smul' := λ c v, (e.linear _ hb).map_smul c v,
  continuous_to_fun := begin
    refine continuous_snd.comp _,
    apply continuous_on.comp_continuous e.to_local_homeomorph.continuous_on
      (topological_vector_bundle.inducing R F E b).continuous (λ x, _),
    rw bundle_trivialization.mem_source,
    exact hb,
  end,
  continuous_inv_fun := begin
    rw (topological_vector_bundle.inducing R F E b).continuous_iff,
    dsimp,
    have : continuous (λ (z : F), (e.to_bundle_trivialization.to_local_homeomorph.symm) (b, z)),
    { apply e.to_local_homeomorph.symm.continuous_on.comp_continuous
        (continuous_const.prod_mk continuous_id') (λ z, _),
      simp only [bundle_trivialization.mem_target, hb, local_equiv.symm_source,
        local_homeomorph.symm_to_local_equiv] },
    convert this,
    ext z,
    { exact (bundle_trivialization.proj_symm_apply' _ hb).symm },
    { exact cast_heq _ _ },
  end }

@[simp] lemma trivialization.continuous_linear_equiv_at_apply (e : trivialization R F E) (b : B)
  (hb : b ∈ e.base_set) (y : E b) : e.continuous_linear_equiv_at b hb y = (e ⟨b, y⟩).2 := rfl

@[simp] lemma trivialization.continuous_linear_equiv_at_apply' (e : trivialization R F E)
  (x : total_space E) (hx : x ∈ e.source) :
  e.continuous_linear_equiv_at (proj E x) (e.mem_source.1 hx) x.2 = (e x).2 :=
by { cases x, refl }

section
local attribute [reducible] bundle.trivial

instance {B : Type*} {F : Type*} [add_comm_monoid F] (b : B) :
  add_comm_monoid (bundle.trivial B F b) := ‹add_comm_monoid F›

instance {B : Type*} {F : Type*} [add_comm_group F] (b : B) :
  add_comm_group (bundle.trivial B F b) := ‹add_comm_group F›

instance {B : Type*} {F : Type*} [add_comm_monoid F] [module R F] (b : B) :
  module R (bundle.trivial B F b) := ‹module R F›

end

variables (R B F)
/-- Local trivialization for trivial bundle. -/
def trivial_bundle_trivialization : trivialization R F (bundle.trivial B F) :=
{ to_fun := λ x, (x.fst, x.snd),
  inv_fun := λ y, ⟨y.fst, y.snd⟩,
  source := univ,
  target := univ,
  map_source' := λ x h, mem_univ (x.fst, x.snd),
  map_target' :=λ y h,  mem_univ ⟨y.fst, y.snd⟩,
  left_inv' := λ x h, sigma.eq rfl rfl,
  right_inv' := λ x h, prod.ext rfl rfl,
  open_source := is_open_univ,
  open_target := is_open_univ,
  continuous_to_fun := by { rw [←continuous_iff_continuous_on_univ, continuous_iff_le_induced],
    simp only [prod.topological_space, induced_inf, induced_compose], exact le_refl _, },
  continuous_inv_fun := by { rw [←continuous_iff_continuous_on_univ, continuous_iff_le_induced],
    simp only [bundle.total_space.topological_space, induced_inf, induced_compose],
    exact le_refl _, },
  base_set := univ,
  open_base_set := is_open_univ,
  source_eq := rfl,
  target_eq := by simp only [univ_prod_univ],
  proj_to_fun := λ y hy, rfl,
  linear := λ x hx, ⟨λ y z, rfl, λ c y, rfl⟩ }

instance trivial_bundle.topological_vector_bundle :
  topological_vector_bundle R F (bundle.trivial B F) :=
{ locally_trivial := λ x, ⟨trivial_bundle_trivialization R B F, mem_univ x⟩,
  inducing := λ b, ⟨begin
    have : (λ (x : trivial B F b), x) = @id F, by { ext x, refl },
    simp only [total_space.topological_space, induced_inf, induced_compose, function.comp, proj,
      induced_const, top_inf_eq, trivial.proj_snd, id.def, trivial.topological_space, this,
      induced_id],
  end⟩ }

variables {R B F}

/- Not registered as an instance because of a metavariable. -/
lemma is_topological_vector_bundle_is_topological_fiber_bundle :
  is_topological_fiber_bundle F (proj E) :=
λ x, ⟨(trivialization_at R F E x).to_bundle_trivialization, mem_base_set_trivialization_at R F E x⟩

end topological_vector_bundle


import M4R.Algebra.Ring.Radical
import M4R.Algebra.Ring.Field

namespace M4R
  open NCRing Semiring NCSemiring Group CommMonoid Monoid

  structure MultiplicativeSet (α : Type _) [Ring α] where
    subset     : Set α
    has_one    : 1 ∈ subset
    mul_closed : ∀ {a b : α}, a ∈ subset → b ∈ subset → a * b ∈ subset
  instance MultiplicativeSet.MultiplicativeSetMem [Ring α]: Mem α (MultiplicativeSet α) where mem := fun x S => x ∈ S.subset

  theorem MultiplicativeSet.disjoint_ideal_proper [Ring α] {S : MultiplicativeSet α}
    {I : Ideal α} (hIS : Set.disjoint I.subset S.subset) : I.proper_ideal := fun h =>
      absurd (Ideal.is_unit_ideal.mp h) (Set.disjoint.elementwise.mp (hIS.comm) 1 S.has_one)

  theorem MultiplicativeSet.pow_closed [Ring α] (S : MultiplicativeSet α) {a : α} (ha : a ∈ S) (n : Nat) :
    a ^ n ∈ S := by
      induction n with
      | zero => exact S.has_one
      | succ n ih => exact pow_nat_succ a n ▸ S.mul_closed ih ha

  def PrimeComp [Ring α] {P : Ideal α} (hP : P.is_prime) : MultiplicativeSet α where
    subset     := P.subsetᶜ
    has_one    := Ideal.proper_iff_1_notin.mp hP.left
    mul_closed := fun h₁ h₂ h₃ => Or.elim (hP.right _ _ h₃) h₁ h₂

  theorem PrimeComp.disjoint [Ring α] {P : Ideal α} (hP : P.is_prime) : Set.disjoint P.subset (PrimeComp hP).subset :=
    Set.disjoint.elementwise.mpr fun _ => iff_not_not.mpr

  theorem PrimeComp.disjoint_subset [Ring α] {P : Ideal α} (hP : P.is_prime) {I : Ideal α} (hIP : I ⊆ P) : Set.disjoint I.subset (PrimeComp hP).subset :=
    Set.ext.mp fun x => ⟨fun hx => absurd (hIP hx.left) hx.right, fun _ => by contradiction⟩

  def frac [Ring α] (S : MultiplicativeSet α) := α × ↑S.subset

  namespace frac
    variable [Ring α] {S : MultiplicativeSet α} (f : frac S)

    protected abbrev mk (r : α) ⦃s : α⦄ (hs : s ∈ S) : frac S := (r, ⟨s, hs⟩)

    abbrev num : α := f.fst
    abbrev denom : α := f.snd.val
    abbrev num_eq (r : α) {s : α} (hs : s ∈ S) : (frac.mk r hs).num = r := rfl
    abbrev denom_eq (r : α) {s : α} (hs : s ∈ S) : (frac.mk r hs).denom = s := rfl
    theorem denom_in_S : denom f ∈ S := f.snd.property

    theorem ext : ∀ {x y : frac S},  x = y ↔ x.num = y.num ∧ x.denom = y.denom
    | (x₁, x₂), (y₁, y₂) =>
      ⟨fun h => have ⟨h₁, h₂⟩ := Prod.mk.inj h; ⟨h₁, congrArg Subtype.val h₂⟩,
       fun ⟨h₁, h₂⟩ => Prod.mk.injEq x₁ x₂ y₁ y₂ ▸ ⟨h₁, Set.elementExt h₂⟩⟩

    protected def r (x y : frac S) : Prop := ∃ s ∈ S, s * x.num * y.denom = s * y.num * x.denom

    protected instance setoid (S : MultiplicativeSet α) : Setoid (frac S) where
      r     := frac.r
      iseqv := {
        refl  := fun _ => ⟨1, S.has_one, rfl⟩
        symm  := fun ⟨s, hs, h⟩ => ⟨s, hs, h.symm⟩
        trans := by
          intro x y z ⟨s₁, hs₁, h₁⟩ ⟨s₂, hs₂, h₂⟩
          exact ⟨s₁ * s₂ * y.denom, S.mul_closed (S.mul_closed hs₁ hs₂) y.denom_in_S, by
            rw [mul_right_comm s₁, mul_right_comm _ s₂, mul_right_comm s₁, h₁]
            conv => rhs rw [mul_right_comm s₁, mul_right_comm _ y.denom, mul_assoc _ z.num,
              mul_assoc s₁, ←mul_assoc s₂, ←h₂, mul_right_comm s₂, ←mul_assoc, mul_right_comm s₁,
              mul_right_comm _ _ x.denom, ←mul_assoc]⟩
      }

  end frac

  def localisation [Ring α] (S : MultiplicativeSet α) := Quotient (frac.setoid S)

  namespace localisation
    variable [Ring α] {S : MultiplicativeSet α}

    def of_frac : frac S → localisation S := Quotient.mk

    abbrev of_frac' (r : α) {s : α} (hs : s ∈ S) : localisation S :=
      of_frac (frac.mk r hs)

    theorem equiv {x y : frac S} : of_frac x = of_frac y ↔
      ∃ s ∈ S, s * x.num * y.denom = s * y.num * x.denom :=
        ⟨Quotient.exact, @Quotient.sound (frac S) (frac.setoid S) x y⟩

    theorem equiv' {r₁ r₂ s₁ s₂ : α} {hs₁ : s₁ ∈ S} {hs₂ : s₂ ∈ S} :
      of_frac' r₁ hs₁ = of_frac' r₂ hs₂ ↔ ∃ s ∈ S, s * r₁ * s₂ = s * r₂ * s₁ := equiv

    protected instance zero_inst : Zero (localisation S) where zero := of_frac' 0 S.has_one
    protected theorem zero_def : (0 : localisation S) = of_frac' 0 S.has_one := rfl
    protected instance one_inst : One (localisation S) where one := of_frac' 1 S.has_one
    protected theorem one_def : (1 : localisation S) = of_frac' 1 S.has_one := rfl

    protected def add : localisation S → localisation S → localisation S :=
      Function.Quotient.map₂ _ _ _ (frac.setoid S).refl (frac.setoid S).refl
        (fun x y => frac.mk (x.num * y.denom + y.num * x.denom) (S.mul_closed x.denom_in_S y.denom_in_S))
        fun a₁ a₂ b₁ b₂ ⟨sa, hsaS, hsae⟩ ⟨sb, hsbS, hsbe⟩ =>
          ⟨sa * sb, S.mul_closed hsaS hsbS, (by
            simp only [mul_distrib_left, mul_distrib_right, ←mul_assoc]
            rw [mul_right_comm sa, mul_right_comm _ _ a₂.denom, mul_right_comm _ _ a₂.denom, hsae,
              mul_right_comm, mul_right_comm _ a₁.denom, mul_right_comm _ a₁.denom, mul_right_comm sa]
            conv => lhs rhs rw [mul_right_comm, mul_right_comm _ _ b₂.denom, mul_assoc sa, mul_assoc sa, hsbe,
              ←mul_assoc, ←mul_assoc, mul_right_comm, mul_right_comm _ b₁.denom, mul_right_comm _ b₁.denom] :
            sa * sb * (a₁.num * b₁.denom + b₁.num * a₁.denom) * (a₂.denom * b₂.denom)
              = sa * sb * (a₂.num * b₂.denom + b₂.num * a₂.denom) * (a₁.denom * b₁.denom))⟩
    protected instance add_inst : Add (localisation S) where add := localisation.add

    protected def neg : localisation S → localisation S :=
      Function.Quotient.map _ _ (fun f => frac.mk (-f.num) f.denom_in_S)
        fun a₁ a₂ ⟨s, hsS, hse⟩ => ⟨s, hsS, (by simp only [mul_neg, neg_mul, hse] :
          s * -a₁.num * a₂.denom = s * -a₂.num * a₁.denom)⟩
    protected instance neg_inst : Neg (localisation S) where neg := localisation.neg

    protected def mul : localisation S → localisation S → localisation S :=
      Function.Quotient.map₂ _ _ _ (frac.setoid S).refl (frac.setoid S).refl
        (fun x y => frac.mk (x.num * y.num) (S.mul_closed x.denom_in_S y.denom_in_S))
        fun a₁ a₂ b₁ b₂ ⟨sa, hsaS, hsae⟩ ⟨sb, hsbS, hsbe⟩ =>
          ⟨sa * sb, S.mul_closed hsaS hsbS, (by
            simp only [←mul_assoc]; rw [mul_right_comm _ _ a₂.denom, mul_right_comm sa,
              mul_right_comm _ sb, hsae, mul_assoc, mul_assoc, ←mul_assoc sb, hsbe,
              ←mul_assoc, ←mul_assoc, mul_right_comm _ _ sb, mul_right_comm sa, mul_right_comm _ a₁.denom] :
              sa * sb * (frac.num a₁ * frac.num b₁) * (frac.denom a₂ * frac.denom b₂) =
                sa * sb * (frac.num a₂ * frac.num b₂) * (frac.denom a₁ * frac.denom b₁))⟩
    protected instance mul_inst : Mul (localisation S) where mul := localisation.mul

    protected instance ring (S : MultiplicativeSet α) : Ring (localisation S) := Ring.construct {
      add_zero := Quot.ind fun _ => Quot.sound ⟨1, S.has_one, by
        simp only [frac.denom_eq, mul_one, zero_mul, add_zero]⟩
      add_assoc := Function.Quotient.ind₃ _ _ _ fun x y z => Quot.sound ⟨1, S.has_one, by
        simp only [one_mul, mul_distrib_left, mul_distrib_right, ←mul_assoc, ←add_assoc]
        conv => rhs rw [mul_right_comm y.num, mul_right_comm z.num]⟩
      add_neg := Quot.ind fun _ => Quot.sound ⟨1, S.has_one, by
        simp only [one_mul, mul_one, zero_mul, ←mul_distrib_right, Group.add_neg]⟩
      add_comm := Quotient.ind₂ fun x y => Quot.sound ⟨1, S.has_one, by
        simp only [frac.num_eq, frac.denom_eq]; rw [add_comm, mul_comm y.denom]⟩
      mul_one := Quot.ind fun _ => Quot.sound ⟨1, S.has_one, by
        simp only [frac.denom_eq, mul_one]⟩
      mul_assoc := Function.Quotient.ind₃ _ _ _ fun _ _ _ => Quot.sound ⟨1, S.has_one, by
        simp only [←mul_assoc]⟩
      mul_distrib_left := Function.Quotient.ind₃ _ _ _ fun x y z => Quot.sound ⟨1, S.has_one, by
        simp only [frac.num_eq, frac.denom_eq, one_mul]; rw [mul_distrib_left]
        conv => rhs rw [mul_comm x.denom, mul_comm x.denom, mul_left_comm x.denom,
          ←mul_assoc _ _ x.denom, ←mul_assoc _ _ x.denom, ←mul_distrib_right]
        simp only [←mul_assoc]⟩
      mul_comm := Quotient.ind₂ fun x y => Quot.sound ⟨1, S.has_one, by
        simp only [frac.num_eq, frac.denom_eq]; rw [mul_comm y.num, mul_comm y.denom]⟩
    }

    protected theorem trivial : (1 : localisation S) = (0 : localisation S) ↔ 0 ∈ S :=
      ⟨fun h => by
        rw [localisation.one_def, localisation.zero_def] at h
        let ⟨s, hs, he⟩ := equiv.mp h
        simp only [mul_one, mul_zero] at he
        exact he ▸ hs,
      fun h => by
        rw [localisation.one_def, localisation.zero_def]
        exact equiv.mpr ⟨0, h, by simp only [zero_mul]⟩⟩

    protected theorem nontrivial : (localisation.ring S).is_NonTrivial ↔ 0 ∉ S :=
      not_iff_not.mpr localisation.trivial

    def natural_hom (S : MultiplicativeSet α) : α →ᵣ₁ localisation S where
      hom           := (of_frac' · S.has_one)
      preserve_zero := rfl
      preserve_add  := fun _ _ => equiv.mpr ⟨1, S.has_one, by simp only [frac.denom_eq, mul_one]⟩
      preserve_one  := rfl
      preserve_mul  := fun _ _ => equiv.mpr ⟨1, S.has_one, by simp only [frac.denom_eq, mul_one]⟩
      preserve_neg  := fun _ => rfl

    theorem natural_hom_def (S : MultiplicativeSet α) (r : α) : natural_hom S r = of_frac' r S.has_one := rfl

    theorem natural_hom_factor (r : α) {s : α} (hs : s ∈ S) :
      of_frac' r hs = of_frac' 1 hs * natural_hom S r :=
        equiv'.mpr ⟨1, S.has_one, by simp only [one_mul, mul_one]⟩

    noncomputable def localise_ideal (S : MultiplicativeSet α) : Ideal α → Ideal (localisation S) :=
      Ideal.extension (natural_hom S)

    def delocalise_ideal (S : MultiplicativeSet α) : Ideal (localisation S) → Ideal α :=
      Ideal.contractionᵣ₁ (natural_hom S)

    theorem localise_ideal.contains_mul {I : Ideal α} {r s : α} (hr : r ∈ I) (hs : s ∈ S) :
      of_frac' r hs ∈ localise_ideal S I :=
        natural_hom_factor r hs ▸ Ideal.from_set.contains_mem_mul _ ⟨r, hr, rfl⟩

    theorem exists_frac (x : localisation S) : ∃ (r s : α) (hs : s ∈ S), x = of_frac' r hs :=
      @Quot.ind _ _ (fun x : localisation S => ∃ (r s : α) (hs : s ∈ S), x = of_frac' r hs)
        (fun f => ⟨f.num, f.denom, f.denom_in_S, equiv.mpr ⟨1, S.has_one, rfl⟩⟩) x

    protected theorem localise_ideal.exists_frac {I : Ideal α} {x : localisation S} :
      x ∈ localise_ideal S I ↔ ∃ (r s : α) (hr : r ∈ I) (hs : s ∈ S), x = of_frac' r hs := ⟨fun hx =>
        Ideal.from_set.induction (fun x => ∃ (r s : α) (hr : r ∈ I) (hs : s ∈ S), x = of_frac' r hs) hx
          ⟨0, 1, I.has_zero, S.has_one, rfl⟩
          (fun x ⟨y, hy, he⟩ => ⟨y, 1, hy, S.has_one, he.symm⟩)
          (fun x y ⟨rx, sx, hrx, hsx, hex⟩ ⟨ry, sy, hry, hsy, hey⟩ => ⟨rx * sy + ry * sx, sx * sy,
            I.add_closed (I.mul_closed' hrx sy) (I.mul_closed' hry sx), S.mul_closed hsx hsy,
            by rw [hex, hey]; rfl⟩)
          (fun x y ⟨r, s, hr, hs, he⟩ =>
            @Quot.ind _ _ (fun x : localisation S => ∃ (r s : α) (hr : r ∈ I) (hs : s ∈ S), x * y = of_frac' r hs)
              (fun f => ⟨f.num * r, f.denom * s, I.mul_closed f.num hr, S.mul_closed f.denom_in_S hs, he ▸ rfl⟩) x),
        fun ⟨r, s, hr, hs, he⟩ => he ▸ localise_ideal.contains_mul hr hs⟩

    theorem is_unit {r s : α} (hr : r ∈ S) (hs : s ∈ S) :
      isUnit (of_frac' r hs) :=
        ⟨of_frac' s hr, equiv.mpr ⟨1, S.has_one, by simp only [mul_one, one_mul]; exact mul_comm r s⟩⟩

    theorem localise_ideal.proper {I : Ideal α} :
      (localise_ideal S I).proper_ideal ↔ Set.disjoint I.subset S.subset :=
        not_iff_not.mp ⟨fun h => by
          apply Set.disjoint.not_disjoint_iff_nonempty.mpr
          let ⟨r, s, hr, hs, he⟩ := localise_ideal.exists_frac.mp (Ideal.is_unit_ideal.mp (of_not_not h))
          rw [localisation.one_def] at he
          let ⟨t, ht, he⟩ := equiv.mp he
          simp only [mul_one] at he
          exact ⟨t * r, I.mul_closed t hr, he ▸ S.mul_closed ht hs⟩,
        fun h =>
          let ⟨s, hsI, hsS⟩ := Set.disjoint.not_disjoint_iff_nonempty.mp h
          iff_not_not.mpr (Ideal.is_unit_ideal'.mpr ⟨of_frac' s hsS, is_unit hsS hsS,
            localise_ideal.contains_mul hsI hsS⟩)⟩

    theorem localise_ideal.primary_numerator {Q : Ideal α} (hQ : Q.is_primary) (hQS : Set.disjoint Q.subset S.subset)
      {r s : α} {hs : s ∈ S} : of_frac' r hs ∈ localise_ideal S Q ↔ r ∈ Q := ⟨fun h => by
        let ⟨r', s', hr', hs', he⟩ := localise_ideal.exists_frac.mp h
        let ⟨t, ht, he⟩ := equiv.mp he
        rw [mul_right_comm] at he
        exact (hQ.right r (t * s') (by rw [mul_comm, he, mul_right_comm]; exact Q.mul_closed _ hr')).resolve_right
          (fun ⟨n, hn, h⟩ => Set.disjoint.elementwise.mp hQS _ h (S.pow_closed (S.mul_closed ht hs') n)),
        fun hr => localise_ideal.exists_frac.mpr ⟨r, s, hr, hs, rfl⟩⟩

    theorem localise_ideal.primary_loc_deloc {Q : Ideal α} (hQ : Q.is_primary) (hQS : Set.disjoint Q.subset S.subset) :
      delocalise_ideal S (localise_ideal S Q) = Q :=
        Ideal.antisymm (fun a ha => (localise_ideal.primary_numerator hQ hQS).mp ha) (Ideal.extension_contraction _ Q)

    theorem localise_ideal.prime_numerator {P : Ideal α} (hP : P.is_prime) (hPS : Set.disjoint P.subset S.subset)
      {r s : α} {hs : s ∈ S} : of_frac' r hs ∈ localise_ideal S P ↔ r ∈ P := primary_numerator (Ideal.is_primary_of_prime hP) hPS

    theorem localise_ideal.prime_loc_deloc {P : Ideal α} (hP : P.is_prime) (hPS : Set.disjoint P.subset S.subset) :
      delocalise_ideal S (localise_ideal S P) = P := primary_loc_deloc (Ideal.is_primary_of_prime hP) hPS

    theorem localise_ideal.prime {P : Ideal α} (hP : P.is_prime) (hPS : Set.disjoint P.subset S.subset) :
      (localise_ideal S P).is_prime := ⟨localise_ideal.proper.mpr hPS,
        fun x y hxy => by
          let ⟨rx, sx, hsx, hex⟩ := exists_frac x
          let ⟨ry, sy, hsy, hey⟩ := exists_frac y
          have : x * y = of_frac' (rx * ry) (S.mul_closed hsx hsy) := by rw [hex, hey]; rfl
          rw [this] at hxy
          exact Or.imp (hex ▸ (localise_ideal.prime_numerator hP hPS).mpr)
            (hey ▸ (localise_ideal.prime_numerator hP hPS).mpr)
            (hP.right rx ry ((localise_ideal.prime_numerator hP hPS).mp hxy))⟩

    theorem delocalise_ideal.prime {P : Ideal (localisation S)} (hP : P.is_prime) :
      (delocalise_ideal S P).is_prime := Ideal.contraction_prime _ hP

    theorem delocalise_ideal.deloc_loc (I : Ideal (localisation S)) :
      localise_ideal S (delocalise_ideal S I) = I :=
        Ideal.antisymm (Ideal.contraction_extension _ I)
          fun x hx =>
            let ⟨r, s, hs, he⟩ := exists_frac x
            have : r ∈ delocalise_ideal S I :=
              have : natural_hom S r = of_frac' s S.has_one * of_frac' r hs :=
                equiv'.mpr ⟨1, S.has_one, by simp only [one_mul, mul_one]; exact mul_comm r s⟩
              (this ▸ I.mul_closed _ (he ▸ hx) : _ ∈ I)
            he ▸ localise_ideal.contains_mul this hs

    theorem localise_ideal.principal (S : MultiplicativeSet α) (a : α) :
      localise_ideal S (Ideal.principal a) = Ideal.principal (natural_hom S a) :=
        Ideal.extension_principal (natural_hom S).toRMulMap a

    abbrev localisationₚ [Ring α] {P : Ideal α} (hP : P.is_prime) := localisation (PrimeComp hP)

    noncomputable def localiseₚ [Ring α] {P : Ideal α} (hP : P.is_prime) (I : Ideal α) :
      Ideal (localisationₚ hP) := localise_ideal (PrimeComp hP) I

    def delocaliseₚ [Ring α] {P : Ideal α} (hP : P.is_prime) (I : Ideal (localisationₚ hP)) :
      Ideal α := delocalise_ideal (PrimeComp hP) I

    abbrev natural_homₚ [Ring α] {P : Ideal α} (hP : P.is_prime) : α →ᵣ₁ localisationₚ hP := natural_hom (PrimeComp hP)

    theorem localisationₚ.is_max [Ring α] {P : Ideal α} (hP : P.is_prime) :
      ∀ I, I.is_maximal ↔ I = localiseₚ hP P :=
        have : ∀ I : Ideal (localisationₚ hP), I ⊈ localiseₚ hP P → I = 1 := fun I hI =>
          let ⟨x, hx₁, hx₂⟩ := NotSubset.exists_def.mp hI
          Ideal.is_unit_ideal'.mpr ⟨x,
            let ⟨r, s, hs, he⟩ := exists_frac x
            he ▸ is_unit (fun hr => hx₂ (localise_ideal.exists_frac.mpr ⟨r, s, hr, hs, he⟩)) hs, hx₁⟩
        fun I =>
          ⟨fun hI => ((hI.right (of_not_not (mt (this I) hI.left))).resolve_right
            (localise_ideal.proper.mpr (PrimeComp.disjoint hP))).symm,
          fun h => by rw [h]; exact ⟨localise_ideal.proper.mpr (PrimeComp.disjoint hP), fun hJ =>
            or_iff_not_imp_left.mpr fun h => this _ fun h' => h (Ideal.antisymm h' hJ)⟩⟩

    theorem localisationₚ.maximal [Ring α] {P : Ideal α} (hP : P.is_prime) : (localiseₚ hP P).is_maximal :=
      (localisationₚ.is_max hP _).mpr rfl

    theorem localisationₚ.prime [Ring α] {P : Ideal α} (hP : P.is_prime) : (localiseₚ hP P).is_prime :=
      Ideal.maximal_is_prime (maximal hP)

    noncomputable def symbolic_power [Ring α] {P : Ideal α} (hP : P.is_prime) (n : Nat) : Ideal α :=
      delocaliseₚ hP (localiseₚ hP (P ^ n))

    namespace symbolic_power
      theorem zero_eq_unit [Ring α] {P : Ideal α} (hP : P.is_prime) : symbolic_power hP 0 = 1 :=
        Ideal.antisymm (Ideal.in_unit_ideal _) (fun x hx => Ideal.from_set.contains_mem ⟨x, hx, rfl⟩)

      theorem primary [Ring α] {P : Ideal α} (hP : P.is_prime) {n : Nat} (hn : n ≠ 0) : (symbolic_power hP n).is_primary := by
        have h₁ : localiseₚ hP (P ^ n) = localiseₚ hP P ^ n := Ideal.extension_pow (natural_hom (PrimeComp hP)).toRMulMap P hn
        have h₂ : ((localiseₚ hP P) ^ n).is_primary := Ideal.is_primary_of_radical_maximal (by
          rw [Ideal.radical_pow_of_prime (Ideal.maximal_is_prime (localisationₚ.maximal hP)) n hn]; exact localisationₚ.maximal hP)
        simp only [symbolic_power, h₁]; exact Ideal.contraction_is_primary _ h₂

      theorem proper [Ring α] {P : Ideal α} (hP : P.is_prime) {n : Nat} (hn : n ≠ 0) : (symbolic_power hP n).proper_ideal :=
        (primary hP hn).left

      theorem rad_eq [Ring α] {P : Ideal α} (hP : P.is_prime) {n : Nat} (hn : n ≠ 0) : (symbolic_power hP n).radical = P := by
        simp only [symbolic_power]
        have h₁ : localiseₚ hP (P ^ n) = localiseₚ hP P ^ n := Ideal.extension_pow (natural_hom (PrimeComp hP)).toRMulMap P hn
        have h₂ : delocaliseₚ hP (localiseₚ hP P ^ n).radical = (delocaliseₚ hP (localiseₚ hP P ^ n)).radical :=
          Ideal.contraction_radical (natural_hom (PrimeComp hP)) (localiseₚ hP P ^ n)
        have h₃ : (localiseₚ hP P ^ n).radical = localiseₚ hP P := Ideal.radical_pow_of_prime (localisationₚ.prime hP) n hn
        rw [h₁, ←h₂, h₃]; exact localise_ideal.prime_loc_deloc hP (PrimeComp.disjoint hP)

      theorem descending [Ring α] {P : Ideal α} (hP : P.is_prime) (n : Nat) : symbolic_power hP n.succ ⊆ symbolic_power hP n :=
        Ideal.contraction.subset (natural_hom (PrimeComp hP)).preserve_mul_right (Ideal.extension.subset _ (Ideal.product.pow_succ_subset P n))

      theorem subset_base [Ring α] {P : Ideal α} (hP : P.is_prime) {n : Nat} (hn : n ≠ 0) : symbolic_power hP n ⊆ P := by
        have := Ideal.radical.sub_self (symbolic_power hP n); rw [rad_eq hP hn] at this; exact this
    end symbolic_power
  end localisation

end M4R


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_numbertheory_345 :
  (2000 + 2001 + 2002 + 2003 + 2004 + 2005 + 2006) % 7 = 0 :=
begin
  norm_num,
end


import Std.Data.List.Lemmas
import Playground.Data.Fin.Family.Basic
import Playground.Data.Fin.Family.Sum
namespace Logic

section
  structure FOL where
    function : Nat → Type
    relation : Nat → Type
    fdeq : ∀ n, DecidableEq (function n)
    rdeq : ∀ n, DecidableEq (relation n)

  instance (language : FOL) (n) : DecidableEq (language.function n) := language.fdeq n
  instance (language : FOL) (n) : DecidableEq (language.relation n) := language.rdeq n

  abbrev Var := Nat
  abbrev PropVar := Nat

  variable (language : FOL) in
  inductive Term
  | var : Var → Term
  | app : (n : Nat) → language.function n → (Fin n → Term) → Term

  variable (language : FOL) in
  inductive Formula
  | and : Formula → Formula → Formula
  | or : Formula → Formula → Formula
  | imp : Formula → Formula → Formula
  | bot : Formula
  | propVar : PropVar → Formula
  | app : (n : Nat) → language.relation n → (Fin n → Term language) → Formula
  | all : Var → Formula → Formula
  | ex : Var → Formula → Formula
  | eq : Term language → Term language → Formula

  scoped infixr:35 " ∧ "   => Formula.and
  scoped infixr:30 " ∨  "  => Formula.or
  scoped infixr:2 " ⇒ "   => Formula.imp
  scoped notation:max "⊥" => Formula.bot
  scoped notation:max "¬" p => (p ⇒ ⊥)
  scoped notation:max "∀ " x "; " f => Formula.all x f
  scoped notation:max "∃ " x "; " f => Formula.ex x f
  scoped infixr:50 " ≡ " => Formula.eq

  section
    variable {language : FOL}

    inductive Term.Mem (v : Var) : Term language → Prop
    | var : (var v).Mem v
    | app {n} {f} {l} {k} : (l k).Mem v → (app n f l).Mem v

    instance : Membership Var (Term language) where mem := Term.Mem

    namespace Term.Mem
    theorem Mem_var_iff (v : Var) (x)
      : v ∈ (Term.var (language := language) x) ↔ v = x := ⟨
        let motive : (t : Term language) → v ∈ t → Prop :=
          λ | .var x', _ => v = x' | _, _ => True
        rec (motive := motive) rfl (λ _ _ => trivial)
        , λ h => h ▸ .var⟩

    theorem Mem_app_iff (v : Var) (n) (f) (l)
      : v ∈ (Term.app (language := language) n f l) ↔ ∃ k, v ∈ l k := ⟨
      let motive : (t : Term language) → v ∈ t → Prop :=
        λ | .app _ _ l', _ => ∃ k, v ∈ l' k | _, _ => True
      rec (motive := motive) (by simp) (λ hk _ => ⟨_, hk⟩)
      , λ ⟨_, hk⟩ => .app hk⟩

    def decidable_Mem (v : Var) : (t : Term language) → Decidable (v ∈ t)
      | .var x => by
        rw [Mem_var_iff]
        infer_instance
      | .app n f l => by
        rw [Mem_app_iff]
        let r k := decidable_Mem v (l k)
        infer_instance

    instance (v : Var) : (t : Term language) → Decidable (v ∈ t) := decidable_Mem v

    end Term.Mem

    def Term.decidable_Eq : DecidableEq (Term language)
    | var .., app ..
    | app .., var .. => isFalse Term.noConfusion
    | var .., var .. => by rw [var.injEq]; infer_instance
    | app n f l, app n' f' l' => by
      rw [app.injEq]
      exact if hn : n = n' then by
        subst hn
        let _ := λ k => decidable_Eq (l k) (l' k)
        simp; infer_instance
      else isFalse λ c => hn c.1

    instance : DecidableEq (Term language) := Term.decidable_Eq

    def Formula.decidable_Eq : DecidableEq (Formula language)
    | propVar .., propVar .. => by rw [propVar.injEq]; infer_instance
    | and .., or .. | and .., imp .. | and .., bot .. | and .., propVar ..
    | and .., app .. | and .., all .. | and .., ex .. | and .., eq .. => isFalse Formula.noConfusion
    | or .., and .. | or .., imp .. | or .., bot .. | or .., propVar ..
    | or .., app .. | or .., all .. | or .., ex .. | or .., eq .. => isFalse Formula.noConfusion
    | imp .., and .. | imp .., or .. | imp .., bot .. | imp .., propVar ..
    | imp .., app .. | imp .., all .. | imp .., ex .. | imp .., eq .. => isFalse Formula.noConfusion
    | bot .., and .. | bot .., or .. | bot .., imp .. | bot .., propVar ..
    | bot .., app .. | bot .., all .. | bot .., ex .. | bot .., eq .. => isFalse Formula.noConfusion
    | propVar .., and .. | propVar .., or .. | propVar .., imp .. | propVar .., bot ..
    | propVar .., app .. | propVar .., all .. | propVar .., ex .. | propVar .., eq .. => isFalse Formula.noConfusion
    | app .., and .. | app .., or .. | app .., imp .. | app .., bot .. | app .., propVar ..
    | app .., all .. | app .., ex .. | app .., eq .. => isFalse Formula.noConfusion
    | all .., and .. | all .., or .. | all .., imp .. | all .., bot .. | all .., propVar ..
    | all .., app .. | all .., ex .. | all .., eq .. => isFalse Formula.noConfusion
    | ex .., and .. | ex .., or .. | ex .., imp .. | ex .., bot .. | ex .., propVar ..
    | ex .., app .. | ex .., all .. | ex .., eq .. => isFalse Formula.noConfusion
    | eq .., and .. | eq .., or .. | eq .., imp .. | eq .., bot .. | eq .., propVar ..
    | eq .., app .. | eq .., all .. | eq .., ex .. => isFalse Formula.noConfusion
    | and f g, and f' g' => by
      rw [and.injEq]; let _ := decidable_Eq f f'; let _ := decidable_Eq g g'
      infer_instance
    | or f g, or f' g' => by
      rw [or.injEq]; let _ := decidable_Eq f f'; let _ := decidable_Eq g g'
      infer_instance
    | imp f g, imp f' g' => by
      rw [imp.injEq]; let _ := decidable_Eq f f'; let _ := decidable_Eq g g'
      infer_instance
    | bot, bot => isTrue rfl
    | all x f, all x' f' => by rw [all.injEq]; let _ := decidable_Eq f f'; infer_instance
    | ex x f, ex x' f' => by rw [ex.injEq]; let _ := decidable_Eq f f'; infer_instance
    | eq a b, eq a' b' => by rw [eq.injEq]; infer_instance
    | app n f l, app n' f' l' => by
      rw [app.injEq]
      exact if hn : n = n' then by subst hn; simp; infer_instance
      else isFalse λ c => hn c.1

    instance : DecidableEq (Formula language) := Formula.decidable_Eq

    inductive Formula.Mem (v : Var) : Formula language → Prop
    | and_l {f g : Formula _} : f.Mem v → (f ∧ g).Mem v
    | and_r {f g : Formula _} : g.Mem v → (f ∧ g).Mem v
    | or_l {f g : Formula _} : f.Mem v → (f ∨ g).Mem v
    | or_r {f g : Formula _} : g.Mem v → (f ∨ g).Mem v
    | imp_l {f g : Formula _} : f.Mem v → (f ⇒ g).Mem v
    | imp_r {f g : Formula _} : g.Mem v → (f ⇒ g).Mem v
    | app {n} {r} {l} {k} : (l k).Mem v → (app n r l).Mem v
    | all_f {x} {f} : f.Mem v → (∀ x; f).Mem v
    | all_x {f} : (∀ v; f).Mem v
    | ex_f {x} {f} : f.Mem v → (∃ x; f).Mem v
    | ex_x {f} : (∃ v; f).Mem v
    | eq_l {a b : Term _} : a.Mem v → (a ≡ b).Mem v
    | eq_r {a b : Term _} : b.Mem v → (a ≡ b).Mem v

    instance : Membership Var (Formula language) where mem := Formula.Mem

    namespace Formula.Mem

    theorem Mem_and_iff (v : Var) (f g : Formula language)
      : v ∈ (f ∧ g) ↔ (v ∈ f ∨ v ∈ g) := ⟨
      let motive : (t : Formula language) → v ∈ t → Prop :=
        λ | .and f' g', _ => (v ∈ f' ∨ v ∈ g') | _, _ => True
      rec (motive := motive) (and_l := λ h _ => Or.inl h) (and_r := λ h _ => Or.inr h)
        (by simp) (by simp) (by simp) (by simp) (by simp) (by simp)
        (by simp) (by simp) (by simp) (by simp) (by simp)
      , λ | .inl h => .and_l h | .inr h => .and_r h⟩

    theorem Mem_or_iff (v : Var) (f g : Formula language)
      : v ∈ (f ∨ g) ↔ (v ∈ f ∨ v ∈ g) := ⟨
      let motive : (t : Formula language) → v ∈ t → Prop :=
        λ | .or f' g', _ => (v ∈ f' ∨ v ∈ g') | _, _ => True
      rec (motive := motive) (or_l := λ h _ => Or.inl h) (or_r := λ h _ => Or.inr h)
        (by simp) (by simp) (by simp) (by simp) (by simp) (by simp)
        (by simp) (by simp) (by simp) (by simp) (by simp)
      , λ | .inl h => .or_l h | .inr h => .or_r h⟩

    theorem Mem_imp_iff (v : Var) (f g : Formula language)
      : v ∈ (f ⇒ g) ↔ (v ∈ f ∨ v ∈ g) := ⟨
      let motive : (t : Formula language) → v ∈ t → Prop :=
        λ | .imp f' g', _ => (v ∈ f' ∨ v ∈ g') | _, _ => True
      rec (motive := motive) (imp_l := λ h _ => Or.inl h) (imp_r := λ h _ => Or.inr h)
        (by simp) (by simp) (by simp) (by simp) (by simp) (by simp)
        (by simp) (by simp) (by simp) (by simp) (by simp)
      , λ | .inl h => .imp_l h | .inr h => .imp_r h⟩

    theorem Mem_bot_iff (v : Var)
      : v ∈ (⊥ : Formula language) ↔ False := ⟨
      let motive : (t : Formula language) → v ∈ t → Prop :=
        λ | .bot, _ => False | _, _ => True
      rec (motive := motive) (by simp) (by simp)
        (by simp) (by simp) (by simp) (by simp) (by simp) (by simp)
        (by simp) (by simp) (by simp) (by simp) (by simp)
      , False.elim⟩

    theorem Mem_propVar_iff (v : Var) {x}
      : v ∈ (.propVar x : Formula language) ↔ False := ⟨
      let motive : (t : Formula language) → v ∈ t → Prop :=
        λ | .propVar _, _ => False | _, _ => True
      rec (motive := motive) (by simp) (by simp)
        (by simp) (by simp) (by simp) (by simp) (by simp) (by simp)
        (by simp) (by simp) (by simp) (by simp) (by simp)
      , False.elim⟩

    theorem Mem_app_iff (v : Var) (n) (f) (l)
      : v ∈ (Formula.app (language := language) n f l) ↔ (∃ k, v ∈ l k) := ⟨
      let motive : (t : Formula language) → v ∈ t → Prop :=
        λ | .app _ _ l', _ => (∃ k, v ∈ l' k) | _, _ => True
      rec (motive := motive) (app := λ h => ⟨_, h⟩) (by simp)
        (by simp) (by simp) (by simp) (by simp) (by simp) (by simp)
        (by simp) (by simp) (by simp) (by simp) (by simp)
      , λ ⟨_, h⟩ => .app h⟩

    theorem Mem_all_iff (v : Var) (x) (f : Formula language)
      : v ∈ (∀ x; f) ↔ (v = x ∨ v ∈ f) := ⟨
      let motive : (t : Formula language) → v ∈ t → Prop :=
        λ | .all x' f', _ => (v = x' ∨ v ∈ f') | _, _ => True
      rec (motive := motive) (all_x := Or.inl rfl) (all_f := λ h _ => Or.inr h)
        (by simp) (by simp) (by simp) (by simp) (by simp) (by simp)
        (by simp) (by simp) (by simp) (by simp) (by simp)
      , λ | .inl h => h ▸ .all_x | .inr h => .all_f h⟩

    theorem Mem_ex_iff (v : Var) (x) (f : Formula language)
      : v ∈ (∃ x; f) ↔ (v = x ∨ v ∈ f) := ⟨
      let motive : (t : Formula language) → v ∈ t → Prop :=
        λ | .ex x' f', _ => (v = x' ∨ v ∈ f') | _, _ => True
      rec (motive := motive) (ex_x := Or.inl rfl) (ex_f := λ h _ => Or.inr h)
        (by simp) (by simp) (by simp) (by simp) (by simp) (by simp)
        (by simp) (by simp) (by simp) (by simp) (by simp)
      , λ | .inl h => h ▸ .ex_x | .inr h => .ex_f h⟩

    theorem Mem_eq_iff (v : Var) (a b : Term language)
      : v ∈ (a ≡ b) ↔ (v ∈ a ∨ v ∈ b) := ⟨
      let motive : (t : Formula language) → v ∈ t → Prop :=
        λ | .eq a' b', _ => (v ∈ a' ∨ v ∈ b') | _, _ => True
      rec (motive := motive) (eq_l := λ h => Or.inl h) (eq_r := λ h => Or.inr h)
        (by simp) (by simp) (by simp) (by simp) (by simp) (by simp)
        (by simp) (by simp) (by simp) (by simp) (by simp)
      , λ | .inl h => .eq_l h | .inr h => .eq_r h⟩

    def decidable_Mem (v : Var) : (t : Formula language) → Decidable (v ∈ t)
      | .and f g => by
        rw [Mem_and_iff]
        let _ := decidable_Mem v f; let _ := decidable_Mem v g
        infer_instance
      | .or f g => by
        rw [Mem_or_iff]
        let _ := decidable_Mem v f; let _ := decidable_Mem v g
        infer_instance
      | .imp f g => by
        rw [Mem_imp_iff]
        let _ := decidable_Mem v f; let _ := decidable_Mem v g
        infer_instance
      | .bot => by
        rw [Mem_bot_iff]
        infer_instance
      | .propVar x => by
        rw [Mem_propVar_iff]
        infer_instance
      | .app n f l => by
        rw [Mem_app_iff]
        infer_instance
      | .all x f => by
        rw [Mem_all_iff]
        let _ := decidable_Mem v f
        infer_instance
      | .ex x f => by
        rw [Mem_ex_iff]
        let _ := decidable_Mem v f
        infer_instance
      | .eq a b => by
        rw [Mem_eq_iff]
        infer_instance

    instance (v : Var) : (f : Formula language) → Decidable (v ∈ f) := decidable_Mem v

    end Formula.Mem

    def Term.subst (v : Var) (t : Term language) : Term language → Term language
    | var x => if x = v then t else var x
    | app n f l => app n f (λ i => subst v t (l i))
    scoped notation:max u "[" v " := " t "]"  => Term.subst v t u

    inductive Formula.ValidSubst (v : Var) (t : Term language) : Formula language → Type
    | and {f g : Formula _} : f.ValidSubst v t → g.ValidSubst v t → (f ∧ g).ValidSubst v t
    | or {f g : Formula _} : f.ValidSubst v t → g.ValidSubst v t → (f ∨ g).ValidSubst v t
    | imp {f g : Formula _} : f.ValidSubst v t → g.ValidSubst v t → (f ⇒ g).ValidSubst v t
    | bot : (⊥ : Formula _).ValidSubst v t
    | propVar : (propVar ..).ValidSubst v t
    | app : (app ..).ValidSubst v t
    | all {x} {f} : v ≠ x → x ∉ t → f.ValidSubst v t → (∀ x; f).ValidSubst v t
    | ex {x} {f} : v ≠ x → x ∉ t → f.ValidSubst v t → (∃ x; f).ValidSubst v t
    | eq {a b : Term language} : (a ≡ b).ValidSubst v t
    scoped notation:max p "[" v " := " t "] valid" => Formula.ValidSubst v t p

    def Formula.subst (v : Var) (t : Term language)
      : (f : Formula language) → f[v := t] valid → Formula language
    | and f g, .and h1 h2 => and (f.subst v t h1) (g.subst v t h2)
    | or f g, .or h1 h2 => or (f.subst v t h1) (g.subst v t h2)
    | imp f g, .imp h1 h2 => imp (f.subst v t h1) (g.subst v t h2)
    | bot, _ => bot
    | propVar p, _ => propVar p
    | app n f l, _ => app n f (λ k => (l k)[v := t])
    | all x p, .all _ _ h3 => all x (p.subst v t h3)
    | ex x p, .ex _ _ h3 => ex x (p.subst v t h3)
    | eq a b, _ => eq a[v := t] b[v := t]
    scoped notation:max p "[" v " := " t ", " h "]"  => Formula.subst v t p h

    open Formula in
    inductive Proof : List (Formula language) → Formula language → Type
    | ax : p ∈ s → Proof s p
    | weaken (t) : Proof s p → Proof (t :: s) p
    | and_intro : Proof s p → Proof s q → Proof s (p ∧ q)
    | and_elim_left : Proof s (p ∧ q) → Proof s p
    | and_elim_right : Proof s (p ∧ q) → Proof s q
    | or_intro_left (q) : Proof s p → Proof s (p ∨ q)
    | or_intro_right (p) : Proof s q → Proof s (p ∨ q)
    | or_elim : Proof s (p ∨ q) → Proof s (p ⇒ r) → Proof s (q ⇒ r) → Proof s r
    | imp_intro : Proof (p :: s) q → Proof s (p ⇒ q)
    | imp_elim : Proof s p → Proof s (p ⇒ q) → Proof s q
    | bot_elim (p) : Proof s ⊥ → Proof s p
    | lem (p) : Proof s (p ∨ ¬p)
    | all_intro (x) (hsx : ∀ f, f ∈ s → x ∉ f) : Proof s p → Proof s (∀ x; p)
    | all_elim (ht : p[x := t] valid) : Proof s (∀ x; p) → Proof s p[x := t, ht]
    | ex_intro {ht : p[x := t] valid} : Proof s p[x := t, ht] → Proof s (∃ x; p)
    | ex_elim (hsx : ∀ f, f ∈ s → x ∉ f) (hqx : x ∉ q) : Proof s (∃ x; p) → Proof (p :: s) q → Proof s q
    | eq_intro (t) : Proof s (t ≡ t)
    | eq_elim (t) (ht : p[x := t] valid) (hu : p[x := u] valid)
      :  Proof s (t ≡ u) → Proof s p[x := t, ht] → Proof s p[x := u, hu]

    scoped notation:max s " ⊢ " f => Proof s f
    scoped notation:max "⊢ " f => Proof ∅ f
    scoped notation:max s " ⊢[" L "] " f => Proof (language := L) s f
    scoped notation:max "⊢[" L "] " f => Proof (language := L) ∅ f

    def Term.newFreshVar : Term language → Var
    | var x => (x : Nat) + 1
    | app n f l => (Fin.Family.of λ k => (l k).newFreshVar).sum 0 + 1

    theorem Term.lt_newFreshVar_of_Mem
      : ∀ (t : Term language), ∀ ⦃v⦄, v ∈ t → v < t.newFreshVar
    | var x, v, hv =>
      have hv := (Term.Mem.Mem_var_iff ..).mp hv
      hv ▸ by simp_arith [newFreshVar]
    | app n f l, v, hv =>
      have ⟨k, h⟩ := (Term.Mem.Mem_app_iff ..).mp hv
      have h := lt_newFreshVar_of_Mem _ h
      have := (Fin.Family.of λ k => (l k).newFreshVar).sum_ge k
      Nat.lt_trans h (Nat.lt_succ_of_le this)

    theorem Term.newFreshVar_not_Mem (t : Term language) : t.newFreshVar ∉ t :=
      λ c => Nat.lt_irrefl _ (t.lt_newFreshVar_of_Mem c)

    theorem Term.subst_of_not_Mem {x} {t : Term language} (u : Term language) (h : x ∉ t)
      : t[x := u] = t :=
        match t with
        | var v => by
          show ite .. = _
          rw [Mem.Mem_var_iff] at h
          rw [if_neg λ c => h c.symm]
        | app n f l => by
          show app .. = app ..
          rw [Mem.Mem_app_iff] at h
          apply congr_arg
          funext i
          exact (l i).subst_of_not_Mem u λ c => h ⟨i, c⟩

    def Proof.eq_symm {s} {t u : Term language} (h : s ⊢ t ≡ u) : s ⊢ u ≡ t :=
      let x := t.newFreshVar
      have hx := t.newFreshVar_not_Mem
      let p := .var x ≡ t
      let vz : ∀ z, p[x := z] valid := λ z => by apply Formula.ValidSubst.eq
      have sz : ∀ z, p[x := z, vz z] = (z ≡ t) := λ z =>
        by dsimp [Formula.subst]; rw [Term.subst_of_not_Mem z hx]; simp [Term.subst]
      sz u ▸ eq_elim t (vz t) (vz u) h <| sz t ▸ eq_intro t

  end

  section
    open Formula Proof
    variable {L : FOL}
    def p_imp_p (p : Formula L) : ⊢ p ⇒ p := imp_intro <| ax <| by simp
    def bot_intro : (s ⊢ p) → (s ⊢ ¬p) → (s ⊢ ⊥) := imp_elim
    def has_notro : (s ⊢ p ⇒ ⊥) → (s ⊢ ¬p) := id
    def not_elim : (s ⊢ ¬p) → (s ⊢ p ⇒ ⊥) := id
    def absurd_r : (s ⊢ ¬p ⇒ ⊥) → (s ⊢ p) := λ h =>
      or_elim (lem p) (imp_intro <| ax <| by simp)
        <| imp_intro
          <| bot_elim _
            <| imp_elim (ax <| by simp)
              <| weaken _ h
    def of_notnot : (s ⊢ ¬¬p) → (s ⊢ p) := absurd_r
  end

  section
  -- semantics
  structure Interpretation (language : FOL) where
    propValue (p : Nat) : Bool
    domain : Type
    varValue (x : Nat) : domain
    functionValue (n : Nat) (f : language.function n) : (Fin n → domain) → domain
    relationValue (n : Nat) (r : language.relation n) : (Fin n → domain) → Bool

  def Term.value {language} (i : Interpretation language) : Term language → i.domain
  | var x => i.varValue x
  | app _ f l => i.functionValue _ f λ k => (l k).value i

  scoped notation:max "⟦" t " | " i "⟧"  => Term.value i t

  def Interpretation.setPropValue {language} (i : Interpretation language) (v : Nat) (d : Bool)
  : Interpretation language :=
  { i with propValue := λ a => if a = v then d else i.propValue a }

  def Interpretation.setVarValue {language} (i : Interpretation language) (v : Nat) (d : i.domain)
  : Interpretation language :=
  { i with varValue := λ a => if a = v then d else i.varValue a }

  scoped notation:max i "⟦" v " := " d "⟧" => Interpretation.setVarValue i v d

  -- todo: change this to inductive
  def Formula.isTrueUnder {language} (i : Interpretation language) : Formula language → Prop
  | and f g => f.isTrueUnder i ∧ g.isTrueUnder i
  | or f g => f.isTrueUnder i ∨ g.isTrueUnder i
  | imp f g => f.isTrueUnder i → g.isTrueUnder i
  | bot => False
  | propVar x => i.propValue x = true
  | app _ f l => (i.relationValue _ f λ k => ⟦l k | i⟧) = true
  | all x f => ∀ d, f.isTrueUnder i⟦x := d⟧
  | ex x f => ∃ d, f.isTrueUnder i⟦x := d⟧
  | eq a b => ⟦a | i⟧ = ⟦b | i⟧

  scoped notation:max "⊨[" i "] " f  => Formula.isTrueUnder i f
  def Formula.isTrue {language} (f : Formula language) := ∀ i, ⊨[i] f
  scoped notation:max "⊨ " f  => Formula.isTrue f
  def Formula.entailsUnder {language} (i : Interpretation language)
    (s : List (Formula language)) (f : Formula language) := (∀ x ∈ s, ⊨[i] x) → ⊨[i] f
  scoped notation:max s " ⊨[" i "] " f  => Formula.entailsUnder i s f
  def Formula.entails {language} (s : List (Formula language)) (f : Formula language) := ∀ i, s ⊨[i] f
  scoped notation:max s " ⊨ " f  => Formula.entails s f

  def Proof.size {s} (f : Formula language) (h : s ⊢ f) : Nat :=
    let x : Inhabited Nat :=
    match h with
    | ax .. => ⟨1⟩
    | weaken h1 h2 => ⟨h2.size + 1⟩
    | and_intro h1 h2 => ⟨h1.size + h2.size + 1⟩
    | and_elim_left h1 => ⟨h1.size + 1⟩
    | and_elim_right h1 => ⟨h1.size + 1⟩
    | or_intro_left h1 h2 => ⟨h2.size + 1⟩
    | or_intro_right h1 h2 => ⟨h2.size + 1⟩
    | or_elim h1 h2 h3 => ⟨h1.size + h2.size + h3.size + 1⟩
    | imp_intro h1 => ⟨h1.size + 1⟩
    | imp_elim h1 h2 => ⟨h1.size + h2.size + 1⟩
    | bot_elim h1 h2 => ⟨h2.size + 1⟩
    | lem h1 => ⟨1⟩
    | all_intro h1 h2 h3 => ⟨h3.size + 1⟩
    | all_elim h1 h2 => ⟨h2.size + 1⟩
    | ex_intro h1 => ⟨h1.size + 1⟩
    | ex_elim h1 h2 h3 h4 => ⟨h3.size + h4.size + 1⟩
    | eq_intro h1 => ⟨1⟩
    | eq_elim h1 h2 h3 h4 h5 => ⟨h4.size + h5.size + 1⟩
  x.1

  theorem Formula.isTrueUnder_invariant_of_not_Mem {language} {f} {v : Var}
    (hv : v ∉ f) (i : Interpretation language) (d : i.domain)
    : (⊨[i] f) ↔ ⊨[i⟦v := d⟧] f := ⟨by
      intro h; induction f with
      | and f g hf hg =>
          rw [Mem.Mem_and_iff] at hv; exact ⟨hf (λ c => hv (.inl c)) h.1, hg (λ c => hv (.inr c)) h.2⟩
      | or f g hf hg =>
          rw [Mem.Mem_or_iff] at hv; match h with
          | .inl h => exact Or.inl $ hf (λ c => hv (.inl c)) h
          | .inr h => exact Or.inr $ hg (λ c => hv (.inr c)) h
      | _ => sorry
      , sorry⟩

  theorem Proof.soundness {f : Formula language} {s} : (s ⊢ f) → s ⊨ f
    | ax h1 => λ i hs => hs _ h1
    | weaken h1 h2 => λ i hs => soundness h2 i λ x hx => hs x (.tail h1 hx)
    | and_intro h1 h2 => λ i hs => ⟨soundness h1 i hs, soundness h2 i hs⟩
    | and_elim_left h1 => λ i hs => (soundness h1 i hs).1
    | and_elim_right h1 => λ i hs => (soundness h1 i hs).2
    | or_intro_left h1 h2 => λ i hs => Or.inl (soundness h2 i hs)
    | or_intro_right h1 h2 => λ i hs => Or.inr (soundness h2 i hs)
    | or_elim h1 h2 h3 => λ i hs => match soundness h1 i hs with
      | .inl h1 => soundness h2 i hs h1
      | .inr h1 => soundness h3 i hs h1
    | imp_intro h1 => λ i hs =>
      λ b => soundness h1 i λ x => λ | .head _ => b | .tail _ hx => hs _ hx
    | imp_elim h1 h2 => λ i hs => soundness h2 i hs (soundness h1 i hs)
    | bot_elim h1 h2 => λ i hs => (soundness h2 i hs).elim
    | lem h1 => λ i hs => Classical.em _
    | all_intro x h2 h3 => λ i hs =>
      λ d => soundness h3 i⟦x := d⟧ λ g hg =>
        (g.isTrueUnder_invariant_of_not_Mem (h2 g hg) i d).mp (hs g hg)
    | all_elim (x := x) (t := t) h1 h2 => λ i hs =>
      let j := i⟦x := ⟦t | i⟧⟧
      have := soundness h2 j sorry sorry
      sorry --needs a lemma
    | ex_intro .. => sorry
    | ex_elim .. => sorry
    | eq_intro .. => sorry
    | eq_elim .. => sorry
  termination_by _ f h => h.size
  decreasing_by simp_wf; dsimp [size]; simp_arith

  theorem Term.subst_value {language} {a} {v} {t} (i : Interpretation language)
  : ⟦a[v := t] | i⟧ = ⟦a | i⟦v := ⟦t | i⟧⟧⟧ :=
  match a with
  | var x =>
    if h : x = v then by
      dsimp [subst]
      rw [if_pos h]
      dsimp [value, Interpretation.setVarValue]
      rw [if_pos h]
    else by
      dsimp [subst]
      rw [if_neg h]
      dsimp [value, Interpretation.setVarValue]
      rw [if_neg h]
  | app n f l => by
    dsimp [subst]
    dsimp [value]
    congr
    funext k
    apply subst_value

  theorem Formula.isTrueUnder_subst_iff {language} {f} {v} {t} (i : Interpretation language) (ht)
  : (⊨[i] f[v := t, ht]) ↔ ⊨[i⟦v := ⟦t | i⟧⟧] f :=
    match f, ht with
    | .and f g, .and h1 h2 => by
      dsimp [subst, isTrueUnder]
      rw [isTrueUnder_subst_iff i h1, isTrueUnder_subst_iff i h2]
    | or f g, .or h1 h2 => by
      dsimp [subst, isTrueUnder]
      rw [isTrueUnder_subst_iff i h1, isTrueUnder_subst_iff i h2]
    | imp f g, .imp h1 h2 => by
      dsimp [subst, isTrueUnder]
      rw [isTrueUnder_subst_iff i h1, isTrueUnder_subst_iff i h2]
    | bot, _ => by
      simp [subst, isTrueUnder]
    | propVar p, _ => by
      simp [subst, isTrueUnder]
      exact ⟨id, id⟩
    | app n f l, h1 => by
      simp [subst]
      apply Bool.eq_iff_eq_true_iff.mp
      congr
      funext k
      apply Term.subst_value
    | all x p, .all h1 h2 h3 => by
      dsimp [subst]
      dsimp [isTrueUnder]
      have : {α : Type} → {p q : α → _} → (∀ x, (p x ↔ q x)) → ((∀ x, p x) ↔ ∀ x, q x) :=
        λ h => ⟨λ g x => (h x).mp (g x), λ g x => (h x).mpr (g x)⟩
      apply this
      intro d
      rw [isTrueUnder_subst_iff i⟦x := d⟧ h3]
      sorry
    | ex x p, .ex h1 h2 h3 => by
      dsimp [subst]
      dsimp [isTrueUnder]
      have : {α : Type} → {p q : α → _} → (∀ x, (p x ↔ q x)) → ((∃ x, p x) ↔ ∃ x, q x) :=
        λ h => ⟨λ ⟨x, g⟩ => ⟨x, (h x).mp g⟩, λ ⟨x, g⟩ => ⟨x, (h x).mpr g⟩⟩
      apply this
      intro d
      rw [isTrueUnder_subst_iff i⟦x := d⟧ h3]
      sorry
    | eq a b, _ => by
      simp [subst]
      dsimp [isTrueUnder]
      rw [Term.subst_value]
      rw [Term.subst_value]

    example {language} (i : Interpretation language) (f : Formula language)
    (x : Var) (v : Var)
    (t : Term language) (d : i.domain) :
      (⊨[i⟦x := d⟧⟦v := ⟦t | i⟦x := d⟧⟧⟧] f) ↔ ⊨[i⟦v := ⟦t | i⟧⟧⟦x := d⟧] f
      := sorry

    open Term in
    example {language} (i : Interpretation language) (a : Term language)
    (x : Var) (v : Var)
    (t : Term language) (d : i.domain) :
      ⟦a | i⟦x := d⟧⟦v := ⟦t | i⟦x := d⟧⟧⟧ ⟧ = ⟦a | i⟦v := ⟦t | i⟧⟧⟦x := d⟧ ⟧
      := match a with
      | .var y =>
        if h : y = x then by
          dsimp [value]
          dsimp [Interpretation.setVarValue]
          -- rw [h]
          simp [h]
          sorry
        else
          sorry
      | .app n f l => sorry

  end
end

end Logic