import Lean
syntax (name := test) "test%" ident : command

open Lean.Elab
open Lean.Elab.Command

@[command_elab test] def elabTest : CommandElab := fun stx => do
  let id ← resolveGlobalConstNoOverloadWithInfo stx[1]
  liftTermElabM none do
    Lean.Meta.Match.mkEquationsFor id
  return ()

def f (xs ys : List String) : Nat :=
  match xs, ys with
  | [], []      => 0
  | _,  ["abc"] => 1
  | _, x::xs    => xs.length
  | _,  _       => 2

def h (x y : Nat) : Nat :=
  match x, y with
  | 10000, _ => 0
  | 10001, _ => 5
  | _, 20000 => 4
  | x+1, _   => 3
  | Nat.zero, y+1 => 44
  | _, _     => 1

theorem ex1 : h 10000 1 = 0 := rfl
theorem ex2 : h 10002 1 = 3 := rfl

-- set_option trace.Meta.debug true
-- set_option pp.proofs true
-- set_option trace.Meta.debug truen
set_option trace.Meta.Match.matchEqs true in
test% f.match_1
#check @f.match_1.eq_1
#check @f.match_1.eq_2
#check @f.match_1.eq_3
#check @f.match_1.eq_4
#check @f.match_1.splitter

test% h.match_1
#check @h.match_1.eq_1
#check @h.match_1.eq_2
#check @h.match_1.eq_3
#check @h.match_1.eq_4
#check @h.match_1.eq_5
#check @h.match_1.eq_6
#check @h.match_1.splitter

def g (xs ys : List (Nat × String)) : Nat :=
  match xs, ys with
  | _,  [(a,b)] => 0
  | [(c, d)], _ => 1
  | _,  _       => 2

set_option pp.analyze false
set_option pp.proofs true
set_option trace.Meta.Match.matchEqs true in
test% g.match_1
#check @g.match_1.eq_1
#check @g.match_1.eq_2
#check @g.match_1.eq_3
#check @g.match_1.splitter


universes u v

inductive Foo (α : Type u)
| leaf (a : α) : Foo
| node (left : Foo) (right : Foo) : Foo
| cons (head : α) (tail : Foo) : Foo

def Foo.elim {α : Type u} (C : Foo α → Foo α → Sort v) (x y : Foo α)
  (h₁ : forall (a₁ a₂ : α), C (Foo.leaf a₁) (Foo.leaf a₂))
  (h₂ : forall (l₁ r₁ l₂ r₂ : Foo α), C (Foo.node l₁ r₁) (Foo.node l₂ r₂))
  (h₃ : forall (h₁ t₁ h₂ t₂), C (Foo.cons h₁ t₁) (Foo.cons h₂ t₂))
  (h₄ : forall (x y), C x y)
  : C x y :=
Foo.casesOn x
  (fun a₁ => Foo.casesOn y
    (fun a₂ => h₁ a₁ a₂)
    (fun l₂ r₂ => h₄ (Foo.leaf a₁) (Foo.node l₂ r₂))
    (fun h₂ t₂ => h₄ (Foo.leaf a₁) (Foo.cons h₂ t₂)))
  (fun l₁ r₁ => Foo.casesOn y
    (fun a₂    => h₄ (Foo.node l₁ r₁) (Foo.leaf a₂))
    (fun l₂ r₂ => h₂ l₁ r₁ l₂ r₂)
    (fun h₂ t₂ => h₄ (Foo.node l₁ r₁) (Foo.cons h₂ t₂)))
  (fun h₁ t₁ => Foo.casesOn y
    (fun a₂    => h₄ (Foo.cons h₁ t₁) (Foo.leaf a₂))
    (fun l₂ r₂ => h₄ (Foo.cons h₁ t₁) (Foo.node l₂ r₂))
    (fun h₂ t₂ => h₃ h₁ t₁ h₂ t₂))

def f : List Nat → List Nat → List Nat
| x::xs, _   => []
| _,     []  => []
| xs,    ys  => xs ++ ys

def List.elim (C : List Nat → List Nat → Sort v) (xs ys : List Nat)
  (h₁ : forall x xs ys, C (x::xs) ys)
  (h₂ : forall xs,      C xs [])
  (h₃ : forall xs ys,   C xs ys)
  : C xs ys :=
List.casesOn xs
  (List.casesOn ys
     (h₂ [])
     (fun y ys => h₃ [] (y::ys)))
  (fun x xs => h₁ x xs ys)

theorem List.elim.eq1 (C : List Nat → List Nat → Sort v)
  (h₁ : forall x xs ys, C (x::xs) ys)
  (h₂ : forall xs,      C xs [])
  (h₃ : forall xs ys,   C xs ys)
  (x : Nat) (xs ys : List Nat)
  : List.elim C (x::xs) ys h₁ h₂ h₃ = h₁ x xs ys :=
rfl

theorem List.elim.eq2 (C : List Nat → List Nat → Sort v)
  (h₁ : forall x xs ys, C (x::xs) ys)
  (h₂ : forall xs,      C xs [])
  (h₃ : forall xs ys,   C xs ys)
  (xs : List Nat)
  : (forall x' xs', xs = x'::xs' → False) → List.elim C xs [] h₁ h₂ h₃ = h₂ xs :=
List.casesOn xs
  (fun _      => rfl)
  (fun x xs h => False.elim (h x xs rfl))

theorem List.elim.eq3 (C : List Nat → List Nat → Sort v)
  (h₁ : forall x xs ys, C (x::xs) ys)
  (h₂ : forall xs,      C xs [])
  (h₃ : forall xs ys,   C xs ys)
  (xs : List Nat) (ys : List Nat)
  : (forall x' xs', xs = x'::xs' → False) → (ys = [] → False) → List.elim C xs ys h₁ h₂ h₃ = h₃ xs ys :=
List.casesOn xs
  (List.casesOn ys
     (fun _ h => False.elim (h rfl))
     (fun y ys _ _ => rfl))
  (fun x xs h _ => False.elim (h x xs rfl))

theorem List.elim.eq3.a (C : List Nat → List Nat → Sort v)
  (h₁ : forall x xs ys, C (x::xs) ys)
  (h₂ : forall xs,      C xs [])
  (h₃ : forall xs ys,   C xs ys)
  (y : Nat) (ys : List Nat)
  : List.elim C [] (y::ys) h₁ h₂ h₃ = h₃ [] (y::ys) :=
rfl

def List.elim2 (C : List Nat → List Nat → Sort v) (xs ys : List Nat)
  (h₁ : forall x xs ys, C (x::xs) ys)
  (h₂ : forall xs,    (forall (x' : Nat) (xs' : List Nat), xs = x' :: xs' → False) → C xs [])
  (h₃ : forall xs ys, (forall (x' : Nat) (xs' : List Nat), xs = x' :: xs' → False) → (ys = [] → False) → C xs ys)
  : C xs ys :=
List.casesOn xs
  (List.casesOn ys
     (h₂ [] (fun _ _ h => List.noConfusion h))
     (fun y ys => h₃ [] (y::ys) (fun _ _ h => List.noConfusion h) (fun h => List.noConfusion h)))
  (fun x xs => h₁ x xs ys)

def List.elim3 (C : List Nat → List Nat → List Nat → Sort v) (xs ys zs : List Nat)
  (h₁ : forall zs,       C [] [] zs)
  (h₂ : forall xs ys,    C xs ys [])
  (h₃ : forall xs ys zs, C xs ys zs)
  : C xs ys zs :=
List.casesOn xs
  (List.casesOn ys
     (h₁ zs)
     (fun y ys => List.casesOn zs
        (h₃ [] (y::ys) [])
        (fun z zs => h₃ [] (y::ys) (z::zs))))
  (fun x xs =>
    (List.casesOn zs
      (h₂ (x::xs) ys)
      (fun z zs => h₃ (x::xs) ys (z::zs))))

theorem List.elim3.eq (C : List Nat → List Nat → List Nat → Sort v)
  (h₁ : forall zs,       C [] [] zs)
  (h₂ : forall xs ys,    C xs ys [])
  (h₃ : forall xs ys zs, C xs ys zs)
  (xs ys zs : List Nat)
  : (xs = [] → ys = [] → False) → (zs = [] → False) → List.elim3 C xs ys zs h₁ h₂ h₃ = h₃ xs ys zs :=
List.casesOn xs
  (List.casesOn ys
    (fun h _  => False.elim (h rfl rfl))
    (fun y ys => List.casesOn zs
      (fun _ h => False.elim (h rfl))
      (fun z zs _ _ => rfl)))
  (fun x xs =>
    List.casesOn zs
      (fun _ h => False.elim (h rfl))
      (fun z zs _ _ => rfl))

theorem List.elim3.eq.a (C : List Nat → List Nat → List Nat → Sort v)
  (h₁ : forall zs,       C [] [] zs)
  (h₂ : forall xs ys,    C xs ys [])
  (h₃ : forall xs ys zs, C xs ys zs)
  (y : Nat) (ys : List Nat) (z : Nat) (zs : List Nat)
  : List.elim3 C [] (y::ys) (z::zs) h₁ h₂ h₃ = h₃ [] (y::ys) (z::zs) :=
rfl

theorem List.elim3.eq.b (C : List Nat → List Nat → List Nat → Sort v)
  (h₁ : forall zs,       C [] [] zs)
  (h₂ : forall xs ys,    C xs ys [])
  (h₃ : forall xs ys zs, C xs ys zs)
  (x : Nat) (xs : List Nat) (y : Nat) (ys : List Nat) (z : Nat) (zs : List Nat)
  : List.elim3 C (x::xs) (y::ys) (z::zs) h₁ h₂ h₃ = h₃ (x::xs) (y::ys) (z::zs) :=
rfl


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Anne Baanen
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.ring_theory.algebraic
import Mathlib.ring_theory.localization
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Ideals over/under ideals

This file concerns ideals lying over other ideals.
Let `f : R →+* S` be a ring homomorphism (typically a ring extension), `I` an ideal of `R` and
`J` an ideal of `S`. We say `J` lies over `I` (and `I` under `J`) if `I` is the `f`-preimage of `J`.
This is expressed here by writing `I = J.comap f`.

## Implementation notes

The proofs of the `comap_ne_bot` and `comap_lt_comap` families use an approach
specific for their situation: we construct an element in `I.comap f` from the
coefficients of a minimal polynomial.
Once mathlib has more material on the localization at a prime ideal, the results
can be proven using more general going-up/going-down theory.
-/

namespace ideal

theorem coeff_zero_mem_comap_of_root_mem_of_eval_mem {R : Type u_1} [comm_ring R] {S : Type u_2}
    [comm_ring S] {f : R →+* S} {I : ideal S} {r : S} (hr : r ∈ I) {p : polynomial R}
    (hp : polynomial.eval₂ f r p ∈ I) : polynomial.coeff p 0 ∈ comap f I :=
  sorry

theorem coeff_zero_mem_comap_of_root_mem {R : Type u_1} [comm_ring R] {S : Type u_2} [comm_ring S]
    {f : R →+* S} {I : ideal S} {r : S} (hr : r ∈ I) {p : polynomial R}
    (hp : polynomial.eval₂ f r p = 0) : polynomial.coeff p 0 ∈ comap f I :=
  coeff_zero_mem_comap_of_root_mem_of_eval_mem hr (Eq.symm hp ▸ ideal.zero_mem I)

theorem exists_coeff_ne_zero_mem_comap_of_non_zero_divisor_root_mem {R : Type u_1} [comm_ring R]
    {S : Type u_2} [comm_ring S] {f : R →+* S} {I : ideal S} {r : S}
    (r_non_zero_divisor : ∀ {x : S}, x * r = 0 → x = 0) (hr : r ∈ I) {p : polynomial R}
    (p_ne_zero : p ≠ 0) (hp : polynomial.eval₂ f r p = 0) :
    ∃ (i : ℕ), polynomial.coeff p i ≠ 0 ∧ polynomial.coeff p i ∈ comap f I :=
  sorry

theorem exists_coeff_ne_zero_mem_comap_of_root_mem {R : Type u_1} [comm_ring R] {S : Type u_2}
    [integral_domain S] {f : R →+* S} {I : ideal S} {r : S} (r_ne_zero : r ≠ 0) (hr : r ∈ I)
    {p : polynomial R} (p_ne_zero : p ≠ 0) (hp : polynomial.eval₂ f r p = 0) :
    ∃ (i : ℕ), polynomial.coeff p i ≠ 0 ∧ polynomial.coeff p i ∈ comap f I :=
  exists_coeff_ne_zero_mem_comap_of_non_zero_divisor_root_mem
    (fun (_x : S) (h : _x * r = 0) => or.resolve_right (iff.mp mul_eq_zero h) r_ne_zero) hr

theorem exists_coeff_mem_comap_sdiff_comap_of_root_mem_sdiff {R : Type u_1} [comm_ring R]
    {S : Type u_2} [integral_domain S] {f : R →+* S} {I : ideal S} {J : ideal S} [is_prime I]
    (hIJ : I ≤ J) {r : S} (hr : r ∈ ↑J \ ↑I) {p : polynomial R}
    (p_ne_zero : polynomial.map (quotient.mk (comap f I)) p ≠ 0)
    (hpI : polynomial.eval₂ f r p ∈ I) :
    ∃ (i : ℕ), polynomial.coeff p i ∈ ↑(comap f J) \ ↑(comap f I) :=
  sorry

theorem comap_ne_bot_of_root_mem {R : Type u_1} [comm_ring R] {S : Type u_2} [integral_domain S]
    {f : R →+* S} {I : ideal S} {r : S} (r_ne_zero : r ≠ 0) (hr : r ∈ I) {p : polynomial R}
    (p_ne_zero : p ≠ 0) (hp : polynomial.eval₂ f r p = 0) : comap f I ≠ ⊥ :=
  sorry

theorem comap_lt_comap_of_root_mem_sdiff {R : Type u_1} [comm_ring R] {S : Type u_2}
    [integral_domain S] {f : R →+* S} {I : ideal S} {J : ideal S} [is_prime I] (hIJ : I ≤ J) {r : S}
    (hr : r ∈ ↑J \ ↑I) {p : polynomial R}
    (p_ne_zero : polynomial.map (quotient.mk (comap f I)) p ≠ 0) (hp : polynomial.eval₂ f r p ∈ I) :
    comap f I < comap f J :=
  sorry

theorem comap_ne_bot_of_algebraic_mem {R : Type u_1} [comm_ring R] {S : Type u_2}
    [integral_domain S] {I : ideal S} [algebra R S] {x : S} (x_ne_zero : x ≠ 0) (x_mem : x ∈ I)
    (hx : is_algebraic R x) : comap (algebra_map R S) I ≠ ⊥ :=
  sorry

theorem comap_ne_bot_of_integral_mem {R : Type u_1} [comm_ring R] {S : Type u_2} [integral_domain S]
    {I : ideal S} [algebra R S] [nontrivial R] {x : S} (x_ne_zero : x ≠ 0) (x_mem : x ∈ I)
    (hx : is_integral R x) : comap (algebra_map R S) I ≠ ⊥ :=
  comap_ne_bot_of_algebraic_mem x_ne_zero x_mem (is_integral.is_algebraic R hx)

theorem eq_bot_of_comap_eq_bot {R : Type u_1} [comm_ring R] {S : Type u_2} [integral_domain S]
    {I : ideal S} [algebra R S] [nontrivial R] (hRS : algebra.is_integral R S)
    (hI : comap (algebra_map R S) I = ⊥) : I = ⊥ :=
  sorry

theorem mem_of_one_mem {S : Type u_2} [integral_domain S] {I : ideal S} (h : 1 ∈ I) (x : S) :
    x ∈ I :=
  Eq.symm (iff.mpr (eq_top_iff_one I) h) ▸ submodule.mem_top

theorem comap_lt_comap_of_integral_mem_sdiff {R : Type u_1} [comm_ring R] {S : Type u_2}
    [integral_domain S] {I : ideal S} {J : ideal S} [algebra R S] [hI : is_prime I] (hIJ : I ≤ J)
    {x : S} (mem : x ∈ ↑J \ ↑I) (integral : is_integral R x) :
    comap (algebra_map R S) I < comap (algebra_map R S) J :=
  sorry

theorem is_maximal_of_is_integral_of_is_maximal_comap {R : Type u_1} [comm_ring R] {S : Type u_2}
    [integral_domain S] [algebra R S] (hRS : algebra.is_integral R S) (I : ideal S) [is_prime I]
    (hI : is_maximal (comap (algebra_map R S) I)) : is_maximal I :=
  sorry

theorem is_maximal_of_is_integral_of_is_maximal_comap' {R : Type u_1} {S : Type u_2} [comm_ring R]
    [integral_domain S] (f : R →+* S) (hf : ring_hom.is_integral f) (I : ideal S) [hI' : is_prime I]
    (hI : is_maximal (comap f I)) : is_maximal I :=
  is_maximal_of_is_integral_of_is_maximal_comap hf I hI

theorem is_maximal_comap_of_is_integral_of_is_maximal {R : Type u_1} [comm_ring R] {S : Type u_2}
    [integral_domain S] [algebra R S] (hRS : algebra.is_integral R S) (I : ideal S)
    [hI : is_maximal I] : is_maximal (comap (algebra_map R S) I) :=
  sorry

theorem is_maximal_comap_of_is_integral_of_is_maximal' {R : Type u_1} {S : Type u_2} [comm_ring R]
    [integral_domain S] (f : R →+* S) (hf : ring_hom.is_integral f) (I : ideal S)
    (hI : is_maximal I) : is_maximal (comap f I) :=
  is_maximal_comap_of_is_integral_of_is_maximal hf I

theorem integral_closure.comap_ne_bot {R : Type u_1} [comm_ring R] {S : Type u_2}
    [integral_domain S] [algebra R S] [nontrivial R] {I : ideal ↥(integral_closure R S)}
    (I_ne_bot : I ≠ ⊥) : comap (algebra_map R ↥(integral_closure R S)) I ≠ ⊥ :=
  sorry

theorem integral_closure.eq_bot_of_comap_eq_bot {R : Type u_1} [comm_ring R] {S : Type u_2}
    [integral_domain S] [algebra R S] [nontrivial R] {I : ideal ↥(integral_closure R S)} :
    comap (algebra_map R ↥(integral_closure R S)) I = ⊥ → I = ⊥ :=
  imp_of_not_imp_not (comap (algebra_map R ↥(integral_closure R S)) I = ⊥) (I = ⊥)
    integral_closure.comap_ne_bot

theorem integral_closure.comap_lt_comap {R : Type u_1} [comm_ring R] {S : Type u_2}
    [integral_domain S] [algebra R S] {I : ideal ↥(integral_closure R S)}
    {J : ideal ↥(integral_closure R S)} [is_prime I] (I_lt_J : I < J) :
    comap (algebra_map R ↥(integral_closure R S)) I <
        comap (algebra_map R ↥(integral_closure R S)) J :=
  sorry

theorem integral_closure.is_maximal_of_is_maximal_comap {R : Type u_1} [comm_ring R] {S : Type u_2}
    [integral_domain S] [algebra R S] (I : ideal ↥(integral_closure R S)) [is_prime I]
    (hI : is_maximal (comap (algebra_map R ↥(integral_closure R S)) I)) : is_maximal I :=
  is_maximal_of_is_integral_of_is_maximal_comap
    (fun (x : ↥(integral_closure R S)) => integral_closure.is_integral x) I hI

/-- `comap (algebra_map R S)` is a surjection from the prime spec of `R` to prime spec of `S`.
`hP : (algebra_map R S).ker ≤ P` is a slight generalization of the extension being injective -/
theorem exists_ideal_over_prime_of_is_integral' {R : Type u_1} [comm_ring R] {S : Type u_2}
    [integral_domain S] [algebra R S] (H : algebra.is_integral R S) (P : ideal R) [is_prime P]
    (hP : ring_hom.ker (algebra_map R S) ≤ P) :
    ∃ (Q : ideal S), is_prime Q ∧ comap (algebra_map R S) Q = P :=
  sorry

/-- More general going-up theorem than `exists_ideal_over_prime_of_is_integral'`.
TODO: Version of going-up theorem with arbitrary length chains (by induction on this)?
  Not sure how best to write an ascending chain in Lean -/
theorem exists_ideal_over_prime_of_is_integral {R : Type u_1} [comm_ring R] {S : Type u_2}
    [integral_domain S] [algebra R S] (H : algebra.is_integral R S) (P : ideal R) [is_prime P]
    (I : ideal S) [is_prime I] (hIP : comap (algebra_map R S) I ≤ P) :
    ∃ (Q : ideal S), ∃ (H : Q ≥ I), is_prime Q ∧ comap (algebra_map R S) Q = P :=
  sorry

/-- `comap (algebra_map R S)` is a surjection from the max spec of `S` to max spec of `R`.
`hP : (algebra_map R S).ker ≤ P` is a slight generalization of the extension being injective -/
theorem exists_ideal_over_maximal_of_is_integral {R : Type u_1} [comm_ring R] {S : Type u_2}
    [integral_domain S] [algebra R S] (H : algebra.is_integral R S) (P : ideal R)
    [P_max : is_maximal P] (hP : ring_hom.ker (algebra_map R S) ≤ P) :
    ∃ (Q : ideal S), is_maximal Q ∧ comap (algebra_map R S) Q = P :=
  sorry

end Mathlib


/-
Copyright (c) 2022 Flemming Hermansen.
Released under Apache 2.0 license as described in
https://www.apache.org/licenses/LICENSE-2.0
Authors: Flemming Hermansen
-/

import data.polynomial.basic
import data.polynomial.eval
import tactic
import tactic.basic
import ring_theory.algebraic
import ring_theory.ideal.quotient
import field_theory.separable
import field_theory.minpoly
import field_theory.splitting_field
import algebra.algebra.basic
import algebra.algebra.subalgebra.basic
import algebra.algebra.tower
import algebra.ring.basic
import data.finset.basic
import algebra.big_operators.basic

import ideals_rel_inv

variables {K : Type*} [hK : field K]
{A : Type*} [hA : comm_ring A] [h_alg : algebra K A]
  [h_fin : finite_dimensional K A] [h_sep : is_separable K A] (P : polynomial K)
 {finprod_fields : Type*} [hF : comm_ring finprod_fields] [h_alg_f : algebra K finprod_fields]
------------------
universes u

def Ka {K : Type*} {A : Type*} [hK : field K]
 [hA : comm_ring A] [h_alg : algebra K A] (a: A) :=
 -- The problem is that a field (hK) is not accepted.
 -- An explicit comm_ring is required.
algebra.adjoin K ({a} : set A)

/- -- Remove this line in order to see the errors
-- Lean can not convert properly between fields and commutaative semirings.
-- The unfold should work, but it is confused about these types:
noncomputable
lemma Ka_eqv' {K : Type*} [hK : field K]
{A : Type*} [hA : comm_ring A] [h_alg : algebra K A] (a : A)
[h_fin : finite_dimensional K A] [h_sep : is_separable K A]:
((@Ka K A hK hA h_alg a) : subalgebra K A ) ≃ₐ[K]
(polynomial K ⧸ (ideal.span {minpoly K a} : ideal (polynomial K))) :=
begin
  -- Does not work:
  unfold Ka,
  sorry
end

@[priority 100]
instance field.to_comm_semiring' [s : field K] : comm_semiring K :=
{ mul_zero := mul_zero, zero_mul := zero_mul, ..s }

def Ka' {K : Type*} {A : Type*} [hK : field K]
 [hA : comm_ring A] [h_alg : algebra K A] (a: A) :=
 -- Does not work:
 @algebra.adjoin K A hK hA h_alg ({a} : set A).
 -- The problem is that a field (hK) is not accepted.
 -- An explicit comm_ring is required.

#check Ka.
#check adjoin_root.
#check algebra.adjoin.
-- -/

noncomputable
lemma Ka_eqv {K : Type*} [hK : field K]
{A : Type*} [hA : comm_ring A] [h_alg : algebra K A]
(a : A) :
algebra.adjoin K ({a} : set A) ≃ₐ[K]
(polynomial K ⧸ (ideal.span {minpoly K a} : ideal (polynomial K))) :=
begin
  exact @alg_equiv.adjoin_singleton_equiv_adjoin_root_minpoly K hK A hA h_alg a,
end

/-
We have the following lemmas:

lemma Ka_eqv {K : Type*} [hK : field K]
{A : Type*} [hA : comm_ring A] [h_alg : algebra K A]
(a : A) :
algebra.adjoin K ({a} : set A) ≃ₐ[K]
(polynomial K ⧸ (ideal.span {minpoly K a} : ideal (polynomial K)))

lemma product_all_rel_inv {A : Type*} [comm_semigroup A] {A' : Type*} [comm_semigroup A']
  : ( all_rel_inv A) → ( all_rel_inv A')  → all_rel_inv (A × A')

lemma field_all_rel_inv {A : Type} [field A] : all_rel_inv A

noncomputable def ideal.quotient_inf_ring_equiv_pi_quotient {R : Type*} [comm_ring R]
 {ι : Type v} [finite ι] (f : ι → ideal R) (hf : ∀ (i j : ι), i ≠ j → f i ⊔ f j = ⊤) :
(R ⧸ ⨅ (i : ι), f i) ≃+* Π (i : ι), R ⧸ f i

We could however not combine these lemmas, because of errors in Lean.

Therefore, we will just state the following lemma

lemma from_chinese_lemma {K : Type*} [hK : field K]
{A : Type*} [hA : comm_ring A] [h_alg : algebra K A]
(h_sep : is_separable K A)
(a : A) (h_algebraic : is_algebraic K a)
: ∃ (b : A), is_rel_inv a b
-/

lemma from_chinese_lemma {K : Type*} [hK : field K]
{A : Type*} [hA : comm_ring A] [h_alg : algebra K A]
(h_sep : is_separable K A) (h_algebraic : algebra.is_algebraic K A)
(a : A)
: ∃ (b : A), is_rel_inv a b :=
begin
  sorry
end

lemma all_rel_inv_of_alg_sep {K : Type*} [hK : field K]
{A : Type*} [hA : comm_ring A] [h_alg : algebra K A]
(h_sep : is_separable K A) (h_algebraic : algebra.is_algebraic K A) :
all_rel_inv A :=
begin
  unfold all_rel_inv,
  intros a,
  exact from_chinese_lemma h_sep h_algebraic a,
end

/-
We have proved the following theorems:
This theorem states that if e is an atom then e is the one-element in the ideal,
and each non-zero element in the ideal has an inverse within the ideal.
This means that an ideal generated by an atom is a field.
lemma field_from_atom {A : Type*} [hA : comm_ring A]  (h_inv : all_rel_inv A)
{e a : A} (hnz_a : a ≠ 0) (hcov : covers_0 e) (ha_in_span : a ∈ ((ideal.span {e} : ideal A)) ) :
a * e = a ∧
( ∃ (b : A), b ∈ ((ideal.span {e} : ideal A)) ∧ a * b = e)

-- This theorem states that a finite dimensional algebra has a
-- finite set of atoms with sup = ⊤:
theorem ex_fin_atomset_of_finite_dimensional (K : Type*)
[hK : field K] {A : Type*}
  [h_comm_A : comm_ring A] [h_alg : algebra K A] (h_fin : finite_dimensional K A) :
∃ (s : finset (idempotent_cri A)), (∀ e ∈ s, ⊥ ⋖ e) ∧ boolean_algebra_finset_sup s = ⊤

Atoms are pairwise disjoint. Therefore, boolean_algebra_finset_sup s = ⊤ means
that their sum is 1.

We have the direct sum decomposition of elements (a:A): a = a * 1 = a * Σ a * ei,
where ei are the atoms. This decomposition is unique, because ei ≠ ej implies ei * ej = 0.
This means that A = Π (ideal generated by ei).
Each of these ideals are isomorphic to field extensions of the scalar field.

This means that a finite dimensional separable commutative unital algebra is an
Etale algebra.
-/


/-
Copyright (c) 2020 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.analysis.specific_limits
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Hofer's lemma

This is an elementary lemma about complete metric spaces. It is motivated by an
application to the bubbling-off analysis for holomorphic curves in symplectic topology.
We are *very* far away from having these applications, but the proof here is a nice
example of a proof needing to construct a sequence by induction in the middle of the proof.

## References:

* H. Hofer and C. Viterbo, *The Weinstein conjecture in the presence of holomorphic spheres*
-/

theorem hofer {X : Type u_1} [metric_space X] [complete_space X] (x : X) (ε : ℝ) (ε_pos : 0 < ε)
    {ϕ : X → ℝ} (cont : continuous ϕ) (nonneg : ∀ (y : X), 0 ≤ ϕ y) :
    ∃ (ε' : ℝ),
        ∃ (H : ε' > 0),
          ∃ (x' : X),
            ε' ≤ ε ∧
              dist x' x ≤ bit0 1 * ε ∧
                ε * ϕ x ≤ ε' * ϕ x' ∧ ∀ (y : X), dist x' y ≤ ε' → ϕ y ≤ bit0 1 * ϕ x' :=
  sorry

end Mathlib


import data.real.basic
import order.locally_finite
import data.fin.basic
import algebra.big_operators.ring
import data.nat.interval
import algebra.big_operators.intervals
import group_theory.group_action.basic

variables (d : ℕ) (x y : ℕ → ℝ)

open_locale big_operators

-- finset.range j = finset.Ico 0 j = [0,j)

def majorizes_le : Prop :=
  ∀ j < d, ∑ (i : ℕ) in finset.Ico 1 (j.succ), y i ≤ ∑ (i : ℕ) in finset.Ico 1 (j.succ), x i

def majorizes_eq : Prop :=
  ∑ (i : ℕ) in finset.Ico 1 (d.succ), y i = ∑ (i : ℕ) in finset.Ico 1 (d.succ), x i

def T := ∑ (j : ℕ) in finset.Ico 1 (d.succ), j • (y j - x j)

lemma T_one (x y : ℕ → ℝ) (h_maj : majorizes_eq d x y) :
  T d x y = ∑ (i : ℕ) in finset.Ico 1 (d.succ), ∑ (j : ℕ) in finset.Ico 1 i, (x j - y j) :=
begin
  rw T,
  have : ∀ (j : ℕ), j • (y j - x j) = ∑ (i : ℕ) in finset.Ico 1 (j.succ), (y j - x j) :=
  λ (j : ℕ), by simp only [tsub_zero, finset.sum_sub_distrib, nat.succ_sub_succ_eq_sub,
    finset.sum_const, nsmul_eq_mul, nat.card_Ico],
  simp only [this],
  clear this,
  have : ∑ (j : ℕ) in finset.Ico 1 (d.succ), ∑ (i : ℕ) in finset.Ico 1 (j.succ), (y j - x j)
    = ∑ (i : ℕ) in finset.Ico 1 (d.succ), ∑ (j : ℕ) in finset.Ico i (d.succ), (y j - x j),
  rw finset.sum_Ico_Ico_comm,
  rw this,
  clear this,
  apply finset.sum_congr,
  simp only [eq_self_iff_true],
  intros i hi,
  rw finset.mem_Ico at hi,
  simp only [finset.sum_sub_distrib],
  rw [sub_eq_iff_eq_add, add_comm, ← add_sub_assoc],
  symmetry,
  rw sub_eq_iff_eq_add,
  rw add_comm,
  rw finset.sum_Ico_consecutive _ hi.1 (le_of_lt hi.2),
  rw add_comm,
  rw finset.sum_Ico_consecutive _ hi.1 (le_of_lt hi.2),
  rw majorizes_eq at h_maj,
  symmetry,
  exact h_maj,
end

lemma T_two (x y : ℕ → ℝ) (h_maj : majorizes_eq d x y) :
  T d x y = ∑ (i : ℕ) in finset.Ico 1 (d.succ), ∑ (j : ℕ) in finset.Ico 1 i.succ, (x j - y j) :=
begin
  rw T_one d x y h_maj,
  have : ∑ (i : ℕ) in finset.Ico 1 d.succ, ∑ (j : ℕ) in finset.Ico 1 i.succ, (x j - y j) =
    ∑ (i : ℕ) in finset.Ico 1 d.succ, (∑ (j : ℕ) in finset.Ico 1 i, (x j - y j) + (x i - y i)) :=
  begin
    apply finset.sum_congr,
    simp only [eq_self_iff_true],
    intros i hi,
    rw finset.mem_Ico at hi,
    rw finset.sum_Ico_succ_top hi.1,
  end,
  rw this,
  rw finset.sum_add_distrib,
  simp only [finset.sum_sub_distrib, self_eq_add_right, finset.sum_congr],
  rw majorizes_eq at h_maj,
  rw h_maj,
  simp only [eq_self_iff_true, sub_self],
end

lemma T_three (x y : ℕ → ℝ) (h_d : 1 ≤ d) (h_maj : majorizes_eq d x y) :
  T d x y = ∑ (i : ℕ) in finset.Ico 1 d, ∑ (j : ℕ) in finset.Ico 1 i.succ, (x j - y j) :=
begin
  rw T_two d x y h_maj,
  rw finset.sum_Ico_succ_top h_d,
  simp only [add_right_eq_self, finset.sum_sub_distrib, finset.sum_congr],
  rw majorizes_eq at h_maj,
  rw h_maj,
  simp only [eq_self_iff_true, sub_self],
end

lemma T_four (x y : ℕ → ℝ) (h_d : 1 ≤ d) (h_maj : majorizes_eq d x y) :
  2 • (T d x y) = ∑ (i : ℕ) in finset.Ico 1 d, 2 • ∑ (j : ℕ) in finset.Ico 1 i.succ, (x j - y j) :=
begin
  rw T_three _ _ _ h_d h_maj,
  rw finset.smul_sum,
end

lemma norm_one (x y : ℕ → ℝ) (h_d : 1 ≤ d) :
  ∑ (j : ℕ) in finset.Ico 1 d.succ, |x j - y j| = ∑ (j : ℕ) in finset.Ico 1 d, |x j - y j| + | x d - y d| :=
begin
  rw finset.sum_Ico_succ_top h_d,
end

lemma norm_two (x y : ℕ → ℝ) (h_d : 1 ≤ d) (h_maj : majorizes_eq d x y) (h_majle : majorizes_le d x y):
  |x d - y d| = ∑ (j : ℕ) in finset.Ico 1 d, (x j - y j) :=
begin
  have : ∑ (j : ℕ) in finset.Ico 1 d.succ, (x j - y j) = 0 :=
  begin
    rw majorizes_eq at h_maj,
    rw finset.sum_sub_distrib,
    rw h_maj,
    simp only [eq_self_iff_true, sub_self],
  end,
  have : x d - y d = ∑ (j : ℕ) in finset.Ico 1 d, (y j - x j) :=
  begin
    rw finset.sum_Ico_succ_top at this,
    rw add_eq_zero_iff_neg_eq at this,
    rw ← this,
    norm_num,
    exact h_d,
  end,
  rw this,
  have : ∑ (j : ℕ) in finset.Ico 1 d, (x j - y j) = - ∑ (j : ℕ) in finset.Ico 1 d, (y j - x j) :=
  begin
    simp only [finset.sum_sub_distrib, eq_self_iff_true, neg_sub, sub_left_inj],
  end,
  rw this,
  rw abs_eq_neg_self,
  rw majorizes_le at h_majle,
  specialize h_majle (d - 1),
  simp only [finset.sum_sub_distrib, sub_nonpos],
  simp at h_majle,
  apply h_majle,
  linarith,
end

lemma norm_three (x y : ℕ → ℝ) (h_d : 1 ≤ d) (h_maj : majorizes_eq d x y) (h_majle : majorizes_le d x y) :
  ∑ (j : ℕ) in finset.Ico 1 d.succ, |x j - y j| = ∑ (j : ℕ) in finset.Ico 1 d, (|x j - y j| + (x j - y j)) :=
begin
  rw norm_one _ _ _ h_d,
  rw norm_two _ _ _ h_d h_maj h_majle,
  rw finset.sum_add_distrib,
end

lemma norm_le_2T (x y : ℕ → ℝ) (h_d : 1 ≤ d) (h_majle : majorizes_le d x y) (h_maj : majorizes_eq d x y):
  ∑ (j : ℕ) in finset.Ico 1 d, (|x j - y j| + (x j - y j)) ≤ 2 • (T d x y) :=
begin
  rw T_four d x y h_d h_maj,
  apply finset.sum_le_sum,
  intros i hi,
  by_cases (0 ≤ x i - y i),
  have : |x i - y i| = x i - y i :=
  begin
    rw abs_eq_self,
    exact h,
  end,
  rw this,
  clear this,
  rw finset.sum_Ico_succ_top,
  simp only [finset.sum_sub_distrib, nat.cast_bit0, nsmul_eq_mul, nat.cast_one],
  rw left_distrib,
  have : x i - y i + (x i - y i) = 2 * (x i - y i),
  ring,
  rw this,
  apply le_add_of_nonneg_left,
  rw finset.mem_Ico at hi,
  rw majorizes_le at h_majle,
  specialize h_majle (i - 1),
  rw zero_le_mul_left,
  simp only [sub_nonneg],
  have : i - 1 < d,
  linarith,
  apply h_majle this,
  norm_num,
  rw finset.mem_Ico at hi,
  exact hi.1,
  have : |x i - y i| = -(x i - y i) :=
  begin
    rw abs_eq_neg_self,
    simp only [sub_nonpos],
    simp at h,
    exact le_of_lt h,
  end,
  rw this,
  simp only [finset.sum_sub_distrib, sub_nonneg, nat.cast_bit0, zero_le_mul_left, nsmul_eq_mul,
    neg_sub, nat.cast_one, sub_add_sub_cancel', sub_self],
  rw majorizes_le at h_majle,
  specialize h_majle i,
  rw zero_le_mul_left,
  rw sub_nonneg,
  rw finset.mem_Ico at hi,
  apply h_majle hi.2,
  linarith,
end


import Mathlib.Tactic.Basic

-- For imperfect residue fields of characteristic 2 or 3 ther are new types:
-- Z1, Z2, X1, X2, Y1, Y2, Y3, K n (n ≥ 2), K' n (even n ≥ 2), T n (n ≥ 1)

inductive Kodaira where
  | I     : Nat → Kodaira --for both I0 and In with n > 0
  | II    : Kodaira
  | III   : Kodaira
  | IV    : Kodaira
  | Is    : Nat → Kodaira
  | IIs   : Kodaira
  | IIIs  : Kodaira
  | IVs   : Kodaira
  | Z1    : Kodaira
  | Z2    : Kodaira
  | X1    : Kodaira
  | X2    : Kodaira
  | Y1    : Kodaira
  | Y2    : Kodaira
  | Y3    : Kodaira
  | K     : Nat → Kodaira -- only occurs for n ≥ 2
  | K'    : Nat → Kodaira -- only occurs for even n ≥ 2
  | T     : Nat → Kodaira -- only occurs for n ≥ 1

deriving DecidableEq, Inhabited

open Kodaira

instance : Repr Kodaira where
  reprPrec
    | I m, _   => "I" ++ repr m
    | II, _    => "II"
    | III, _   => "III"
    | IV, _    => "IV"
    | Is m, _  => "I*" ++ repr m
    | IIs, _   => "II*"
    | IIIs, _  => "III*"
    | IVs, _   => "IV*"
    | Z1, _    => "Z1"
    | Z2, _    => "Z2"
    | X1, _    => "X1"
    | X2, _    => "X2"
    | Y1, _    => "Y1"
    | Y2, _    => "Y2"
    | Y3, _    => "Y3"
    | K m, _   => "K" ++ repr m
    | K' m, _   => "K'" ++ repr m
    | T m, _   => "T" ++ repr m

lemma eq_I_Nat (m n : Nat) : m = n ↔ I m = I n := by
  apply Iff.intro
  intro h
  exact congrArg I h
  intro h
  cases h
  rfl

lemma eq_Is_Nat (m n : Nat) : m = n ↔ Is m = Is n := by
  apply Iff.intro
  intro h
  exact congrArg Is h
  intro h
  cases h
  rfl

inductive ReductionType
  | Good
  | SplitMultiplicative
  | NonSplitMultiplicative
  | Additive
deriving DecidableEq, Repr, Inhabited

def ReductionType.to_lmfdb : ReductionType → Int
  | Good                   => unreachable! -- LMFDB has no code for good reduction
  | SplitMultiplicative    => 1
  | NonSplitMultiplicative => -1
  | Additive               => 0


import category.basic
import util.data.functor

universe variables u v w u' v' w'

attribute [norm] seq_assoc pure_seq_eq_map map_pure

class applicative_pair (f : Type u → Type v) (g : Type u' → Type v') extends functor_pair f g :=
 (f_appl : applicative f)
 (g_appl : applicative g)
 (map_pure_comm : ∀ {α β}
            (hp : α → β)
            (x : α),
    map hp (pure x) = pure (hp x))
 (map_seq_comm : ∀ {α β : Type u} {α' β' : Type u'}
            (h : β → β')
            (hx : (α → β) → (α' → β'))
            (hy : α → α')
            (x : f (α → β))
            (y : f α),
    (∀ F y, hx F (hy y) = h (F y)) →
    map h (x <*> y) = map hx x <*> map hy y)

section lemmas

variables {α β γ : Type u}
variables {f : Type u → Type v}
variables [applicative f] [is_lawful_applicative f]

open function applicative is_lawful_applicative

section

variables (g : β → γ)
variables (x : f (α → β)) (y : f α)

lemma  applicative.map_seq_assoc
: @functor.map f _ _ _ g (x <*> y) = comp g <$> x <*> y :=
by rw [← pure_seq_eq_map
      ,seq_assoc
      ,map_pure
      ,pure_seq_eq_map]

end

section

open is_lawful_functor

variables (g : α → β)
variables (x : f (β → γ)) (y : f α)

lemma applicative.seq_map_comm
: x <*> g <$> y = flip comp g <$> x <*> y :=
begin
  rw [← pure_seq_eq_map _ y,seq_assoc,seq_pure,← comp_map],
  refl,
end

-- lemma d
-- : (has_seq.seq ∘ functor.map comp : f (α → β) → f (γ → α) → f (γ → β)) = _ :=
-- begin
--   apply funext, intro x,
--   apply funext, intro y,
--   unfold comp functor.map,
--   rw [← right_id comp,functor.map_comp],
-- end

end

attribute [norm] map_seq

@[norm]
lemma seq_map {β γ σ : Type u} (h : σ → β) (x : f (β → γ)) (y : f σ) :
  x <*> (h <$> y) = (flip comp h) <$> x <*> y :=
begin
  rw [← pure_seq_eq_map,← pure_seq_eq_map,seq_assoc] ,
  simp with norm,refl
end

end lemmas

/- identity applicative instance -/

namespace identity

open function

variables {α : Type u} {β : Type v} {γ : Type u'}

def pure : α → identity α := identity.mk

def seq : identity (α → β) → identity α → identity β
  | ⟨ f ⟩ ⟨ x ⟩ := ⟨ f x ⟩

local infix <$> := map
local infix <*> := seq

protected lemma pure_seq_eq_map (g : α → β) : ∀ (x : identity α), pure g <*> x = g <$> x
  | ⟨ x ⟩ := rfl

protected lemma map_pure (g : α → β) (x : α)
: g <$> pure x = pure (g x) :=
rfl

protected lemma seq_pure : ∀ (g : identity (α → β)) (x : α),
  g <*> pure x = (λ g : α → β, g x) <$> g
  | ⟨ g ⟩ x := rfl

protected lemma seq_assoc : ∀ (x : identity α) (g : identity (α → β)) (h : identity (β → γ)),
  h <*> (g <*> x) = (@comp α β γ <$> h) <*> g <*> x
| ⟨ x ⟩ ⟨ g ⟩ ⟨ h ⟩ := rfl

end identity

instance applicative_identity : applicative identity :=
{ map := @identity.map
, seq := @identity.seq
, pure := @identity.pure }

instance lawful_applicative_identity : is_lawful_applicative identity :=
{ id_map := @identity.id_map
, pure_seq_eq_map := @identity.pure_seq_eq_map
, map_pure := @identity.map_pure
, seq_pure := @identity.seq_pure
, seq_assoc := @identity.seq_assoc }

@[norm]
lemma identity.mk_eq_pure {α : Type v} (x : α)
: identity.mk x = pure x := rfl

lemma identity.seq_mk {α β : Type v}  (f : α → β) (x : α)
: identity.mk f <*> identity.mk x = identity.mk (f x) := rfl

instance : applicative_pair identity identity :=
{ (by apply_instance : functor_pair identity identity) with
  f_appl := by apply_instance
, g_appl := by apply_instance
, map_pure_comm :=
  by { intros, refl }
, map_seq_comm :=
  begin
    intros α β α' β',
    intros h hx hy x y H,
    cases x with x,
    cases y with y,
    unfold has_seq.seq identity.seq functor_pair.map identity.map,
    rw H,
  end }

/- compose applicative instance -/

namespace compose

open function is_lawful_functor is_lawful_applicative

section applicative

variables {f : Type u → Type u'} {g : Type v → Type u}

variables [applicative f] [applicative g]
section
variables {α β γ : Type v}

def seq : compose f g (α → β) → compose f g α → compose f g β
  | ⟨ h ⟩ ⟨ x ⟩ := ⟨ has_seq.seq <$> h <*> x ⟩

def pure : α → compose f g α := compose.mk ∘ has_pure.pure ∘ has_pure.pure
end

variables [is_lawful_applicative f] [is_lawful_applicative g]
variables {α β γ : Type v}

local infix ` <$> ` := map
local infix ` <*> ` := seq

protected lemma map_pure (h : α → β) (x : α) : (h <$> pure x : compose f g β) = pure (h x) :=
begin
  unfold compose.pure comp compose.map,
  apply congr_arg,
  rw [map_pure,map_pure],
end

protected lemma seq_pure (h : compose f g (α → β)) (x : α)
: h <*> pure x = (λ g : α → β, g x) <$> h :=
begin
  cases h with h,
  simp!  with norm,
  apply congr_fun, apply congr_arg, funext,
  simp with norm,
end

protected lemma seq_assoc : ∀ (x : compose f g α) (h₀ : compose f g (α → β)) (h₁ : compose f g (β → γ)),
   h₁ <*> (h₀ <*> x) = (@comp α β γ <$> h₁) <*> h₀ <*> x
| ⟨ x ⟩ ⟨ h₀ ⟩ ⟨ h₁ ⟩ :=
by { simp! [comp,flip] with norm, }

lemma pure_seq_eq_map (h : α → β) : ∀ (x : compose f g α), pure h <*> x = h <$> x
  | ⟨ x ⟩ :=
begin
  simp!  with norm,
  congr, funext, simp with norm,
end

end applicative

end compose

instance applicative_compose
  {f : Type u → Type u'} {g : Type v → Type u}
  [applicative f] [applicative g]
: applicative (compose f g) :=
{ map := @compose.map f g _ _
, seq := @compose.seq f g _ _
, pure := @compose.pure f g _ _ }

instance lawful_applicative_compose
  {f : Type u → Type u'} {g : Type v → Type u}
  [applicative f] [applicative g]
  [is_lawful_applicative f] [is_lawful_applicative g]
: is_lawful_applicative (compose f g) :=
{ id_map := @is_lawful_functor.id_map _ _ _
, comp_map := @is_lawful_functor.comp_map _ _ _
, pure_seq_eq_map := @compose.pure_seq_eq_map f g _ _ _ _
, map_pure := @compose.map_pure f g _ _ _ _
, seq_pure := @compose.seq_pure f g _ _ _ _
, seq_assoc := @compose.seq_assoc f g _ _ _ _ }

@[norm]
lemma compose.seq_mk {α β : Type u'}
  {f : Type u → Type v} {g : Type u' → Type u}
  [applicative f] [applicative g]
  (h : f (g (α → β))) (x : f (g α))
: compose.mk h <*> compose.mk x = compose.mk (has_seq.seq <$> h <*> x) := rfl

namespace compose

section applicative_pair

parameters {f :  Type v  → Type w}  {g  : Type u  → Type v}
parameters {f' : Type v' → Type w'} {g' : Type u' → Type v'}
parameters [applicative_pair f f'] [applicative_pair g g']
parameters {α β : Type u} {α' β' : Type u'}

instance applicative_f : applicative f := applicative_pair.f_appl f f'
instance applicative_g : applicative g := applicative_pair.f_appl g g'
instance applicative_f' : applicative f' := applicative_pair.g_appl f f'
instance applicative_g' : applicative g' := applicative_pair.g_appl g g'

lemma map_pure_comm (hp : α → β') (x : α)
:   functor_pair.map (compose f' g') hp (compose.pure x : compose f g α)
  = compose.pure (hp x) :=
begin
  unfold compose.pure function.comp functor_pair.map map_pair,
  apply congr_arg,
  rw applicative_pair.map_pure_comm,
  rw applicative_pair.map_pure_comm,
end

lemma map_seq_comm (h : β → β') (hx : (α → β) → α' → β') (hy : α → α')
                   (x : compose f g (α → β)) (y : compose f g α)
                   (H : ∀ (F : α → β) (y : α), hx F (hy y) = h (F y))
:   functor_pair.map (compose f' g') h (x <*> y)
  = functor_pair.map (compose f' g') hx x <*> functor_pair.map (compose f' g') hy y  :=
begin
  cases x with x,
  cases y with y,
  unfold has_seq.seq compose.seq functor_pair.map map_pair,
  apply congr_arg,
  let x' : f (g α → g β) := functor.map has_seq.seq x,
  let h' : g β → g' β' := (functor_pair.map g' h),
  let hx' : (g α → g β) → g' α' → g' β' := λ F i, functor_pair.map _ h (F sorry),
  let hy' : g α → g' α' := functor_pair.map _ hy,
  let hh := @functor_pair.map g g' _ _ _ h,
  have H' : (∀ (F : g α → g β) (y : g α), hx' F (hy' y) = h' (F y)) := sorry,
  rw @applicative_pair.map_seq_comm f f' _ (g α) (g β) (g' α') (g' β')
        h' hx' hy' x' y H',
  admit,
end

end applicative_pair

end compose

instance
  {f :  Type v  → Type w}  {g  : Type u  → Type v}
  {f' : Type v' → Type w'} {g' : Type u' → Type v'}
  [applicative_pair f f'] [applicative_pair g g']
: applicative_pair (compose f g) (compose f' g') :=
{ (by apply_instance : functor_pair (compose f g) (compose f' g')) with
  f_appl := by apply applicative_compose
, g_appl := by apply applicative_compose
, map_pure_comm := @compose.map_pure_comm f g f' g' _ _
, map_seq_comm := @compose.map_seq_comm f g f' g' _ _ }

namespace applicative

def lift {m : Type u → Type v} [functor m] {α φ : Type u} (f : α → φ) (ma : m α) : m φ :=
f <$> ma

variables {m : Type u → Type v} [applicative m]
def lift₂
  {α₁ α₂ φ : Type u}
  (f : α₁ → α₂ → φ)
  (ma₁ : m α₁) (ma₂: m α₂) : m φ :=
f <$> ma₁ <*> ma₂

def mmap₂
  {α₁ α₂ φ : Type u}
  (f : α₁ → α₂ → m φ)
: Π (ma₁ : list α₁) (ma₂: list α₂), m (list φ)
 | (x :: xs) (y :: ys) := (::) <$> f x y <*> mmap₂ xs ys
 | _ _ := pure []

def lift₃
  {α₁ α₂ α₃ φ : Type u}
  (f : α₁ → α₂ → α₃ → φ)
  (ma₁ : m α₁) (ma₂: m α₂) (ma₃ : m α₃) : m φ :=
f <$> ma₁ <*> ma₂ <*> ma₃

def lift₄
  {α₁ α₂ α₃ α₄ φ : Type u}
  (f : α₁ → α₂ → α₃ → α₄ → φ)
  (ma₁ : m α₁) (ma₂: m α₂) (ma₃ : m α₃) (ma₄ : m α₄) : m φ :=
f <$> ma₁ <*> ma₂ <*> ma₃ <*> ma₄

def lift₅
  {α₁ α₂ α₃ α₄ α₅ φ : Type u}
  (f : α₁ → α₂ → α₃ → α₄ → α₅ → φ)
  (ma₁ : m α₁) (ma₂: m α₂) (ma₃ : m α₃) (ma₄ : m α₄) (ma₅ : m α₅) : m φ :=
f <$> ma₁ <*> ma₂ <*> ma₃ <*> ma₄ <*> ma₅

open nat
variables {α : Type u}
variables {β : Type v}
variables {γ : Type w}

def replicate : ℕ → m α → m (list α)
 | 0 _ := pure []
 | (succ n) m := (::) <$> m <*> replicate n m

def replicate' : ℕ → m α → m punit
 | 0 _ := pure punit.star
 | (succ n) m := m *> replicate' n m

def mapp (f : γ → β → α) : list (γ × β) → list α
 | [ ] := [ ]
 | ((x,y) :: xs) := f x y :: mapp xs

def mmapp (f : γ → β → m α) : list (γ × β) → m (list α)
 | [ ] := pure [ ]
 | ((x,y) :: xs) := (::) <$> f x y <*> mmapp xs

def mmapp' (f : γ → β → m α) : list (γ × β) → m punit
 | [ ] := pure punit.star
 | ((x,y) :: xs) := f x y *> mmapp' xs

end applicative


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard, Johan Commelin, Patrick Massot
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.linear_ordered_comm_group_with_zero
import Mathlib.algebra.group_power.default
import Mathlib.ring_theory.ideal.operations
import Mathlib.algebra.punit_instances
import Mathlib.PostPort

universes u_1 u_2 l u_3 u_4

namespace Mathlib

/-!

# The basics of valuation theory.

The basic theory of valuations (non-archimedean norms) on a commutative ring,
following T. Wedhorn's unpublished notes “Adic Spaces” ([wedhorn_adic]).

The definition of a valuation we use here is Definition 1.22 of [wedhorn_adic].
A valuation on a ring `R` is a monoid homomorphism `v` to a linearly ordered
commutative group with zero, that in addition satisfies the following two axioms:
 * `v 0 = 0`
 * `∀ x y, v (x + y) ≤ max (v x) (v y)`

`valuation R Γ₀`is the type of valuations `R → Γ₀`, with a coercion to the underlying
function. If `v` is a valuation from `R` to `Γ₀` then the induced group
homomorphism `units(R) → Γ₀` is called `unit_map v`.

The equivalence "relation" `is_equiv v₁ v₂ : Prop` defined in 1.27 of [wedhorn_adic] is not strictly
speaking a relation, because `v₁ : valuation R Γ₁` and `v₂ : valuation R Γ₂` might
not have the same type. This corresponds in ZFC to the set-theoretic difficulty
that the class of all valuations (as `Γ₀` varies) on a ring `R` is not a set.
The "relation" is however reflexive, symmetric and transitive in the obvious
sense. Note that we use 1.27(iii) of [wedhorn_adic] as the definition of equivalence.

The support of a valuation `v : valuation R Γ₀` is `supp v`. If `J` is an ideal of `R`
with `h : J ⊆ supp v` then the induced valuation
on R / J = `ideal.quotient J` is `on_quot v h`.

## Main definitions

* `valuation R Γ₀`, the type of valuations on `R` with values in `Γ₀`
* `valuation.is_equiv`, the heterogeneous equivalence relation on valuations
* `valuation.supp`, the support of a valuation

-/

-- universes u u₀ u₁ u₂ -- v is used for valuations

/-- The type of Γ₀-valued valuations on R. -/
structure valuation (R : Type u_1) (Γ₀ : Type u_2) [linear_ordered_comm_group_with_zero Γ₀] [ring R]
    extends monoid_with_zero_hom R Γ₀ where
  map_add' : ∀ (x y : R), to_fun (x + y) ≤ max (to_fun x) (to_fun y)

/-- The `monoid_with_zero_hom` underlying a valuation. -/
namespace valuation

/-- A valuation is coerced to the underlying function R → Γ₀. -/
protected instance has_coe_to_fun (R : Type u_1) (Γ₀ : Type u_2)
    [linear_ordered_comm_group_with_zero Γ₀] [ring R] : has_coe_to_fun (valuation R Γ₀) :=
  has_coe_to_fun.mk (fun (_x : valuation R Γ₀) => R → Γ₀) to_fun

/-- A valuation is coerced to a monoid morphism R → Γ₀. -/
protected instance monoid_with_zero_hom.has_coe (R : Type u_1) (Γ₀ : Type u_2)
    [linear_ordered_comm_group_with_zero Γ₀] [ring R] :
    has_coe (valuation R Γ₀) (monoid_with_zero_hom R Γ₀) :=
  has_coe.mk to_monoid_with_zero_hom

@[simp] theorem coe_coe {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀]
    [ring R] (v : valuation R Γ₀) : ⇑↑v = ⇑v :=
  rfl

@[simp] theorem map_zero {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀]
    [ring R] (v : valuation R Γ₀) : coe_fn v 0 = 0 :=
  map_zero' v

@[simp] theorem map_one {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀]
    [ring R] (v : valuation R Γ₀) : coe_fn v 1 = 1 :=
  map_one' v

@[simp] theorem map_mul {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀]
    [ring R] (v : valuation R Γ₀) (x : R) (y : R) : coe_fn v (x * y) = coe_fn v x * coe_fn v y :=
  map_mul' v

@[simp] theorem map_add {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀]
    [ring R] (v : valuation R Γ₀) (x : R) (y : R) :
    coe_fn v (x + y) ≤ max (coe_fn v x) (coe_fn v y) :=
  map_add' v

theorem map_add_le {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀] [ring R]
    (v : valuation R Γ₀) {x : R} {y : R} {g : Γ₀} (hx : coe_fn v x ≤ g) (hy : coe_fn v y ≤ g) :
    coe_fn v (x + y) ≤ g :=
  le_trans (map_add v x y) (max_le hx hy)

theorem map_add_lt {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀] [ring R]
    (v : valuation R Γ₀) {x : R} {y : R} {g : Γ₀} (hx : coe_fn v x < g) (hy : coe_fn v y < g) :
    coe_fn v (x + y) < g :=
  lt_of_le_of_lt (map_add v x y) (max_lt hx hy)

theorem map_sum_le {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀] [ring R]
    (v : valuation R Γ₀) {ι : Type u_3} {s : finset ι} {f : ι → R} {g : Γ₀}
    (hf : ∀ (i : ι), i ∈ s → coe_fn v (f i) ≤ g) : coe_fn v (finset.sum s fun (i : ι) => f i) ≤ g :=
  sorry

theorem map_sum_lt {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀] [ring R]
    (v : valuation R Γ₀) {ι : Type u_3} {s : finset ι} {f : ι → R} {g : Γ₀} (hg : g ≠ 0)
    (hf : ∀ (i : ι), i ∈ s → coe_fn v (f i) < g) : coe_fn v (finset.sum s fun (i : ι) => f i) < g :=
  sorry

theorem map_sum_lt' {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀] [ring R]
    (v : valuation R Γ₀) {ι : Type u_3} {s : finset ι} {f : ι → R} {g : Γ₀} (hg : 0 < g)
    (hf : ∀ (i : ι), i ∈ s → coe_fn v (f i) < g) : coe_fn v (finset.sum s fun (i : ι) => f i) < g :=
  map_sum_lt v (ne_of_gt hg) hf

@[simp] theorem map_pow {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀]
    [ring R] (v : valuation R Γ₀) (x : R) (n : ℕ) : coe_fn v (x ^ n) = coe_fn v x ^ n :=
  monoid_hom.map_pow (monoid_with_zero_hom.to_monoid_hom (to_monoid_with_zero_hom v))

theorem ext {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀] [ring R]
    {v₁ : valuation R Γ₀} {v₂ : valuation R Γ₀} (h : ∀ (r : R), coe_fn v₁ r = coe_fn v₂ r) :
    v₁ = v₂ :=
  sorry

theorem ext_iff {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀] [ring R]
    {v₁ : valuation R Γ₀} {v₂ : valuation R Γ₀} : v₁ = v₂ ↔ ∀ (r : R), coe_fn v₁ r = coe_fn v₂ r :=
  { mp := fun (h : v₁ = v₂) (r : R) => congr_arg (fun {v₁ : valuation R Γ₀} => coe_fn v₁ r) h,
    mpr := ext }

-- The following definition is not an instance, because we have more than one `v` on a given `R`.

-- In addition, type class inference would not be able to infer `v`.

/-- A valuation gives a preorder on the underlying ring. -/
def to_preorder {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀] [ring R]
    (v : valuation R Γ₀) : preorder R :=
  preorder.lift ⇑v

/-- If `v` is a valuation on a division ring then `v(x) = 0` iff `x = 0`. -/
@[simp] theorem zero_iff {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀] {K : Type u_1}
    [division_ring K] (v : valuation K Γ₀) {x : K} : coe_fn v x = 0 ↔ x = 0 :=
  monoid_with_zero_hom.map_eq_zero (to_monoid_with_zero_hom v)

theorem ne_zero_iff {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀] {K : Type u_1}
    [division_ring K] (v : valuation K Γ₀) {x : K} : coe_fn v x ≠ 0 ↔ x ≠ 0 :=
  monoid_with_zero_hom.map_ne_zero (to_monoid_with_zero_hom v)

@[simp] theorem map_inv {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀] {K : Type u_1}
    [division_ring K] (v : valuation K Γ₀) {x : K} : coe_fn v (x⁻¹) = (coe_fn v x⁻¹) :=
  monoid_with_zero_hom.map_inv' (to_monoid_with_zero_hom v) x

theorem map_units_inv {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀]
    [ring R] (v : valuation R Γ₀) (x : units R) : coe_fn v ↑(x⁻¹) = (coe_fn v ↑x⁻¹) :=
  monoid_hom.map_units_inv (monoid_with_zero_hom.to_monoid_hom (to_monoid_with_zero_hom v)) x

theorem unit_map_eq {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀] [ring R]
    (v : valuation R Γ₀) (u : units R) : ↑(coe_fn (units.map ↑v) u) = coe_fn v ↑u :=
  rfl

@[simp] theorem map_neg {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀]
    [ring R] (v : valuation R Γ₀) (x : R) : coe_fn v (-x) = coe_fn v x :=
  monoid_hom.map_neg (monoid_with_zero_hom.to_monoid_hom (to_monoid_with_zero_hom v)) x

theorem map_sub_swap {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀]
    [ring R] (v : valuation R Γ₀) (x : R) (y : R) : coe_fn v (x - y) = coe_fn v (y - x) :=
  monoid_hom.map_sub_swap (monoid_with_zero_hom.to_monoid_hom (to_monoid_with_zero_hom v)) x y

theorem map_sub_le_max {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀]
    [ring R] (v : valuation R Γ₀) (x : R) (y : R) :
    coe_fn v (x - y) ≤ max (coe_fn v x) (coe_fn v y) :=
  sorry

theorem map_add_of_distinct_val {R : Type u_1} {Γ₀ : Type u_2}
    [linear_ordered_comm_group_with_zero Γ₀] [ring R] (v : valuation R Γ₀) {x : R} {y : R}
    (h : coe_fn v x ≠ coe_fn v y) : coe_fn v (x + y) = max (coe_fn v x) (coe_fn v y) :=
  sorry

theorem map_eq_of_sub_lt {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀]
    [ring R] (v : valuation R Γ₀) {x : R} {y : R} (h : coe_fn v (y - x) < coe_fn v x) :
    coe_fn v y = coe_fn v x :=
  sorry

/-- A ring homomorphism S → R induces a map valuation R Γ₀ → valuation S Γ₀ -/
def comap {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀] [ring R]
    {S : Type u_3} [ring S] (f : S →+* R) (v : valuation R Γ₀) : valuation S Γ₀ :=
  mk (⇑v ∘ ⇑f) sorry sorry sorry sorry

@[simp] theorem comap_id {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀]
    [ring R] (v : valuation R Γ₀) : comap (ring_hom.id R) v = v :=
  ext fun (r : R) => rfl

theorem comap_comp {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀] [ring R]
    (v : valuation R Γ₀) {S₁ : Type u_3} {S₂ : Type u_4} [ring S₁] [ring S₂] (f : S₁ →+* S₂)
    (g : S₂ →+* R) : comap (ring_hom.comp g f) v = comap f (comap g v) :=
  ext fun (r : S₁) => rfl

/-- A ≤-preserving group homomorphism Γ₀ → Γ'₀ induces a map valuation R Γ₀ → valuation R Γ'₀. -/
def map {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀] {Γ'₀ : Type u_3}
    [linear_ordered_comm_group_with_zero Γ'₀] [ring R] (f : monoid_with_zero_hom Γ₀ Γ'₀)
    (hf : monotone ⇑f) (v : valuation R Γ₀) : valuation R Γ'₀ :=
  mk (⇑f ∘ ⇑v) sorry sorry sorry sorry

/-- Two valuations on R are defined to be equivalent if they induce the same preorder on R. -/
def is_equiv {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀]
    {Γ'₀ : Type u_3} [linear_ordered_comm_group_with_zero Γ'₀] [ring R] (v₁ : valuation R Γ₀)
    (v₂ : valuation R Γ'₀) :=
  ∀ (r s : R), coe_fn v₁ r ≤ coe_fn v₁ s ↔ coe_fn v₂ r ≤ coe_fn v₂ s

namespace is_equiv

theorem refl {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀] [ring R]
    {v : valuation R Γ₀} : is_equiv v v :=
  fun (_x _x_1 : R) => iff.refl (coe_fn v _x ≤ coe_fn v _x_1)

theorem symm {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀]
    {Γ'₀ : Type u_3} [linear_ordered_comm_group_with_zero Γ'₀] [ring R] {v₁ : valuation R Γ₀}
    {v₂ : valuation R Γ'₀} (h : is_equiv v₁ v₂) : is_equiv v₂ v₁ :=
  fun (_x _x_1 : R) => iff.symm (h _x _x_1)

theorem trans {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀]
    {Γ'₀ : Type u_3} [linear_ordered_comm_group_with_zero Γ'₀] {Γ''₀ : Type u_4}
    [linear_ordered_comm_group_with_zero Γ''₀] [ring R] {v₁ : valuation R Γ₀} {v₂ : valuation R Γ'₀}
    {v₃ : valuation R Γ''₀} (h₁₂ : is_equiv v₁ v₂) (h₂₃ : is_equiv v₂ v₃) : is_equiv v₁ v₃ :=
  fun (_x _x_1 : R) => iff.trans (h₁₂ _x _x_1) (h₂₃ _x _x_1)

theorem of_eq {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀] [ring R]
    {v : valuation R Γ₀} {v' : valuation R Γ₀} (h : v = v') : is_equiv v v' :=
  Eq._oldrec refl h

theorem map {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀] {Γ'₀ : Type u_3}
    [linear_ordered_comm_group_with_zero Γ'₀] [ring R] {v : valuation R Γ₀} {v' : valuation R Γ₀}
    (f : monoid_with_zero_hom Γ₀ Γ'₀) (hf : monotone ⇑f) (inf : function.injective ⇑f)
    (h : is_equiv v v') : is_equiv (map f hf v) (map f hf v') :=
  sorry

/-- `comap` preserves equivalence. -/
theorem comap {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀]
    {Γ'₀ : Type u_3} [linear_ordered_comm_group_with_zero Γ'₀] [ring R] {v₁ : valuation R Γ₀}
    {v₂ : valuation R Γ'₀} {S : Type u_4} [ring S] (f : S →+* R) (h : is_equiv v₁ v₂) :
    is_equiv (comap f v₁) (comap f v₂) :=
  fun (r s : S) => h (coe_fn f r) (coe_fn f s)

theorem val_eq {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀]
    {Γ'₀ : Type u_3} [linear_ordered_comm_group_with_zero Γ'₀] [ring R] {v₁ : valuation R Γ₀}
    {v₂ : valuation R Γ'₀} (h : is_equiv v₁ v₂) {r : R} {s : R} :
    coe_fn v₁ r = coe_fn v₁ s ↔ coe_fn v₂ r = coe_fn v₂ s :=
  sorry

theorem ne_zero {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀]
    {Γ'₀ : Type u_3} [linear_ordered_comm_group_with_zero Γ'₀] [ring R] {v₁ : valuation R Γ₀}
    {v₂ : valuation R Γ'₀} (h : is_equiv v₁ v₂) {r : R} : coe_fn v₁ r ≠ 0 ↔ coe_fn v₂ r ≠ 0 :=
  eq.mp (Eq._oldrec (Eq.refl (coe_fn v₁ r ≠ 0 ↔ coe_fn v₂ r ≠ coe_fn v₂ 0)) (map_zero v₂))
    (eq.mp
      (Eq._oldrec (Eq.refl (coe_fn v₁ r ≠ coe_fn v₁ 0 ↔ coe_fn v₂ r ≠ coe_fn v₂ 0)) (map_zero v₁))
      (not_iff_not_of_iff (val_eq h)))

theorem Mathlib.valuation.is_equiv_of_map_strict_mono {R : Type u_1} {Γ₀ : Type u_2}
    [linear_ordered_comm_group_with_zero Γ₀] {Γ'₀ : Type u_3}
    [linear_ordered_comm_group_with_zero Γ'₀] [ring R] {v : valuation R Γ₀}
    (f : monoid_with_zero_hom Γ₀ Γ'₀) (H : strict_mono ⇑f) :
    is_equiv (map f (strict_mono.monotone H) v) v :=
  fun (x y : R) =>
    { mp := iff.mp (strict_mono.le_iff_le H),
      mpr := fun (h : coe_fn v x ≤ coe_fn v y) => strict_mono.monotone H h }

theorem Mathlib.valuation.is_equiv_of_val_le_one {Γ₀ : Type u_2}
    [linear_ordered_comm_group_with_zero Γ₀] {Γ'₀ : Type u_3}
    [linear_ordered_comm_group_with_zero Γ'₀] {K : Type u_1} [division_ring K] (v : valuation K Γ₀)
    (v' : valuation K Γ'₀) (h : ∀ {x : K}, coe_fn v x ≤ 1 ↔ coe_fn v' x ≤ 1) : is_equiv v v' :=
  sorry

/-- The support of a valuation `v : R → Γ₀` is the ideal of `R` where `v` vanishes. -/
def Mathlib.valuation.supp {R : Type u_1} {Γ₀ : Type u_2} [linear_ordered_comm_group_with_zero Γ₀]
    [comm_ring R] (v : valuation R Γ₀) : ideal R :=
  submodule.mk (set_of fun (x : R) => coe_fn v x = 0) sorry sorry sorry

-- @[simp] lemma mem_supp_iff' (x : R) : x ∈ (supp v : set R) ↔ v x = 0 := iff.rfl

@[simp] theorem Mathlib.valuation.mem_supp_iff {R : Type u_1} {Γ₀ : Type u_2}
    [linear_ordered_comm_group_with_zero Γ₀] [comm_ring R] (v : valuation R Γ₀) (x : R) :
    x ∈ supp v ↔ coe_fn v x = 0 :=
  iff.rfl

/-- The support of a valuation is a prime ideal. -/
protected instance Mathlib.valuation.supp.ideal.is_prime {R : Type u_1} {Γ₀ : Type u_2}
    [linear_ordered_comm_group_with_zero Γ₀] [comm_ring R] (v : valuation R Γ₀) :
    ideal.is_prime (supp v) :=
  { left :=
      fun (h : supp v = ⊤) =>
        one_ne_zero
          ((fun (this : 1 = 0) => this)
            (Eq.trans (Eq.symm (map_one v))
              ((fun (this : 1 ∈ supp v) => this)
                (eq.mpr (id (Eq._oldrec (Eq.refl (1 ∈ supp v)) h)) trivial)))),
    right :=
      fun (x y : R) (hxy : x * y ∈ supp v) =>
        id
          (id
            (fun (hxy : coe_fn v (x * y) = 0) =>
              eq_zero_or_eq_zero_of_mul_eq_zero
                (eq.mp (Eq._oldrec (Eq.refl (coe_fn v (x * y) = 0)) (map_mul v x y)) hxy))
            hxy) }

theorem Mathlib.valuation.map_add_supp {R : Type u_1} {Γ₀ : Type u_2}
    [linear_ordered_comm_group_with_zero Γ₀] [comm_ring R] (v : valuation R Γ₀) (a : R) {s : R}
    (h : s ∈ supp v) : coe_fn v (a + s) = coe_fn v a :=
  sorry

/-- If `hJ : J ⊆ supp v` then `on_quot_val hJ` is the induced function on R/J as a function.
Note: it's just the function; the valuation is `on_quot hJ`. -/
def Mathlib.valuation.on_quot_val {R : Type u_1} {Γ₀ : Type u_2}
    [linear_ordered_comm_group_with_zero Γ₀] [comm_ring R] (v : valuation R Γ₀) {J : ideal R}
    (hJ : J ≤ supp v) : ideal.quotient J → Γ₀ :=
  fun (q : ideal.quotient J) => quotient.lift_on' q ⇑v sorry

/-- The extension of valuation v on R to valuation on R/J if J ⊆ supp v -/
def Mathlib.valuation.on_quot {R : Type u_1} {Γ₀ : Type u_2}
    [linear_ordered_comm_group_with_zero Γ₀] [comm_ring R] (v : valuation R Γ₀) {J : ideal R}
    (hJ : J ≤ supp v) : valuation (ideal.quotient J) Γ₀ :=
  mk (on_quot_val v hJ) sorry sorry sorry sorry

@[simp] theorem Mathlib.valuation.on_quot_comap_eq {R : Type u_1} {Γ₀ : Type u_2}
    [linear_ordered_comm_group_with_zero Γ₀] [comm_ring R] (v : valuation R Γ₀) {J : ideal R}
    (hJ : J ≤ supp v) : comap (ideal.quotient.mk J) (on_quot v hJ) = v :=
  sorry

theorem Mathlib.valuation.comap_supp {R : Type u_1} {Γ₀ : Type u_2}
    [linear_ordered_comm_group_with_zero Γ₀] [comm_ring R] (v : valuation R Γ₀) {S : Type u_3}
    [comm_ring S] (f : S →+* R) : supp (comap f v) = ideal.comap f (supp v) :=
  sorry

theorem Mathlib.valuation.self_le_supp_comap {R : Type u_1} {Γ₀ : Type u_2}
    [linear_ordered_comm_group_with_zero Γ₀] [comm_ring R] (J : ideal R)
    (v : valuation (ideal.quotient J) Γ₀) : J ≤ supp (comap (ideal.quotient.mk J) v) :=
  sorry

@[simp] theorem Mathlib.valuation.comap_on_quot_eq {R : Type u_1} {Γ₀ : Type u_2}
    [linear_ordered_comm_group_with_zero Γ₀] [comm_ring R] (J : ideal R)
    (v : valuation (ideal.quotient J) Γ₀) :
    on_quot (comap (ideal.quotient.mk J) v) (self_le_supp_comap J v) = v :=
  sorry

/-- The quotient valuation on R/J has support supp(v)/J if J ⊆ supp v. -/
theorem Mathlib.valuation.supp_quot {R : Type u_1} {Γ₀ : Type u_2}
    [linear_ordered_comm_group_with_zero Γ₀] [comm_ring R] (v : valuation R Γ₀) {J : ideal R}
    (hJ : J ≤ supp v) : supp (on_quot v hJ) = ideal.map (ideal.quotient.mk J) (supp v) :=
  sorry

theorem Mathlib.valuation.supp_quot_supp {R : Type u_1} {Γ₀ : Type u_2}
    [linear_ordered_comm_group_with_zero Γ₀] [comm_ring R] (v : valuation R Γ₀) :
    supp (on_quot v (le_refl (supp v))) = 0 :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (supp (on_quot v (le_refl (supp v))) = 0))
        (supp_quot v (le_refl (supp v)))))
    (ideal.map_quotient_self (supp v))

end Mathlib


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebraic_geometry.presheafed_space
import topology.category.Top.limits
import topology.sheaves.limits

/-!
# `PresheafedSpace C` has colimits.

If `C` has limits, then the category `PresheafedSpace C` has colimits,
and the forgetful functor to `Top` preserves these colimits.

When restricted to a diagram where the underlying continuous maps are open embeddings,
this says that we can glue presheaved spaces.

Given a diagram `F : J ⥤ PresheafedSpace C`,
we first build the colimit of the underlying topological spaces,
as `colimit (F ⋙ PresheafedSpace.forget C)`. Call that colimit space `X`.

Our strategy is to push each of the presheaves `F.obj j`
forward along the continuous map `colimit.ι (F ⋙ PresheafedSpace.forget C) j` to `X`.
Since pushforward is functorial, we obtain a diagram `J ⥤ (presheaf C X)ᵒᵖ`
of presheaves on a single space `X`.
(Note that the arrows now point the other direction,
because this is the way `PresheafedSpace C` is set up.)

The limit of this diagram then constitutes the colimit presheaf.
-/

noncomputable theory

universes v' u' v u

open category_theory
open Top
open Top.presheaf
open topological_space
open opposite
open category_theory.category
open category_theory.limits
open category_theory.functor

variables {J : Type u'} [category.{v'} J]
variables {C : Type u} [category.{v} C]

namespace algebraic_geometry

namespace PresheafedSpace

local attribute [simp] eq_to_hom_map
local attribute [tidy] tactic.auto_cases_opens

@[simp]
lemma map_id_c_app (F : J ⥤ PresheafedSpace.{v} C) (j) (U) :
  (F.map (𝟙 j)).c.app (op U) =
    (pushforward.id (F.obj j).presheaf).inv.app (op U) ≫
      (pushforward_eq (by { simp, refl }) (F.obj j).presheaf).hom.app (op U) :=
begin
  cases U,
  dsimp,
  simp [PresheafedSpace.congr_app (F.map_id j)],
  refl,
end

@[simp]

/--
Given a diagram of `PresheafedSpace C`s, its colimit is computed by pushing the sheaves onto
the colimit of the underlying spaces, and taking componentwise limit.
This is the componentwise diagram for an open set `U` of the colimit of the underlying spaces.
-/
@[simps]
def componentwise_diagram (F : J ⥤ PresheafedSpace.{v} C)
  [has_colimit F] (U : opens (limits.colimit F).carrier) : Jᵒᵖ ⥤ C :=
{ obj := λ j, (F.obj (unop j)).presheaf.obj (op ((opens.map (colimit.ι F (unop j)).base).obj U)),
  map := λ j k f, (F.map f.unop).c.app _ ≫ (F.obj (unop k)).presheaf.map
    (eq_to_hom (by { rw [← colimit.w F f.unop, comp_base], refl })),
  map_comp' := λ i j k f g,
  begin
    cases U,
    dsimp,
    simp_rw [map_comp_c_app, category.assoc],
    congr' 1,
    rw [Top.presheaf.pushforward.comp_inv_app, Top.presheaf.pushforward_eq_hom_app,
      category_theory.nat_trans.naturality_assoc, Top.presheaf.pushforward_map_app],
    congr' 1,
    rw [category.id_comp, ← (F.obj (unop k)).presheaf.map_comp],
    erw ← (F.obj (unop k)).presheaf.map_comp,
    congr
  end }

variable [has_colimits_of_shape J Top.{v}]

/--
Given a diagram of presheafed spaces,
we can push all the presheaves forward to the colimit `X` of the underlying topological spaces,
obtaining a diagram in `(presheaf C X)ᵒᵖ`.
-/
@[simps]
def pushforward_diagram_to_colimit (F : J ⥤ PresheafedSpace.{v} C) :
  J ⥤ (presheaf C (colimit (F ⋙ PresheafedSpace.forget C)))ᵒᵖ :=
{ obj := λ j, op ((colimit.ι (F ⋙ PresheafedSpace.forget C) j) _* (F.obj j).presheaf),
  map := λ j j' f,
  (pushforward_map (colimit.ι (F ⋙ PresheafedSpace.forget C) j') (F.map f).c ≫
    (pushforward.comp (F.obj j).presheaf ((F ⋙ PresheafedSpace.forget C).map f)
      (colimit.ι (F ⋙ PresheafedSpace.forget C) j')).inv ≫
    (pushforward_eq (colimit.w (F ⋙ PresheafedSpace.forget C) f) (F.obj j).presheaf).hom).op,
  map_id' := λ j,
  begin
    apply (op_equiv _ _).injective,
    ext U,
    induction U using opposite.rec,
    cases U,
    dsimp, simp, dsimp, simp,
  end,
  map_comp' := λ j₁ j₂ j₃ f g,
  begin
    apply (op_equiv _ _).injective,
    ext U,
    dsimp,
    simp only [map_comp_c_app, id.def, eq_to_hom_op, pushforward_map_app, eq_to_hom_map, assoc,
      id_comp, pushforward.comp_inv_app, pushforward_eq_hom_app],
    dsimp,
    simp only [eq_to_hom_trans, id_comp],
    congr' 1,
    -- The key fact is `(F.map f).c.congr`,
    -- which allows us in rewrite in the argument of `(F.map f).c.app`.
    rw (F.map f).c.congr,
    -- Now we pick up the pieces. First, we say what we want to replace that open set by:
    swap 3,
    refine op ((opens.map (colimit.ι (F ⋙ PresheafedSpace.forget C) j₂)).obj (unop U)),
    -- Now we show the open sets are equal.
    swap 2,
    { apply unop_injective,
      rw ←opens.map_comp_obj,
      congr,
      exact colimit.w (F ⋙ PresheafedSpace.forget C) g, },
    -- Finally, the original goal is now easy:
    swap 2,
    { simp, refl, },
  end, }

variables [∀ X : Top.{v}, has_limits_of_shape Jᵒᵖ (X.presheaf C)]

/--
Auxiliary definition for `PresheafedSpace.has_colimits`.
-/
def colimit (F : J ⥤ PresheafedSpace.{v} C) : PresheafedSpace C :=
{ carrier := colimit (F ⋙ PresheafedSpace.forget C),
  presheaf := limit (pushforward_diagram_to_colimit F).left_op, }

@[simp] lemma colimit_carrier (F : J ⥤ PresheafedSpace.{v} C) :
  (colimit F).carrier = limits.colimit (F ⋙ PresheafedSpace.forget C) := rfl

@[simp] lemma colimit_presheaf (F : J ⥤ PresheafedSpace.{v} C) :
  (colimit F).presheaf = limit (pushforward_diagram_to_colimit F).left_op := rfl

/--
Auxiliary definition for `PresheafedSpace.has_colimits`.
-/
@[simps]
def colimit_cocone (F : J ⥤ PresheafedSpace.{v} C) : cocone F :=
{ X := colimit F,
  ι :=
  { app := λ j,
    { base := colimit.ι (F ⋙ PresheafedSpace.forget C) j,
      c := limit.π _ (op j), },
    naturality' := λ j j' f,
    begin
      fapply PresheafedSpace.ext,
      { ext x,
        exact colimit.w_apply (F ⋙ PresheafedSpace.forget C) f x, },
      { ext U,
        induction U using opposite.rec,
        cases U,
        dsimp,
        simp only [PresheafedSpace.id_c_app, eq_to_hom_op, eq_to_hom_map, assoc,
          pushforward.comp_inv_app],
        rw ← congr_arg nat_trans.app (limit.w (pushforward_diagram_to_colimit F).left_op f.op),
        dsimp,
        simp only [eq_to_hom_op, eq_to_hom_map, assoc, id_comp, pushforward.comp_inv_app],
        congr,
        dsimp,
        simp only [id_comp],
        simpa, }
    end, }, }

variables [has_limits_of_shape Jᵒᵖ C]

namespace colimit_cocone_is_colimit

/--
Auxiliary definition for `PresheafedSpace.colimit_cocone_is_colimit`.
-/
def desc_c_app (F : J ⥤ PresheafedSpace.{v} C) (s : cocone F) (U : (opens ↥(s.X.carrier))ᵒᵖ) :
  s.X.presheaf.obj U ⟶
    (colimit.desc (F ⋙ PresheafedSpace.forget C)
         ((PresheafedSpace.forget C).map_cocone s) _*
       limit (pushforward_diagram_to_colimit F).left_op).obj
      U :=
begin
  refine
    limit.lift _ { X := s.X.presheaf.obj U, π := { app := λ j, _, naturality' := λ j j' f, _, }} ≫
      (limit_obj_iso_limit_comp_evaluation _ _).inv,
  -- We still need to construct the `app` and `naturality'` fields omitted above.
  { refine (s.ι.app (unop j)).c.app U ≫ (F.obj (unop j)).presheaf.map (eq_to_hom _),
    dsimp,
    rw ←opens.map_comp_obj,
    simp, },
  { rw (PresheafedSpace.congr_app (s.w f.unop).symm U),
    dsimp,
    have w := functor.congr_obj (congr_arg opens.map
      (colimit.ι_desc ((PresheafedSpace.forget C).map_cocone s) (unop j))) (unop U),
    simp only [opens.map_comp_obj_unop] at w,
    replace w := congr_arg op w,
    have w' := nat_trans.congr (F.map f.unop).c w,
    rw w',
    dsimp, simp, dsimp, simp, },
end

lemma desc_c_naturality (F : J ⥤ PresheafedSpace.{v} C) (s : cocone F)
  {U V : (opens ↥(s.X.carrier))ᵒᵖ} (i : U ⟶ V) :
  s.X.presheaf.map i ≫ desc_c_app F s V =
  desc_c_app F s U ≫ (colimit.desc (F ⋙ forget C)
    ((forget C).map_cocone s) _* (colimit_cocone F).X.presheaf).map i :=
begin
  dsimp [desc_c_app],
  ext,
  simp only [limit.lift_π, nat_trans.naturality, limit.lift_π_assoc, eq_to_hom_map, assoc,
    pushforward_obj_map, nat_trans.naturality_assoc, op_map,
    limit_obj_iso_limit_comp_evaluation_inv_π_app_assoc,
    limit_obj_iso_limit_comp_evaluation_inv_π_app],
  dsimp,
  have w := functor.congr_hom (congr_arg opens.map
    (colimit.ι_desc ((PresheafedSpace.forget C).map_cocone s) (unop j))) (i.unop),
  simp only [opens.map_comp_map] at w,
  replace w := congr_arg quiver.hom.op w,
  rw w,
  dsimp, simp,
end

/--
Auxiliary definition for `PresheafedSpace.colimit_cocone_is_colimit`.
-/
def desc (F : J ⥤ PresheafedSpace.{v} C) (s : cocone F) : colimit F ⟶ s.X :=
{ base := colimit.desc (F ⋙ PresheafedSpace.forget C) ((PresheafedSpace.forget C).map_cocone s),
  c :=
  { app := λ U, desc_c_app F s U,
    naturality' := λ U V i, desc_c_naturality F s i } }

lemma desc_fac  (F : J ⥤ PresheafedSpace.{v} C) (s : cocone F) (j : J) :
  (colimit_cocone F).ι.app j ≫ desc F s = s.ι.app j :=
begin
  fapply PresheafedSpace.ext,
  { simp [desc] },
  { ext,
    dsimp [desc, desc_c_app],
    simpa }
end

end colimit_cocone_is_colimit

open colimit_cocone_is_colimit

/--
Auxiliary definition for `PresheafedSpace.has_colimits`.
-/
def colimit_cocone_is_colimit (F : J ⥤ PresheafedSpace.{v} C) : is_colimit (colimit_cocone F) :=
{ desc := λ s, desc F s,
  fac' := λ s, desc_fac F s,
  uniq' := λ s m w,
  begin
    -- We need to use the identity on the continuous maps twice, so we prepare that first:
    have t : m.base = colimit.desc (F ⋙ PresheafedSpace.forget C)
                        ((PresheafedSpace.forget C).map_cocone s),
    { apply category_theory.limits.colimit.hom_ext, intros j,
      apply continuous_map.ext, intros x,
      dsimp,
      simp only [colimit.ι_desc_apply, map_cocone_ι_app],
      rw ← w j,
      simp, },
    fapply PresheafedSpace.ext, -- could `ext` please not reorder goals?
    { exact t, },
    { ext U j, dsimp [desc, desc_c_app],
      simp only [limit.lift_π, eq_to_hom_op, eq_to_hom_map, assoc,
        limit_obj_iso_limit_comp_evaluation_inv_π_app],
      rw PresheafedSpace.congr_app (w (unop j)).symm U,
      dsimp,
      have w := congr_arg op (functor.congr_obj (congr_arg opens.map t) (unop U)),
      rw nat_trans.congr (limit.π (pushforward_diagram_to_colimit F).left_op j) w,
      simp }
  end, }

instance : has_colimits_of_shape J (PresheafedSpace.{v} C) :=
{ has_colimit := λ F, has_colimit.mk
  { cocone     := colimit_cocone F,
    is_colimit := colimit_cocone_is_colimit F } }

instance : preserves_colimits_of_shape J (PresheafedSpace.forget C) :=
{ preserves_colimit := λ F, preserves_colimit_of_preserves_colimit_cocone
  (colimit_cocone_is_colimit F)
  begin
    apply is_colimit.of_iso_colimit (colimit.is_colimit _),
    fapply cocones.ext,
    { refl, },
    { intro j, dsimp, simp, }
  end }

/--
When `C` has limits, the category of presheaved spaces with values in `C` itself has colimits.
-/
instance [has_limits C] : has_colimits (PresheafedSpace.{v} C) :=
{ has_colimits_of_shape := λ J 𝒥, by exactI
  { has_colimit := λ F, has_colimit.mk
    { cocone     := colimit_cocone F,
      is_colimit := colimit_cocone_is_colimit F } } }

/--
The underlying topological space of a colimit of presheaved spaces is
the colimit of the underlying topological spaces.
-/
instance forget_preserves_colimits [has_limits C] : preserves_colimits (PresheafedSpace.forget C) :=
{ preserves_colimits_of_shape := λ J 𝒥, by exactI
  { preserves_colimit := λ F, preserves_colimit_of_preserves_colimit_cocone
    (colimit_cocone_is_colimit F)
    begin
      apply is_colimit.of_iso_colimit (colimit.is_colimit _),
      fapply cocones.ext,
      { refl, },
      { intro j, dsimp, simp, }
    end } }

/--
The components of the colimit of a diagram of `PresheafedSpace C` is obtained
via taking componentwise limits.
-/
def colimit_presheaf_obj_iso_componentwise_limit (F : J ⥤ PresheafedSpace.{v} C) [has_colimit F]
  (U : opens (limits.colimit F).carrier) :
  (limits.colimit F).presheaf.obj (op U) ≅ limit (componentwise_diagram F U) :=
begin
  refine ((sheaf_iso_of_iso (colimit.iso_colimit_cocone
    ⟨_, colimit_cocone_is_colimit F⟩).symm).app (op U)).trans _,
  refine (limit_obj_iso_limit_comp_evaluation _ _).trans (limits.lim.map_iso _),
  fapply nat_iso.of_components,
  { intro X,
    refine ((F.obj (unop X)).presheaf.map_iso (eq_to_iso _)),
    simp only [functor.op_obj, unop_op, op_inj_iff, opens.map_coe, set_like.ext'_iff,
      set.preimage_preimage],
    simp_rw ← comp_app,
    congr' 2,
    exact ι_preserves_colimits_iso_inv (forget C) F (unop X) },
  { intros X Y f,
    change ((F.map f.unop).c.app _ ≫ _ ≫ _) ≫ (F.obj (unop Y)).presheaf.map _ = _ ≫ _,
    rw Top.presheaf.pushforward.comp_inv_app,
    erw category.id_comp,
    rw category.assoc,
    erw [← (F.obj (unop Y)).presheaf.map_comp, (F.map f.unop).c.naturality_assoc,
      ← (F.obj (unop Y)).presheaf.map_comp],
    congr }
end

@[simp]
lemma colimit_presheaf_obj_iso_componentwise_limit_inv_ι_app (F : J ⥤ PresheafedSpace.{v} C)
  (U : opens (limits.colimit F).carrier) (j : J) :
  (colimit_presheaf_obj_iso_componentwise_limit F U).inv ≫ (colimit.ι F j).c.app (op U) =
    limit.π _ (op j) :=
begin
  delta colimit_presheaf_obj_iso_componentwise_limit,
  rw [iso.trans_inv, iso.trans_inv, iso.app_inv, sheaf_iso_of_iso_inv, pushforward_to_of_iso_app,
    congr_app (iso.symm_inv _)],
  simp_rw category.assoc,
  rw [← functor.map_comp_assoc, nat_trans.naturality],
  erw ← comp_c_app_assoc,
  rw congr_app (colimit.iso_colimit_cocone_ι_hom _ _),
  simp_rw category.assoc,
  erw [limit_obj_iso_limit_comp_evaluation_inv_π_app_assoc, lim_map_π_assoc],
  convert category.comp_id _,
  erw ← (F.obj j).presheaf.map_id,
  iterate 2 { erw ← (F.obj j).presheaf.map_comp },
  congr
end

@[simp]
lemma colimit_presheaf_obj_iso_componentwise_limit_hom_π (F : J ⥤ PresheafedSpace.{v} C)
  (U : opens (limits.colimit F).carrier) (j : J) :
    (colimit_presheaf_obj_iso_componentwise_limit F U).hom ≫ limit.π _ (op j) =
      (colimit.ι F j).c.app (op U) :=
by rw [← iso.eq_inv_comp, colimit_presheaf_obj_iso_componentwise_limit_inv_ι_app]

end PresheafedSpace

end algebraic_geometry


/-
Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import analysis.special_functions.integrals
import topology.metric_space.contracting

/-!
# Picard-Lindelöf (Cauchy-Lipschitz) Theorem

In this file we prove that an ordinary differential equation $\dot x=v(t, x)$ such that $v$ is
Lipschitz continuous in $x$ and continuous in $t$ has a local solution, see
`exists_forall_deriv_within_Icc_eq_of_lipschitz_of_continuous`.

## Implementation notes

In order to split the proof into small lemmas, we introduce a structure `picard_lindelof` that holds
all assumptions of the main theorem. This structure and lemmas in the `picard_lindelof` namespace
should be treated as private implementation details.

We only prove existence of a solution in this file. For uniqueness see `ODE_solution_unique` and
related theorems in `analysis.ODE.gronwall`.

## Tags

differential equation
-/

open filter function set metric topological_space interval_integral measure_theory
open measure_theory.measure_space (volume)
open_locale filter topological_space nnreal ennreal nat interval

noncomputable theory

variables {E : Type*} [normed_group E] [normed_space ℝ E]

/-- This structure holds arguments of the Picard-Lipschitz (Cauchy-Lipschitz) theorem. Unless you
want to use one of the auxiliary lemmas, use
`exists_forall_deriv_within_Icc_eq_of_lipschitz_of_continuous` instead of using this structure. -/
structure picard_lindelof (E : Type*) [normed_group E] [normed_space ℝ E] :=
(to_fun : ℝ → E → E)
(t_min t_max : ℝ)
(t₀ : Icc t_min t_max)
(x₀ : E)
(C R L : ℝ≥0)
(lipschitz' : ∀ t ∈ Icc t_min t_max, lipschitz_on_with L (to_fun t) (closed_ball x₀ R))
(cont : ∀ x ∈ closed_ball x₀ R, continuous_on (λ t, to_fun t x) (Icc t_min t_max))
(norm_le' : ∀ (t ∈ Icc t_min t_max) (x ∈ closed_ball x₀ R), ∥to_fun t x∥ ≤ C)
(C_mul_le_R : (C : ℝ) * max (t_max - t₀) (t₀ - t_min) ≤ R)

namespace picard_lindelof

variables (v : picard_lindelof E)

instance : has_coe_to_fun (picard_lindelof E) (λ _, ℝ → E → E) := ⟨to_fun⟩

instance : inhabited (picard_lindelof E) :=
⟨⟨0, 0, 0, ⟨0, le_rfl, le_rfl⟩, 0, 0, 0, 0, λ t ht, (lipschitz_with.const 0).lipschitz_on_with _,
  λ _ _, by simpa only [pi.zero_apply] using continuous_on_const, λ t ht x hx, norm_zero.le,
  (zero_mul _).le⟩⟩

lemma t_min_le_t_max : v.t_min ≤ v.t_max := v.t₀.2.1.trans v.t₀.2.2

protected lemma nonempty_Icc : (Icc v.t_min v.t_max).nonempty := nonempty_Icc.2 v.t_min_le_t_max

protected

protected lemma continuous_on :
  continuous_on (uncurry v) ((Icc v.t_min v.t_max).prod (closed_ball v.x₀ v.R)) :=
have continuous_on (uncurry (flip v)) ((closed_ball v.x₀ v.R).prod (Icc v.t_min v.t_max)),
  from continuous_on_prod_of_continuous_on_lipschitz_on _ v.L v.cont v.lipschitz',
this.comp continuous_swap.continuous_on preimage_swap_prod.symm.subset

lemma norm_le {t : ℝ} (ht : t ∈ Icc v.t_min v.t_max) {x : E} (hx : x ∈ closed_ball v.x₀ v.R) :
  ∥v t x∥ ≤ v.C :=
v.norm_le' _ ht _ hx

/-- The maximum of distances from `t₀` to the endpoints of `[t_min, t_max]`. -/
def t_dist : ℝ := max (v.t_max - v.t₀) (v.t₀ - v.t_min)

lemma t_dist_nonneg : 0 ≤ v.t_dist := le_max_iff.2 $ or.inl $ sub_nonneg.2 v.t₀.2.2

lemma dist_t₀_le (t : Icc v.t_min v.t_max) : dist t v.t₀ ≤ v.t_dist :=
begin
  rw [subtype.dist_eq, real.dist_eq],
  cases le_total t v.t₀ with ht ht,
  { rw [abs_of_nonpos (sub_nonpos.2 $ subtype.coe_le_coe.2 ht), neg_sub],
    exact (sub_le_sub_left t.2.1 _).trans (le_max_right _ _) },
  { rw [abs_of_nonneg (sub_nonneg.2 $ subtype.coe_le_coe.2 ht)],
    exact (sub_le_sub_right t.2.2 _).trans (le_max_left _ _) }
end

/-- Projection $ℝ → [t_{\min}, t_{\max}]$ sending $(-∞, t_{\min}]$ to $t_{\min}$ and $[t_{\max}, ∞)$
to $t_{\max}$. -/
def proj : ℝ → Icc v.t_min v.t_max := proj_Icc v.t_min v.t_max v.t_min_le_t_max

lemma proj_coe (t : Icc v.t_min v.t_max) : v.proj t = t := proj_Icc_coe _ _

lemma proj_of_mem {t : ℝ} (ht : t ∈ Icc v.t_min v.t_max) : ↑(v.proj t) = t :=
by simp only [proj, proj_Icc_of_mem _ ht, subtype.coe_mk]

@[continuity] lemma continuous_proj : continuous v.proj := continuous_proj_Icc

/-- The space of curves $γ \colon [t_{\min}, t_{\max}] \to E$ such that $γ(t₀) = x₀$ and $γ$ is
Lipschitz continuous with constant $C$. The map sending $γ$ to
$\mathbf Pγ(t)=x₀ + ∫_{t₀}^{t} v(τ, γ(τ))\,dτ$ is a contracting map on this space, and its fixed
point is a solution of the ODE $\dot x=v(t, x)$. -/
structure fun_space :=
(to_fun : Icc v.t_min v.t_max → E)
(map_t₀' : to_fun v.t₀ = v.x₀)
(lipschitz' : lipschitz_with v.C to_fun)

namespace fun_space

variables {v} (f : fun_space v)

instance : has_coe_to_fun (fun_space v) (λ _, Icc v.t_min v.t_max → E) := ⟨to_fun⟩

instance : inhabited v.fun_space :=
⟨⟨λ _, v.x₀, rfl, (lipschitz_with.const _).weaken (zero_le _)⟩⟩

protected lemma lipschitz : lipschitz_with v.C f := f.lipschitz'

protected lemma continuous : continuous f := f.lipschitz.continuous

/-- Each curve in `picard_lindelof.fun_space` is continuous. -/
def to_continuous_map : v.fun_space ↪ C(Icc v.t_min v.t_max, E) :=
⟨λ f, ⟨f, f.continuous⟩, λ f g h, by { cases f, cases g, simpa using h }⟩

instance : metric_space v.fun_space :=
metric_space.induced to_continuous_map to_continuous_map.injective infer_instance

lemma uniform_inducing_to_continuous_map : uniform_inducing (@to_continuous_map _ _ _ v) := ⟨rfl⟩

lemma range_to_continuous_map :
  range to_continuous_map =
    {f : C(Icc v.t_min v.t_max, E) | f v.t₀ = v.x₀ ∧ lipschitz_with v.C f} :=
begin
  ext f, split,
  { rintro ⟨⟨f, hf₀, hf_lip⟩, rfl⟩, exact ⟨hf₀, hf_lip⟩ },
  { rcases f with ⟨f, hf⟩, rintro ⟨hf₀, hf_lip⟩, exact ⟨⟨f, hf₀, hf_lip⟩, rfl⟩ }
end

lemma map_t₀ : f v.t₀ = v.x₀ := f.map_t₀'

protected lemma mem_closed_ball (t : Icc v.t_min v.t_max) : f t ∈ closed_ball v.x₀ v.R :=
calc dist (f t) v.x₀ = dist (f t) (f.to_fun v.t₀) : by rw f.map_t₀'
                 ... ≤ v.C * dist t v.t₀          : f.lipschitz.dist_le_mul _ _
                 ... ≤ v.C * v.t_dist             : mul_le_mul_of_nonneg_left (v.dist_t₀_le _) v.C.2
                 ... ≤ v.R                        : v.C_mul_le_R

/-- Given a curve $γ \colon [t_{\min}, t_{\max}] → E$, `v_comp` is the function
$F(t)=v(π t, γ(π t))$, where `π` is the projection $ℝ → [t_{\min}, t_{\max}]$. The integral of this
function is the image of `γ` under the contracting map we are going to define below. -/
def v_comp (t : ℝ) : E := v (v.proj t) (f (v.proj t))

lemma v_comp_apply_coe (t : Icc v.t_min v.t_max) : f.v_comp t = v t (f t) :=
by simp only [v_comp, proj_coe]

lemma continuous_v_comp : continuous f.v_comp :=
begin
  have := (continuous_subtype_coe.prod_mk f.continuous).comp v.continuous_proj,
  refine continuous_on.comp_continuous v.continuous_on this (λ x, _),
  exact ⟨(v.proj x).2, f.mem_closed_ball _⟩
end

lemma norm_v_comp_le (t : ℝ) : ∥f.v_comp t∥ ≤ v.C :=
v.norm_le (v.proj t).2 $ f.mem_closed_ball _

lemma dist_apply_le_dist (f₁ f₂ : fun_space v) (t : Icc v.t_min v.t_max) :
  dist (f₁ t) (f₂ t) ≤ dist f₁ f₂ :=
@continuous_map.dist_apply_le_dist _ _ _ _ _ f₁.to_continuous_map f₂.to_continuous_map _

lemma dist_le_of_forall {f₁ f₂ : fun_space v} {d : ℝ} (h : ∀ t, dist (f₁ t) (f₂ t) ≤ d) :
  dist f₁ f₂ ≤ d :=
(@continuous_map.dist_le_iff_of_nonempty _ _ _ _ _ f₁.to_continuous_map f₂.to_continuous_map _
  v.nonempty_Icc.to_subtype).2 h

instance [complete_space E] : complete_space v.fun_space :=
begin
  refine (complete_space_iff_is_complete_range
    uniform_inducing_to_continuous_map).2 (is_closed.is_complete _),
  rw [range_to_continuous_map, set_of_and],
  refine (is_closed_eq (continuous_map.continuous_evalx _) continuous_const).inter _,
  have : is_closed {f : Icc v.t_min v.t_max → E | lipschitz_with v.C f} :=
    is_closed_set_of_lipschitz_with v.C,
  exact this.preimage continuous_map.continuous_coe
end

variables [measurable_space E] [borel_space E]

lemma interval_integrable_v_comp (t₁ t₂ : ℝ) :
  interval_integrable f.v_comp volume t₁ t₂ :=
(f.continuous_v_comp).interval_integrable _ _

variables [second_countable_topology E] [complete_space E]

/-- The Picard-Lindelöf operator. This is a contracting map on `picard_lindelof.fun_space v` such
that the fixed point of this map is the solution of the corresponding ODE.

More precisely, some iteration of this map is a contracting map. -/
def next (f : fun_space v) : fun_space v :=
{ to_fun := λ t, v.x₀ + ∫ τ : ℝ in v.t₀..t, f.v_comp τ,
  map_t₀' := by rw [integral_same, add_zero],
  lipschitz' := lipschitz_with.of_dist_le_mul $ λ t₁ t₂,
    begin
      rw [dist_add_left, dist_eq_norm,
        integral_interval_sub_left (f.interval_integrable_v_comp _ _)
          (f.interval_integrable_v_comp _ _)],
      exact norm_integral_le_of_norm_le_const (λ t ht, f.norm_v_comp_le _),
    end }

lemma next_apply (t : Icc v.t_min v.t_max) : f.next t = v.x₀ + ∫ τ : ℝ in v.t₀..t, f.v_comp τ := rfl

lemma has_deriv_within_at_next (t : Icc v.t_min v.t_max) :
  has_deriv_within_at (f.next ∘ v.proj) (v t (f t)) (Icc v.t_min v.t_max) t :=
begin
  haveI : fact ((t : ℝ) ∈ Icc v.t_min v.t_max) := ⟨t.2⟩,
  simp only [(∘), next_apply],
  refine has_deriv_within_at.const_add _ _,
  have : has_deriv_within_at (λ t : ℝ, ∫ τ in v.t₀..t, f.v_comp τ) (f.v_comp t)
    (Icc v.t_min v.t_max) t,
    from integral_has_deriv_within_at_right (f.interval_integrable_v_comp _ _)
      (f.continuous_v_comp.measurable_at_filter _ _) f.continuous_v_comp.continuous_within_at,
  rw v_comp_apply_coe at this,
  refine this.congr_of_eventually_eq_of_mem _ t.coe_prop,
  filter_upwards [self_mem_nhds_within],
  intros t' ht',
  rw v.proj_of_mem ht'
end

lemma dist_next_apply_le_of_le {f₁ f₂ : fun_space v} {n : ℕ} {d : ℝ}
  (h : ∀ t, dist (f₁ t) (f₂ t) ≤ (v.L * |t - v.t₀|) ^ n / n! * d) (t : Icc v.t_min v.t_max) :
  dist (next f₁ t) (next f₂ t) ≤ (v.L * |t - v.t₀|) ^ (n + 1) / (n + 1)! * d :=
begin
  simp only [dist_eq_norm, next_apply, add_sub_add_left_eq_sub,
    ← interval_integral.integral_sub (interval_integrable_v_comp _ _ _)
      (interval_integrable_v_comp _ _ _), norm_integral_eq_norm_integral_Ioc] at *,
  calc ∥∫ τ in Ι (v.t₀ : ℝ) t, f₁.v_comp τ - f₂.v_comp τ∥
      ≤ ∫ τ in Ι (v.t₀ : ℝ) t, v.L * ((v.L * |τ - v.t₀|) ^ n / n! * d) :
    begin
      refine norm_integral_le_of_norm_le (continuous.integrable_on_interval_oc _) _,
      { continuity },
      { refine (ae_restrict_mem measurable_set_Ioc).mono (λ τ hτ, _),
        refine (v.lipschitz_on_with (v.proj τ).2).norm_sub_le_of_le
          (f₁.mem_closed_ball _) (f₂.mem_closed_ball _) ((h _).trans_eq _),
        rw v.proj_of_mem,
        exact (interval_subset_Icc v.t₀.2 t.2 $ Ioc_subset_Icc_self hτ) }
    end
  ... = (v.L * |t - v.t₀|) ^ (n + 1) / (n + 1)! * d : _,
  simp_rw [mul_pow, div_eq_mul_inv, mul_assoc, measure_theory.integral_mul_left,
    measure_theory.integral_mul_right, integral_pow_abs_sub_interval_oc, div_eq_mul_inv,
    pow_succ (v.L : ℝ), nat.factorial_succ, nat.cast_mul, nat.cast_succ, mul_inv₀, mul_assoc]
end

lemma dist_iterate_next_apply_le (f₁ f₂ : fun_space v) (n : ℕ) (t : Icc v.t_min v.t_max) :
  dist (next^[n] f₁ t) (next^[n] f₂ t) ≤ (v.L * |t - v.t₀|) ^ n / n! * dist f₁ f₂ :=
begin
  induction n with n ihn generalizing t,
  { rw [pow_zero, nat.factorial_zero, nat.cast_one, div_one, one_mul],
    exact dist_apply_le_dist f₁ f₂ t },
  { rw [iterate_succ_apply', iterate_succ_apply'],
    exact dist_next_apply_le_of_le ihn _ }
end

lemma dist_iterate_next_le (f₁ f₂ : fun_space v) (n : ℕ) :
  dist (next^[n] f₁) (next^[n] f₂) ≤ (v.L * v.t_dist) ^ n / n! * dist f₁ f₂ :=
begin
  refine dist_le_of_forall (λ t, (dist_iterate_next_apply_le _ _ _ _).trans _),
  have : 0 ≤ dist f₁ f₂ := dist_nonneg,
  have : |(t - v.t₀ : ℝ)| ≤ v.t_dist := v.dist_t₀_le t,
  mono*; simp only [nat.cast_nonneg, mul_nonneg, nnreal.coe_nonneg, abs_nonneg, *]
end

end fun_space

variables [second_countable_topology E] [complete_space E]

section
variables [measurable_space E] [borel_space E]

lemma exists_contracting_iterate :
  ∃ (N : ℕ) K, contracting_with K ((fun_space.next : v.fun_space → v.fun_space)^[N]) :=
begin
  rcases ((real.tendsto_pow_div_factorial_at_top (v.L * v.t_dist)).eventually
    (gt_mem_nhds zero_lt_one)).exists with ⟨N, hN⟩,
  have : (0 : ℝ) ≤ (v.L * v.t_dist) ^ N / N!,
    from div_nonneg (pow_nonneg (mul_nonneg v.L.2 v.t_dist_nonneg) _) (nat.cast_nonneg _),
  exact ⟨N, ⟨_, this⟩, hN,
    lipschitz_with.of_dist_le_mul (λ f g, fun_space.dist_iterate_next_le f g N)⟩
end

lemma exists_fixed : ∃ f : v.fun_space, f.next = f :=
let ⟨N, K, hK⟩ := exists_contracting_iterate v in ⟨_, hK.is_fixed_pt_fixed_point_iterate⟩

end

/-- Picard-Lindelöf (Cauchy-Lipschitz) theorem. -/
lemma exists_solution :
  ∃ f : ℝ → E, f v.t₀ = v.x₀ ∧ ∀ t ∈ Icc v.t_min v.t_max,
    has_deriv_within_at f (v t (f t)) (Icc v.t_min v.t_max) t :=
begin
  letI : measurable_space E := borel E, haveI : borel_space E := ⟨rfl⟩,
  rcases v.exists_fixed with ⟨f, hf⟩,
  refine ⟨f ∘ v.proj, _, λ t ht, _⟩,
  { simp only [(∘), proj_coe, f.map_t₀] },
  { simp only [(∘), v.proj_of_mem ht],
    lift t to Icc v.t_min v.t_max using ht,
    simpa only [hf, v.proj_coe] using f.has_deriv_within_at_next t }
end

end picard_lindelof

/-- Picard-Lindelöf (Cauchy-Lipschitz) theorem. -/
lemma exists_forall_deriv_within_Icc_eq_of_lipschitz_of_continuous
  [complete_space E] [second_countable_topology E]
  {v : ℝ → E → E} {t_min t₀ t_max : ℝ} (ht₀ : t₀ ∈ Icc t_min t_max)
  (x₀ : E) {C R : ℝ} (hR : 0 ≤ R) {L : ℝ≥0}
  (Hlip : ∀ t ∈ Icc t_min t_max, lipschitz_on_with L (v t) (closed_ball x₀ R))
  (Hcont : ∀ x ∈ closed_ball x₀ R, continuous_on (λ t, v t x) (Icc t_min t_max))
  (Hnorm : ∀ (t ∈ Icc t_min t_max) (x ∈ closed_ball x₀ R), ∥v t x∥ ≤ C)
  (Hmul_le : C * max (t_max - t₀) (t₀ - t_min) ≤ R) :
  ∃ f : ℝ → E, f t₀ = x₀ ∧ ∀ t ∈ Icc t_min t_max,
    has_deriv_within_at f (v t (f t)) (Icc t_min t_max) t :=
begin
  lift C to ℝ≥0 using ((norm_nonneg _).trans $ Hnorm t₀ ht₀ x₀ (mem_closed_ball_self hR)),
  lift R to ℝ≥0 using hR,
  lift t₀ to Icc t_min t_max using ht₀,
  exact picard_lindelof.exists_solution
    ⟨v, t_min, t_max, t₀, x₀, C, R, L, Hlip, Hcont, Hnorm, Hmul_le⟩
end