import tactic.ring
import tactic.ring_exp
import data.finset
import data.finsupp
import data.nat.choose
import algebra.category.CommRing.basic
import data.fin
import data.finset
open CommRing
open finset

---          Goal : understand the notion of structure with a little exemple !
namespace co_maxi
structure comax {R : Type*}[comm_ring R] (a b : R)  :=   --- ici c'est est ce que a et b sont comaximaux
(u : R)(v : R)
(certificat : a * u + b * v = (1 : R))
#print comax
local infix     ⊥  :=  comax   --- notation
structure comax_hom (A : Type*) (B : Type*)[comm_ring A] [comm_ring B] (a1 a2: A)(b1 b2 : B) :=
    (hom : ring_hom A  B)
    (hom_comp_point : hom a1 = b1 ∧ (hom a2 = b2))

open is_ring_hom  --- to have acces map_mul map_one
def comp (A B: Type)(φ : A → B)[comm_ring A][comm_ring B][is_ring_hom φ] (a b : A) : (comax a b) → comax (φ a) (φ b) := λ ⟨u_ab,v_ab,certificat_ab⟩, --- {} or ⟨ ⟩ λ OBJET and then OBJET.u etc
    begin
        have certificat : (φ a) * (φ u_ab) + (φ b) * (φ v_ab) = 1,          -- It's trivial ring identity, but i have to control !
            rw [ ←  map_mul φ, ← map_mul φ , ← map_add φ,certificat_ab],
            apply map_one,
        exact {u := φ u_ab,v := φ v_ab,certificat := certificat},            --- the constructor of structure  : i thinck better than  ⟨  ⟩
    end

end co_maxi
namespace Exemple
--- This is a closed universe
#print Ring
--- but we have access to the primitive structure
#print co_maxi.comax -- we have to co_maxi. first to acces comax !
end Exemple
open co_maxi
namespace comax
section
parameters  {R : Type}[comm_ring R]
parameters (a b c : R)
local infix     ⊥  :=  comax   --- notation

def symm  :  (a) ⊥  (b)  →   (b) ⊥ (a)   :=   --- a u + b v = 1 → b v + a u = 1
    λ ⟨u,v,certificat⟩,
        begin
            have  t :  b * v + a * u = 1,
                rw add_comm,  assumption,
            use ⟨v,u,t⟩,
        end
lemma one_perp  :  1 ⊥ a :=   --- with 1 * 1 + a * 0 = 1
begin
    have h: 1 * 1 + a * 0 = 1,
        rw [one_mul,mul_zero,add_zero],
    use ⟨1,0,h⟩
end
lemma abab_trick : (a ⊥ c) → (b ⊥ c) → (a * b) ⊥ c :=    ---  Trick to simplify proof !  if a ⊥ c and b ⊥ c then ab ⊥ c  from calculus !
    λ ⟨ua,va,ka⟩  ⟨ub,vb,kb⟩,
        begin
            have J : (a * b) * ( ua * ub) + c * ( a * ua * vb + va * b * ub + va * c * vb) = 1,
                 by calc
                    (a * b) * ( ua * ub) + c * ( a * ua * vb + va * b * ub + va * c * vb)  =  (a * ua + c * va) * (b * ub + c * vb) : by ring_exp
                    ...                                                                    =   1                                    : by rw [ka,kb, one_mul],
        use ⟨ ua * ub,  a * ua * vb + va * b * ub + va * c * vb , J⟩,
        end
open nat
lemma star (a  b : R) (n : nat):   (a ⊥ b) → ((a^n) ⊥ b)  :=
    λ u,
        nat.rec_on n
                (show  (a^0) ⊥ b, {rw pow_zero a, apply one_perp, })
                (assume n, assume re : ((a^n) ⊥ b), show (a^(n+1)) ⊥ b,
                       {rw pow_succ a n,apply abab_trick, assumption,assumption})

theorem My_favorite_localisation_lemma (n m : nat) : (a ⊥ b) → (a^n) ⊥ (b^m) :=                 --- the goals
    λ u, begin
        apply star,
        apply symm,    -- is there a repeat method ? How to programme such method ?
        apply star,
        apply symm,
        assumption,
    end
----
---     We want to proof 𝔸 is a local functor : a scheaf for global Zariski for Affᵒᵖ.
----   ( Note 𝔸 is structural for Ring so if you do the job for 𝔸 you do the job for all ring i.e Spec R := Hom(R,•) is a scheme (in sense of functorial geometry)
---    (ref Jantzen : 'algebraic group and representation' the first chapter) for all ring R : i can explain) !
---                 for the moment only with 2-covering famillies
---     There is two axioms :
---             1/ Separation : (for two elements ONLY)
---                      let R : comm_ring
---                      Let f,g ∈ R :  f ⊥ g.
---                      Let a ∈ R :
---                             ∃ m n : ℕ,  f^m a = 0 ∧  g^n a = 0   --- i.e a = 0 in localisation  {f^k k ∈ N⋆} and   {g^k k ∈ N⋆}
---                      Since f ⊥ g , we have f^m ⊥ b^n
---                      Have (u,v) s.t   f^m u + g^n v = 1
---                      multipliying by a give f^m au  + g^n a v = a  so 0 = a !
---    Note : i don't use Localisation library for the moment (i have to study) !
parameters (f g : R)

structure localy_zero (a : R) extends  comax(f)(g) :=
(m : ℕ)(n : ℕ)
(proof_localy_zero : f^m * a = 0 ∧ g^n * a = 0)

theorem Separation_axiom (a : R) : f ⊥ g → localy_zero (a)   →   a = 0  :=  λ coma ⟨t,m,n,proof_localy_zero ⟩,
begin
     have H : (f^m) ⊥ (g^n),
        apply My_favorite_localisation_lemma,
        assumption,
    rcases H with ⟨ua,va,ka⟩,
        apply eq.symm,
        have H :  0  = (f ^ m * a* ua  +  g ^ n *a * va),
            rw [proof_localy_zero.1,proof_localy_zero.2],
            apply eq.symm,
            rw [zero_mul,zero_mul,add_zero],
        have G : (f ^ m * a* ua  +  g ^ n *a * va) = (f ^ m * ua  +  g ^ n  * va) * a,
        ring,
        rewrite [H,G,ka,one_mul a],
end
---   Gluing_axiome :
---
structure descent_data (s_f s_g : R)(n : ℕ) extends f ⊥ g  :=    --- comment est structuré la notion de desc
(m : ℕ)                                                                      ---   F : N →₀ R  + certiticat F^⊥ : N →₀ R  co-max
(proof_m : f^m * g^(n+m) * s_f = g^m * f^(n+m) * s_g )                       ---   là j'ai accées a des fonctions touts faites
                                                                             ---    --->  F,  :::  s_F : ℕ  → R  et  n_F : N → ℕ
                                                                             ---    ' ζ_f :=  s_f / f^n_f ' (data)
parameters s_f s_g : R                                                       ---    descent data + ∃ m_f t q  (f,g) ---> certificat f g
parameters n : ℕ                                                             ---

structure effective_descente_data  extends descent_data s_f  s_g n:=
( s : R)
(N_f : ℕ) (N_g : ℕ)
(proof_n_plus_m_f_g : f^(N_f+n) * s = f^N_f * s_f ∧  g^(N_g+n) * s = g^N_g * s_g)

set_option class.instance_max_depth 20
theorem gluing_data  :   f ⊥ g →      descent_data s_f s_g n    →   effective_descente_data  :=
         λ comma,λ y,
            begin
                rcases comma with ⟨u,v,proof_of_comax⟩,
                rcases y with ⟨t,m,proof_m⟩,
                have H: (f^(n+m)) ⊥ (g^(n+m)),
                    apply My_favorite_localisation_lemma,
                assumption,
            rcases H with ⟨vf,vg,proof_n_plus_m_f_g⟩,

            have H1 : f ^ (m + n) * (vf * s_f * f ^ m + vg * s_g * g ^ m) =   ( f ^ (n + m)* vf * s_f * f ^ m +  g ^ m *f ^ (n + m) *s_g * vg),
                        ring_exp,

            have B1 : f ^ (n + m) * vf * s_f * f ^ m + f ^ m * g ^ (n + m) * s_f * vg = f^m *s_f *(f ^ (n + m) * vf + g ^ (n + m) * vg),
                           ring,

            have H2 : g ^ (m + n) * (vf * s_f * f ^ m + vg * s_g * g ^ m) =      f ^ m *g ^ (n+m) *s_f *vf + g ^ m* g ^ (n + m) * vg * s_g,
                  ring_exp,

            have B2 : g ^ m * f ^ (n + m) * s_g * vf + g ^ m * g ^ (n + m) * vg * s_g = g^m * s_g *(f ^ (n + m) * vf + g ^ (n + m) * vg ),
                      ring,
            have Y : f^(m+n) * (vf *s_f * f^m+ vg*s_g*g^m) = f^m * s_f ∧  g^(m+n) * (vf *s_f * f^m+ vg*s_g*g^m) = g^m * s_g,
                split,
                rw [H1,eq.symm proof_m,B1,proof_n_plus_m_f_g,mul_one],
                rw [H2,proof_m,B2, proof_n_plus_m_f_g,mul_one],
            exact {to_descent_data := ⟨t,m,proof_m⟩, s := vf *s_f * f^m+ vg*s_g*g^m, N_f := m, N_g := m, proof_n_plus_m_f_g := Y},
end

#check gluing_data

end co_maxi


import .love08_operational_semantics_demo

/- # LoVe Demo 9: Hoare Logic

We review a second way to specify the semantics of a programming language: Hoare
logic. If operational semantics corresponds to an idealized interpreter,
__Hoare logic__ (also called __axiomatic semantics__) corresponds to a verifier.
Hoare logic is particularly convenient to reason about concrete programs. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/- ## First Things First: Formalization Projects

Instead of two of the homework sheets, you can do a verification project, worth
20 points. If you choose to do so, please send your lecturer a message by email
by the end of the week. For a fully successful project, we expect about 200 (or
more) lines of Lean, including definitions and proofs.

Some ideas for projects follow.

Computer science:

* extended WHILE language with static arrays or other features;
* functional data structures (e.g., balanced trees);
* functional algorithms (e.g., bubble sort, merge sort, Tarjan's algorithm);
* compiler from expressions or imperative programs to, e.g., stack machine;
* type systems (e.g., Benjamin Pierce's __Types and Programming Languages__);
* security properties (e.g., Volpano–Smith-style noninterference analysis);
* theory of first-order terms, including matching, term rewriting;
* automata theory;
* normalization of context-free grammars or regular expressions;
* process algebras and bisimilarity;
* soundness and possibly completeness of proof systems (e.g., Genzen's sequent
  calculus, natural deduction, tableaux);
* separation logic;
* verified program using Hoare logic.

Mathematics:

* graphs;
* combinatorics;
* number theory.

Evaluation from 2018–2019:

Q: How did you find the project?

A: Enjoyable.

A: Fun and hard.

A: Good, I think the format was excellent in a way that it gave people the
   chance to do challenging exercises and hand them in incomplete.

A: I really really liked it. I think it's a great way of learning—find
   something you like, dig in it a little, get stuck, ask for help. I wish I
   could do more of that!

A: It was great to have some time to try to work out some stuff you find
   interesting yourself.

A: lots of fun actually!!!

A: Very helpful. It gave the opportunity to spend some more time on a
   particular aspect of the course.

## Hoare Triples

The basic judgments of Hoare logic are often called __Hoare triples__. They have
the form

    `{P} S {Q}`

where `S` is a statement, and `P` and `Q` (called __precondition__ and
__postcondition__) are logical formulas over the state variables.

Intended meaning:

    If `P` holds before `S` is executed and the execution terminates normally,
    `Q` holds at termination.

This is a __partial correctness__ statement: The program is correct if it
terminates normally (i.e., no run-time error, no infinite loop or divergence).

All of these Hoare triples are valid (with respect to the intended meaning):

    `{true} b := 4 {b = 4}`
    `{a = 2} b := 2 * a {a = 2 ∧ b = 4}`
    `{b ≥ 5} b := b + 1 {b ≥ 6}`
    `{false} skip {b = 100}`
    `{true} while i ≠ 100 do i := i + 1 {i = 100}`

## Hoare Rules

The following is a complete set of rules for reasoning about WHILE programs:

    ———————————— Skip
    {P} skip {P}

    ——————————————————— Asn
    {Q[a/x]} x := a {Q}

    {P} S {R}   {R} S' {Q}
    —————————————————————— Seq
    {P} S; S' {Q}

    {P ∧ b} S {Q}   {P ∧ ¬b} S' {Q}
    ——————————————————————————————— If
    {P} if b then S else S' {Q}

    {I ∧ b} S {I}
    ————————————————————————— While
    {I} while b do S {I ∧ ¬b}

    P' → P   {P} S {Q}   Q → Q'
    ——————————————————————————— Conseq
    {P'} S {Q'}

`Q[a/x]` denotes `Q` with `x` replaced by `a`.

In the `While` rule, `I` is called an __invariant__.

Except for `Conseq`, the rules are syntax-driven: by looking at a program, we
see immediately which rule to apply.

Example derivations:

    —————————————————————— Asn   —————————————————————— Asn
    {a = 2} b := a {b = 2}       {b = 2} c := b {c = 2}
    ——————————————————————————————————————————————————— Seq
    {a = 2} b := a; c := b {c = 2}

                     —————————————————————— Asn
    x > 10 → x > 5   {x > 5} y := x {y > 5}   y > 5 → y > 0
    ——————————————————————————————————————————————————————— Conseq
    {x > 10} y := x {y > 0}

Various __derived rules__ can be proved to be correct in terms of the standard
rules. For example, we can derive bidirectional rules for `skip`, `:=`, and
`while`:

    P → Q
    ———————————— Skip'
    {P} skip {Q}

    P → Q[a/x]
    —————————————— Asn'
    {P} x := a {Q}

    {P ∧ b} S {P}   P ∧ ¬b → Q
    —————————————————————————— While'
    {P} while b do S {Q}

## A Semantic Approach to Hoare Logic

We can, and will, define Hoare triples **semantically** in Lean.

We will use predicates on states (`state → Prop`) to represent pre- and
postconditions, following the shallow embedding style. -/

def partial_hoare (P : state → Prop) (S : stmt)
  (Q : state → Prop) : Prop :=
∀s t, P s → (S, s) ⟹ t → Q t

notation `{* ` P : 1 ` *} ` S : 1 ` {* ` Q : 1 ` *}` :=
partial_hoare P S Q

namespace partial_hoare

lemma skip_intro {P} :
  {* P *} stmt.skip {* P *} :=
begin
  intros s t hs hst,
  cases' hst,
  assumption
end

lemma assign_intro (P : state → Prop) {x} {a : state → ℕ} :
  {* λs, P (s{x ↦ a s}) *} stmt.assign x a {* P *} :=
begin
  intros s t P hst,
  cases' hst,
  assumption
end

lemma seq_intro {P Q R S T} (hS : {* P *} S {* Q *})
    (hT : {* Q *} T {* R *}) :
  {* P *} S ;; T {* R *} :=
begin
  intros s t hs hst,
  cases' hst,
  apply hT,
  { apply hS,
    { exact hs },
    { assumption } },
  { assumption }
end

lemma ite_intro {b P Q : state → Prop} {S T}
    (hS : {* λs, P s ∧ b s *} S {* Q *})
    (hT : {* λs, P s ∧ ¬ b s *} T {* Q *}) :
  {* P *} stmt.ite b S T {* Q *} :=
begin
  intros s t hs hst,
  cases' hst,
  { apply hS,
    exact and.intro hs hcond,
    assumption },
  { apply hT,
    exact and.intro hs hcond,
    assumption }
end

lemma while_intro (P : state → Prop) {b : state → Prop} {S}
    (h : {* λs, P s ∧ b s *} S {* P *}) :
  {* P *} stmt.while b S {* λs, P s ∧ ¬ b s *} :=
begin
  intros s t hs hst,
  induction' hst,
  case while_true {
    apply ih_hst_1 P h,
    exact h _ _ (and.intro hs hcond) hst },
  case while_false {
    exact and.intro hs hcond }
end

lemma consequence {P P' Q Q' : state → Prop} {S}
    (h : {* P *} S {* Q *}) (hp : ∀s, P' s → P s)
    (hq : ∀s, Q s → Q' s) :
  {* P' *} S {* Q' *} :=
fix s t,
assume hs : P' s,
assume hst : (S, s) ⟹ t,
show Q' t, from
  hq _ (h s t (hp s hs) hst)

lemma consequence_left (P' : state → Prop) {P Q S}
    (h : {* P *} S {* Q *}) (hp : ∀s, P' s → P s) :
  {* P' *} S {* Q *} :=
consequence h hp (by cc)

lemma consequence_right (Q) {Q' : state → Prop} {P S}
    (h : {* P *} S {* Q *}) (hq : ∀s, Q s → Q' s) :
  {* P *} S {* Q' *} :=
consequence h (by cc) hq

lemma skip_intro' {P Q : state → Prop} (h : ∀s, P s → Q s) :
  {* P *} stmt.skip {* Q *} :=
consequence skip_intro h (by cc)

lemma assign_intro' {P Q : state → Prop} {x} {a : state → ℕ}
    (h : ∀s, P s → Q (s{x ↦ a s})):
  {* P *} stmt.assign x a {* Q *} :=
consequence (assign_intro Q) h (by cc)

lemma seq_intro' {P Q R S T} (hT : {* Q *} T {* R *})
    (hS : {* P *} S {* Q *}) :
  {* P *} S ;; T {* R *} :=
seq_intro hS hT

lemma while_intro' {b P Q : state → Prop} {S}
    (I : state → Prop)
    (hS : {* λs, I s ∧ b s *} S {* I *})
    (hP : ∀s, P s → I s)
    (hQ : ∀s, ¬ b s → I s → Q s) :
  {* P *} stmt.while b S {* Q *} :=
consequence (while_intro I hS) hP (by finish)

/- `finish` applies a combination of techniques, including normalization of
logical connectives and quantifiers, simplification, congruence closure, and
quantifier instantiation. It either fully succeeds or fails. -/

lemma assign_intro_forward (P) {x a} :
  {* P *}
  stmt.assign x a
  {* λs, ∃n₀, P (s{x ↦ n₀}) ∧ s x = a (s{x ↦ n₀}) *} :=
begin
  apply assign_intro',
  intros s hP,
  apply exists.intro (s x),
  simp [*]
end

lemma assign_intro_backward (Q : state → Prop) {x}
    {a : state → ℕ} :
  {* λs, ∃n', Q (s{x ↦ n'}) ∧ n' = a s *}
  stmt.assign x a
  {* Q *} :=
begin
  apply assign_intro',
  intros s hP,
  cases' hP,
  cc
end

end partial_hoare

/- ## First Program: Exchanging Two Variables -/

def SWAP : stmt :=
stmt.assign "t" (λs, s "a") ;;
stmt.assign "a" (λs, s "b") ;;
stmt.assign "b" (λs, s "t")

lemma SWAP_correct (a₀ b₀ : ℕ) :
  {* λs, s "a" = a₀ ∧ s "b" = b₀ *}
  SWAP
  {* λs, s "a" = b₀ ∧ s "b" = a₀ *} :=
begin
  apply partial_hoare.seq_intro',
  apply partial_hoare.seq_intro',
  apply partial_hoare.assign_intro,
  apply partial_hoare.assign_intro,
  apply partial_hoare.assign_intro',
  simp { contextual := tt }
end

lemma SWAP_correct₂ (a₀ b₀ : ℕ) :
  {* λs, s "a" = a₀ ∧ s "b" = b₀ *}
  SWAP
  {* λs, s "a" = b₀ ∧ s "b" = a₀ *} :=
begin
  intros s t hP hstep,
  cases' hstep,
  cases' hstep,
  cases' hstep_1,
  cases' hstep_1_1,
  cases' hstep_1,
  finish
end

/- ## Second Program: Adding Two Numbers -/

def ADD : stmt :=
stmt.while (λs, s "n" ≠ 0)
  (stmt.assign "n" (λs, s "n" - 1) ;;
   stmt.assign "m" (λs, s "m" + 1))

lemma ADD_correct (n₀ m₀ : ℕ) :
  {* λs, s "n" = n₀ ∧ s "m" = m₀ *}
  ADD
  {* λs, s "n" = 0 ∧ s "m" = n₀ + m₀ *} :=
partial_hoare.while_intro' (λs, s "n" + s "m" = n₀ + m₀)
  begin
    apply partial_hoare.seq_intro',
    { apply partial_hoare.assign_intro },
    { apply partial_hoare.assign_intro',
      simp,
      intros s hnm hnz,
      rw ←hnm,
      cases' s "n",
      { finish },
      { simp [nat.succ_eq_add_one],
        linarith } }
  end
  (by simp { contextual := true })
  (by simp { contextual := true })

/- ## A Verification Condition Generator

__Verification condition generators__ (VCGs) are programs that apply Hoare rules
automatically, producing __verification conditions__ that must be proved by the
user. The user must usually also provide strong enough loop invariants, as an
annotation in their programs.

We can use Lean's metaprogramming framework to define a simple VCG.

Hundreds if not thousands of program verification tools are based on these
principles. Often these are based on an extension called separation logic.

VCGs typically work backwards from the postcondition, using backward rules
(rules stated to have an arbitrary `Q` as their postcondition). This works well
because `Asn` is backward. -/

def stmt.while_inv (I b : state → Prop) (S : stmt) : stmt :=
stmt.while b S

namespace partial_hoare

lemma while_inv_intro {b I Q : state → Prop} {S}
    (hS : {* λs, I s ∧ b s *} S {* I *})
    (hQ : ∀s, ¬ b s → I s → Q s) :
  {* I *} stmt.while_inv I b S {* Q *} :=
while_intro' I hS (by cc) hQ

lemma while_inv_intro' {b I P Q : state → Prop} {S}
    (hS : {* λs, I s ∧ b s *} S {* I *})
    (hP : ∀s, P s → I s) (hQ : ∀s, ¬ b s → I s → Q s) :
  {* P *} stmt.while_inv I b S {* Q *} :=
while_intro' I hS hP hQ

end partial_hoare

meta def vcg : tactic unit :=
do
  t ← tactic.target,
  match t with
  | `({* %%P *} %%S {* _ *}) :=
    match S with
    | `(stmt.skip)            :=
      tactic.applyc
        (if expr.is_mvar P then ``partial_hoare.skip_intro
         else ``partial_hoare.skip_intro')
    | `(stmt.assign _ _)      :=
      tactic.applyc
        (if expr.is_mvar P then ``partial_hoare.assign_intro
         else ``partial_hoare.assign_intro')
    | `(stmt.seq _ _)         :=
      tactic.applyc ``partial_hoare.seq_intro'; vcg
    | `(stmt.ite _ _ _)       :=
      tactic.applyc ``partial_hoare.ite_intro; vcg
    | `(stmt.while_inv _ _ _) :=
      tactic.applyc
        (if expr.is_mvar P then ``partial_hoare.while_inv_intro
         else ``partial_hoare.while_inv_intro');
        vcg
    | _                       :=
      tactic.fail (to_fmt "cannot analyze " ++ to_fmt S)
    end
  | _                        := pure ()
  end

end LoVe

/- Register `vcg` as a proper tactic: -/

meta def tactic.interactive.vcg : tactic unit :=
LoVe.vcg

namespace LoVe

/- ## Second Program Revisited: Adding Two Numbers -/

lemma ADD_correct₂ (n₀ m₀ : ℕ) :
  {* λs, s "n" = n₀ ∧ s "m" = m₀ *}
  ADD
  {* λs, s "n" = 0 ∧ s "m" = n₀ + m₀ *} :=
show {* λs, s "n" = n₀ ∧ s "m" = m₀ *}
     stmt.while_inv (λs, s "n" + s "m" = n₀ + m₀)
       (λs, s "n" ≠ 0)
       (stmt.assign "n" (λs, s "n" - 1) ;;
        stmt.assign "m" (λs, s "m" + 1))
     {* λs, s "n" = 0 ∧ s "m" = n₀ + m₀ *}, from
  begin
    vcg; simp { contextual := tt },
    intros s hnm hnz,
    rw ←hnm,
    cases' s "n",
    { finish },
    { simp [nat.succ_eq_add_one],
      linarith }
  end

/- ## Hoare Triples for Total Correctness

__Total correctness__ asserts that the program not only is partially correct but
also that it always terminates normally. Hoare triples for total correctness
have the form

    [P] S [Q]

Intended meaning:

    If `P` holds before `S` is executed, the execution terminates normally and
    `Q` holds in the final state.

For deterministic programs, an equivalent formulation is as follows:

    If `P` holds before `S` is executed, there exists a state in which execution
    terminates normally and `Q` holds in that state.

Example:

    `[i ≤ 100] while i ≠ 100 do i := i + 1 [i = 100]`

In our WHILE language, this only affects while loops, which must now be
annotated by a __variant__ `V` (a natural number that decreases with each
iteration):

    [I ∧ b ∧ V = v₀] S [I ∧ V < v₀]
    ——————————————————————————————— While-Var
    [I] while b do S [I ∧ ¬b]

What is a suitable variant for the example above? -/

end LoVe


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta

! This file was ported from Lean 3 source module category_theory.sites.closed
! leanprover-community/mathlib commit 4cfc30e317caad46858393f1a7a33f609296cc30
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Sites.SheafOfTypes
import Mathbin.Order.Closure

/-!
# Closed sieves

A natural closure operator on sieves is a closure operator on `sieve X` for each `X` which commutes
with pullback.
We show that a Grothendieck topology `J` induces a natural closure operator, and define what the
closed sieves are. The collection of `J`-closed sieves forms a presheaf which is a sheaf for `J`,
and further this presheaf can be used to determine the Grothendieck topology from the sheaf
predicate.
Finally we show that a natural closure operator on sieves induces a Grothendieck topology, and hence
that natural closure operators are in bijection with Grothendieck topologies.

## Main definitions

* `category_theory.grothendieck_topology.close`: Sends a sieve `S` on `X` to the set of arrows
  which it covers. This has all the usual properties of a closure operator, as well as commuting
  with pullback.
* `category_theory.grothendieck_topology.closure_operator`: The bundled `closure_operator` given
  by `category_theory.grothendieck_topology.close`.
* `category_theory.grothendieck_topology.closed`: A sieve `S` on `X` is closed for the topology `J`
   if it contains every arrow it covers.
* `category_theory.functor.closed_sieves`: The presheaf sending `X` to the collection of `J`-closed
  sieves on `X`. This is additionally shown to be a sheaf for `J`, and if this is a sheaf for a
  different topology `J'`, then `J' ≤ J`.
* `category_theory.grothendieck_topology.topology_of_closure_operator`: A closure operator on the
  set of sieves on every object which commutes with pullback additionally induces a Grothendieck
  topology, giving a bijection with `category_theory.grothendieck_topology.closure_operator`.

## Tags

closed sieve, closure, Grothendieck topology

## References

* [S. MacLane, I. Moerdijk, *Sheaves in Geometry and Logic*][MM92]
-/

universe v u

namespace CategoryTheory

variable {C : Type u} [Category.{v} C]

variable (J₁ J₂ : GrothendieckTopology C)

namespace GrothendieckTopology

/-- The `J`-closure of a sieve is the collection of arrows which it covers. -/
@[simps]
def close {X : C} (S : Sieve X) : Sieve X
    where
  arrows Y f := J₁.Covers S f
  downward_closed' Y Z f hS := J₁.arrow_stable _ _ hS
#align category_theory.grothendieck_topology.close CategoryTheory.GrothendieckTopology.close

/-- Any sieve is smaller than its closure. -/
theorem le_close {X : C} (S : Sieve X) : S ≤ J₁.close S := fun Y g hg =>
  J₁.covering_of_eq_top (S.pullback_eq_top_of_mem hg)
#align category_theory.grothendieck_topology.le_close CategoryTheory.GrothendieckTopology.le_close

/-- A sieve is closed for the Grothendieck topology if it contains every arrow it covers.
In the case of the usual topology on a topological space, this means that the open cover contains
every open set which it covers.

Note this has no relation to a closed subset of a topological space.
-/
def IsClosed {X : C} (S : Sieve X) : Prop :=
  ∀ ⦃Y : C⦄ (f : Y ⟶ X), J₁.Covers S f → S f
#align category_theory.grothendieck_topology.is_closed CategoryTheory.GrothendieckTopology.IsClosed

/-- If `S` is `J₁`-closed, then `S` covers exactly the arrows it contains. -/
theorem covers_iff_mem_of_closed {X : C} {S : Sieve X} (h : J₁.IsClosed S) {Y : C} (f : Y ⟶ X) :
    J₁.Covers S f ↔ S f :=
  ⟨h _, J₁.arrow_max _ _⟩
#align category_theory.grothendieck_topology.covers_iff_mem_of_closed CategoryTheory.GrothendieckTopology.covers_iff_mem_of_closed

/-- Being `J`-closed is stable under pullback. -/
theorem isClosed_pullback {X Y : C} (f : Y ⟶ X) (S : Sieve X) :
    J₁.IsClosed S → J₁.IsClosed (S.pullback f) := fun hS Z g hg =>
  hS (g ≫ f) (by rwa [J₁.covers_iff, sieve.pullback_comp])
#align category_theory.grothendieck_topology.is_closed_pullback CategoryTheory.GrothendieckTopology.isClosed_pullback

/-- The closure of a sieve `S` is the largest closed sieve which contains `S` (justifying the name
"closure").
-/
theorem le_close_of_isClosed {X : C} {S T : Sieve X} (h : S ≤ T) (hT : J₁.IsClosed T) :
    J₁.close S ≤ T := fun Y f hf => hT _ (J₁.superset_covering (Sieve.pullback_monotone f h) hf)
#align category_theory.grothendieck_topology.le_close_of_is_closed CategoryTheory.GrothendieckTopology.le_close_of_isClosed

/-- The closure of a sieve is closed. -/
theorem close_isClosed {X : C} (S : Sieve X) : J₁.IsClosed (J₁.close S) := fun Y g hg =>
  J₁.arrow_trans g _ S hg fun Z h hS => hS
#align category_theory.grothendieck_topology.close_is_closed CategoryTheory.GrothendieckTopology.close_isClosed

/-- The sieve `S` is closed iff its closure is equal to itself. -/
theorem isClosed_iff_close_eq_self {X : C} (S : Sieve X) : J₁.IsClosed S ↔ J₁.close S = S :=
  by
  constructor
  · intro h
    apply le_antisymm
    · intro Y f hf
      rw [← J₁.covers_iff_mem_of_closed h]
      apply hf
    · apply J₁.le_close
  · intro e
    rw [← e]
    apply J₁.close_is_closed
#align category_theory.grothendieck_topology.is_closed_iff_close_eq_self CategoryTheory.GrothendieckTopology.isClosed_iff_close_eq_self

theorem close_eq_self_of_isClosed {X : C} {S : Sieve X} (hS : J₁.IsClosed S) : J₁.close S = S :=
  (J₁.isClosed_iff_close_eq_self S).1 hS
#align category_theory.grothendieck_topology.close_eq_self_of_is_closed CategoryTheory.GrothendieckTopology.close_eq_self_of_isClosed

/-- Closing under `J` is stable under pullback. -/
theorem pullback_close {X Y : C} (f : Y ⟶ X) (S : Sieve X) :
    J₁.close (S.pullback f) = (J₁.close S).pullback f :=
  by
  apply le_antisymm
  · refine' J₁.le_close_of_is_closed (sieve.pullback_monotone _ (J₁.le_close S)) _
    apply J₁.is_closed_pullback _ _ (J₁.close_is_closed _)
  · intro Z g hg
    change _ ∈ J₁ _
    rw [← sieve.pullback_comp]
    apply hg
#align category_theory.grothendieck_topology.pullback_close CategoryTheory.GrothendieckTopology.pullback_close

@[mono]
theorem monotone_close {X : C} : Monotone (J₁.close : Sieve X → Sieve X) := fun S₁ S₂ h =>
  J₁.le_close_of_isClosed (h.trans (J₁.le_close _)) (J₁.close_isClosed S₂)
#align category_theory.grothendieck_topology.monotone_close CategoryTheory.GrothendieckTopology.monotone_close

@[simp]
theorem close_close {X : C} (S : Sieve X) : J₁.close (J₁.close S) = J₁.close S :=
  le_antisymm (J₁.le_close_of_isClosed le_rfl (J₁.close_isClosed S))
    (J₁.monotone_close (J₁.le_close _))
#align category_theory.grothendieck_topology.close_close CategoryTheory.GrothendieckTopology.close_close

/--
The sieve `S` is in the topology iff its closure is the maximal sieve. This shows that the closure
operator determines the topology.
-/
theorem close_eq_top_iff_mem {X : C} (S : Sieve X) : J₁.close S = ⊤ ↔ S ∈ J₁ X :=
  by
  constructor
  · intro h
    apply J₁.transitive (J₁.top_mem X)
    intro Y f hf
    change J₁.close S f
    rwa [h]
  · intro hS
    rw [eq_top_iff]
    intro Y f hf
    apply J₁.pullback_stable _ hS
#align category_theory.grothendieck_topology.close_eq_top_iff_mem CategoryTheory.GrothendieckTopology.close_eq_top_iff_mem

/-- A Grothendieck topology induces a natural family of closure operators on sieves. -/
@[simps (config := { rhsMd := semireducible })]
def closureOperator (X : C) : ClosureOperator (Sieve X) :=
  ClosureOperator.mk' J₁.close
    (fun S₁ S₂ h => J₁.le_close_of_isClosed (h.trans (J₁.le_close _)) (J₁.close_isClosed S₂))
    J₁.le_close fun S => J₁.le_close_of_isClosed le_rfl (J₁.close_isClosed S)
#align category_theory.grothendieck_topology.closure_operator CategoryTheory.GrothendieckTopology.closureOperator

@[simp]
theorem closed_iff_closed {X : C} (S : Sieve X) :
    S ∈ (J₁.ClosureOperator X).closed ↔ J₁.IsClosed S :=
  (J₁.isClosed_iff_close_eq_self S).symm
#align category_theory.grothendieck_topology.closed_iff_closed CategoryTheory.GrothendieckTopology.closed_iff_closed

end GrothendieckTopology

/--
The presheaf sending each object to the set of `J`-closed sieves on it. This presheaf is a `J`-sheaf
(and will turn out to be a subobject classifier for the category of `J`-sheaves).
-/
@[simps]
def Functor.closedSieves : Cᵒᵖ ⥤ Type max v u
    where
  obj X := { S : Sieve X.unop // J₁.IsClosed S }
  map X Y f S := ⟨S.1.pullback f.unop, J₁.isClosed_pullback f.unop _ S.2⟩
#align category_theory.functor.closed_sieves CategoryTheory.Functor.closedSieves

/-- The presheaf of `J`-closed sieves is a `J`-sheaf.
The proof of this is adapted from [MM92], Chatper III, Section 7, Lemma 1.
-/
theorem classifier_isSheaf : Presieve.IsSheaf J₁ (Functor.closedSieves J₁) :=
  by
  intro X S hS
  rw [← presieve.is_separated_for_and_exists_is_amalgamation_iff_sheaf_for]
  refine' ⟨_, _⟩
  · rintro x ⟨M, hM⟩ ⟨N, hN⟩ hM₂ hN₂
    ext
    dsimp only [Subtype.coe_mk]
    rw [← J₁.covers_iff_mem_of_closed hM, ← J₁.covers_iff_mem_of_closed hN]
    have q : ∀ ⦃Z : C⦄ (g : Z ⟶ X) (hg : S g), M.pullback g = N.pullback g :=
      by
      intro Z g hg
      apply congr_arg Subtype.val ((hM₂ g hg).trans (hN₂ g hg).symm)
    have MSNS : M ⊓ S = N ⊓ S := by
      ext (Z g)
      rw [sieve.inter_apply, sieve.inter_apply, and_comm' (N g), and_comm']
      apply and_congr_right
      intro hg
      rw [sieve.pullback_eq_top_iff_mem, sieve.pullback_eq_top_iff_mem, q g hg]
    constructor
    · intro hf
      rw [J₁.covers_iff]
      apply J₁.superset_covering (sieve.pullback_monotone f inf_le_left)
      rw [← MSNS]
      apply J₁.arrow_intersect f M S hf (J₁.pullback_stable _ hS)
    · intro hf
      rw [J₁.covers_iff]
      apply J₁.superset_covering (sieve.pullback_monotone f inf_le_left)
      rw [MSNS]
      apply J₁.arrow_intersect f N S hf (J₁.pullback_stable _ hS)
  · intro x hx
    rw [presieve.compatible_iff_sieve_compatible] at hx
    let M := sieve.bind S fun Y f hf => (x f hf).1
    have : ∀ ⦃Y⦄ (f : Y ⟶ X) (hf : S f), M.pullback f = (x f hf).1 :=
      by
      intro Y f hf
      apply le_antisymm
      · rintro Z u ⟨W, g, f', hf', hg : (x f' hf').1 _, c⟩
        rw [sieve.pullback_eq_top_iff_mem, ←
          show (x (u ≫ f) _).1 = (x f hf).1.pullback u from congr_arg Subtype.val (hx f u hf)]
        simp_rw [← c]
        rw [show (x (g ≫ f') _).1 = _ from congr_arg Subtype.val (hx f' g hf')]
        apply sieve.pullback_eq_top_of_mem _ hg
      · apply sieve.le_pullback_bind S fun Y f hf => (x f hf).1
    refine' ⟨⟨_, J₁.close_is_closed M⟩, _⟩
    · intro Y f hf
      ext1
      dsimp
      rw [← J₁.pullback_close, this _ hf]
      apply le_antisymm (J₁.le_close_of_is_closed le_rfl (x f hf).2) (J₁.le_close _)
#align category_theory.classifier_is_sheaf CategoryTheory.classifier_isSheaf

/-- If presheaf of `J₁`-closed sieves is a `J₂`-sheaf then `J₁ ≤ J₂`. Note the converse is true by
`classifier_is_sheaf` and `is_sheaf_of_le`.
-/
theorem le_topology_of_closedSieves_isSheaf {J₁ J₂ : GrothendieckTopology C}
    (h : Presieve.IsSheaf J₁ (Functor.closedSieves J₂)) : J₁ ≤ J₂ := fun X S hS =>
  by
  rw [← J₂.close_eq_top_iff_mem]
  have : J₂.is_closed (⊤ : sieve X) := by
    intro Y f hf
    trivial
  suffices (⟨J₂.close S, J₂.close_is_closed S⟩ : Subtype _) = ⟨⊤, this⟩
    by
    rw [Subtype.ext_iff] at this
    exact this
  apply (h S hS).IsSeparatedFor.ext
  · intro Y f hf
    ext1
    dsimp
    rw [sieve.pullback_top, ← J₂.pullback_close, S.pullback_eq_top_of_mem hf,
      J₂.close_eq_top_iff_mem]
    apply J₂.top_mem
#align category_theory.le_topology_of_closed_sieves_is_sheaf CategoryTheory.le_topology_of_closedSieves_isSheaf

/-- If being a sheaf for `J₁` is equivalent to being a sheaf for `J₂`, then `J₁ = J₂`. -/
theorem topology_eq_iff_same_sheaves {J₁ J₂ : GrothendieckTopology C} :
    J₁ = J₂ ↔ ∀ P : Cᵒᵖ ⥤ Type max v u, Presieve.IsSheaf J₁ P ↔ Presieve.IsSheaf J₂ P :=
  by
  constructor
  · rintro rfl
    intro P
    rfl
  · intro h
    apply le_antisymm
    · apply le_topology_of_closed_sieves_is_sheaf
      rw [h]
      apply classifier_is_sheaf
    · apply le_topology_of_closed_sieves_is_sheaf
      rw [← h]
      apply classifier_is_sheaf
#align category_theory.topology_eq_iff_same_sheaves CategoryTheory.topology_eq_iff_same_sheaves

/--
A closure (increasing, inflationary and idempotent) operation on sieves that commutes with pullback
induces a Grothendieck topology.
In fact, such operations are in bijection with Grothendieck topologies.
-/
@[simps]
def topologyOfClosureOperator (c : ∀ X : C, ClosureOperator (Sieve X))
    (hc : ∀ ⦃X Y : C⦄ (f : Y ⟶ X) (S : Sieve X), c _ (S.pullback f) = (c _ S).pullback f) :
    GrothendieckTopology C where
  sieves X := { S | c X S = ⊤ }
  top_mem' X := top_unique ((c X).le_closure _)
  pullback_stable' X Y S f hS := by
    rw [Set.mem_setOf_eq] at hS
    rw [Set.mem_setOf_eq, hc, hS, sieve.pullback_top]
  transitive' X S hS R hR := by
    rw [Set.mem_setOf_eq] at hS
    rw [Set.mem_setOf_eq, ← (c X).idempotent, eq_top_iff, ← hS]
    apply (c X).Monotone fun Y f hf => _
    rw [sieve.pullback_eq_top_iff_mem, ← hc]
    apply hR hf
#align category_theory.topology_of_closure_operator CategoryTheory.topologyOfClosureOperator

/--
The topology given by the closure operator `J.close` on a Grothendieck topology is the same as `J`.
-/
theorem topologyOfClosureOperator_self :
    (topologyOfClosureOperator J₁.ClosureOperator fun X Y => J₁.pullback_close) = J₁ :=
  by
  ext (X S)
  apply grothendieck_topology.close_eq_top_iff_mem
#align category_theory.topology_of_closure_operator_self CategoryTheory.topologyOfClosureOperator_self

theorem topologyOfClosureOperator_close (c : ∀ X : C, ClosureOperator (Sieve X))
    (pb : ∀ ⦃X Y : C⦄ (f : Y ⟶ X) (S : Sieve X), c Y (S.pullback f) = (c X S).pullback f) (X : C)
    (S : Sieve X) : (topologyOfClosureOperator c pb).close S = c X S :=
  by
  ext
  change c _ (sieve.pullback f S) = ⊤ ↔ c _ S f
  rw [pb, sieve.pullback_eq_top_iff_mem]
#align category_theory.topology_of_closure_operator_close CategoryTheory.topologyOfClosureOperator_close

end CategoryTheory


import data.vect
import .basic .prod

/-!
 * Theories that have trivial initial models.
-/

namespace model

--- `is_initial th α` guarantees that `α` is an initial model of the theory `th`.
structure is_initial (th : theory) (α : Type _) [model th α] :=
  (elim : Π {β : Type _} [mb : model th β], @morphism th α β _ mb.to_premodel)
  (hunique : Π {β : Type _} [mb : model th β], ∀ (g : @morphism th α β _ mb.to_premodel) (a : α), g.val a = elim.val a)

--- `has_trivial_init th` can be defined if `unit` is an initial model of the theory `th`. Examples include groups and abelian groups. Non-examples include unital rings.
class has_trivial_init (th : theory) :=
  (init_unit : is_initial th unit)

--- If a theory `th` has `unit` as an initial model, then every model of `th` admits an element that is closed under operations in the theory.
definition fixed_element (th : theory) [ht : has_trivial_init th] (α : Type _) [model th α] : α := ((@is_initial.elim th unit _ ht.init_unit) α _).val ()

--- Proof that `fixed th α` is closed under operations in the theory `th`.
theorem fixed_op (th : theory) [ht : has_trivial_init th] (α : Type _) [model th α] : ∀ {n} μ, fixed_element th α = @premodel.act th α _ n μ (vect.repeat (fixed_element th α) n) :=
  begin
    intros n μ,
    dsimp [fixed_element],
    cases hht: ht.init_unit with f hf,
    dsimp [is_initial.elim],
    rw [←vect.map_repeat],
    let hact := (@f α _).property,
    dunfold is_morphism at hact,
    rw [←hact],
    dsimp [premodel.act],
    refl
  end

#print axioms fixed_op

theorem fixed_const (th : theory) [ht : has_trivial_init th] (α : Type _) [model th α] : ∀ (μ : th.op 0), fixed_element th α = @premodel.act th α _ _ μ vect.nil :=
  fixed_op th α

--- The morphism that factors through the terminal model.
definition null_morphism (th : theory) [ht : has_trivial_init th] (α β : Type _) [model th α] [model th β] : morphism th α β :=
  ⟨(λ _, fixed_element th β), by intros n μ as; dsimp *; rw [vect.map_const,←fixed_op th β μ]⟩

--- If `unit` is an initial model, then there is a canonical morphism that injects a model `α` into the first component of a product `α×β`.
definition prod_inl (th : theory) [has_trivial_init th] {α β : Type _} [model th α] [model th β] : morphism th α (α×β) :=
{
  val := λ a, (a, fixed_element th β),
  property :=
    begin
      intros n μ as,
      dsimp [premodel.act, prod.map],
      rw [vect.unzip_fst_is_map_fst, vect.unzip_snd_is_map_snd],
      csimp [←vect.map_comp],
      dsimp [function.comp],
      have : @id α = (λ x,x) , from rfl,
      rw [←this,vect.map_id]; clear this,
      rw [vect.map_const],
      rw [←fixed_op th β μ],
    end
}

--- If `unit` is an initial model, then there is a canonical morphism that injects a model `β` into the second component of a product `α×β`.
definition prod_inr (th : theory) [has_trivial_init th] {α β : Type _} [model th α] [model th β] : morphism th β (α×β) :=
{
  val := λ b, (fixed_element th α,b),
  property :=
    begin
      intros n μ as,
      dsimp [premodel.act, prod.map],
      rw [vect.unzip_fst_is_map_fst, vect.unzip_snd_is_map_snd],
      csimp [←vect.map_comp],
      dsimp [function.comp],
      have : @id β = (λ x,x) , from rfl,
      rw [←this,vect.map_id]; clear this,
      rw [vect.map_const],
      rw [←fixed_op th α μ],
    end
}

#print axioms prod_inl
#print axioms prod_inr

end model


import model_theory.substructures
import model_theory.bundled

--OUTPUT 1
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  -- For each $n$, let $\mathbf A_n$ be the formula:
  let A : ℕ → L.formula,
  -- $\exists x_1 \exists x_2 \ldots \exists x_n: \{x_1 \ne x_2 \land x_1 \ne x_3 \land \ldots \land x_{n - 1} \ne x_n\}$
  have h1 : ∀ n : ℕ, A n = ∃' (x : fin n), ∀ (i j : fin n), i ≠ j → x i ≠ x j, from by {
    assume n : ℕ,
    have h2 : ∀ (i j : fin n), i ≠ j → x i ≠ x j, from by {
      assume (i j : fin n) (hne : i ≠ j),
      have h3 : i < n ∧ j < n, from by {split, apply fin.lt_iff_ne_zero.mp hne.left, apply fin.lt_iff_ne_zero.mp hne.right},
      have h4 : i ≠ j, from by {apply ne_of_lt, exact h3.left},
      have h5 : i ≠ j, from by {apply ne_of_lt, exact h3.right},
      show x i ≠ x j, from by {apply ne_of_ne_of_ne, exact h4, exact h5},
    },
    show A n = ∃' (x : fin n), ∀ (i j : fin n), i ≠ j → x i ≠ x j, from by {
      apply funext,
      assume x : fin n,
      show (∃' (x : fin n), ∀ (i j : fin n), i ≠ j → x i ≠ x j) x ↔ ∀ (i j : fin n), i ≠ j → x i ≠ x j, from by {
        split,
        assume h3 : (∃' (x : fin n), ∀ (i j : fin n), i ≠ j → x i ≠ x j) x,
        show ∀ (i j : fin n), i ≠ j → x i ≠ x j, from by {
          assume (i j : fin n) (hne : i ≠ j),
          have h4 : ∀ (i j : fin n), i ≠ j → x i ≠ x j, from by {
            assume (i j : fin n) (hne : i ≠ j),
            have h5 : i < n ∧ j < n, from by {split, apply fin.lt_iff_ne_zero.mp hne.left, apply fin.lt_iff_ne_zero.mp hne.right},
            have h6 : i ≠ j, from by {apply ne_of_lt, exact h5.left},
            have h7 : i ≠ j, from by {apply ne_of_lt, exact h5.right},
            show x i ≠ x j, from by {apply ne_of_ne_of_ne, exact h6, exact h7},
          },
          show x i ≠ x j, from by {apply h4, exact hne},
        },
        assume h3 : ∀ (i j : fin n), i ≠ j → x i ≠ x j,
        show (∃' (x : fin n), ∀ (i j : fin n), i ≠ j → x i ≠ x j) x, from by {
          apply exists.intro x,
          show ∀ (i j : fin n), i ≠ j → x i ≠ x j, from by {
            assume (i j : fin n) (hne : i ≠ j),
            have h4 : ∀ (i j : fin n), i ≠ j → x i ≠ x j, from by {
              assume (i j : fin n) (hne : i ≠ j),
              have h5 : i < n ∧ j < n, from by {split, apply fin.lt_iff_ne_zero.mp hne.left, apply fin.lt_iff_ne_zero.mp hne.right},
              have h6 : i ≠ j, from by {apply ne_of_lt, exact h5.left},
              have h7 : i ≠ j, from by {apply ne_of_lt, exact h5.right},
              show x i ≠ x j, from by {apply ne_of_ne_of_ne, exact h6, exact h7},
            },
            show x i ≠ x j, from by {apply h4, exact hne},
          },
        },
      },
    },
  },
  -- Then $\mathbf A_i$ is true in a structure $\AA$ iff $\AA$ has at least $n$ elements.
  have h2 : ∀ (n : ℕ) (M : F.Model), M ⊨ A n ↔ fintype.card M ≥ n, from by {
    assume (n : ℕ) (M : F.Model),
    have h3 : ∀ (n : ℕ) (M : F.Model), M ⊨ A n → fintype.card M ≥ n, from by {
      assume (n : ℕ) (M : F.Model) (h4 : M ⊨ A n),
      have h5 : ∃ (x : fin n → M), ∀ (i j : fin n), i ≠ j → x i ≠ x j, from by {
        have h6 : ∃ (x : fin n → M), ∀ (i j : fin n), i ≠ j → x i ≠ x j, from by {
          apply exists.elim h4,
          assume (x : fin n → M),
          assume h7 : ∀ (i j : fin n), i ≠ j → x i ≠ x j,
          show ∃ (x : fin n → M), ∀ (i j : fin n), i ≠ j → x i ≠ x j, from by {
            apply exists.intro x,
            show ∀ (i j : fin n), i ≠ j → x i ≠ x j, from by {
              assume (i j : fin n) (hne : i ≠ j),
              have h8 : ∀ (i j : fin n), i ≠ j → x i ≠ x j, from by {
                assume (i j : fin n) (hne : i ≠ j),
                have h9 : i < n ∧ j < n, from by {split, apply fin.lt_iff_ne_zero.mp hne.left, apply fin.lt_iff_ne_zero.mp hne.right},
                have h10 : i ≠ j, from by {apply ne_of_lt, exact h9.left},
                have h11 : i ≠ j, from by {apply ne_of_lt, exact h9.right},
                show x i ≠ x j, from by {apply ne_of_ne_of_ne, exact h10, exact h11},
              },
              show x i ≠ x j, from by {apply h8, exact hne},
            },
          },
        },
        show ∃ (x : fin n → M), ∀ (i j : fin n), i ≠ j → x i ≠ x j, from by {
          apply exists.elim h6,
          assume (x : fin n → M),
          assume h7 : ∀ (i j : fin n), i ≠ j → x i ≠ x j,
          show ∃ (x : fin n → M), ∀ (i j : fin n), i ≠ j → x i ≠ x j, from by {
            apply exists.intro x,
            show ∀ (i j : fin n), i ≠ j → x i ≠ x j, from by {
              assume (i j : fin n) (hne : i ≠ j),
              have h8 : ∀ (i j : fin n), i ≠ j → x i ≠ x j, from by {
                assume (i j : fin n) (hne : i ≠ j),
                have h9 : i < n ∧ j < n, from by {split, apply fin.lt_iff_ne_zero.mp hne.left, apply fin.lt_iff_ne_zero.mp hne
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, ring}
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from
    assume a : G, h1 a a,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from
    assume a : G, h2 a a,

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from assume a :G,
    exists_unique.unique (h3 a) (classical.some_spec (exists_unique.exists (h3 a)))
    (mul_one a),
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from assume a : G,
    exists_unique.unique (h4 a) (classical.some_spec (exists_unique.exists (h4 a))) (one_mul a),

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
end

/--`theorem`
Overflow theorem
Let $F$ be a set of first-order formulas which has finite models of arbitrarily large size. Then $F$ has an infinite model.
`proof`
For each $n$, let $\mathbf A_n$ be the formula:

$\exists x_1 \exists x_2 \ldots \exists x_n: \{x_1 \ne x_2 \land x_1 \ne x_3 \land \ldots \land x_{n - 1} \ne x_n\}$

Then $\mathbf A_i$ is true in a structure $\AA$ iff $\AA$ has at least $n$ elements.

Take:
$$ \Gamma := F \cup \bigcup_{i \mathop = 1}^\infty A_i $$

Since $F$ has models of arbitrarily large size, every finite subset of $\Gamma$ is satisfiable.

From the Compactness Theorem, $\Gamma$ is satisfiable in some model $\mathbf{M}$.

But since $\mathbf{M} \models A_i$ for each $i$, $\mathbf{M}$ must be infinite.

So $F$ has an infinite model.

QED
-/
theorem  overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
FEW SHOT PROMPTS TO CODEX(END)-/


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

/-!
# Homological complexes are differential graded objects.

We verify that a `homological_complex` indexed by an `add_comm_group` is
essentially the same thing as a differential graded object.

This equivalence is probably not particularly useful in practice;
it's here to check that definitions match up as expected.
-/

open category_theory
open category_theory.limits

open_locale classical
noncomputable theory

namespace homological_complex

variables {β : Type*} [add_comm_group β] {b : β}
variables {V : Type*} [category V] [has_zero_morphisms V]

/-- Since `eq_to_hom` only preserves the fact that `X.X i = X.X j` but not `i = j`, this definition
is used to aid the simplifier. -/
abbreviation _root_.category_theory.differential_object.X_eq_to_hom
  (X : differential_object (graded_object_with_shift b V))
  {i j : β} (h : i = j) : X.X i ⟶ X.X j := eq_to_hom (congr_arg X.X h)

@[simp] lemma _root_.category_theory.differential_object.X_eq_to_hom_refl
  (X : differential_object (graded_object_with_shift b V)) (i : β) :
  X.X_eq_to_hom (refl i) = 𝟙 _ := rfl

@[simp, reassoc] lemma eq_to_hom_d (X : differential_object (graded_object_with_shift b V))
  {x y : β} (h : x = y) :
  X.X_eq_to_hom h ≫ X.d y = X.d x ≫ X.X_eq_to_hom (by { cases h, refl }) :=
by { cases h, dsimp, simp }

@[simp, reassoc] lemma d_eq_to_hom (X : homological_complex V (complex_shape.up' b))
  {x y z : β} (h : y = z) :
  X.d x y ≫ eq_to_hom (congr_arg X.X h) = X.d x z :=
by { cases h, simp }

@[simp, reassoc] lemma eq_to_hom_f {X Y : differential_object (graded_object_with_shift b V)}
  (f : X ⟶ Y) {x y : β} (h : x = y) :
  X.X_eq_to_hom h ≫ f.f y = f.f x ≫ Y.X_eq_to_hom h :=
by { cases h, simp }

variables (b V)

local attribute [reducible] graded_object.has_shift

/--
The functor from differential graded objects to homological complexes.
-/
@[simps]
def dgo_to_homological_complex :
  differential_object (graded_object_with_shift b V) ⥤
    homological_complex V (complex_shape.up' b) :=
{ obj := λ X,
  { X := λ i, X.X i,
    d := λ i j, if h : i + b = j then
      X.d i ≫ X.X_eq_to_hom (show i + (1 : ℤ) • b = j, by simp [h]) else 0,
    shape' := λ i j w, by { dsimp at w, convert dif_neg w },
    d_comp_d' := λ i j k hij hjk, begin
      dsimp at hij hjk, substs hij hjk,
      have : X.d i ≫ X.d _ = _ := (congr_fun X.d_squared i : _),
      reassoc! this,
      simp [this],
    end },
  map := λ X Y f,
  { f := f.f,
    comm' := λ i j h, begin
      dsimp at h ⊢,
      subst h,
      have : f.f i ≫ Y.d i = X.d i ≫ f.f (i + 1 • b) := (congr_fun f.comm i).symm,
      reassoc! this,
      simp only [category.comp_id, eq_to_hom_refl, dif_pos rfl, this, category.assoc, eq_to_hom_f]
    end, } }

/--
The functor from homological complexes to differential graded objects.
-/
@[simps]
def homological_complex_to_dgo :
  homological_complex V (complex_shape.up' b) ⥤
    differential_object (graded_object_with_shift b V) :=
{ obj := λ X,
  { X := λ i, X.X i,
    d := λ i, X.d i (i + 1 • b),
    d_squared' := by { ext i, dsimp, simp, } },
  map := λ X Y f,
  { f := f.f,
    comm' := by { ext i, dsimp, simp, }, } }

/--
The unit isomorphism for `dgo_equiv_homological_complex`.
-/
@[simps]
def dgo_equiv_homological_complex_unit_iso :
  𝟭 (differential_object (graded_object_with_shift b V)) ≅
    dgo_to_homological_complex b V ⋙ homological_complex_to_dgo b V :=
nat_iso.of_components (λ X,
  { hom := { f := λ i, 𝟙 (X.X i), },
    inv := { f := λ i, 𝟙 (X.X i), }, }) (by tidy)

/--
The counit isomorphism for `dgo_equiv_homological_complex`.
-/
@[simps]
def dgo_equiv_homological_complex_counit_iso :
  homological_complex_to_dgo b V ⋙ dgo_to_homological_complex b V ≅
    𝟭 (homological_complex V (complex_shape.up' b)) :=
nat_iso.of_components (λ X,
  { hom :=
    { f := λ i, 𝟙 (X.X i),
      comm' := λ i j h, begin
        dsimp at h ⊢, subst h,
        delta homological_complex_to_dgo,
        simp,
      end },
    inv :=
    { f := λ i, 𝟙 (X.X i),
      comm' := λ i j h, begin
        dsimp at h ⊢, subst h,
        delta homological_complex_to_dgo,
        simp,
      end }, }) (by tidy)

/--
The category of differential graded objects in `V` is equivalent
to the category of homological complexes in `V`.
-/
@[simps]
def dgo_equiv_homological_complex :
  differential_object (graded_object_with_shift b V) ≌
    homological_complex V (complex_shape.up' b) :=
{ functor := dgo_to_homological_complex b V,
  inverse := homological_complex_to_dgo b V,
  unit_iso := dgo_equiv_homological_complex_unit_iso b V,
  counit_iso := dgo_equiv_homological_complex_counit_iso b V, }

end homological_complex


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import Std.Data.Option.Init.Lemmas
import Std.Data.Option.Basic
import Std.Tactic.Ext.Attr
import Std.Logic

namespace Option

theorem mem_iff {a : α} {b : Option α} : a ∈ b ↔ b = a := .rfl

theorem some_ne_none (x : α) : some x ≠ none := fun.

protected theorem «forall» {p : Option α → Prop} : (∀ x, p x) ↔ p none ∧ ∀ x, p (some x) :=
  ⟨fun h => ⟨h _, fun _ => h _⟩, fun h x => Option.casesOn x h.1 h.2⟩

protected theorem «exists» {p : Option α → Prop} : (∃ x, p x) ↔ p none ∨ ∃ x, p (some x) :=
  ⟨fun | ⟨none, hx⟩ => .inl hx | ⟨some x, hx⟩ => .inr ⟨x, hx⟩,
   fun | .inl h => ⟨_, h⟩ | .inr ⟨_, hx⟩ => ⟨_, hx⟩⟩

theorem get_mem : ∀ {o : Option α} (h : isSome o), o.get h ∈ o
| some _, _ => rfl

theorem get_of_mem : ∀ {o : Option α} (h : isSome o), a ∈ o → o.get h = a
| _, _, rfl => rfl

theorem not_mem_none (a : α) : a ∉ (none : Option α) := fun.

@[simp] theorem some_get : ∀ {x : Option α} (h : isSome x), some (x.get h) = x
| some _, _ => rfl

@[simp] theorem get_some (x : α) (h : isSome (some x)) : (some x).get h = x := rfl

theorem getD_of_ne_none {x : Option α} (hx : x ≠ none) (y : α) : some (x.getD y) = x := by
  cases x; {contradiction}; rw [getD_some]

theorem mem_unique {o : Option α} {a b : α} (ha : a ∈ o) (hb : b ∈ o) : a = b :=
  some.inj <| ha ▸ hb

@[ext] theorem ext : ∀ {o₁ o₂ : Option α}, (∀ a, a ∈ o₁ ↔ a ∈ o₂) → o₁ = o₂
  | none, none, _ => rfl
  | some _, _, H => ((H _).1 rfl).symm
  | _, some _, H => (H _).2 rfl

theorem eq_none_iff_forall_not_mem : o = none ↔ ∀ a, a ∉ o :=
  ⟨fun e a h => by rw [e] at h; (cases h), fun h => ext <| by simp; exact h⟩

@[simp] theorem isSome_none : @isSome α none = false := rfl

@[simp] theorem isSome_some : isSome (some a) = true := rfl

theorem isSome_iff_exists : isSome x ↔ ∃ a, x = some a := by cases x <;> simp [isSome]

@[simp] theorem isNone_none : @isNone α none = true := rfl

@[simp] theorem isNone_some : isNone (some a) = false := rfl

@[simp] theorem not_isSome : isSome a = false ↔ a.isNone = true := by
  cases a <;> simp

theorem eq_some_iff_get_eq : o = some a ↔ ∃ h : o.isSome, o.get h = a := by
  cases o <;> simp; intro.

theorem eq_some_of_isSome : ∀ {o : Option α} (h : o.isSome), o = some (o.get h)
  | some _, _ => rfl

theorem not_isSome_iff_eq_none : ¬o.isSome ↔ o = none := by
  cases o <;> simp

theorem ne_none_iff_isSome : o ≠ none ↔ o.isSome := by cases o <;> simp

theorem ne_none_iff_exists : o ≠ none ↔ ∃ x, some x = o := by cases o <;> simp

theorem ne_none_iff_exists' : o ≠ none ↔ ∃ x, o = some x :=
  ne_none_iff_exists.trans <| exists_congr fun _ => eq_comm

theorem ball_ne_none {p : Option α → Prop} : (∀ x (_ : x ≠ none), p x) ↔ ∀ x, p (some x) :=
  ⟨fun h x => h (some x) (some_ne_none x),
    fun h x hx => by
      have := h <| x.get <| ne_none_iff_isSome.1 hx
      simp [some_get] at this ⊢
      exact this⟩

@[simp] theorem bind_some (x : Option α) : x.bind some = x := by cases x <;> rfl

@[simp] theorem bind_eq_some : x.bind f = some b ↔ ∃ a, x = some a ∧ f a = some b := by
  cases x <;> simp

@[simp] theorem bind_eq_none {o : Option α} {f : α → Option β} :
    o.bind f = none ↔ ∀ b a, a ∈ o → b ∉ f a := by
  simp only [eq_none_iff_forall_not_mem, not_exists, not_and, mem_def, bind_eq_some]

theorem bind_comm {f : α → β → Option γ} (a : Option α) (b : Option β) :
    (a.bind fun x => b.bind (f x)) = b.bind fun y => a.bind fun x => f x y := by
  cases a <;> cases b <;> rfl

theorem bind_assoc (x : Option α) (f : α → Option β) (g : β → Option γ) :
    (x.bind f).bind g = x.bind fun y => (f y).bind g := by cases x <;> rfl

theorem join_eq_some : x.join = some a ↔ x = some (some a) := by
  simp

theorem join_ne_none : x.join ≠ none ↔ ∃ z, x = some (some z) := by
  simp only [ne_none_iff_exists', join_eq_some, iff_self]

theorem join_ne_none' : ¬x.join = none ↔ ∃ z, x = some (some z) :=
  join_ne_none

theorem join_eq_none : o.join = none ↔ o = none ∨ o = some none :=
  match o with | none | some none | some (some _) => by simp

theorem bind_id_eq_join {x : Option (Option α)} : x.bind id = x.join := rfl

@[simp] theorem map_eq_map : Functor.map f = Option.map f := rfl

theorem map_none : f <$> none = none := rfl

theorem map_some : f <$> some a = some (f a) := rfl

@[simp] theorem map_eq_some' : x.map f = some b ↔ ∃ a, x = some a ∧ f a = b := by cases x <;> simp

theorem map_eq_some : f <$> x = some b ↔ ∃ a, x = some a ∧ f a = b := map_eq_some'

@[simp] theorem map_eq_none' : x.map f = none ↔ x = none := by
  cases x <;> simp only [map_none', map_some', eq_self_iff_true]

theorem map_eq_none : f <$> x = none ↔ x = none := map_eq_none'

theorem map_eq_bind {x : Option α} : x.map f = x.bind (some ∘ f) := by
  cases x <;> simp [Option.bind]

theorem map_congr {x : Option α} (h : ∀ a ∈ x, f a = g a) : x.map f = x.map g := by
  cases x <;> simp only [map_none', map_some', h, mem_def]

@[simp] theorem map_id' : Option.map (@id α) = id := map_id

@[simp] theorem map_map (h : β → γ) (g : α → β) (x : Option α) :
    (x.map g).map h = x.map (h ∘ g) := by
  cases x <;> simp only [map_none', map_some', ·∘·]

theorem comp_map (h : β → γ) (g : α → β) (x : Option α) : x.map (h ∘ g) = (x.map g).map h :=
  (map_map ..).symm

@[simp] theorem map_comp_map (f : α → β) (g : β → γ) :
    Option.map g ∘ Option.map f = Option.map (g ∘ f) := by funext x; simp

theorem mem_map_of_mem (g : α → β) (h : a ∈ x) : g a ∈ Option.map g x := h.symm ▸ map_some' ..

theorem bind_map_comm {α β} {x : Option (Option α)} {f : α → β} :
    x.bind (Option.map f) = (x.map (Option.map f)).bind id := by cases x <;> simp

theorem join_map_eq_map_join {f : α → β} {x : Option (Option α)} :
    (x.map (Option.map f)).join = x.join.map f := by cases x <;> simp

theorem join_join {x : Option (Option (Option α))} : x.join.join = (x.map join).join := by
  cases x <;> simp

theorem mem_of_mem_join {a : α} {x : Option (Option α)} (h : a ∈ x.join) : some a ∈ x :=
  h.symm ▸ join_eq_some.1 h

@[simp] theorem some_orElse (a : α) (x : Option α) : (some a <|> x) = some a := rfl

@[simp] theorem none_orElse (x : Option α) : (none <|> x) = x := rfl

@[simp] theorem orElse_none (x : Option α) : (x <|> none) = x := by cases x <;> rfl

@[simp] theorem guard_eq_some [DecidablePred p] : guard p a = some b ↔ a = b ∧ p a := by
  by_cases h : p a <;> simp [Option.guard, h]

theorem liftOrGet_eq_or_eq {f : α → α → α} (h : ∀ a b, f a b = a ∨ f a b = b) :
    ∀ o₁ o₂, liftOrGet f o₁ o₂ = o₁ ∨ liftOrGet f o₁ o₂ = o₂
  | none, none => .inl rfl
  | some a, none => .inl rfl
  | none, some b => .inr rfl
  | some a, some b => by have := h a b; simp [liftOrGet] at this ⊢; exact this

@[simp] theorem liftOrGet_none_left {f} {b : Option α} : liftOrGet f none b = b := by
  cases b <;> rfl

@[simp] theorem liftOrGet_none_right {f} {a : Option α} : liftOrGet f a none = a := by
  cases a <;> rfl

@[simp] theorem liftOrGet_some_some {f} {a b : α} :
  liftOrGet f (some a) (some b) = f a b := rfl

theorem elim_none (x : β) (f : α → β) : none.elim x f = x := rfl

theorem elim_some (x : β) (f : α → β) (a : α) : (some a).elim x f = f a := rfl

@[simp] theorem getD_map (f : α → β) (x : α) (o : Option α) :
  (o.map f).getD (f x) = f (getD o x) := by cases o <;> rfl

section

attribute [local instance] Classical.propDecidable

/-- An arbitrary `some a` with `a : α` if `α` is nonempty, and otherwise `none`. -/
noncomputable def choice (α : Type _) : Option α :=
  if h : Nonempty α then some (Classical.choice h) else none

theorem choice_eq {α : Type _} [Subsingleton α] (a : α) : choice α = some a := by
  simp [choice]
  rw [dif_pos (⟨a⟩ : Nonempty α)]
  simp; apply Subsingleton.elim

theorem choice_isSome_iff_nonempty {α : Type _} : (choice α).isSome ↔ Nonempty α :=
  ⟨fun h => ⟨(choice α).get h⟩, fun h => by simp only [choice, dif_pos h, isSome_some]⟩

end

@[simp] theorem to_list_some (a : α) : (a : Option α).toList = [a] := rfl

@[simp] theorem to_list_none (α : Type _) : (none : Option α).toList = [] := rfl


/-
Copyright (c) 2020 Frédéric Dupuis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Frédéric Dupuis
-/
import linear_algebra.affine_space.affine_map
import topology.algebra.group
import topology.algebra.mul_action

/-!
# Topological properties of affine spaces and maps

For now, this contains only a few facts regarding the continuity of affine maps in the special
case when the point space and vector space are the same.

TODO: Deal with the case where the point spaces are different from the vector spaces. Note that
we do have some results in this direction under the assumption that the topologies are induced by
(semi)norms.
-/

namespace affine_map

variables {R E F : Type*}
variables [add_comm_group E] [topological_space E]
variables [add_comm_group F] [topological_space F] [topological_add_group F]

section ring

variables [ring R] [module R E] [module R F]

/-- An affine map is continuous iff its underlying linear map is continuous. See also
`affine_map.continuous_linear_iff`. -/
lemma continuous_iff {f : E →ᵃ[R] F} :
  continuous f ↔ continuous f.linear :=
begin
  split,
  { intro hc,
    rw decomp' f,
    have := hc.sub continuous_const,
    exact this, },
  { intro hc,
    rw decomp f,
    have := hc.add continuous_const,
    exact this }
end

/-- The line map is continuous. -/
@[continuity]
lemma line_map_continuous [topological_space R] [has_continuous_smul R F] {p v : F} :
  continuous ⇑(line_map p v : R →ᵃ[R] F) :=
continuous_iff.mpr $ (continuous_id.smul continuous_const).add $
  @continuous_const _ _ _ _ (0 : F)

end ring

section comm_ring

variables [comm_ring R] [module R F] [has_continuous_const_smul R F]

@[continuity]
lemma homothety_continuous (x : F) (t : R) : continuous $ homothety x t :=
begin
  suffices : ⇑(homothety x t) = λ y, t • (y - x) + x, { rw this, continuity, },
  ext y,
  simp [homothety_apply],
end

end comm_ring

section field

variables [field R] [module R F] [has_continuous_const_smul R F]

lemma homothety_is_open_map (x : F) (t : R) (ht : t ≠ 0) : is_open_map $ homothety x t :=
begin
  apply is_open_map.of_inverse (homothety_continuous x t⁻¹);
  intros e;
  simp [← affine_map.comp_apply, ← homothety_mul, ht],
end

end field

end affine_map