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

! This file was ported from Lean 3 source module topology.algebra.algebra
! leanprover-community/mathlib commit 43afc5ad87891456c57b5a183e3e617d67c2b1db
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Algebra.Subalgebra.Basic
import Mathbin.Topology.Algebra.Module.Basic
import Mathbin.RingTheory.Adjoin.Basic

/-!
# Topological (sub)algebras

A topological algebra over a topological semiring `R` is a topological semiring with a compatible
continuous scalar multiplication by elements of `R`. We reuse typeclass `has_continuous_smul` for
topological algebras.

## Results

This is just a minimal stub for now!

The topological closure of a subalgebra is still a subalgebra,
which as an algebra is a topological algebra.
-/

open Classical Set TopologicalSpace Algebra

open Classical

universe u v w

section TopologicalAlgebra

variable (R : Type _) (A : Type u)

variable [CommSemiring R] [Semiring A] [Algebra R A]

variable [TopologicalSpace R] [TopologicalSpace A] [TopologicalSemiring A]

theorem continuous_algebraMap_iff_smul :
    Continuous (algebraMap R A) ↔ Continuous fun p : R × A => p.1 • p.2 :=
  by
  refine' ⟨fun h => _, fun h => _⟩
  · simp only [Algebra.smul_def]
    exact (h.comp continuous_fst).mul continuous_snd
  · rw [algebra_map_eq_smul_one']
    exact h.comp (continuous_id.prod_mk continuous_const)
#align continuous_algebra_map_iff_smul continuous_algebraMap_iff_smul

@[continuity]
theorem continuous_algebraMap [ContinuousSMul R A] : Continuous (algebraMap R A) :=
  (continuous_algebraMap_iff_smul R A).2 continuous_smul
#align continuous_algebra_map continuous_algebraMap

theorem continuousSMul_of_algebraMap (h : Continuous (algebraMap R A)) : ContinuousSMul R A :=
  ⟨(continuous_algebraMap_iff_smul R A).1 h⟩
#align has_continuous_smul_of_algebra_map continuousSMul_of_algebraMap

variable [ContinuousSMul R A]

/-- The inclusion of the base ring in a topological algebra as a continuous linear map. -/
@[simps]
def algebraMapClm : R →L[R] A :=
  { Algebra.linearMap R A with
    toFun := algebraMap R A
    cont := continuous_algebraMap R A }
#align algebra_map_clm algebraMapClm

theorem algebraMapClm_coe : ⇑(algebraMapClm R A) = algebraMap R A :=
  rfl
#align algebra_map_clm_coe algebraMapClm_coe

theorem algebraMapClm_toLinearMap : (algebraMapClm R A).toLinearMap = Algebra.linearMap R A :=
  rfl
#align algebra_map_clm_to_linear_map algebraMapClm_toLinearMap

end TopologicalAlgebra

section TopologicalAlgebra

variable {R : Type _} [CommSemiring R]

variable {A : Type u} [TopologicalSpace A]

variable [Semiring A] [Algebra R A]

instance Subalgebra.continuousSMul [TopologicalSpace R] [ContinuousSMul R A] (s : Subalgebra R A) :
    ContinuousSMul R s :=
  s.toSubmodule.ContinuousSMul
#align subalgebra.has_continuous_smul Subalgebra.continuousSMul

variable [TopologicalSemiring A]

/-- The closure of a subalgebra in a topological algebra as a subalgebra. -/
def Subalgebra.topologicalClosure (s : Subalgebra R A) : Subalgebra R A :=
  {
    s.toSubsemiring.topologicalClosure with
    carrier := closure (s : Set A)
    algebraMap_mem' := fun r => s.toSubsemiring.le_topologicalClosure (s.algebraMap_mem r) }
#align subalgebra.topological_closure Subalgebra.topologicalClosure

@[simp]
theorem Subalgebra.topologicalClosure_coe (s : Subalgebra R A) :
    (s.topologicalClosure : Set A) = closure (s : Set A) :=
  rfl
#align subalgebra.topological_closure_coe Subalgebra.topologicalClosure_coe

instance Subalgebra.topologicalSemiring (s : Subalgebra R A) : TopologicalSemiring s :=
  s.toSubsemiring.TopologicalSemiring
#align subalgebra.topological_semiring Subalgebra.topologicalSemiring

theorem Subalgebra.le_topologicalClosure (s : Subalgebra R A) : s ≤ s.topologicalClosure :=
  subset_closure
#align subalgebra.le_topological_closure Subalgebra.le_topologicalClosure

theorem Subalgebra.isClosed_topologicalClosure (s : Subalgebra R A) :
    IsClosed (s.topologicalClosure : Set A) := by convert isClosed_closure
#align subalgebra.is_closed_topological_closure Subalgebra.isClosed_topologicalClosure

theorem Subalgebra.topologicalClosure_minimal (s : Subalgebra R A) {t : Subalgebra R A} (h : s ≤ t)
    (ht : IsClosed (t : Set A)) : s.topologicalClosure ≤ t :=
  closure_minimal h ht
#align subalgebra.topological_closure_minimal Subalgebra.topologicalClosure_minimal

/-- If a subalgebra of a topological algebra is commutative, then so is its topological closure. -/
def Subalgebra.commSemiringTopologicalClosure [T2Space A] (s : Subalgebra R A)
    (hs : ∀ x y : s, x * y = y * x) : CommSemiring s.topologicalClosure :=
  { s.topologicalClosure.toSemiring, s.toSubmonoid.commMonoidTopologicalClosure hs with }
#align subalgebra.comm_semiring_topological_closure Subalgebra.commSemiringTopologicalClosure

/-- This is really a statement about topological algebra isomorphisms,
but we don't have those, so we use the clunky approach of talking about
an algebra homomorphism, and a separate homeomorphism,
along with a witness that as functions they are the same.
-/
theorem Subalgebra.topologicalClosure_comap_homeomorph (s : Subalgebra R A) {B : Type _}
    [TopologicalSpace B] [Ring B] [TopologicalRing B] [Algebra R B] (f : B →ₐ[R] A) (f' : B ≃ₜ A)
    (w : (f : B → A) = f') : s.topologicalClosure.comap f = (s.comap f).topologicalClosure :=
  by
  apply SetLike.ext'
  simp only [Subalgebra.topologicalClosure_coe]
  simp only [Subalgebra.coe_comap, Subsemiring.coe_comap, AlgHom.coe_toRingHom]
  rw [w]
  exact f'.preimage_closure _
#align subalgebra.topological_closure_comap_homeomorph Subalgebra.topologicalClosure_comap_homeomorph

end TopologicalAlgebra

section Ring

variable {R : Type _} [CommRing R]

variable {A : Type u} [TopologicalSpace A]

variable [Ring A]

variable [Algebra R A] [TopologicalRing A]

/-- If a subalgebra of a topological algebra is commutative, then so is its topological closure.
See note [reducible non-instances]. -/
@[reducible]
def Subalgebra.commRingTopologicalClosure [T2Space A] (s : Subalgebra R A)
    (hs : ∀ x y : s, x * y = y * x) : CommRing s.topologicalClosure :=
  { s.topologicalClosure.toRing, s.toSubmonoid.commMonoidTopologicalClosure hs with }
#align subalgebra.comm_ring_topological_closure Subalgebra.commRingTopologicalClosure

variable (R)

/-- The topological closure of the subalgebra generated by a single element. -/
def Algebra.elementalAlgebra (x : A) : Subalgebra R A :=
  (Algebra.adjoin R ({x} : Set A)).topologicalClosure
#align algebra.elemental_algebra Algebra.elementalAlgebra

theorem Algebra.self_mem_elementalAlgebra (x : A) : x ∈ Algebra.elementalAlgebra R x :=
  SetLike.le_def.mp (Subalgebra.le_topologicalClosure (Algebra.adjoin R ({x} : Set A))) <|
    Algebra.self_mem_adjoin_singleton R x
#align algebra.self_mem_elemental_algebra Algebra.self_mem_elementalAlgebra

variable {R}

instance [T2Space A] {x : A} : CommRing (Algebra.elementalAlgebra R x) :=
  Subalgebra.commRingTopologicalClosure _
    letI : CommRing (Algebra.adjoin R ({x} : Set A)) :=
      Algebra.adjoinCommRingOfComm R fun y hy z hz =>
        by
        rw [mem_singleton_iff] at hy hz
        rw [hy, hz]
    fun _ _ => mul_comm _ _

end Ring

section DivisionRing

/-- The action induced by `algebra_rat` is continuous. -/
instance DivisionRing.continuousConstSMul_rat {A} [DivisionRing A] [TopologicalSpace A]
    [ContinuousMul A] [CharZero A] : ContinuousConstSMul ℚ A :=
  ⟨fun r => by simpa only [Algebra.smul_def] using continuous_const.mul continuous_id⟩
#align division_ring.has_continuous_const_smul_rat DivisionRing.continuousConstSMul_rat

end DivisionRing


import mynat.definition -- Imports the natural numbers.
import mynat.add -- imports addition.

namespace mynat -- hide

lemma zero_add (n : mynat) : 0 + n = n :=
begin [nat_num_game]
  induction n with d hd,
  rw add_zero,
  refl,
  rw add_succ,
  rw hd,
  refl,
end

end mynat -- hide


import Saturn.Core
import Saturn.FinSeq
import Saturn.Vector
open Nat
open Vector
open FinSeq

/-
Containment of clauses and basic properties
-/

abbrev varContains (v1 v2 : Option Bool) : Prop :=
  ∀ b : Bool, v2 = some b → v1  = some b

infix:65 "≥" => varContains

def varDomDecide : (v1 : Option Bool) → (v2 : Option Bool) → Decidable (v1 ≥  v2) :=
  fun v1 v2 =>
  match v2 with
  | none =>
     isTrue $ fun b hyp =>
          Option.noConfusion hyp
  | some b2 =>
    match v1  with
    | none =>
      isFalse $ fun hyp =>
          Option.noConfusion (hyp b2 rfl)
    | some b1 =>
          if c : b1 = b2 then
            isTrue (by
                        intro b hyp
                        rw [c]
                        exact hyp)
          else
            isFalse (
              fun hyp =>
                  let lem1 := hyp b2 rfl
                  let lem2 : b1 = b2 := by
                      injection lem1
                      assumption
                  c (lem2)
            )

def contains{n: Nat} (cl1 cl2 : Clause n) : Prop :=
  ∀ k : Nat, ∀ kw : k < n, ∀ b : Bool, cl2.coords k kw = some b → cl1.coords k kw = some b

infix:65 " ⊇  " => contains

theorem contains_refl{n: Nat} (cl : Clause n) :
  cl ⊇ cl := fun k w b hyp => hyp

theorem contains_trans{n: Nat} (cl1 cl2 cl3 : Clause n) :
        cl1 ⊇  cl2 → cl2 ⊇ cl3 →  cl1 ⊇ cl3 := by
                intro hyp1 hyp2  k w b dHyp
                apply hyp1
                apply hyp2
                apply dHyp

theorem contains_prepend{n: Nat}(v1 v2 : Option Bool)(cl1 cl2 : Clause n) :
          v1 ≥  v2 → cl1 ⊇  cl2 →
                (v1 +: cl1) ⊇ (v2 +: cl2) := by
            intro hyp1 hyp2 k
            match k with
            | zero =>
              intro w b hb
              exact hyp1 b hb
            | j + 1  =>
              intro kw b hb
              have w : j < n := by
                  apply le_of_succ_le_succ
                  exact kw
              exact hyp2 j w b hb

/-
Implementation of checking for containment; tail-call optimized
-/
abbrev containsBeyond(cl1 cl2 : Clause n)(m: Nat) : Prop :=
  ∀ k : Nat, ∀ kw : k < n, m ≤ k →  ∀ b : Bool, cl2.coords k kw = some b → cl1.coords k kw = some b

theorem contains_implies_contains_beyond {n: Nat} (cl1 cl2 : Clause n) (m: Nat) :
  contains cl1 cl2 → containsBeyond cl1 cl2 m := by
    intro h k kw ineq b
    exact h k kw b

theorem contains_beyond_zero_implies_contains {n: Nat} (cl1 cl2 : Clause n) :
  containsBeyond cl1 cl2 zero → contains cl1 cl2 := by
    intro h k kw b
    exact h k kw (Nat.zero_le _) b

theorem containsSat{n: Nat} (cl1 cl2 : Clause n) :
  cl1 ⊇  cl2 → (valuation : Valuation n) → clauseSat cl2 valuation → clauseSat cl1 valuation := by
    intro dom valuation
    intro ⟨j, jw, vs⟩
    let lem0 :  cl2.coords j jw = some (valuation.coords j jw) := vs
    let lem1 : coords cl1 j jw = some (coords valuation j jw) := dom j jw (valuation.coords j jw) lem0
    exact ⟨j, jw, lem1⟩

theorem contains_beyond_vacuously{n: Nat} (cl1 cl2 : Clause n)(m: Nat) :
    (n ≤ m) → containsBeyond cl1 cl2 m := by
      intro h k kw ineq
      let inq := Nat.le_trans h ineq
      let inq2 := Nat.lt_of_lt_of_le kw inq
      exact (False.elim (Nat.lt_irrefl k inq2))

def decideContainsRec{n: Nat} (cl1 cl2 : Clause n) :
        (m: Nat) → Decidable (containsBeyond cl1 cl2 m) → Decidable (contains cl1 cl2) :=
        fun m dContainsBeyond =>
          match m, dContainsBeyond with
          | m, isFalse contra => isFalse (
              by
                intro hyp
                apply contra
                apply contains_implies_contains_beyond cl1 cl2 m hyp
                )
          | zero, isTrue pf => isTrue (contains_beyond_zero_implies_contains cl1 cl2 pf)
          | l + 1, isTrue pf =>
            let accum: Decidable (containsBeyond cl1 cl2 l) :=
              if lw : l < n then
                match varDomDecide (cl1.coords l lw) (cl2.coords l lw) with
                | isTrue pfHead =>
                      isTrue (
                        by
                          intro k kw ineq b
                          cases Nat.eq_or_lt_of_le ineq with
                          | inl eql =>
                            let lem1 : cl1.coords l lw = cl1.coords k kw := by
                              apply witness_independent
                              exact eql
                            let lem2 : cl2.coords l lw = cl2.coords k kw := by
                              apply witness_independent
                              exact eql
                            rw [← lem1]
                            rw [← lem2]
                            exact pfHead b
                          | inr l2 =>
                            exact pf k kw l2 b
                      )
                | isFalse contra =>
                    isFalse (fun hyp => contra (fun b => hyp l lw (Nat.le_refl _) b))
            else
                let overshoot : n ≤ l := by
                  cases Nat.lt_or_ge l n with
                  | inl l1 => exact absurd l1 lw
                  | inr l2 => exact l2
                isTrue (contains_beyond_vacuously cl1 cl2 l overshoot)
        decideContainsRec cl1 cl2 l accum

def decideContains(n: Nat) : (cl1: Clause n) →  (cl2 : Clause n) →
                                          Decidable (cl1 ⊇   cl2) :=
    fun cl1 cl2 => decideContainsRec cl1 cl2 n
        (isTrue (contains_beyond_vacuously cl1 cl2 n (Nat.le_refl _)))

instance {n: Nat}{cl: Clause n} : DecidablePred (contains cl) :=
  decideContains n cl

def parityCount{n: Nat}  (b: Bool) (cl : Clause n) : Nat :=
    let p : Option Bool →  Bool :=
      fun bo =>
        match bo with
        | some bb => bb = b
        | none => false
    cl.count p

abbrev countBelow (p1 n1 p2 n2 : Nat) : Bool :=
  (p1 ≤ p2) ∧ (n1 ≤ n2) ∧ ((p1 < p2) ∨ (n1 < n2))

-- Simplification removing clauses that contain other clauses.

structure Containment{dom n : Nat}(base: Vector (Clause n) dom) where
    codom: Nat
    imageSeq : Vector (Clause n) codom
    forwardVec : Vector Nat dom
    forwardBound : (j : Nat) →  (jw : j < dom) → forwardVec.coords j jw < codom
    forwardEq : (j : Nat) →  (jw : j < dom) →
              base.coords j jw ⊇ imageSeq.coords (forwardVec.coords j jw) (forwardBound j jw)
    reverseVec : Vector Nat codom
    reverseBound : (j : Nat) →  (jw : j < codom) → reverseVec.coords j jw < dom
    reverseEq : (j : Nat) →  (jw : j < codom) →
             base.coords (reverseVec.coords j jw) (reverseBound j jw) = imageSeq.coords j jw

namespace Containment
abbrev forward {dom n : Nat}{base: Vector (Clause n) dom}
      (cntn : Containment base) (j : Nat) (jw : j < dom) :
                  ElemSeqPred cntn.imageSeq.coords (contains (base.coords j jw)) :=
                ⟨cntn.forwardVec.coords j jw, cntn.forwardBound j jw,
                    cntn.forwardEq j jw⟩

abbrev reverse {dom n : Nat}{base: Vector (Clause n) dom}
      (cntn : Containment base) (j : Nat) (jw : j < cntn.codom) :
                  ElemInSeq base.coords (cntn.imageSeq.coords j jw) :=
                ⟨cntn.reverseVec.coords j jw, cntn.reverseBound j jw,
                    cntn.reverseEq j jw⟩

def identity{dom n : Nat}(base: Vector (Clause n) dom) : Containment base :=
    let idVec : Vector Nat dom := FinSeq.vec (fun j jw => j)
    let idAt : (j : Nat) → (jw : j < dom) → idVec.coords j jw = j := by
      intro j jw
      rw [seq_to_vec_coords]
    let idBound : (j : Nat) → (jw : j < dom) → idVec.coords j jw < dom := by
      intro j jw
      rw [idAt]
      exact jw
    let idEqn : (j : Nat) → (jw : j < dom) →
          idVec.coords (idVec.coords j jw) (idBound j jw) = j := by
          intro j jw
          rw [idAt]
          rw [idAt]
    let baseEqn : (j : Nat) → (jw : j < dom) →
          base.coords (idVec.coords j jw) (idBound j jw) = base.coords j jw := by
          intro j jw
          apply witness_independent
          rw [idAt]
    let baseContains : (j : Nat) → (jw : j < dom) →
          contains (base.coords j jw) (base.coords (idVec.coords j jw) (idBound j jw)) := by
          intro j jw
          rw [baseEqn]
          exact contains_refl (base.coords j jw)
    ⟨dom, base, idVec, idBound, baseContains, idVec, idBound,
      by
      intro j jw
      apply witness_independent
      rw [idAt]⟩

end Containment

def simplifyNonEmptyContainment{d n : Nat}: (cursorBound : Nat) →
      (base : Vector (Clause n) (d + 1)) → Vector Nat (d + 1) → Vector Nat (d + 1) →
      Containment (base) → Containment (base) :=
      fun cursorBound =>
      match cursorBound with
      | zero => fun _ _ _ => id
      | k + 1 =>
        fun base posCount negCount contn =>
          let ⟨j, (ineq : j < contn.codom), _⟩ := contn.forward zero (zero_lt_succ _)
          let neZero : Not (0 = contn.codom) := fun hyp =>
          let l0 : j < 0 := by
            rw [hyp]
            exact ineq
            done
          Nat.not_lt_zero j l0
        let ⟨l, leqn⟩ := posSucc contn.codom neZero
        match contn.codom, leqn, contn.imageSeq, contn.forward, contn.reverse,
            contn.forwardVec, contn.forwardBound, contn.forwardEq,
            contn.reverseVec, contn.reverseBound, contn.reverseEq with
        | .(l + 1), rfl, imageSeq, forward, reverse,
            forwardVec, forwardBound, forwardEq,
            reverseVec, reverseBound, revereseEq =>
         if lt : k < (l + 1) then
          let focus := imageSeq.coords k lt
          let rest := delete k lt imageSeq.coords
          let posFocus := posCount.coords (reverseVec.coords k lt) (reverseBound k lt)
          let negFocus := negCount.coords (reverseVec.coords k lt) (reverseBound k lt)
          let filter : FinSeq l Bool :=
              delete k lt (fun j jw =>
                countBelow (posCount.coords (reverseVec.coords j jw) (reverseBound j jw))
                  (negCount.coords (reverseVec.coords j jw) (reverseBound j jw))
                    posFocus negFocus)
          let step  : Containment base :=
            match findFiltered? filter (contains focus) rest with
            | none =>
                ⟨l + 1, imageSeq, forwardVec, forwardBound, forwardEq,
                   reverseVec, reverseBound, revereseEq⟩
            | some ⟨zi, zb, zc⟩ => -- clause at k contains clause at index zi in deleted sequence
              let codomN := l
              let imageSeqN := rest
              let domN := d + 1
              let forwardN : (j : Nat) → (jw : j < domN) →
                    ElemSeqPred imageSeqN (contains (base.coords j jw)) :=
                    fun j jw =>
                      let ⟨i, iw , ict⟩ := forward j jw
                      if c : i = k then -- index i redirected
                          let lem1 : imageSeq.coords i iw = imageSeq.coords k lt := by
                                apply witness_independent
                                apply c
                          let lem2 : imageSeq.coords i iw ⊇ imageSeqN zi zb := by
                                rw [lem1]
                                exact zc
                          ⟨zi, zb, contains_trans _ _ _ ict lem2⟩
                      else
                        let ii := skipInverse k i c -- index in sequence before deletion
                        let eqn := skip_inverse_eq k i c
                        let iiw := skip_preimage_lt lt iw eqn
                        let lem1 : imageSeqN ii iiw = imageSeq.coords (skip k ii) (skip_le_succ iiw)  :=
                                by rfl
                        let lem2 : imageSeq.coords (skip k ii) (skip_le_succ iiw) = imageSeq.coords i iw :=
                                by
                                    apply witness_independent
                                    apply eqn
                                    done
                        ⟨ii, iiw, by
                                  rw [lem1]
                                  rw [lem2]
                                  exact ict⟩
              let forwardNVec := FinSeq.vec (fun j jw => (forwardN j jw).index)
              have forwardNAt : (j : Nat) → (jw : j < domN) →
                      forwardNVec.coords j jw = (forwardN j jw).index :=
                      by
                        intro j jw
                        rw [seq_to_vec_coords]
              have forwardNBound : (j : Nat) → (jw : j < domN) →
                      forwardNVec.coords j jw < codomN := by
                        intro j jw
                        rw [forwardNAt]
                        exact (forwardN j jw).bound
              have forwardNEq : (j : Nat) → (jw : j < domN) →
                  (imageSeqN (forwardNVec.coords j jw) (forwardNBound j jw)) =
                      imageSeqN (forwardN j jw).index (forwardN j jw).bound :=
                        by
                          intro j jw
                          apply witness_independent
                          rw [forwardNAt]
              have forwardNPred : (j : Nat) → (jw : j < domN) →
                    contains (base.coords j jw)
                          (imageSeqN.vec.coords (forwardNVec.coords j jw) (forwardNBound j jw)) :=
                        by
                          intro j jw
                          have se :
                            (imageSeqN.vec.coords (forwardNVec.coords j jw) (forwardNBound j jw)) =
                            (imageSeqN (forwardNVec.coords j jw) (forwardNBound j jw)) := by
                              rw [seq_to_vec_coords]
                          rw [se, forwardNEq j jw]
                          exact (forwardN j jw).equation
              let reverseN : (j : Nat) → (jw : j < codomN) →
                    ElemInSeq base.coords (imageSeqN j jw) :=
                    fun i iw =>
                        let ⟨ind, bd, eqn⟩ := reverse (skip k i) (skip_le_succ iw)
                        ⟨ind, bd, by exact eqn⟩
              let reverseNVec := FinSeq.vec (fun j jw => (reverseN j jw).index)
              have reverseNAt : (j : Nat) → (jw : j < codomN) →
                      reverseNVec.coords j jw = (reverseN j jw).index :=
                      by
                        intro j jw
                        rw [seq_to_vec_coords]
              have reverseNBound : (j : Nat) → (jw : j < codomN) →
                      reverseNVec.coords j jw < domN := by
                        intro j jw
                        rw [reverseNAt]
                        exact (reverseN j jw).bound
              have reverseNAtImage : (j : Nat) → (jw : j < l) →
                      imageSeqN.vec.coords j jw = imageSeqN j jw :=
                      by
                        intro j jw
                        rw [seq_to_vec_coords]
              have reverseNEq : (j : Nat) → (jw : j < codomN) →
                  (base.coords (reverseNVec.coords j jw) (reverseNBound j jw)) =
                    base.coords (reverseN j jw).index (reverseN j jw).bound := by
                        intro j jw
                        apply witness_independent
                        rw [reverseNAt]
              have reverseNPred : (j : Nat) → (jw : j < codomN) →
                  base.coords (reverseNVec.coords j jw) (reverseNBound j jw) =
                    imageSeqN.vec.coords j jw := by
                        intro j jw
                        rw [reverseNAtImage j jw]
                        rw [reverseNEq j jw]
                        exact (reverseN j jw).equation
             ⟨codomN, imageSeqN.vec, forwardNVec, forwardNBound, forwardNPred,
                reverseNVec, reverseNBound, reverseNPred⟩
          simplifyNonEmptyContainment k base posCount negCount step
        else ⟨l + 1, imageSeq, forwardVec, forwardBound, forwardEq,
                   reverseVec, reverseBound, revereseEq⟩

def simplifiedContainment{dom n : Nat}: (clauses : Vector (Clause n) dom) →
                             Vector Nat dom → Vector Nat dom →
                              Containment clauses :=
                    match dom with
                    |zero => fun _ _ _ =>
                      ⟨zero, Vector.nil, Vector.nil, fun j jw => nomatch jw, fun j jw => nomatch jw,
                        Vector.nil, fun j jw => nomatch jw, fun j jw => nomatch jw⟩
                    | m + 1 => fun clauses posCount negCount =>
                        simplifyNonEmptyContainment (m + 1) clauses
                            posCount negCount (Containment.identity clauses)


def f (x : Nat) (y : Nat) :=
  3 + x

def g (x : Nat) := x*x*x

@[simp] theorem eq1 (x y : Nat) : f (x+2) y = x+5 := by
  simp [f]
  rw [Nat.add_left_comm]

theorem ex1 : g (f (x+3) y) = g (x+6) := by
  simp

theorem ex2 : g (f (x.succ.succ) y) = g (x+5) := by
  simp

theorem ex3 : g (f 3 y) = g 6 := by
  simp

theorem ex4 : g (f 2 y) = g 5 := by
  simp

theorem ex5 : g (f (x.succ.succ.succ) y) = g (x+6) := by
  simp

def h (x : Nat) : Type :=
  match x with
  | 0 => Nat
  | _ => Unit

@[simp] theorem h_zero : h 0 = Nat :=
  rfl

theorem ex6 : h Nat.zero = Nat := by
  simp


import field_theory.finiteness
import ring_theory.artinian
import dimension_theory.order_height
import dimension_theory.rank
import dimension_theory.min_generator_card

variables {R M M' M'' : Type*} [comm_ring R] [add_comm_group M] [module R M] (p : submodule R M)
variables [add_comm_group M'] [module R M'] [add_comm_group M''] [module R M'']

noncomputable
def submodule.length : with_top ℕ :=
(set.Iio p).chain_height

noncomputable
def module.length (R M : Type*) [comm_ring R] [add_comm_group M] [module R M] : with_top ℕ :=
(⊤ : submodule R M).length

lemma submodule.length_succ :
  p.length + 1 = (set.Iic p).chain_height  :=
begin
  convert (set.chain_height_insert_of_forall_lt _ p _).symm,
  { rw set.Iio_insert },
  { intros p e, exact e }
end

lemma module.length_succ (R M : Type*) [comm_ring R] [add_comm_group M] [module R M] :
  module.length R M + 1 = (set.univ : set $ submodule R M).chain_height :=
begin
  rw [module.length, submodule.length_succ, set.Iic_top],
end

lemma set.dedup_mem_subchain {α : Type*} [partial_order α] [decidable_eq α] (s : set α) (l : list α)
  (h₁ : list.chain' (≤) l) (h₂ : ∀ x ∈ l, x ∈ s) : l.dedup ∈ s.subchain :=
begin
  refine ⟨_, λ i e, h₂ _ (list.mem_dedup.mp e)⟩,
  have := h₁.sublist l.dedup_sublist,
  rw [list.chain'_iff_pairwise] at this ⊢,
  exact (this.and l.nodup_dedup).imp (λ _ _ h, lt_of_le_of_ne h.1 h.2)
end

lemma list.sublist_pw_filter_cons {α : Type*} (x : α) (xs : list α) {r : α → α → Prop}
  [decidable_rel r] : xs.pw_filter r <+ (x :: xs).pw_filter r :=
begin
  by_cases ∀ (b : α), b ∈ list.pw_filter r xs → r x b,
  { rw list.pw_filter_cons_of_pos h, exact list.sublist.cons _ _ _ (list.sublist.refl _) },
  { rw list.pw_filter_cons_of_neg h },
end

lemma list.dedup_sublist_dedup_cons {α : Type*} (x : α) (xs : list α) [decidable_eq α] :
  xs.dedup <+ (x :: xs).dedup :=
list.sublist_pw_filter_cons x xs

lemma list.length_le_map_dedup_length_add {α β γ : Type*} [preorder α] [partial_order β] [partial_order γ]
  [decidable_eq β] [decidable_eq γ] (f : α → β) (g : α → γ)
  (hf : monotone f) (hg : monotone g)
  (H : ∀ x y, f x = f y → g x = g y → x ≤ y → x = y) (l : list α) (hl : l.chain' (<))
  (hl' : l ≠ []) :
  l.length + 1 ≤ (l.map f).dedup.length + (l.map g).dedup.length :=
begin
  induction l with x xs h,
  { exact (hl' rfl).elim },
  { cases xs with x' xs, { simp },
    cases hl with _ _ _ _ hx hl,
    refine (add_le_add (h hl (λ e, by cases e)) (le_refl 1)).trans _,
    by_cases e : f x = f x',
    { have : g x ∉ g x' :: xs.map g,
      { have : g x < g x' := lt_of_le_of_ne (hg hx.le) (λ e', hx.ne (H _ _ e e' hx.le)),
        cases list.chain_iff_pairwise.mp hl with _ _ hxs,
        rintros (e|e),
        { exact this.ne e },
        { obtain ⟨a, ha, ha'⟩ := list.mem_map.mp e,
          exact (this.trans_le (hg (hxs a ha).le)).ne ha'.symm } },
      rw add_assoc,
      apply add_le_add,
      { exact list.length_le_of_sublist (list.dedup_sublist_dedup_cons _ _) },
      { exact (congr_arg list.length (list.dedup_cons_of_not_mem this).symm).le } },
    { have : f x ∉ f x' :: xs.map f,
      { have : f x < f x' := lt_of_le_of_ne (hf hx.le) e,
        cases list.chain_iff_pairwise.mp hl with _ _ hxs,
        rintros (e|e),
        { exact this.ne e },
        { obtain ⟨a, ha, ha'⟩ := list.mem_map.mp e,
          exact (this.trans_le (hf (hxs a ha).le)).ne ha'.symm } },
      rw add_right_comm,
      apply add_le_add,
      { exact (congr_arg list.length (list.dedup_cons_of_not_mem this).symm).le },
      { exact list.length_le_of_sublist (list.dedup_sublist_dedup_cons _ _) } } },
end

lemma module.length_eq_add_of_exact (f : M' →ₗ[R] M) (g : M →ₗ[R] M'') (hf : function.injective f)
  (hg : function.surjective g) (e : f.range = g.ker) :
    module.length R M = module.length R M' + module.length R M'' :=
begin
  classical,
  suffices : module.length R M + 1 = (module.length R M' + module.length R M'') + 1,
  { apply le_antisymm;
      exact (with_top.add_le_add_iff_right with_top.one_ne_top).mp (by simp [this]) },
  rw [module.length_succ, add_assoc, module.length_succ],
  apply le_antisymm,
  { apply supr₂_le _,
    intros l hl,
    by_cases hl' : l = [], { subst hl', exact zero_le _ },
    have : l.length + 1 ≤
      (l.map $ submodule.comap f).dedup.length + (l.map $ submodule.map g).dedup.length,
    { apply list.length_le_map_dedup_length_add,
      { exact λ _ _ e, submodule.comap_mono e },
      { exact λ _ _ e, submodule.map_mono e },
      { intros p₁ p₂ e₁ e₂ e₃,
        apply e₃.antisymm,
        intros x hx,
        obtain ⟨y, hy, ey⟩ := (show _, from e₂.symm.le) (submodule.mem_map_of_mem hx),
        obtain ⟨z, hz⟩ : x - y ∈ f.range,
        { rw [e, linear_map.mem_ker, map_sub, ey, sub_self] },
        have : z ∈ p₁.comap f,
        { rw [e₁, submodule.mem_comap, hz], exact sub_mem hx (e₃ hy) },
        exact eq_sub_iff_add_eq.mp hz ▸ add_mem this hy },
      { exact hl.1 },
      { exact hl' } },
    rw [← with_top.coe_le_coe, with_top.coe_add, with_top.coe_add] at this,
    apply (with_top.add_le_add_iff_right with_top.one_ne_top).mp,
    rw [add_right_comm, module.length_succ],
    refine this.trans (add_le_add _ _); refine set.length_le_chain_height_of_mem_subchain _
      (set.dedup_mem_subchain _ _ ((list.chain'_map _).mpr $ (hl.1.imp _)) (λ _ _, trivial)),
    { intros _ _ e, exact submodule.comap_mono e.le },
    { intros _ _ e, exact submodule.map_mono e.le },
    all_goals { apply_instance } },
  rw [module.length, submodule.length, ← set.chain_height_image (submodule.map f),
    ← set.chain_height_image (submodule.comap g), ← set.chain_height_union_eq],
  { exact set.chain_height_le_of_subset (set.subset_univ _) },
  { rintros _ ⟨a, ha, rfl⟩ _ ⟨b, hb, rfl⟩,
    refine (submodule.map_strict_mono_of_injective hf ha).trans_le _,
    rw [submodule.map_top, e, ← submodule.comap_bot],
    exact submodule.comap_mono bot_le },
  { intros _ _,
    simp_rw [lt_iff_le_and_ne, submodule.comap_le_comap_iff_of_surjective hg,
      (submodule.comap_injective_of_surjective hg).ne_iff] },
  { intros _ _,
    simp_rw [lt_iff_le_and_ne, submodule.map_le_map_iff_of_injective hf,
      (submodule.map_injective_of_injective hf).ne_iff] },
end

lemma submodule.supr_lt_length_succ :
  (⨆ q < p, q.length + 1) = p.length :=
begin
  rw [submodule.length, set.chain_height_eq_supr_Iic, supr_subtype', supr_subtype'],
  congr,
  ext1 ⟨q, hq⟩,
  rw [submodule.length, subtype.coe_mk, ← set.chain_height_insert_of_forall_lt _ q,
    set.Iio_insert, set.inter_eq_right_iff_subset.mpr _],
  { intros x hx, exact has_le.le.trans_lt hx hq },
  { intros a ha, exact ha }
end
.

section

open_locale classical

@[simps] noncomputable
def cardinal.to_with_top_nat : cardinal →+ with_top ℕ :=
{ to_fun := λ c, c.to_part_enat.to_with_top,
  map_zero' := by simp only [part_enat.to_with_top_zero', map_zero],
  map_add' := by simp }

end

lemma cardinal.to_with_top_nat_apply' (c : cardinal) :
  c.to_with_top_nat = if c < cardinal.aleph_0 then c.to_nat else ⊤ :=
begin
  dsimp [cardinal.to_with_top_nat, cardinal.to_part_enat],
  split_ifs,
  { rw [if_pos h, part_enat.to_with_top_coe] },
  { rw part_enat.to_with_top_top }
end

lemma cardinal.coe_le_to_with_top_nat {c : cardinal} (n : ℕ) :
  ↑n ≤ c.to_with_top_nat ↔ ↑n ≤ c :=
begin
  classical,
  rw ← part_enat.to_with_top_coe,
  refine part_enat.to_with_top_le.trans _,
  change ↑n ≤ dite _ _ _ ↔ _,
  split_ifs,
  { rw [← cardinal.to_nat_cast n, part_enat.coe_le_coe, cardinal.to_nat_le_iff_le_of_lt_aleph_0 _ h,
      cardinal.to_nat_cast],
    exact cardinal.nat_lt_aleph_0 n },
  { simp only [le_top, true_iff], exact (cardinal.nat_lt_aleph_0 n).le.trans (not_lt.mp h) },
end

lemma cardinal.coe_eq_to_with_top_nat_iff {c : cardinal} {n : ℕ} :
  ↑n = c.to_with_top_nat ↔ c = n ∧ c < cardinal.aleph_0 :=
begin
  rw cardinal.to_with_top_nat_apply',
  split_ifs with h,
  { rw [with_top.coe_eq_coe, and_iff_left h, ← cardinal.nat_cast_inj,
      cardinal.cast_to_nat_of_lt_aleph_0 h, eq_comm] },
  { simp [h] },
end

lemma cardinal.to_with_top_nat_eq_top_iff {c : cardinal} :
  c.to_with_top_nat = ⊤ ↔ cardinal.aleph_0 ≤ c :=
begin
  rw [cardinal.to_with_top_nat_apply'],
  split_ifs,
  { simp [h] },
  { rw not_lt at h, simpa }
end

lemma cardinal.to_with_top_nat_cast (n : ℕ) : cardinal.to_with_top_nat n = n :=
by { rw [cardinal.to_with_top_nat_apply, cardinal.to_part_enat_cast, part_enat.to_with_top_coe] }

lemma cardinal.to_with_top_nat_one : cardinal.to_with_top_nat 1 = 1 :=
begin
  rw [cardinal.to_with_top_nat_apply', if_pos cardinal.one_lt_aleph_0, ← with_top.coe_one,
    with_top.coe_eq_coe, cardinal.to_nat_eq_one.mpr rfl],
end

lemma cardinal.to_with_top_nat_mono : monotone cardinal.to_with_top_nat :=
begin
  rintros a b e x (e' : _ = ↑x),
  rw [eq_comm, cardinal.coe_eq_to_with_top_nat_iff] at e',
  have := cardinal.cast_to_nat_of_lt_aleph_0 (e.trans_lt e'.2),
  rw ← this,
  rw [← this, e'.1, cardinal.nat_cast_le] at e,
  exact ⟨a.to_nat, cardinal.to_with_top_nat_cast _, e⟩
end

lemma cardinal.supr_to_with_top_nat {ι : Type*} {f : ι → cardinal} (hf : bdd_above $ set.range f) :
  (⨆ i, f i).to_with_top_nat = ⨆ i, (f i).to_with_top_nat :=
begin
  refine le_antisymm _ (supr_le (λ i, cardinal.to_with_top_nat_mono $ le_csupr hf i)),
  rw cardinal.to_with_top_nat_apply',
  split_ifs,
  { have : ∀ i, (f i).to_with_top_nat = (f i).to_nat :=
      λ i, (f i).to_with_top_nat_apply'.trans (if_pos $ (le_csupr hf i).trans_lt h),
    simp_rw this,
    rintros a (e : _ = (a : with_top ℕ)), refine ⟨_, rfl, _⟩,
    have : bdd_above (set.range (λ i, (f i).to_nat)),
    { rw [← with_top.supr_coe_lt_top, e], exact with_top.coe_lt_top _ },
    rw [← cardinal.to_nat_cast a,
      cardinal.to_nat_le_iff_le_of_lt_aleph_0 h (cardinal.nat_lt_aleph_0 _)],
    refine csupr_le' (λ i, _),
    rw [← with_top.coe_supr _ this, with_top.coe_eq_coe] at e,
    rw [← e, ← cardinal.cast_to_nat_of_lt_aleph_0 ((le_csupr hf i).trans_lt h),
      cardinal.nat_cast_le],
    exact le_csupr this i },
  { rintros a (e : _ = (a : with_top ℕ)),
    apply h.elim,
    refine (csupr_le' _).trans_lt (cardinal.nat_lt_aleph_0 a),
    intro i,
    have : (f i).to_with_top_nat ≤ a := ((le_supr _ _).trans_eq e : _),
    rw [cardinal.to_with_top_nat_apply'] at this,
    split_ifs at this with h',
    { rwa [with_top.coe_le_coe, ← cardinal.nat_cast_le,
        cardinal.cast_to_nat_of_lt_aleph_0 h'] at this },
    { exact (not_le_of_lt (with_top.coe_lt_top a) this).elim } }
end

@[simp]
lemma submodule.length_bot : (⊥ : submodule R M).length = 0 :=
by rw [submodule.length, set.chain_height_eq_zero_iff, set.Iio_bot]

lemma is_field_iff_ideal [nontrivial R] : is_field R ↔ @set.univ (ideal R) = {⊤, ⊥} :=
begin
  rw [← not_iff_not, ring.not_is_field_iff_exists_ideal_bot_lt_and_lt_top, iff_not_comm,
    set.insert_eq, eq_comm, set.eq_univ_iff_forall],
  push_neg,
  simp [bot_lt_iff_ne_bot, or_iff_not_imp_left],
end

instance {R} [field R] : finite (ideal R) :=
begin
  rw [← set.finite_univ_iff, is_field_iff_ideal.mp (field.to_is_field R)],
  simp
end

instance field.is_artinian_ring {R} [field R] : is_artinian_ring R :=
⟨finite.preorder.well_founded_lt⟩

lemma submodule.length_mono {p q : submodule R M} (h : p ≤ q) : p.length ≤ q.length :=
begin
  apply set.chain_height_le_of_subset,
  exact λ x, h.trans_lt',
end

lemma submodule.length_succ_le_of_lt {p q : submodule R M} (h : p < q) : p.length + 1 ≤ q.length :=
begin
  rw [submodule.length_succ],
  apply set.chain_height_le_of_subset,
  exact λ x, h.trans_le',
end

lemma submodule.length_succ_lt_of_lt {p q : submodule R M} (h : p < q) (h' : p.length ≠ ⊤) :
  p.length < q.length :=
begin
  obtain ⟨a, e⟩ := with_top.ne_top_iff_exists.mp h',
  simp_rw [← e, with_top.coe_lt_iff, ← nat.add_one_le_iff, ← with_top.coe_le_iff, with_top.coe_add,
    e, with_top.coe_one],
  exact submodule.length_succ_le_of_lt h,
end

lemma submodule.eq_of_le_of_length_le {p q : submodule R M}
  (h : p ≤ q) (h' : q.length ≤ p.length) (hp : p.length ≠ ⊤) :
  p = q :=
begin
  by_contra h'',
  apply not_lt_of_le rfl.le,
  exact h'.trans_lt (submodule.length_succ_lt_of_lt (lt_of_le_of_ne h h'') hp)
end

lemma is_noetherian_of_finite_length (h : module.length R M ≠ ⊤) : is_noetherian R M :=
begin
  rw is_noetherian_iff_well_founded,
  apply (@order_iso.set.univ (submodule R M) _).symm.to_order_embedding.dual.well_founded,
  rw ← is_well_founded_iff,
  apply set.well_founded_gt_of_chain_height_ne_top,
  rw [← module.length_succ, with_top.add_ne_top],
  exact ⟨h, with_top.one_ne_top⟩,
end

lemma is_artinian_of_finite_length (h : module.length R M ≠ ⊤) : is_artinian R M :=
begin
  rw is_artinian_iff_well_founded,
  apply (@order_iso.set.univ (submodule R M) _).symm.to_order_embedding.well_founded,
  rw ← is_well_founded_iff,
  apply set.well_founded_lt_of_chain_height_ne_top,
  rw [← module.length_succ, with_top.add_ne_top],
  exact ⟨h, with_top.one_ne_top⟩,
end

lemma module.length_eq_rank
  {R M : Type*} [field R] [add_comm_group M] [module R M] :
  module.length R M = (module.rank R M).to_with_top_nat :=
begin
  by_cases is_artinian R M,
  { resetI,
    rw [module.length, ← dim_top],
    generalize : ⊤ = N,
    apply is_artinian.induction _ N; clear N,
    intros N H,
    rw [← submodule.supr_lt_length_succ N, ← rank_supr_lt_add_one, supr_subtype', csupr_subtype,
      cardinal.supr_to_with_top_nat],
    simp_rw [map_add, cardinal.to_with_top_nat_one],
    congr,
    ext1 ⟨p, hp⟩,
    rw [subtype.coe_mk, H _ hp],
    { use module.rank R M + 1, rintros _ ⟨_, rfl⟩, exact add_le_add (dim_submodule_le _) rfl.le },
    { exact ⟨module.rank R M + 1, λ _ _, add_le_add (dim_submodule_le _) rfl.le⟩ } },
  { have : ¬ is_noetherian R M,
    { introI H, apply h, exact is_artinian_of_fg_of_artinian' module.finite.out },
    rw is_noetherian.iff_dim_lt_aleph_0 at this,
    rw [cardinal.to_with_top_nat_apply', if_neg this],
    revert h,
    rw not_imp_comm,
    exact is_artinian_of_finite_length }
end

lemma module.finite_length_tfae_of_field (R M : Type*) [field R] [add_comm_group M] [module R M] :
  tfae [finite_dimensional R M,
    is_noetherian R M,
    is_artinian R M,
    module.length R M ≠ ⊤] :=
begin
  tfae_have : 1 → 2,
  { rintro ⟨a⟩, exact is_noetherian_of_fg_of_noetherian' a, },
  tfae_have : 1 → 3,
  { rintro ⟨a⟩, exact is_artinian_of_fg_of_artinian' a, },
  tfae_have : 2 → 1,
  { introI _, apply_instance },
  tfae_have : 3 → 2,
  { introI H,
    suffices : ∀ p : submodule R M, module.rank R p < cardinal.aleph_0,
    { rw [is_noetherian.iff_dim_lt_aleph_0, ← dim_top], apply this },
    intro p,
    apply is_artinian.induction _ p; clear p,
    intros p H,
    by_contra h,
    push_neg at h,
    obtain ⟨q, hq, e⟩ := add_one_le_dim_iff_exists_submodule_rank_eq.mp (cardinal.add_one_eq h).le,
    refine not_lt_of_le h _,
    rw [← e, (submodule.equiv_map_of_injective _ p.injective_subtype q).dim_eq],
    apply H,
    convert submodule.map_strict_mono_of_injective p.injective_subtype (lt_top_iff_ne_top.mpr hq),
    exact p.map_subtype_top.symm },
  tfae_have : 2 ↔ 4,
  { rw [is_noetherian.iff_dim_lt_aleph_0, module.length_eq_rank, iff_not_comm, not_lt,
      cardinal.to_with_top_nat_eq_top_iff] },
  tfae_finish
end


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.nat.pairing

/-!
# Equivalences involving `ℕ`

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

This file defines some additional constructive equivalences using `encodable` and the pairing
function on `ℕ`.
-/

open nat function

namespace equiv

variables {α : Type*}

/--
An equivalence between `bool × ℕ` and `ℕ`, by mapping `(tt, x)` to `2 * x + 1` and `(ff, x)` to
`2 * x`.
-/
@[simps] def bool_prod_nat_equiv_nat : bool × ℕ ≃ ℕ :=
{ to_fun := uncurry bit,
  inv_fun := bodd_div2,
  left_inv := λ ⟨b, n⟩, by simp only [bodd_bit, div2_bit, uncurry_apply_pair, bodd_div2_eq],
  right_inv := λ n, by simp only [bit_decomp, bodd_div2_eq, uncurry_apply_pair] }

/--
An equivalence between `ℕ ⊕ ℕ` and `ℕ`, by mapping `(sum.inl x)` to `2 * x` and `(sum.inr x)` to
`2 * x + 1`.
-/
@[simps symm_apply] def nat_sum_nat_equiv_nat : ℕ ⊕ ℕ ≃ ℕ :=
(bool_prod_equiv_sum ℕ).symm.trans bool_prod_nat_equiv_nat

@[simp] lemma nat_sum_nat_equiv_nat_apply : ⇑nat_sum_nat_equiv_nat = sum.elim bit0 bit1 :=
by ext (x|x); refl

/--
An equivalence between `ℤ` and `ℕ`, through `ℤ ≃ ℕ ⊕ ℕ` and `ℕ ⊕ ℕ ≃ ℕ`.
-/
def int_equiv_nat : ℤ ≃ ℕ :=
int_equiv_nat_sum_nat.trans nat_sum_nat_equiv_nat

/--
An equivalence between `α × α` and `α`, given that there is an equivalence between `α` and `ℕ`.
-/
def prod_equiv_of_equiv_nat (e : α ≃ ℕ) : α × α ≃ α :=
calc α × α ≃ ℕ × ℕ : prod_congr e e
      ...  ≃ ℕ     : mkpair_equiv
      ...  ≃ α     : e.symm

end equiv


import .defs
import algebra.pi_instances

open espace_metrique
open_locale classical

section suites

variables {X:Type} [espace_metrique X]
variables {Y:Type} [espace_metrique Y]
variables {Z:Type} [espace_metrique Z]
variables {T: Type} [linear_order T]

def strictement_croissante (x: ℕ → T) := ∀ p : ℕ, ∀ q > p, x p < x q

def converge (x: ℕ → X) (l : X) :=
  ∀ ε > 0, ∃ N, ∀ n ≥ N, ((d l (x n))  < ε)

def diverge_inf (x: ℕ → ℕ) :=
  ∀ A, ∃ N, ∀ n ≥ N, x n ≥ A

def cauchy (x: ℕ → X) :=
  ∀ ε > 0, ∃ N, ∀ p ≥ N, ∀ q ≥ N, ((d (x p) (x q)) < ε)

-- Pour tout élément de l'espace,
-- la suite est au plus à M de l'élément de l'espace.
def bornee (x: ℕ → X) :=
  ∀ y : X, ∃ M: ℝ, M > 0 ∧ (∀ n : ℕ, d (x n) y ≤ M)

def suite_image (f : X → Y) (x : ℕ → X) (n: ℕ) := f (x n)
def sous_suite (x: ℕ → X) (φ: ℕ → ℕ) (n: ℕ) := x (φ n)

-- valeur d'adhérence.
def adhere (x: ℕ → X) (l: X) := ∀ ε > 0, ∀ N : ℕ, ∃ p ≥ N, d l (x p) < ε
def c_adhere (x: ℕ → X) (l: X) := ∀ N: ℕ, ∀ n: ℕ, ∃ p ≥ n, d l (x p) < 1 / (N + 1)

def seq_adhere (x: ℕ → X) (l: X)
  := ∃ φ : ℕ → ℕ, strictement_croissante φ ∧ converge (sous_suite x φ) l

lemma neg_converge {x: ℕ → ℝ} {l: ℝ}:
  converge x l → converge (-x) (-l) := begin
  intro cv,
  intros ε hε,
  obtain ⟨ N, hN ⟩ := cv ε hε,
  use N,
  intros n hn,
  simp,
  rw real.dist_eq,
  simp,
  rw ← real.dist_eq,
  rw sym,
  exact hN n hn,
end

lemma add_converge_add {x y: ℕ → ℝ} {a b: ℝ}:
  converge x a ∧ converge y b → converge (x + y) (a + b) := begin
  intro H,
  intros ε hε,
  obtain ⟨ N, hX ⟩ := H.1 (ε/2) (by linarith),
  obtain ⟨ M, hY ⟩ := H.2 (ε/2) (by linarith),
  use (max N M),
  intros n hn,
  rw real.dist_eq,
  calc
  abs (a + b - (x + y) n) = abs (a + b - (x n + y n)) : by simp
  ... = abs (a - x n + (b - y n)) : by rw add_sub_comm _ _ _ _
  ... ≤ abs (a - x n) + abs (b - y n) : abs_add _ _
  ... = d a (x n) + d b (y n) : by rw [← real.dist_eq a (x n), ← real.dist_eq b (y n)]
  ... < ε/2 + ε/2 :
   add_lt_add (hX n (le_of_max_le_left hn)) (hY n (le_of_max_le_right hn))
  ... = ε : by simp,
end

lemma converge_of_dist_lt_one_div_succ {x: ℕ → X} {l: X}: (∀ n, d l (x n) ≤ 1 / (n + 1)) → converge x l := begin
intro H,
intros ε hε,
obtain ⟨ N, hN ⟩ := exists_nat_one_div_lt hε,
use N,
intros n hn,
calc d l (x n) ≤ 1 / (n + 1) : H n
    ... ≤ 1 / (N + 1) : nat.one_div_le_one_div hn
    ... < ε : hN
end

lemma countable_adhere_of_adhere {x: ℕ → X} {l: X}:
  adhere x l → c_adhere x l := begin
  intro adh,
  intros N n,
  obtain ⟨ p, ⟨ hp, hclose ⟩ ⟩ := adh (1/(N + 1)) (nat.one_div_pos_of_nat) n,
  use p,
  split,
  exact hp,
  exact hclose,
end

lemma st_croissante_of_succ {x: ℕ → T}:
  (∀ n, x (n + 1) > x n) → strictement_croissante x := begin
  intro H,
  intros p q hpq,
  induction q with q hq,
  linarith,
  by_cases (q > p),
  calc
    x p < x q : hq h
    ... < x (q + 1) : H q,
  push_neg at h,
  rw le_antisymm h (nat.le_of_lt_succ hpq), -- q = p.
  exact H p,
end

lemma seq_adhere_of_adhere {x: ℕ → X} {l: X}:
  adhere x l → seq_adhere x l := begin
  intro adh,
  choose Y hpos hdist using (countable_adhere_of_adhere adh),
  -- TODO: extraire R et démontrer un lemme type spec dessus.
  have R: ℕ → ℕ := well_founded.fix nat.lt_wf
    (λ n r,
    if n > 0 then (
      Y n
      (nat.find (
        let t := { k | Y n k > r (n - 1) (sorry)}
        in adh (1/(n + 1)) (sorry) (r (n - 1) (sorry) + 1)
      )))
      --(1 + r (n - 1) (sorry))) -- plutôt que de prendre 1 + r (n - 1), il faudrait prendre min { k | Y n k > r (n - 1)}
      -- il existe forcément, puisque c'est une partie de N non vide
      -- en effet, adh fournit un N ≥ r (n - 1) + 1 tel que d l (x N) < 1 / (r(n - 1) + 2) < 1 / (N + 1)
      -- un tel N est dans l'ensemble en question, puisque Y n N < 1 / (n + 1)
    else (
        Y 0 0
      )
    ),
  have Req: ∀ n ≥ 1, (∃ k: ℕ, R n = Y n k) ∧ R n > R (n - 1) := sorry,
  have R0: R 0 = Y 0 0 := sorry,
  use R,
  split,
  apply st_croissante_of_succ,
  intros p,
  cases p,
  simp,
  exact (Req 1 (by simp)).2,
  exact (Req (nat.succ p + 1) (by simp)).2,
  apply converge_of_dist_lt_one_div_succ,
  intro n,
  apply le_of_lt,
  cases n,
  simp,
  rw [sous_suite, R0],
  have := hdist 0 0,
  simp at this,
  exact this,
  obtain ⟨ k, Req ⟩ := (Req (nat.succ n) (sorry)).1,
  rw [sous_suite, Req],
  exact hdist _ _,
end

def identity_seq (n: ℕ) := n
lemma diverge_of_identity_seq:
  diverge_inf identity_seq := begin
  intro A,
  use A,
  intros n hn,
  rw identity_seq,
  exact hn
end
lemma diverge_of_comparison_seq {φ: ℕ → ℕ} {x: ℕ → ℕ}:
  diverge_inf x → (∃ N, ∀ n ≥ N, φ n ≥ x n) → diverge_inf φ := begin
  intros hdivx hcomp,
  intro A,
  obtain ⟨ N, hdivx ⟩ := hdivx A,
  obtain ⟨ M, hcomp ⟩ := hcomp,
  use (max N M),
  intros n hn,
  calc
    φ n ≥ x n : hcomp n (le_of_max_le_right hn)
    ... ≥ A : hdivx n (le_of_max_le_left hn)
end

lemma pos_of_strictly_increasing_seq {φ: ℕ → ℕ}:
  strictement_croissante φ → ∀ n, φ n ≥ n := begin
  intro st,
  intro n,
  induction n with hn,
  simp,
  rw nat.succ_eq_add_one,
  calc
    φ (hn + 1) > φ hn : st hn (hn + 1) (lt_add_one hn)
    ... ≥ hn : n_ih
end

lemma diverge_of_strictly_increasing_seq {φ: ℕ → ℕ}:
  strictement_croissante φ → diverge_inf φ := begin
  intro st,
  apply diverge_of_comparison_seq (diverge_of_identity_seq),
  use 0,
  simp,
  exact pos_of_strictly_increasing_seq st,
end

lemma adhere_of_seq_adhere {x: ℕ → X} {l: X}:
  seq_adhere x l → adhere x l := begin
  intro sadh,
  obtain ⟨ φ, ⟨ hmon, hconv ⟩ ⟩ := sadh,
  intros ε hε N,
  obtain ⟨ P, hconv ⟩ := hconv ε hε,
  obtain ⟨ Q, hPhi ⟩ := diverge_of_strictly_increasing_seq hmon N,
  use (φ (max P Q)),
  split,
  exact hPhi _ (le_max_right _ _),
  exact hconv _ (le_max_left _ _),
end

lemma adhere_iff_seq_adhere {x: ℕ → X} {l: X}:
  adhere x l ↔ seq_adhere x l := begin
  split,
  exact seq_adhere_of_adhere,
  exact adhere_of_seq_adhere,
end

lemma generalized_extractor_of_seq_in_range (x: ℕ → X) (y: ℕ → X) (S: set X):
  S ⊆ (set.range x) → ∀ n, y n ∈ S → ∃ φ : ℕ → ℕ, y = sous_suite x φ := sorry

end suites


/-
Copyright (c) 2022 Rémi Bottinelli. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rémi Bottinelli

! This file was ported from Lean 3 source module combinatorics.quiver.push
! leanprover-community/mathlib commit 2258b40dacd2942571c8ce136215350c702dc78f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Combinatorics.Quiver.Basic

/-!

# Pushing a quiver structure along a map

Given a map `σ : V → W` and a `Quiver` instance on `V`, this files defines a `quiver` instance
on `W` by associating to each arrow `v ⟶ v'` in `V` an arrow `σ v ⟶ σ v'` in `W`.

-/

namespace Quiver

universe v v₁ v₂ u u₁ u₂

variable {V : Type _} [Quiver V] {W : Type _} (σ : V → W)

/-- The `Quiver` instance obtained by pushing arrows of `V` along the map `σ : V → W` -/
@[nolint unusedArguments]
def Push (_ : V → W) :=
  W
#align quiver.push Quiver.Push

instance [h : Nonempty W] : Nonempty (Push σ) :=
  h

/-- The quiver structure obtained by pushing arrows of `V` along the map `σ : V → W` -/
inductive PushQuiver {V : Type u} [Quiver.{v} V] {W : Type u₂} (σ : V → W) : W → W → Type max u u₂ v
  | arrow {X Y : V} (f : X ⟶ Y) : PushQuiver σ (σ X) (σ Y)
#align quiver.push_quiver Quiver.PushQuiver

instance : Quiver (Push σ) :=
  ⟨PushQuiver σ⟩

namespace Push

/-- The prefunctor induced by pushing arrows via `σ` -/
def of : V ⥤q Push σ where
  obj := σ
  map f := PushQuiver.arrow f
#align quiver.push.of Quiver.Push.of

@[simp]
theorem of_obj : (of σ).obj = σ :=
  rfl
#align quiver.push.of_obj Quiver.Push.of_obj

variable {W' : Type _} [Quiver W'] (φ : V ⥤q W') (τ : W → W') (h : ∀ x, φ.obj x = τ (σ x))

/-- Given a function `τ : W → W'` and a prefunctor `φ : V ⥤q W'`, one can extend `τ` to be
a prefunctor `W ⥤q W'` if `τ` and `σ` factorize `φ` at the level of objects, where `W` is given
the pushforward quiver structure `Push σ`. -/
noncomputable def lift : Push σ ⥤q W' where
  obj := τ
  map :=
    @PushQuiver.rec V _ W σ (fun X Y _ => τ X ⟶ τ Y) @fun X Y f => by
      dsimp only
      rw [← h X, ← h Y]
      exact φ.map f
#align quiver.push.lift Quiver.Push.lift

theorem lift_obj : (lift σ φ τ h).obj = τ :=
  rfl
#align quiver.push.lift_obj Quiver.Push.lift_obj

theorem lift_comp : (of σ ⋙q lift σ φ τ h) = φ := by
  fapply Prefunctor.ext
  · rintro X
    simp only [Prefunctor.comp_obj]
    apply Eq.symm
    exact h X
  · rintro X Y f
    simp only [Prefunctor.comp_map]
    apply eq_of_heq
    iterate 2 apply (cast_heq _ _).trans
    apply HEq.symm
    apply (eqRec_heq _ _).trans
    have : ∀ {α γ} {β : α → γ → Sort _} {a a'} (p : a = a') g (b : β a g), HEq (p ▸ b) b := by
      intros
      subst_vars
      rfl
    apply this
#align quiver.push.lift_comp Quiver.Push.lift_comp

theorem lift_unique (Φ : Push σ ⥤q W') (Φ₀ : Φ.obj = τ) (Φcomp : (of σ ⋙q Φ) = φ) :
    Φ = lift σ φ τ h := by
  dsimp only [of, lift]
  fapply Prefunctor.ext
  · intro X
    simp only
    rw [Φ₀]
  · rintro _ _ ⟨⟩
    subst_vars
    simp only [Prefunctor.comp_map, cast_eq]
    rfl
#align quiver.push.lift_unique Quiver.Push.lift_unique

end Push

end Quiver


/-
Copyright (c) 2021 David Wärn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Wärn, Eric Wieser, Joachim Breitner
-/
import group_theory.free_group
/-!
# Free groups structures on arbitrary types

This file defines a type class for type that are free groups, together with the usual operations.
The type class can be instantiated by providing an isomorphim to the canonical free group, or by
proving that the universal property holds.

For the explicit construction of free groups, see `group_theory/free_group`.

## Main definitions

* `is_free_group G` - a typeclass to indicate that `G` is free over some generators
* `is_free_group.of` - the canonical injection of `G`'s generators into `G`
* `is_free_group.lift` - the universal property of the free group

## Main results

* `is_free_group.to_free_group` - any free group with generators `A` is equivalent to
  `free_group A`.
* `is_free_group.unique_lift` - the universal property of a free group
* `is_free_group.of_unique_lift` - constructing `is_free_group` from the universal property

-/

universes u

/-- `is_free_group G` means that `G` isomorphic to a free group. -/
class is_free_group (G : Type u) [group G] :=
(generators : Type u)
(mul_equiv [] : free_group generators ≃* G)

instance (X : Type*) : is_free_group (free_group X) :=
{ generators := X,
  mul_equiv := mul_equiv.refl _ }

namespace is_free_group

variables (G : Type*) [group G] [is_free_group G]

/-- Any free group is isomorphic to "the" free group. -/
@[simps] def to_free_group : G ≃* free_group (generators G) := (mul_equiv G).symm

variable {G}

/-- The canonical injection of G's generators into G -/
def of : generators G → G := (mul_equiv G).to_fun ∘ free_group.of

@[simp] lemma of_eq_free_group_of {A : Type u} : (@of (free_group A) _ _ ) = free_group.of := rfl

variables {H : Type*} [group H]

/-- The equivalence between functions on the generators and group homomorphisms from a free group
given by those generators. -/
def lift : (generators G → H) ≃ (G →* H) :=
free_group.lift.trans
  { to_fun := λ f, f.comp (mul_equiv G).symm.to_monoid_hom,
    inv_fun := λ f, f.comp (mul_equiv G).to_monoid_hom,
    left_inv := λ f, by { ext, simp, },
    right_inv := λ f, by { ext, simp, }, }

@[simp] lemma lift'_eq_free_group_lift {A : Type u} :
  (@lift (free_group A) _ _ H _) = free_group.lift := rfl

@[simp] lemma lift_of (f : generators G → H) (a : generators G) : lift f (of a) = f a :=
congr_fun (lift.symm_apply_apply f) a

@[simp] lemma lift_symm_apply (f : G →* H) (a : generators G) : (lift.symm f) a = f (of a) :=
rfl

@[ext] lemma ext_hom ⦃f g : G →* H⦄ (h : ∀ (a : generators G), f (of a) = g (of a)) : f = g :=
lift.symm.injective (funext h)

/-- The universal property of a free group: A functions from the generators of `G` to another
group extends in a unique way to a homomorphism from `G`.

Note that since `is_free_group.lift` is expressed as a bijection, it already
expresses the universal property.  -/
lemma unique_lift (f : generators G → H) : ∃! F : G →* H, ∀ a, F (of a) = f a :=
by simpa only [function.funext_iff] using lift.symm.bijective.exists_unique f

/-- If a group satisfies the universal property of a free group, then it is a free group, where
the universal property is expressed as in `is_free_group.lift` and its properties. -/
def of_lift {G : Type u} [group G] (X : Type u)
  (of : X → G)
  (lift : ∀ {H : Type u} [group H], by exactI (X → H) ≃ (G →* H))
  (lift_of : ∀ {H : Type u} [group H], by exactI ∀ (f : X → H) a, lift f (of a) = f a) :
  is_free_group G :=
{ generators := X,
  mul_equiv := monoid_hom.to_mul_equiv
    (free_group.lift of)
    (lift free_group.of)
    begin
      apply free_group.ext_hom, intro x,
      simp only [monoid_hom.coe_comp, function.comp_app, monoid_hom.id_apply, free_group.lift.of,
        lift_of],
    end
    begin
      let lift_symm_of : ∀ {H : Type u} [group H], by exactI ∀ (f : G →* H) a,
        lift.symm f a = f (of a) := by introsI H _ f a; simp [← lift_of (lift.symm f)],
      apply lift.symm.injective, ext x,
      simp only [monoid_hom.coe_comp, function.comp_app, monoid_hom.id_apply,
        free_group.lift.of, lift_of, lift_symm_of],
    end }

/-- If a group satisfies the universal property of a free group, then it is a free group, where
the universal property is expressed as in `is_free_group.unique_lift`.  -/
noncomputable
def of_unique_lift {G : Type u} [group G] (X : Type u)
  (of : X → G)
  (h : ∀ {H : Type u} [group H] (f : X → H), by exactI ∃! F : G →* H, ∀ a, F (of a) = f a) :
  is_free_group G :=
let lift {H : Type u} [group H] : by exactI (X → H) ≃ (G →* H) := by exactI
  { to_fun := λ f, classical.some (h f),
    inv_fun := λ F, F ∘ of,
    left_inv := λ f, funext (classical.some_spec (h f)).left,
    right_inv := λ F, ((classical.some_spec (h (F ∘ of))).right F (λ _, rfl)).symm } in
let lift_of {H : Type u} [group H] (f : X → H) (a : X) : by exactI lift f (of a) = f a :=
  by exactI congr_fun (lift.symm_apply_apply f) a in
of_lift X of @lift @lift_of

/-- Being a free group transports across group isomorphisms. -/
def of_mul_equiv {H : Type*} [group H] (h : G ≃* H) : is_free_group H :=
{ generators := generators G, mul_equiv := (mul_equiv G).trans h }

end is_free_group


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.uniform_space.basic
import Mathlib.topology.bases
import Mathlib.data.set.intervals.default
import Mathlib.PostPort

universes u v u_1 l

namespace Mathlib

/-!
# Theory of Cauchy filters in uniform spaces. Complete uniform spaces. Totally bounded subsets.
-/

/-- A filter `f` is Cauchy if for every entourage `r`, there exists an
  `s ∈ f` such that `s × s ⊆ r`. This is a generalization of Cauchy
  sequences, because if `a : ℕ → α` then the filter of sets containing
  cofinitely many of the `a n` is Cauchy iff `a` is a Cauchy sequence. -/
def cauchy {α : Type u} [uniform_space α] (f : filter α) :=
  filter.ne_bot f ∧ filter.prod f f ≤ uniformity α

/-- A set `s` is called *complete*, if any Cauchy filter `f` such that `s ∈ f`
has a limit in `s` (formally, it satisfies `f ≤ 𝓝 x` for some `x ∈ s`). -/
def is_complete {α : Type u} [uniform_space α] (s : set α) :=
  ∀ (f : filter α), cauchy f → f ≤ filter.principal s → ∃ (x : α), ∃ (H : x ∈ s), f ≤ nhds x

theorem filter.has_basis.cauchy_iff {α : Type u} {β : Type v} [uniform_space α] {p : β → Prop}
    {s : β → set (α × α)} (h : filter.has_basis (uniformity α) p s) {f : filter α} :
    cauchy f ↔
        filter.ne_bot f ∧
          ∀ (i : β),
            p i → ∃ (t : set α), ∃ (H : t ∈ f), ∀ (x y : α), x ∈ t → y ∈ t → (x, y) ∈ s i :=
  sorry

theorem cauchy_iff' {α : Type u} [uniform_space α] {f : filter α} :
    cauchy f ↔
        filter.ne_bot f ∧
          ∀ (s : set (α × α)) (H : s ∈ uniformity α),
            ∃ (t : set α), ∃ (H : t ∈ f), ∀ (x y : α), x ∈ t → y ∈ t → (x, y) ∈ s :=
  filter.has_basis.cauchy_iff (filter.basis_sets (uniformity α))

theorem cauchy_iff {α : Type u} [uniform_space α] {f : filter α} :
    cauchy f ↔
        filter.ne_bot f ∧
          ∀ (s : set (α × α)) (H : s ∈ uniformity α),
            ∃ (t : set α), ∃ (H : t ∈ f), set.prod t t ⊆ s :=
  sorry

theorem cauchy_map_iff {α : Type u} {β : Type v} [uniform_space α] {l : filter β} {f : β → α} :
    cauchy (filter.map f l) ↔
        filter.ne_bot l ∧
          filter.tendsto (fun (p : β × β) => (f (prod.fst p), f (prod.snd p))) (filter.prod l l)
            (uniformity α) :=
  sorry

theorem cauchy_map_iff' {α : Type u} {β : Type v} [uniform_space α] {l : filter β}
    [hl : filter.ne_bot l] {f : β → α} :
    cauchy (filter.map f l) ↔
        filter.tendsto (fun (p : β × β) => (f (prod.fst p), f (prod.snd p))) (filter.prod l l)
          (uniformity α) :=
  iff.trans cauchy_map_iff (and_iff_right hl)

theorem cauchy.mono {α : Type u} [uniform_space α] {f : filter α} {g : filter α}
    [hg : filter.ne_bot g] (h_c : cauchy f) (h_le : g ≤ f) : cauchy g :=
  { left := hg, right := le_trans (filter.prod_mono h_le h_le) (and.right h_c) }

theorem cauchy.mono' {α : Type u} [uniform_space α] {f : filter α} {g : filter α} (h_c : cauchy f)
    (hg : filter.ne_bot g) (h_le : g ≤ f) : cauchy g :=
  cauchy.mono h_c h_le

theorem cauchy_nhds {α : Type u} [uniform_space α] {a : α} : cauchy (nhds a) := sorry

theorem cauchy_pure {α : Type u} [uniform_space α] {a : α} : cauchy (pure a) :=
  cauchy.mono cauchy_nhds (pure_le_nhds a)

theorem filter.tendsto.cauchy_map {α : Type u} {β : Type v} [uniform_space α] {l : filter β}
    [filter.ne_bot l] {f : β → α} {a : α} (h : filter.tendsto f l (nhds a)) :
    cauchy (filter.map f l) :=
  cauchy.mono cauchy_nhds h

/-- The common part of the proofs of `le_nhds_of_cauchy_adhp` and
`sequentially_complete.le_nhds_of_seq_tendsto_nhds`: if for any entourage `s`
one can choose a set `t ∈ f` of diameter `s` such that it contains a point `y`
with `(x, y) ∈ s`, then `f` converges to `x`. -/
theorem le_nhds_of_cauchy_adhp_aux {α : Type u} [uniform_space α] {f : filter α} {x : α}
    (adhs :
      ∀ (s : set (α × α)) (H : s ∈ uniformity α),
        ∃ (t : set α), ∃ (H : t ∈ f), set.prod t t ⊆ s ∧ ∃ (y : α), (x, y) ∈ s ∧ y ∈ t) :
    f ≤ nhds x :=
  sorry

/-- If `x` is an adherent (cluster) point for a Cauchy filter `f`, then it is a limit point
for `f`. -/
theorem le_nhds_of_cauchy_adhp {α : Type u} [uniform_space α] {f : filter α} {x : α} (hf : cauchy f)
    (adhs : cluster_pt x f) : f ≤ nhds x :=
  sorry

theorem le_nhds_iff_adhp_of_cauchy {α : Type u} [uniform_space α] {f : filter α} {x : α}
    (hf : cauchy f) : f ≤ nhds x ↔ cluster_pt x f :=
  { mp := fun (h : f ≤ nhds x) => cluster_pt.of_le_nhds' h (and.left hf),
    mpr := le_nhds_of_cauchy_adhp hf }

theorem cauchy.map {α : Type u} {β : Type v} [uniform_space α] [uniform_space β] {f : filter α}
    {m : α → β} (hf : cauchy f) (hm : uniform_continuous m) : cauchy (filter.map m f) :=
  { left := filter.ne_bot.map (and.left hf) m,
    right :=
      le_trans (trans_rel_right LessEq filter.prod_map_map_eq (filter.map_mono (and.right hf))) hm }

theorem cauchy.comap {α : Type u} {β : Type v} [uniform_space α] [uniform_space β] {f : filter β}
    {m : α → β} (hf : cauchy f)
    (hm :
      filter.comap (fun (p : α × α) => (m (prod.fst p), m (prod.snd p))) (uniformity β) ≤
        uniformity α)
    [filter.ne_bot (filter.comap m f)] : cauchy (filter.comap m f) :=
  { left := _inst_3,
    right :=
      le_trans
        (trans_rel_right LessEq filter.prod_comap_comap_eq (filter.comap_mono (and.right hf))) hm }

theorem cauchy.comap' {α : Type u} {β : Type v} [uniform_space α] [uniform_space β] {f : filter β}
    {m : α → β} (hf : cauchy f)
    (hm :
      filter.comap (fun (p : α × α) => (m (prod.fst p), m (prod.snd p))) (uniformity β) ≤
        uniformity α)
    (hb : filter.ne_bot (filter.comap m f)) : cauchy (filter.comap m f) :=
  cauchy.comap hf hm

/-- Cauchy sequences. Usually defined on ℕ, but often it is also useful to say that a function
defined on ℝ is Cauchy at +∞ to deduce convergence. Therefore, we define it in a type class that
is general enough to cover both ℕ and ℝ, which are the main motivating examples. -/
def cauchy_seq {α : Type u} {β : Type v} [uniform_space α] [semilattice_sup β] (u : β → α) :=
  cauchy (filter.map u filter.at_top)

theorem cauchy_seq.mem_entourage {α : Type u} [uniform_space α] {ι : Type u_1} [Nonempty ι]
    [linear_order ι] {u : ι → α} (h : cauchy_seq u) {V : set (α × α)} (hV : V ∈ uniformity α) :
    ∃ (k₀ : ι), ∀ (i j : ι), k₀ ≤ i → k₀ ≤ j → (u i, u j) ∈ V :=
  sorry

theorem filter.tendsto.cauchy_seq {α : Type u} {β : Type v} [uniform_space α] [semilattice_sup β]
    [Nonempty β] {f : β → α} {x : α} (hx : filter.tendsto f filter.at_top (nhds x)) :
    cauchy_seq f :=
  filter.tendsto.cauchy_map hx

theorem cauchy_seq_iff_tendsto {α : Type u} {β : Type v} [uniform_space α] [Nonempty β]
    [semilattice_sup β] {u : β → α} :
    cauchy_seq u ↔ filter.tendsto (prod.map u u) filter.at_top (uniformity α) :=
  sorry

/-- If a Cauchy sequence has a convergent subsequence, then it converges. -/
theorem tendsto_nhds_of_cauchy_seq_of_subseq {α : Type u} {β : Type v} [uniform_space α]
    [semilattice_sup β] {u : β → α} (hu : cauchy_seq u) {ι : Type u_1} {f : ι → β} {p : filter ι}
    [filter.ne_bot p] (hf : filter.tendsto f p filter.at_top) {a : α}
    (ha : filter.tendsto (u ∘ f) p (nhds a)) : filter.tendsto u filter.at_top (nhds a) :=
  le_nhds_of_cauchy_adhp hu (map_cluster_pt_of_comp hf ha)

theorem filter.has_basis.cauchy_seq_iff {α : Type u} {β : Type v} [uniform_space α] {γ : Type u_1}
    [Nonempty β] [semilattice_sup β] {u : β → α} {p : γ → Prop} {s : γ → set (α × α)}
    (h : filter.has_basis (uniformity α) p s) :
    cauchy_seq u ↔ ∀ (i : γ), p i → ∃ (N : β), ∀ (m n : β), m ≥ N → n ≥ N → (u m, u n) ∈ s i :=
  sorry

theorem filter.has_basis.cauchy_seq_iff' {α : Type u} {β : Type v} [uniform_space α] {γ : Type u_1}
    [Nonempty β] [semilattice_sup β] {u : β → α} {p : γ → Prop} {s : γ → set (α × α)}
    (H : filter.has_basis (uniformity α) p s) :
    cauchy_seq u ↔ ∀ (i : γ), p i → ∃ (N : β), ∀ (n : β), n ≥ N → (u n, u N) ∈ s i :=
  sorry

theorem cauchy_seq_of_controlled {α : Type u} {β : Type v} [uniform_space α] [semilattice_sup β]
    [Nonempty β] (U : β → set (α × α))
    (hU : ∀ (s : set (α × α)), s ∈ uniformity α → ∃ (n : β), U n ⊆ s) {f : β → α}
    (hf : ∀ {N m n : β}, N ≤ m → N ≤ n → (f m, f n) ∈ U N) : cauchy_seq f :=
  sorry

/-- A complete space is defined here using uniformities. A uniform space
  is complete if every Cauchy filter converges. -/
class complete_space (α : Type u) [uniform_space α] where
  complete : ∀ {f : filter α}, cauchy f → ∃ (x : α), f ≤ nhds x

theorem complete_univ {α : Type u} [uniform_space α] [complete_space α] : is_complete set.univ :=
  sorry

theorem cauchy_prod {α : Type u} {β : Type v} [uniform_space α] [uniform_space β] {f : filter α}
    {g : filter β} : cauchy f → cauchy g → cauchy (filter.prod f g) :=
  sorry

protected instance complete_space.prod {α : Type u} {β : Type v} [uniform_space α] [uniform_space β]
    [complete_space α] [complete_space β] : complete_space (α × β) :=
  complete_space.mk fun (f : filter (α × β)) (hf : cauchy f) => sorry

/--If `univ` is complete, the space is a complete space -/
theorem complete_space_of_is_complete_univ {α : Type u} [uniform_space α]
    (h : is_complete set.univ) : complete_space α :=
  sorry

theorem complete_space_iff_is_complete_univ {α : Type u} [uniform_space α] :
    complete_space α ↔ is_complete set.univ :=
  { mp := complete_univ, mpr := complete_space_of_is_complete_univ }

theorem cauchy_iff_exists_le_nhds {α : Type u} [uniform_space α] [complete_space α] {l : filter α}
    [filter.ne_bot l] : cauchy l ↔ ∃ (x : α), l ≤ nhds x :=
  sorry

theorem cauchy_map_iff_exists_tendsto {α : Type u} {β : Type v} [uniform_space α] [complete_space α]
    {l : filter β} {f : β → α} [filter.ne_bot l] :
    cauchy (filter.map f l) ↔ ∃ (x : α), filter.tendsto f l (nhds x) :=
  cauchy_iff_exists_le_nhds

/-- A Cauchy sequence in a complete space converges -/
theorem cauchy_seq_tendsto_of_complete {α : Type u} {β : Type v} [uniform_space α]
    [semilattice_sup β] [complete_space α] {u : β → α} (H : cauchy_seq u) :
    ∃ (x : α), filter.tendsto u filter.at_top (nhds x) :=
  complete_space.complete H

/-- If `K` is a complete subset, then any cauchy sequence in `K` converges to a point in `K` -/
theorem cauchy_seq_tendsto_of_is_complete {α : Type u} {β : Type v} [uniform_space α]
    [semilattice_sup β] {K : set α} (h₁ : is_complete K) {u : β → α} (h₂ : ∀ (n : β), u n ∈ K)
    (h₃ : cauchy_seq u) : ∃ (v : α), ∃ (H : v ∈ K), filter.tendsto u filter.at_top (nhds v) :=
  sorry

theorem cauchy.le_nhds_Lim {α : Type u} [uniform_space α] [complete_space α] [Nonempty α]
    {f : filter α} (hf : cauchy f) : f ≤ nhds (Lim f) :=
  le_nhds_Lim (complete_space.complete hf)

theorem cauchy_seq.tendsto_lim {α : Type u} {β : Type v} [uniform_space α] [semilattice_sup β]
    [complete_space α] [Nonempty α] {u : β → α} (h : cauchy_seq u) :
    filter.tendsto u filter.at_top (nhds (lim filter.at_top u)) :=
  cauchy.le_nhds_Lim h

theorem is_closed.is_complete {α : Type u} [uniform_space α] [complete_space α] {s : set α}
    (h : is_closed s) : is_complete s :=
  sorry

/-- A set `s` is totally bounded if for every entourage `d` there is a finite
  set of points `t` such that every element of `s` is `d`-near to some element of `t`. -/
def totally_bounded {α : Type u} [uniform_space α] (s : set α) :=
  ∀ (d : set (α × α)) (H : d ∈ uniformity α),
    ∃ (t : set α),
      set.finite t ∧
        s ⊆ set.Union fun (y : α) => set.Union fun (H : y ∈ t) => set_of fun (x : α) => (x, y) ∈ d

theorem totally_bounded_iff_subset {α : Type u} [uniform_space α] {s : set α} :
    totally_bounded s ↔
        ∀ (d : set (α × α)) (H : d ∈ uniformity α),
          ∃ (t : set α),
            ∃ (H : t ⊆ s),
              set.finite t ∧
                s ⊆
                  set.Union
                    fun (y : α) => set.Union fun (H : y ∈ t) => set_of fun (x : α) => (x, y) ∈ d :=
  sorry

theorem totally_bounded_of_forall_symm {α : Type u} [uniform_space α] {s : set α}
    (h :
      ∀ (V : set (α × α)) (H : V ∈ uniformity α),
        symmetric_rel V →
          ∃ (t : set α),
            set.finite t ∧
              s ⊆ set.Union fun (y : α) => set.Union fun (H : y ∈ t) => uniform_space.ball y V) :
    totally_bounded s :=
  sorry

theorem totally_bounded_subset {α : Type u} [uniform_space α] {s₁ : set α} {s₂ : set α}
    (hs : s₁ ⊆ s₂) (h : totally_bounded s₂) : totally_bounded s₁ :=
  sorry

theorem totally_bounded_empty {α : Type u} [uniform_space α] : totally_bounded ∅ := sorry

/-- The closure of a totally bounded set is totally bounded. -/
theorem totally_bounded.closure {α : Type u} [uniform_space α] {s : set α} (h : totally_bounded s) :
    totally_bounded (closure s) :=
  sorry

/-- The image of a totally bounded set under a unifromly continuous map is totally bounded. -/
theorem totally_bounded.image {α : Type u} {β : Type v} [uniform_space α] [uniform_space β]
    {f : α → β} {s : set α} (hs : totally_bounded s) (hf : uniform_continuous f) :
    totally_bounded (f '' s) :=
  sorry

theorem ultrafilter.cauchy_of_totally_bounded {α : Type u} [uniform_space α] {s : set α}
    (f : ultrafilter α) (hs : totally_bounded s) (h : ↑f ≤ filter.principal s) : cauchy ↑f :=
  sorry

theorem totally_bounded_iff_filter {α : Type u} [uniform_space α] {s : set α} :
    totally_bounded s ↔
        ∀ (f : filter α),
          filter.ne_bot f → f ≤ filter.principal s → ∃ (c : filter α), ∃ (H : c ≤ f), cauchy c :=
  sorry

theorem totally_bounded_iff_ultrafilter {α : Type u} [uniform_space α] {s : set α} :
    totally_bounded s ↔ ∀ (f : ultrafilter α), ↑f ≤ filter.principal s → cauchy ↑f :=
  sorry

theorem compact_iff_totally_bounded_complete {α : Type u} [uniform_space α] {s : set α} :
    is_compact s ↔ totally_bounded s ∧ is_complete s :=
  sorry

protected instance complete_of_compact {α : Type u} [uniform_space α] [compact_space α] :
    complete_space α :=
  sorry

theorem compact_of_totally_bounded_is_closed {α : Type u} [uniform_space α] [complete_space α]
    {s : set α} (ht : totally_bounded s) (hc : is_closed s) : is_compact s :=
  iff.mpr compact_iff_totally_bounded_complete { left := ht, right := is_closed.is_complete hc }

/-!
### Sequentially complete space

In this section we prove that a uniform space is complete provided that it is sequentially complete
(i.e., any Cauchy sequence converges) and its uniformity filter admits a countable generating set.
In particular, this applies to (e)metric spaces, see the files `topology/metric_space/emetric_space`
and `topology/metric_space/basic`.

More precisely, we assume that there is a sequence of entourages `U_n` such that any other
entourage includes one of `U_n`. Then any Cauchy filter `f` generates a decreasing sequence of
sets `s_n ∈ f` such that `s_n × s_n ⊆ U_n`. Choose a sequence `x_n∈s_n`. It is easy to show
that this is a Cauchy sequence. If this sequence converges to some `a`, then `f ≤ 𝓝 a`. -/

namespace sequentially_complete

/-- An auxiliary sequence of sets approximating a Cauchy filter. -/
def set_seq_aux {α : Type u} [uniform_space α] {f : filter α} (hf : cauchy f) {U : ℕ → set (α × α)}
    (U_mem : ∀ (n : ℕ), U n ∈ uniformity α) (n : ℕ) :
    Subtype fun (s : set α) => ∃ (_x : s ∈ f), set.prod s s ⊆ U n :=
  classical.indefinite_description (fun (s : set α) => ∃ (_x : s ∈ f), set.prod s s ⊆ U n) sorry

/-- Given a Cauchy filter `f` and a sequence `U` of entourages, `set_seq` provides
a sequence of monotonically decreasing sets `s n ∈ f` such that `(s n).prod (s n) ⊆ U`. -/
def set_seq {α : Type u} [uniform_space α] {f : filter α} (hf : cauchy f) {U : ℕ → set (α × α)}
    (U_mem : ∀ (n : ℕ), U n ∈ uniformity α) (n : ℕ) : set α :=
  set.Inter fun (m : ℕ) => set.Inter fun (H : m ∈ set.Iic n) => subtype.val (set_seq_aux hf U_mem m)

theorem set_seq_mem {α : Type u} [uniform_space α] {f : filter α} (hf : cauchy f)
    {U : ℕ → set (α × α)} (U_mem : ∀ (n : ℕ), U n ∈ uniformity α) (n : ℕ) :
    set_seq hf U_mem n ∈ f :=
  iff.mpr (filter.bInter_mem_sets (set.finite_le_nat n))
    fun (m : ℕ) (_x : m ∈ set_of fun (i : ℕ) => i ≤ n) =>
      Exists.fst (subtype.property (set_seq_aux hf U_mem m))

theorem set_seq_mono {α : Type u} [uniform_space α] {f : filter α} (hf : cauchy f)
    {U : ℕ → set (α × α)} (U_mem : ∀ (n : ℕ), U n ∈ uniformity α) {m : ℕ} {n : ℕ} (h : m ≤ n) :
    set_seq hf U_mem n ⊆ set_seq hf U_mem m :=
  set.bInter_subset_bInter_left fun (k : ℕ) (hk : k ∈ set.Iic m) => le_trans hk h

theorem set_seq_sub_aux {α : Type u} [uniform_space α] {f : filter α} (hf : cauchy f)
    {U : ℕ → set (α × α)} (U_mem : ∀ (n : ℕ), U n ∈ uniformity α) (n : ℕ) :
    set_seq hf U_mem n ⊆ ↑(set_seq_aux hf U_mem n) :=
  set.bInter_subset_of_mem set.right_mem_Iic

theorem set_seq_prod_subset {α : Type u} [uniform_space α] {f : filter α} (hf : cauchy f)
    {U : ℕ → set (α × α)} (U_mem : ∀ (n : ℕ), U n ∈ uniformity α) {N : ℕ} {m : ℕ} {n : ℕ}
    (hm : N ≤ m) (hn : N ≤ n) : set.prod (set_seq hf U_mem m) (set_seq hf U_mem n) ⊆ U N :=
  sorry

/-- A sequence of points such that `seq n ∈ set_seq n`. Here `set_seq` is a monotonically
decreasing sequence of sets `set_seq n ∈ f` with diameters controlled by a given sequence
of entourages. -/
def seq {α : Type u} [uniform_space α] {f : filter α} (hf : cauchy f) {U : ℕ → set (α × α)}
    (U_mem : ∀ (n : ℕ), U n ∈ uniformity α) (n : ℕ) : α :=
  classical.some sorry

theorem seq_mem {α : Type u} [uniform_space α] {f : filter α} (hf : cauchy f) {U : ℕ → set (α × α)}
    (U_mem : ∀ (n : ℕ), U n ∈ uniformity α) (n : ℕ) : seq hf U_mem n ∈ set_seq hf U_mem n :=
  classical.some_spec (filter.ne_bot.nonempty_of_mem (and.left hf) (set_seq_mem hf U_mem n))

theorem seq_pair_mem {α : Type u} [uniform_space α] {f : filter α} (hf : cauchy f)
    {U : ℕ → set (α × α)} (U_mem : ∀ (n : ℕ), U n ∈ uniformity α) {N : ℕ} {m : ℕ} {n : ℕ}
    (hm : N ≤ m) (hn : N ≤ n) : (seq hf U_mem m, seq hf U_mem n) ∈ U N :=
  set_seq_prod_subset hf U_mem hm hn { left := seq_mem hf U_mem m, right := seq_mem hf U_mem n }

theorem seq_is_cauchy_seq {α : Type u} [uniform_space α] {f : filter α} (hf : cauchy f)
    {U : ℕ → set (α × α)} (U_mem : ∀ (n : ℕ), U n ∈ uniformity α)
    (U_le : ∀ (s : set (α × α)), s ∈ uniformity α → ∃ (n : ℕ), U n ⊆ s) :
    cauchy_seq (seq hf U_mem) :=
  cauchy_seq_of_controlled U U_le (seq_pair_mem hf U_mem)

/-- If the sequence `sequentially_complete.seq` converges to `a`, then `f ≤ 𝓝 a`. -/
theorem le_nhds_of_seq_tendsto_nhds {α : Type u} [uniform_space α] {f : filter α} (hf : cauchy f)
    {U : ℕ → set (α × α)} (U_mem : ∀ (n : ℕ), U n ∈ uniformity α)
    (U_le : ∀ (s : set (α × α)), s ∈ uniformity α → ∃ (n : ℕ), U n ⊆ s) {a : α}
    (ha : filter.tendsto (seq hf U_mem) filter.at_top (nhds a)) : f ≤ nhds a :=
  sorry

end sequentially_complete

namespace uniform_space

/-- A uniform space is complete provided that (a) its uniformity filter has a countable basis;
(b) any sequence satisfying a "controlled" version of the Cauchy condition converges. -/
theorem complete_of_convergent_controlled_sequences {α : Type u} [uniform_space α]
    (H : filter.is_countably_generated (uniformity α)) (U : ℕ → set (α × α))
    (U_mem : ∀ (n : ℕ), U n ∈ uniformity α)
    (HU :
      ∀ (u : ℕ → α),
        (∀ (N m n : ℕ), N ≤ m → N ≤ n → (u m, u n) ∈ U N) →
          ∃ (a : α), filter.tendsto u filter.at_top (nhds a)) :
    complete_space α :=
  sorry

/-- A sequentially complete uniform space with a countable basis of the uniformity filter is
complete. -/
theorem complete_of_cauchy_seq_tendsto {α : Type u} [uniform_space α]
    (H : filter.is_countably_generated (uniformity α))
    (H' : ∀ (u : ℕ → α), cauchy_seq u → ∃ (a : α), filter.tendsto u filter.at_top (nhds a)) :
    complete_space α :=
  sorry

protected theorem first_countable_topology {α : Type u} [uniform_space α]
    (H : filter.is_countably_generated (uniformity α)) :
    topological_space.first_countable_topology α :=
  sorry

/-- A separable uniform space with countably generated uniformity filter is second countable:
one obtains a countable basis by taking the balls centered at points in a dense subset,
and with rational "radii" from a countable open symmetric antimono basis of `𝓤 α`. We do not
register this as an instance, as there is already an instance going in the other direction
from second countable spaces to separable spaces, and we want to avoid loops. -/
theorem second_countable_of_separable {α : Type u} [uniform_space α]
    (H : filter.is_countably_generated (uniformity α)) [topological_space.separable_space α] :
    topological_space.second_countable_topology α :=
  sorry

end Mathlib


import data.finset.basic
import data.vector

import tactic.linarith

def tofinset' : ∀ {n : ℕ} {α : Type} [decidable_eq α], vector α n -> finset α
| 0 _ _ vec := ∅
| (nat.succ n) α eq_dec_inst vec :=
  let union := (@finset.has_union α eq_dec_inst).union
  in union (@tofinset' n α eq_dec_inst (vec.tail)) (singleton (vec.head))

lemma vec_head_in_finset : ∀ {n : ℕ} {α : Type} [inst : decidable_eq α] (vec : vector α (n+1)),
              vec.head ∈ @tofinset' (n+1) α inst vec :=
  begin
    intros n α inst vec,
    rw tofinset',
    apply finset.mem_union.2,
    exact or.inr (finset.mem_singleton_self vec.head),
  end

lemma tl_finset_subset_vec_finset :
  ∀ {n : ℕ} {α : Type} [inst : decidable_eq α] (vec : vector α (n+1)),
    @tofinset' n α inst vec.tail ⊆ @tofinset' (n+1) α inst vec :=
  begin
    intros n α inst vec,
    rw tofinset',
    exact @finset.subset_union_left α inst (@tofinset' n α inst vec.tail) _,
  end

def tofinset {n : ℕ} {α : Type} [α_eq_dec : decidable_eq α] (f : fin n → α) : finset α :=
      tofinset' (vector.of_fn f)

def default_vals : ∀ {α : Type} {n : ℕ}, α → vector α n
| α 0 _ := vector.nil
| α (nat.succ n) a := vector.cons a (default_vals a)

lemma ord_lem : ∀ (z : ℕ) {x y : ℕ}, x ≤ y → x < 1 + z + y :=
  begin
    intros x y z x_leq_y,
    linarith,
  end

lemma of_fn_lemma : ∀ {α : Type} {n : ℕ} (f g : fin n → α),
        (∀ i : fin n, f i = g i) → list.of_fn f = list.of_fn g :=
  begin
    intros α n f g forall_i_f_eq_g,
    induction n,
    rw list.of_fn_zero f,
    rw list.of_fn_zero g,
    rw list.of_fn_succ f,
    rw list.of_fn_succ g,
    rw forall_i_f_eq_g 0,
    rw (list.cons_inj (g 0)).2,
    apply n_ih (λi, f i.succ) (λi, g i.succ),
    intro i,
    change f i.succ = g i.succ,
    exact forall_i_f_eq_g i.succ,
  end


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Yury Kudryashov, Neil Strickland

! This file was ported from Lean 3 source module algebra.ring.commute
! leanprover-community/mathlib commit 70d50ecfd4900dd6d328da39ab7ebd516abe4025
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Ring.Semiconj
import Mathlib.Algebra.Ring.Units
import Mathlib.Algebra.Group.Commute

/-!
# Semirings and rings

This file gives lemmas about semirings, rings and domains.
This is analogous to `Mathlib.Algebra.Group.Basic`,
the difference being that the former is about `+` and `*` separately, while
the present file is about their interaction.

For the definitions of semirings and rings see `Mathlib.Algebra.Ring.Defs`.

-/

universe u v w x

variable {α : Type u} {β : Type v} {γ : Type w} {R : Type x}

open Function

namespace Commute

@[simp]
theorem add_right [Distrib R] {a b c : R} : Commute a b → Commute a c → Commute a (b + c) :=
  SemiconjBy.add_right
#align commute.add_right Commute.add_rightₓ
-- for some reason mathport expected `Semiring` instead of `Distrib`?

@[simp]
theorem add_left [Distrib R] {a b c : R} : Commute a c → Commute b c → Commute (a + b) c :=
  SemiconjBy.add_left
#align commute.add_left Commute.add_leftₓ
-- for some reason mathport expected `Semiring` instead of `Distrib`?

section deprecated
set_option linter.deprecated false

@[deprecated]
theorem bit0_right [Distrib R] {x y : R} (h : Commute x y) : Commute x (bit0 y) :=
  h.add_right h
#align commute.bit0_right Commute.bit0_right

@[deprecated]
theorem bit0_left [Distrib R] {x y : R} (h : Commute x y) : Commute (bit0 x) y :=
  h.add_left h
#align commute.bit0_left Commute.bit0_left

@[deprecated]
theorem bit1_right [NonAssocSemiring R] {x y : R} (h : Commute x y) : Commute x (bit1 y) :=
  h.bit0_right.add_right (Commute.one_right x)
#align commute.bit1_right Commute.bit1_right

@[deprecated]
theorem bit1_left [NonAssocSemiring R] {x y : R} (h : Commute x y) : Commute (bit1 x) y :=
  h.bit0_left.add_left (Commute.one_left y)
#align commute.bit1_left Commute.bit1_left

end deprecated

/-- Representation of a difference of two squares of commuting elements as a product. -/
theorem mul_self_sub_mul_self_eq [NonUnitalNonAssocRing R] {a b : R} (h : Commute a b) :
    a * a - b * b = (a + b) * (a - b) := by
  rw [add_mul, mul_sub, mul_sub, h.eq, sub_add_sub_cancel]
#align commute.mul_self_sub_mul_self_eq Commute.mul_self_sub_mul_self_eq

theorem mul_self_sub_mul_self_eq' [NonUnitalNonAssocRing R] {a b : R} (h : Commute a b) :
    a * a - b * b = (a - b) * (a + b) := by
  rw [mul_add, sub_mul, sub_mul, h.eq, sub_add_sub_cancel]
#align commute.mul_self_sub_mul_self_eq' Commute.mul_self_sub_mul_self_eq'

theorem mul_self_eq_mul_self_iff [NonUnitalNonAssocRing R] [NoZeroDivisors R] {a b : R}
    (h : Commute a b) : a * a = b * b ↔ a = b ∨ a = -b := by
  rw [← sub_eq_zero, h.mul_self_sub_mul_self_eq, mul_eq_zero, or_comm, sub_eq_zero,
    add_eq_zero_iff_eq_neg]
#align commute.mul_self_eq_mul_self_iff Commute.mul_self_eq_mul_self_iff

section

variable [Mul R] [HasDistribNeg R] {a b : R}

theorem neg_right : Commute a b → Commute a (-b) :=
  SemiconjBy.neg_right
#align commute.neg_right Commute.neg_right

@[simp]
theorem neg_right_iff : Commute a (-b) ↔ Commute a b :=
  SemiconjBy.neg_right_iff
#align commute.neg_right_iff Commute.neg_right_iff

theorem neg_left : Commute a b → Commute (-a) b :=
  SemiconjBy.neg_left
#align commute.neg_left Commute.neg_left

@[simp]
theorem neg_left_iff : Commute (-a) b ↔ Commute a b :=
  SemiconjBy.neg_left_iff
#align commute.neg_left_iff Commute.neg_left_iff

end

section

variable [MulOneClass R] [HasDistribNeg R] {a : R}

-- Porting note: no longer needs to be `@[simp]` since `simp` can prove it.
-- @[simp]
theorem neg_one_right (a : R) : Commute a (-1) :=
  SemiconjBy.neg_one_right a
#align commute.neg_one_right Commute.neg_one_right

-- Porting note: no longer needs to be `@[simp]` since `simp` can prove it.
-- @[simp]
theorem neg_one_left (a : R) : Commute (-1) a :=
  SemiconjBy.neg_one_left a
#align commute.neg_one_left Commute.neg_one_left

end

section

variable [NonUnitalNonAssocRing R] {a b c : R}

@[simp]
theorem sub_right : Commute a b → Commute a c → Commute a (b - c) :=
  SemiconjBy.sub_right
#align commute.sub_right Commute.sub_right

@[simp]
theorem sub_left : Commute a c → Commute b c → Commute (a - b) c :=
  SemiconjBy.sub_left
#align commute.sub_left Commute.sub_left

end

end Commute

/-- Representation of a difference of two squares in a commutative ring as a product. -/
theorem mul_self_sub_mul_self [CommRing R] (a b : R) : a * a - b * b = (a + b) * (a - b) :=
  (Commute.all a b).mul_self_sub_mul_self_eq
#align mul_self_sub_mul_self mul_self_sub_mul_self

theorem mul_self_sub_one [NonAssocRing R] (a : R) : a * a - 1 = (a + 1) * (a - 1) := by
  rw [← (Commute.one_right a).mul_self_sub_mul_self_eq, mul_one]
#align mul_self_sub_one mul_self_sub_one

theorem mul_self_eq_mul_self_iff [CommRing R] [NoZeroDivisors R] {a b : R} :
    a * a = b * b ↔ a = b ∨ a = -b :=
  (Commute.all a b).mul_self_eq_mul_self_iff
#align mul_self_eq_mul_self_iff mul_self_eq_mul_self_iff

theorem mul_self_eq_one_iff [NonAssocRing R] [NoZeroDivisors R] {a : R} :
    a * a = 1 ↔ a = 1 ∨ a = -1 := by
  rw [← (Commute.one_right a).mul_self_eq_mul_self_iff, mul_one]
#align mul_self_eq_one_iff mul_self_eq_one_iff

namespace Units

/-- In the unit group of an integral domain, a unit is its own inverse iff the unit is one or
  one's additive inverse. -/
theorem inv_eq_self_iff [Ring R] [NoZeroDivisors R] (u : Rˣ) : u⁻¹ = u ↔ u = 1 ∨ u = -1 := by
  rw [inv_eq_iff_mul_eq_one]
  simp only [ext_iff]
  push_cast
  exact mul_self_eq_one_iff
#align units.inv_eq_self_iff Units.inv_eq_self_iff

end Units


import tactic
import data.rel
import data.vector
import data.nat.basic

open rel vector nat

variables {α β γ δ ε φ ψ : Type}

/- Basic defintions & notation -/

def par (r : rel α β) (s : rel γ δ) : rel (α × γ) (β × δ)
  := λ ⟨a,c⟩ ⟨b,d⟩, r a b ∧ s c d

infixl `;;`:60 := comp
notation `[` r `,` s `]` := par r s
postfix `†`:70 := inv

def conj (r : rel α α) (s : rel α β) : rel β β
  := s† ;; r ;; s

def conjt (r : rel (α × β) (β × α)) (s : rel β γ × rel α δ) : rel (δ × γ) (γ × δ)
  := [s.2†, s.1†] ;; r ;; [s.1, s.2]

infixl `\`:70 := conj
infixl `\\`:70 := conjt
notation `⟦` r `,` s `⟧` := ⟨r,s⟩

def stream (α : Type) : Type
  := ℤ → α

prefix `$`:100 := stream

def lift_to_stream (r : rel α β) : rel ($α) ($β)
  := λ a b, ∀ n, r (a n) (b n)

prefix `↟`:100 := lift_to_stream

@[simp]
def inv_def (r : rel α β) {a : α} {b : β} : r† b a ↔ r a b := by unfold inv flip

def idd : rel α α := eq

@[simp]
def idd_def (x y : α) : idd x y ↔ x = y := by unfold idd

instance fun_to_rel : has_coe (α → β) (rel α β) :=
{ coe := λ f x y, f x = y }

@[simp]
def to_rel (f : α → β) : rel α β
  := λ x y, f x = y

theorem conv_inv_left (r : rel α β) {f : α → β} {hr : r = to_rel f} {hs : function.surjective f} :
  r† ;; r = idd :=
begin
  ext x z,
  split,
  { rintro ⟨y,hxy,hyz⟩,
    simp [hr] at hxy hyz,
    simp [← hxy, ← hyz], },
  { intro h,
    simp at hr h,
    rw [hr, h],
    obtain ⟨y,hy⟩ := hs z,
    use y,
    simpa using hy, }
end

theorem conv_inv_right (r : rel α β) {f : α → β} {hr : r = to_rel f} {hi : function.injective f} :
  r ;; r† = idd :=
begin
  ext x z,
  unfold to_rel at hr,
  unfold idd inv flip,
  split,
  { rintro ⟨y,hxy,hyz⟩,
    rw hr at hxy hyz,
    rw ← hyz at hxy,
    exact hi hxy,
  },
  { intro h,
    rw [hr, h],
    unfold comp,
    use (f z),
    simp, }
end

theorem inv_left (r : rel α β) {f : α → β} {hr : r = to_rel f} {hf : function.bijective f} : r† ;; r = idd
  := @conv_inv_left _ _ r _ hr hf.2

theorem inv_right (r : rel α β) {f : α → β} {hr : r = to_rel f} {hf : function.bijective f} : r ;; r† = idd
  := @conv_inv_right _ _ r _ hr hf.1


import propositional_logic.lanugage

open formula

def valuation := var → Prop

def eval (v : valuation) : Formula → Prop :=
begin
  intro φ,
  induction φ with n α β vα vβ α vα,
  exact v n,
  exact vα → vβ,
  exact ¬vα,
end

namespace semantics

section valuation

variable (v : valuation)
variables (n : var) (φ ψ : Formula)

instance : has_coe_to_fun valuation (λ _, Formula → Prop) := ⟨eval⟩

variable {v}

@[simp] lemma eval_var : eval v (Var n) = v n := rfl
@[simp] lemma eval_to : eval v (φ →ᶠ ψ) = ((eval v φ) → (eval v ψ)) := rfl
@[simp] lemma eval_not : eval v (¬ᶠ φ) = ¬ (eval v φ) := rfl

end valuation

def models (v : valuation) (T : Theory) : Prop :=
∀ ⦃φ : Formula⦄, φ ∈ T → eval v φ

infix ` ⊧ `:50 := models

def consequence (T : Theory) (φ : Formula) : Prop :=
∀ ⦃v : valuation⦄, v ⊧ T → eval v φ

infix ` ⊢ `:50 := consequence

def is_true (φ : Formula) : Prop := ∅ ⊢ φ

prefix ` ⊢ₜ `:40 := is_true

section basics

variables {S T : Theory}
variables {v : valuation} {φ ψ ξ : Formula}

lemma subset_models (h : S ⊆ T) (hT : v ⊧ T) : v ⊧ S := λ _ hφ, hT (h hφ)

lemma consequence_trans (h : S ⊆ T) (hS : S ⊢ φ) : T ⊢ φ :=
λ _ _, hS (subset_models h ‹_›)

lemma consequence_mem (h : φ ∈ T) : T ⊢ φ :=
λ _ hv, hv ‹_›

lemma consequence_self : {φ} ⊢ φ := consequence_mem (set.mem_singleton _)

lemma consequence_cut (h : ∀ ψ ∈ S, T ⊢ ψ) (hs : S ⊢ φ) : T ⊢ φ :=
λ _ hv, hs (λ _ hψ, h _ hψ hv)

lemma empty_models : v ⊧ ∅ :=
begin
  intros _ _,
  exfalso,
  exact set.not_mem_empty ‹_› ‹_›,
end

lemma is_true_def : ⊢ₜ φ ↔ ∅ ⊢ φ := iff.rfl

lemma is_true_iff : ⊢ₜ φ ↔ ∀ v : valuation, eval v φ :=
⟨λ h _, h empty_models, λ h v _, h v⟩

lemma consequence_of_is_true : ⊢ₜ φ → T ⊢ φ :=
consequence_trans (set.empty_subset _)

lemma consequence_to_of_consequence_union_singleton (h : T ∪ {φ} ⊢ ψ) : (T ⊢ φ →ᶠ ψ) :=
begin
  intros v hv,
  rw eval_to,
  intro vφ,
  apply h,
  intros α hα,
  rw set.mem_union at hα,
  cases hα,
  { exact hv hα },
  { rw set.mem_singleton_iff at hα,
    rwa hα,
  }
end

lemma consequence_union_singleton_of_consequence_to (h : T ⊢ φ →ᶠ ψ) : T ∪ {φ} ⊢ ψ :=
begin
  intros v hv,
  have hvto := h (subset_models (set.subset_union_left _ _) hv),
  rw eval_to at hvto,
  apply hvto,
  apply hv,
  right,
  exact set.mem_singleton φ,
end

theorem deduction : (T ⊢ φ →ᶠ ψ) ↔ T ∪ {φ} ⊢ ψ :=
⟨consequence_union_singleton_of_consequence_to, consequence_to_of_consequence_union_singleton⟩

lemma is_true_to_iff : ⊢ₜ φ →ᶠ ψ ↔ {φ} ⊢ ψ :=
begin
  rw [is_true_def, deduction, set.empty_union],
end

lemma refl_true : ⊢ₜ φ →ᶠ φ := is_true_to_iff.2 consequence_self

lemma is_true_P1 : ⊢ₜ φ →ᶠ (ψ →ᶠ φ) :=
begin
  rw is_true_to_iff,
  rw deduction,
  apply consequence_mem,
  simp,
end

lemma is_true_P2 : ⊢ₜ (φ →ᶠ (ψ →ᶠ ξ)) →ᶠ ((φ →ᶠ ψ) →ᶠ (φ →ᶠ ξ)) :=
begin
  rw is_true_to_iff,
  repeat {rw deduction},
  intros v h,
  have vφ   : eval v φ := h (by simp),
  have vφψ  : eval v (φ →ᶠ ψ) := h (by simp),
  have vφψξ : eval v (φ →ᶠ (ψ →ᶠ ξ)) := h (by simp),
  simp at *,
  cc
end

lemma is_true_P3 : ⊢ₜ (¬ᶠφ →ᶠ ¬ᶠψ) →ᶠ (ψ →ᶠ φ) :=
begin
  rw is_true_to_iff,
  intros v h,
  have vφψ : eval v (¬ᶠ φ →ᶠ ¬ᶠ ψ) := h (by simp),
  simp at *,
  cc
end

lemma consequence_P1 : T ⊢ φ →ᶠ (ψ →ᶠ φ) :=
consequence_of_is_true is_true_P1

lemma consequence_P2 : T ⊢ (φ →ᶠ (ψ →ᶠ ξ)) →ᶠ ((φ →ᶠ ψ) →ᶠ (φ →ᶠ ξ)) :=
consequence_of_is_true is_true_P2

lemma consequence_P3 : T ⊢ (¬ᶠφ →ᶠ ¬ᶠψ) →ᶠ (ψ →ᶠ φ) :=
consequence_of_is_true is_true_P3

lemma consequence_modus_ponens (hφψ : T ⊢ φ →ᶠ ψ) (hφ : T ⊢ φ) : T ⊢ ψ :=
begin
  intros v h,
  have eφ := hφ h,
  have eφψ := hφψ h,
  rw eval_to at eφψ,
  cc,
end

end basics

section completeness

variables {T : Theory} {v : valuation} {φ : Formula}

lemma not_consequence_of_models_union_not (h : v ⊧ T ∪ {¬ᶠ φ}) : ¬ (T ⊢ φ) :=
begin
  by_contra H,
  have hvT : v ⊧ T := subset_models (set.subset_union_left _ _) h,
  have hvnφ : eval v (¬ᶠ φ) := h (by simp),
  rw eval_not at hvnφ,
  have hvφ := H hvT,
  exact hvnφ hvφ,
end

end completeness

end semantics