/-
Copyright (c) 2014 Parikshit Khanna. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.option.defs
import Mathlib.logic.basic
import Mathlib.tactic.cache
import Mathlib.PostPort

universes u_1 u v w u_2

namespace Mathlib

/-!
## Definitions on lists

This file contains various definitions on lists. It does not contain
proofs about these definitions, those are contained in other files in `data/list`
-/

namespace list

/-- Returns whether a list is []. Returns a boolean even if `l = []` is not decidable. -/
def is_nil {α : Type u_1} : List α → Bool :=
  sorry

protected instance has_sdiff {α : Type u} [DecidableEq α] : has_sdiff (List α) :=
  has_sdiff.mk list.diff

/-- Split a list at an index.

     split_at 2 [a, b, c] = ([a, b], [c]) -/
def split_at {α : Type u} : ℕ → List α → List α × List α :=
  sorry

/-- An auxiliary function for `split_on_p`. -/
def split_on_p_aux {α : Type u} (P : α → Prop) [decidable_pred P] : List α → (List α → List α) → List (List α) :=
  sorry

/-- Split a list at every element satisfying a predicate. -/
def split_on_p {α : Type u} (P : α → Prop) [decidable_pred P] (l : List α) : List (List α) :=
  split_on_p_aux P l id

/-- Split a list at every occurrence of an element.

    [1,1,2,3,2,4,4].split_on 2 = [[1,1],[3],[4,4]] -/
def split_on {α : Type u} [DecidableEq α] (a : α) (as : List α) : List (List α) :=
  split_on_p (fun (_x : α) => _x = a) as

/-- Concatenate an element at the end of a list.

     concat [a, b] c = [a, b, c] -/
@[simp] def concat {α : Type u} : List α → α → List α :=
  sorry

/-- `head' xs` returns the first element of `xs` if `xs` is non-empty;
it returns `none` otherwise -/
@[simp] def head' {α : Type u} : List α → Option α :=
  sorry

/-- Convert a list into an array (whose length is the length of `l`). -/
def to_array {α : Type u} (l : List α) : array (length l) α :=
  d_array.mk fun (v : fin (length l)) => nth_le l (subtype.val v) sorry

/-- "inhabited" `nth` function: returns `default` instead of `none` in the case
  that the index is out of bounds. -/
@[simp] def inth {α : Type u} [h : Inhabited α] (l : List α) (n : ℕ) : α :=
  option.iget (nth l n)

/-- Apply a function to the nth tail of `l`. Returns the input without
  using `f` if the index is larger than the length of the list.

     modify_nth_tail f 2 [a, b, c] = [a, b] ++ f [c] -/
@[simp] def modify_nth_tail {α : Type u} (f : List α → List α) : ℕ → List α → List α :=
  sorry

/-- Apply `f` to the head of the list, if it exists. -/
@[simp] def modify_head {α : Type u} (f : α → α) : List α → List α :=
  sorry

/-- Apply `f` to the nth element of the list, if it exists. -/
def modify_nth {α : Type u} (f : α → α) : ℕ → List α → List α :=
  modify_nth_tail (modify_head f)

/-- Apply `f` to the last element of `l`, if it exists. -/
@[simp] def modify_last {α : Type u} (f : α → α) : List α → List α :=
  sorry

/-- `insert_nth n a l` inserts `a` into the list `l` after the first `n` elements of `l`
 `insert_nth 2 1 [1, 2, 3, 4] = [1, 2, 1, 3, 4]`-/
def insert_nth {α : Type u} (n : ℕ) (a : α) : List α → List α :=
  modify_nth_tail (List.cons a) n

/-- Take `n` elements from a list `l`. If `l` has less than `n` elements, append `n - length l`
elements `default α`. -/
def take' {α : Type u} [Inhabited α] (n : ℕ) : List α → List α :=
  sorry

/-- Get the longest initial segment of the list whose members all satisfy `p`.

     take_while (λ x, x < 3) [0, 2, 5, 1] = [0, 2] -/
def take_while {α : Type u} (p : α → Prop) [decidable_pred p] : List α → List α :=
  sorry

/-- Fold a function `f` over the list from the left, returning the list
  of partial results.

     scanl (+) 0 [1, 2, 3] = [0, 1, 3, 6] -/
def scanl {α : Type u} {β : Type v} (f : α → β → α) : α → List β → List α :=
  sorry

/-- Auxiliary definition used to define `scanr`. If `scanr_aux f b l = (b', l')`
then `scanr f b l = b' :: l'` -/
def scanr_aux {α : Type u} {β : Type v} (f : α → β → β) (b : β) : List α → β × List β :=
  sorry

/-- Fold a function `f` over the list from the right, returning the list
  of partial results.

     scanr (+) 0 [1, 2, 3] = [6, 5, 3, 0] -/
def scanr {α : Type u} {β : Type v} (f : α → β → β) (b : β) (l : List α) : List β :=
  sorry

/-- Product of a list.

     prod [a, b, c] = ((1 * a) * b) * c -/
def prod {α : Type u} [Mul α] [HasOne α] : List α → α :=
  foldl Mul.mul 1

/-- Sum of a list.

     sum [a, b, c] = ((0 + a) + b) + c -/
-- Later this will be tagged with `to_additive`, but this can't be done yet because of import

-- dependencies.

def sum {α : Type u} [Add α] [HasZero α] : List α → α :=
  foldl Add.add 0

/-- The alternating sum of a list. -/
def alternating_sum {G : Type u_1} [HasZero G] [Add G] [Neg G] : List G → G :=
  sorry

/-- The alternating product of a list. -/
def alternating_prod {G : Type u_1} [HasOne G] [Mul G] [has_inv G] : List G → G :=
  sorry

/-- Given a function `f : α → β ⊕ γ`, `partition_map f l` maps the list by `f`
  whilst partitioning the result it into a pair of lists, `list β × list γ`,
  partitioning the `sum.inl _` into the left list, and the `sum.inr _` into the right list.
  `partition_map (id : ℕ ⊕ ℕ → ℕ ⊕ ℕ) [inl 0, inr 1, inl 2] = ([0,2], [1])`    -/
def partition_map {α : Type u} {β : Type v} {γ : Type w} (f : α → β ⊕ γ) : List α → List β × List γ :=
  sorry

/-- `find p l` is the first element of `l` satisfying `p`, or `none` if no such
  element exists. -/
def find {α : Type u} (p : α → Prop) [decidable_pred p] : List α → Option α :=
  sorry

/-- `mfind tac l` returns the first element of `l` on which `tac` succeeds, and
fails otherwise. -/
def mfind {α : Type u} {m : Type u → Type v} [Monad m] [alternative m] (tac : α → m PUnit) : List α → m α :=
  mfirst fun (a : α) => tac a $> a

/-- `mbfind' p l` returns the first element `a` of `l` for which `p a` returns
true. `mbfind'` short-circuits, so `p` is not necessarily run on every `a` in
`l`. This is a monadic version of `list.find`. -/
def mbfind' {m : Type u → Type v} [Monad m] {α : Type u} (p : α → m (ulift Bool)) : List α → m (Option α) :=
  sorry

/-- A variant of `mbfind'` with more restrictive universe levels. -/
def mbfind {m : Type → Type v} [Monad m] {α : Type} (p : α → m Bool) (xs : List α) : m (Option α) :=
  mbfind' (Functor.map ulift.up ∘ p) xs

/-- `many p as` returns true iff `p` returns true for any element of `l`.
`many` short-circuits, so if `p` returns true for any element of `l`, later
elements are not checked. This is a monadic version of `list.any`. -/
-- Implementing this via `mbfind` would give us less universe polymorphism.

def many {m : Type → Type v} [Monad m] {α : Type u} (p : α → m Bool) : List α → m Bool :=
  sorry

/-- `mall p as` returns true iff `p` returns true for all elements of `l`.
`mall` short-circuits, so if `p` returns false for any element of `l`, later
elements are not checked. This is a monadic version of `list.all`. -/
def mall {m : Type → Type v} [Monad m] {α : Type u} (p : α → m Bool) (as : List α) : m Bool :=
  bnot <$> many (fun (a : α) => bnot <$> p a) as

/-- `mbor xs` runs the actions in `xs`, returning true if any of them returns
true. `mbor` short-circuits, so if an action returns true, later actions are
not run. This is a monadic version of `list.bor`. -/
def mbor {m : Type → Type v} [Monad m] : List (m Bool) → m Bool :=
  many id

/-- `mband xs` runs the actions in `xs`, returning true if all of them return
true. `mband` short-circuits, so if an action returns false, later actions are
not run. This is a monadic version of `list.band`. -/
def mband {m : Type → Type v} [Monad m] : List (m Bool) → m Bool :=
  mall id

/-- Auxiliary definition for `foldl_with_index`. -/
def foldl_with_index_aux {α : Type u} {β : Type v} (f : ℕ → α → β → α) : ℕ → α → List β → α :=
  sorry

/-- Fold a list from left to right as with `foldl`, but the combining function
also receives each element's index. -/
def foldl_with_index {α : Type u} {β : Type v} (f : ℕ → α → β → α) (a : α) (l : List β) : α :=
  foldl_with_index_aux f 0 a l

/-- Auxiliary definition for `foldr_with_index`. -/
def foldr_with_index_aux {α : Type u} {β : Type v} (f : ℕ → α → β → β) : ℕ → β → List α → β :=
  sorry

/-- Fold a list from right to left as with `foldr`, but the combining function
also receives each element's index. -/
def foldr_with_index {α : Type u} {β : Type v} (f : ℕ → α → β → β) (b : β) (l : List α) : β :=
  foldr_with_index_aux f 0 b l

/-- `find_indexes p l` is the list of indexes of elements of `l` that satisfy `p`. -/
def find_indexes {α : Type u} (p : α → Prop) [decidable_pred p] (l : List α) : List ℕ :=
  foldr_with_index (fun (i : ℕ) (a : α) (is : List ℕ) => ite (p a) (i :: is) is) [] l

/-- Returns the elements of `l` that satisfy `p` together with their indexes in
`l`. The returned list is ordered by index. -/
def indexes_values {α : Type u} (p : α → Prop) [decidable_pred p] (l : List α) : List (ℕ × α) :=
  foldr_with_index (fun (i : ℕ) (a : α) (l : List (ℕ × α)) => ite (p a) ((i, a) :: l) l) [] l

/-- `indexes_of a l` is the list of all indexes of `a` in `l`. For example:
```
indexes_of a [a, b, a, a] = [0, 2, 3]
```
-/
def indexes_of {α : Type u} [DecidableEq α] (a : α) : List α → List ℕ :=
  find_indexes (Eq a)

/-- Monadic variant of `foldl_with_index`. -/
def mfoldl_with_index {m : Type v → Type w} [Monad m] {α : Type u_1} {β : Type v} (f : ℕ → β → α → m β) (b : β) (as : List α) : m β :=
  foldl_with_index
    (fun (i : ℕ) (ma : m β) (b : α) =>
      do
        let a ← ma
        f i a b)
    (pure b) as

/-- Monadic variant of `foldr_with_index`. -/
def mfoldr_with_index {m : Type v → Type w} [Monad m] {α : Type u_1} {β : Type v} (f : ℕ → α → β → m β) (b : β) (as : List α) : m β :=
  foldr_with_index
    (fun (i : ℕ) (a : α) (mb : m β) =>
      do
        let b ← mb
        f i a b)
    (pure b) as

/-- Auxiliary definition for `mmap_with_index`. -/
def mmap_with_index_aux {m : Type v → Type w} [Applicative m] {α : Type u_1} {β : Type v} (f : ℕ → α → m β) : ℕ → List α → m (List β) :=
  sorry

/-- Applicative variant of `map_with_index`. -/
def mmap_with_index {m : Type v → Type w} [Applicative m] {α : Type u_1} {β : Type v} (f : ℕ → α → m β) (as : List α) : m (List β) :=
  mmap_with_index_aux f 0 as

/-- Auxiliary definition for `mmap_with_index'`. -/
def mmap_with_index'_aux {m : Type v → Type w} [Applicative m] {α : Type u_1} (f : ℕ → α → m PUnit) : ℕ → List α → m PUnit :=
  sorry

/-- A variant of `mmap_with_index` specialised to applicative actions which
return `unit`. -/
def mmap_with_index' {m : Type v → Type w} [Applicative m] {α : Type u_1} (f : ℕ → α → m PUnit) (as : List α) : m PUnit :=
  mmap_with_index'_aux f 0 as

/-- `lookmap` is a combination of `lookup` and `filter_map`.
  `lookmap f l` will apply `f : α → option α` to each element of the list,
  replacing `a → b` at the first value `a` in the list such that `f a = some b`. -/
def lookmap {α : Type u} (f : α → Option α) : List α → List α :=
  sorry

/-- `countp p l` is the number of elements of `l` that satisfy `p`. -/
def countp {α : Type u} (p : α → Prop) [decidable_pred p] : List α → ℕ :=
  sorry

/-- `count a l` is the number of occurrences of `a` in `l`. -/
def count {α : Type u} [DecidableEq α] (a : α) : List α → ℕ :=
  countp (Eq a)

/-- `is_prefix l₁ l₂`, or `l₁ <+: l₂`, means that `l₁` is a prefix of `l₂`,
  that is, `l₂` has the form `l₁ ++ t` for some `t`. -/
def is_prefix {α : Type u} (l₁ : List α) (l₂ : List α) :=
  ∃ (t : List α), l₁ ++ t = l₂

/-- `is_suffix l₁ l₂`, or `l₁ <:+ l₂`, means that `l₁` is a suffix of `l₂`,
  that is, `l₂` has the form `t ++ l₁` for some `t`. -/
def is_suffix {α : Type u} (l₁ : List α) (l₂ : List α) :=
  ∃ (t : List α), t ++ l₁ = l₂

/-- `is_infix l₁ l₂`, or `l₁ <:+: l₂`, means that `l₁` is a contiguous
  substring of `l₂`, that is, `l₂` has the form `s ++ l₁ ++ t` for some `s, t`. -/
def is_infix {α : Type u} (l₁ : List α) (l₂ : List α) :=
  ∃ (s : List α), ∃ (t : List α), s ++ l₁ ++ t = l₂

infixl:50 " <+: " => Mathlib.list.is_prefix

infixl:50 " <:+ " => Mathlib.list.is_suffix

infixl:50 " <:+: " => Mathlib.list.is_infix

/-- `inits l` is the list of initial segments of `l`.

     inits [1, 2, 3] = [[], [1], [1, 2], [1, 2, 3]] -/
@[simp] def inits {α : Type u} : List α → List (List α) :=
  sorry

/-- `tails l` is the list of terminal segments of `l`.

     tails [1, 2, 3] = [[1, 2, 3], [2, 3], [3], []] -/
@[simp] def tails {α : Type u} : List α → List (List α) :=
  sorry

def sublists'_aux {α : Type u} {β : Type v} : List α → (List α → List β) → List (List β) → List (List β) :=
  sorry

/-- `sublists' l` is the list of all (non-contiguous) sublists of `l`.
  It differs from `sublists` only in the order of appearance of the sublists;
  `sublists'` uses the first element of the list as the MSB,
  `sublists` uses the first element of the list as the LSB.

     sublists' [1, 2, 3] = [[], [3], [2], [2, 3], [1], [1, 3], [1, 2], [1, 2, 3]] -/
def sublists' {α : Type u} (l : List α) : List (List α) :=
  sublists'_aux l id []

def sublists_aux {α : Type u} {β : Type v} : List α → (List α → List β → List β) → List β :=
  sorry

/-- `sublists l` is the list of all (non-contiguous) sublists of `l`; cf. `sublists'`
  for a different ordering.

     sublists [1, 2, 3] = [[], [1], [2], [1, 2], [3], [1, 3], [2, 3], [1, 2, 3]] -/
def sublists {α : Type u} (l : List α) : List (List α) :=
  [] :: sublists_aux l List.cons

def sublists_aux₁ {α : Type u} {β : Type v} : List α → (List α → List β) → List β :=
  sorry

/-- `forall₂ R l₁ l₂` means that `l₁` and `l₂` have the same length,
  and whenever `a` is the nth element of `l₁`, and `b` is the nth element of `l₂`,
  then `R a b` is satisfied. -/
inductive forall₂ {α : Type u} {β : Type v} (R : α → β → Prop) : List α → List β → Prop
where
| nil : forall₂ R [] []
| cons : ∀ {a : α} {b : β} {l₁ : List α} {l₂ : List β}, R a b → forall₂ R l₁ l₂ → forall₂ R (a :: l₁) (b :: l₂)

/-- Auxiliary definition used to define `transpose`.
  `transpose_aux l L` takes each element of `l` and appends it to the start of
  each element of `L`.

  `transpose_aux [a, b, c] [l₁, l₂, l₃] = [a::l₁, b::l₂, c::l₃]` -/
def transpose_aux {α : Type u} : List α → List (List α) → List (List α) :=
  sorry

/-- transpose of a list of lists, treated as a matrix.

     transpose [[1, 2], [3, 4], [5, 6]] = [[1, 3, 5], [2, 4, 6]] -/
def transpose {α : Type u} : List (List α) → List (List α) :=
  sorry

/-- List of all sections through a list of lists. A section
  of `[L₁, L₂, ..., Lₙ]` is a list whose first element comes from
  `L₁`, whose second element comes from `L₂`, and so on. -/
def sections {α : Type u} : List (List α) → List (List α) :=
  sorry

def permutations_aux2 {α : Type u} {β : Type v} (t : α) (ts : List α) (r : List β) : List α → (List α → β) → List α × List β :=
  sorry

def permutations_aux.rec {α : Type u} {C : List α → List α → Sort v} (H0 : (is : List α) → C [] is) (H1 : (t : α) → (ts is : List α) → C ts (t :: is) → C is [] → C (t :: ts) is) (l₁ : List α) (l₂ : List α) : C l₁ l₂ :=
  sorry

def permutations_aux {α : Type u} : List α → List α → List (List α) :=
  sorry

/-- List of all permutations of `l`.

     permutations [1, 2, 3] =
       [[1, 2, 3], [2, 1, 3], [3, 2, 1],
        [2, 3, 1], [3, 1, 2], [1, 3, 2]] -/
def permutations {α : Type u} (l : List α) : List (List α) :=
  l :: permutations_aux l []

/-- `erasep p l` removes the first element of `l` satisfying the predicate `p`. -/
def erasep {α : Type u} (p : α → Prop) [decidable_pred p] : List α → List α :=
  sorry

/-- `extractp p l` returns a pair of an element `a` of `l` satisfying the predicate
  `p`, and `l`, with `a` removed. If there is no such element `a` it returns `(none, l)`. -/
def extractp {α : Type u} (p : α → Prop) [decidable_pred p] : List α → Option α × List α :=
  sorry

/-- `revzip l` returns a list of pairs of the elements of `l` paired
  with the elements of `l` in reverse order.

`revzip [1,2,3,4,5] = [(1, 5), (2, 4), (3, 3), (4, 2), (5, 1)]`
 -/
def revzip {α : Type u} (l : List α) : List (α × α) :=
  zip l (reverse l)

/-- `product l₁ l₂` is the list of pairs `(a, b)` where `a ∈ l₁` and `b ∈ l₂`.

     product [1, 2] [5, 6] = [(1, 5), (1, 6), (2, 5), (2, 6)] -/
def product {α : Type u} {β : Type v} (l₁ : List α) (l₂ : List β) : List (α × β) :=
  list.bind l₁ fun (a : α) => map (Prod.mk a) l₂

/-- `sigma l₁ l₂` is the list of dependent pairs `(a, b)` where `a ∈ l₁` and `b ∈ l₂ a`.

     sigma [1, 2] (λ_, [(5 : ℕ), 6]) = [(1, 5), (1, 6), (2, 5), (2, 6)] -/
protected def sigma {α : Type u} {σ : α → Type u_1} (l₁ : List α) (l₂ : (a : α) → List (σ a)) : List (sigma fun (a : α) => σ a) :=
  list.bind l₁ fun (a : α) => map (sigma.mk a) (l₂ a)

/-- Auxliary definition used to define `of_fn`.

  `of_fn_aux f m h l` returns the first `m` elements of `of_fn f`
  appended to `l` -/
def of_fn_aux {α : Type u} {n : ℕ} (f : fin n → α) (m : ℕ) : m ≤ n → List α → List α :=
  sorry

/-- `of_fn f` with `f : fin n → α` returns the list whose ith element is `f i`
  `of_fun f = [f 0, f 1, ... , f(n - 1)]` -/
def of_fn {α : Type u} {n : ℕ} (f : fin n → α) : List α :=
  of_fn_aux f n sorry []

/-- `of_fn_nth_val f i` returns `some (f i)` if `i < n` and `none` otherwise. -/
def of_fn_nth_val {α : Type u} {n : ℕ} (f : fin n → α) (i : ℕ) : Option α :=
  dite (i < n) (fun (h : i < n) => some (f { val := i, property := h })) fun (h : ¬i < n) => none

/-- `disjoint l₁ l₂` means that `l₁` and `l₂` have no elements in common. -/
def disjoint {α : Type u} (l₁ : List α) (l₂ : List α) :=
  ∀ {a : α}, a ∈ l₁ → a ∈ l₂ → False

/-- `pairwise R l` means that all the elements with earlier indexes are
  `R`-related to all the elements with later indexes.

     pairwise R [1, 2, 3] ↔ R 1 2 ∧ R 1 3 ∧ R 2 3

  For example if `R = (≠)` then it asserts `l` has no duplicates,
  and if `R = (<)` then it asserts that `l` is (strictly) sorted. -/
inductive pairwise {α : Type u} (R : α → α → Prop) : List α → Prop
where
| nil : pairwise R []
| cons : ∀ {a : α} {l : List α}, (∀ (a' : α), a' ∈ l → R a a') → pairwise R l → pairwise R (a :: l)

@[simp] theorem pairwise_cons {α : Type u} {R : α → α → Prop} {a : α} {l : List α} : pairwise R (a :: l) ↔ (∀ (a' : α), a' ∈ l → R a a') ∧ pairwise R l := sorry

protected instance decidable_pairwise {α : Type u} {R : α → α → Prop} [DecidableRel R] (l : List α) : Decidable (pairwise R l) :=
  List.rec (is_true pairwise.nil)
    (fun (hd : α) (tl : List α) (ih : Decidable (pairwise R tl)) =>
      decidable_of_iff' ((∀ (a' : α), a' ∈ tl → R hd a') ∧ pairwise R tl) pairwise_cons)
    l

/-- `pw_filter R l` is a maximal sublist of `l` which is `pairwise R`.
  `pw_filter (≠)` is the erase duplicates function (cf. `erase_dup`), and `pw_filter (<)` finds
  a maximal increasing subsequence in `l`. For example,

     pw_filter (<) [0, 1, 5, 2, 6, 3, 4] = [0, 1, 2, 3, 4] -/
def pw_filter {α : Type u} (R : α → α → Prop) [DecidableRel R] : List α → List α :=
  sorry

/-- `chain R a l` means that `R` holds between adjacent elements of `a::l`.

     chain R a [b, c, d] ↔ R a b ∧ R b c ∧ R c d -/
inductive chain {α : Type u} (R : α → α → Prop) : α → List α → Prop
where
| nil : ∀ {a : α}, chain R a []
| cons : ∀ {a b : α} {l : List α}, R a b → chain R b l → chain R a (b :: l)

/-- `chain' R l` means that `R` holds between adjacent elements of `l`.

     chain' R [a, b, c, d] ↔ R a b ∧ R b c ∧ R c d -/
def chain' {α : Type u} (R : α → α → Prop) : List α → Prop :=
  sorry

@[simp] theorem chain_cons {α : Type u} {R : α → α → Prop} {a : α} {b : α} {l : List α} : chain R a (b :: l) ↔ R a b ∧ chain R b l := sorry

protected instance decidable_chain {α : Type u} {R : α → α → Prop} [DecidableRel R] (a : α) (l : List α) : Decidable (chain R a l) :=
  List.rec (fun (a : α) => eq.mpr sorry decidable.true)
    (fun (l_hd : α) (l_tl : List α) (l_ih : (a : α) → Decidable (chain R a l_tl)) (a : α) => eq.mpr sorry and.decidable) l
    a

protected instance decidable_chain' {α : Type u} {R : α → α → Prop} [DecidableRel R] (l : List α) : Decidable (chain' R l) :=
  list.cases_on l (id decidable.true) fun (l_hd : α) (l_tl : List α) => id (list.decidable_chain l_hd l_tl)

/-- `nodup l` means that `l` has no duplicates, that is, any element appears at most
  once in the list. It is defined as `pairwise (≠)`. -/
def nodup {α : Type u} : List α → Prop :=
  pairwise ne

protected instance nodup_decidable {α : Type u} [DecidableEq α] (l : List α) : Decidable (nodup l) :=
  list.decidable_pairwise

/-- `erase_dup l` removes duplicates from `l` (taking only the first occurrence).
  Defined as `pw_filter (≠)`.

     erase_dup [1, 0, 2, 2, 1] = [0, 2, 1] -/
def erase_dup {α : Type u} [DecidableEq α] : List α → List α :=
  pw_filter ne

/-- `range' s n` is the list of numbers `[s, s+1, ..., s+n-1]`.
  It is intended mainly for proving properties of `range` and `iota`. -/
@[simp] def range' : ℕ → ℕ → List ℕ :=
  sorry

/-- Drop `none`s from a list, and replace each remaining `some a` with `a`. -/
def reduce_option {α : Type u_1} : List (Option α) → List α :=
  filter_map id

/-- `ilast' x xs` returns the last element of `xs` if `xs` is non-empty;
it returns `x` otherwise -/
@[simp] def ilast' {α : Type u_1} : α → List α → α :=
  sorry

/-- `last' xs` returns the last element of `xs` if `xs` is non-empty;
it returns `none` otherwise -/
@[simp] def last' {α : Type u_1} : List α → Option α :=
  sorry

/-- `rotate l n` rotates the elements of `l` to the left by `n`

     rotate [0, 1, 2, 3, 4, 5] 2 = [2, 3, 4, 5, 0, 1] -/
def rotate {α : Type u} (l : List α) (n : ℕ) : List α :=
  sorry

/-- rotate' is the same as `rotate`, but slower. Used for proofs about `rotate`-/
def rotate' {α : Type u} : List α → ℕ → List α :=
  sorry

/-- Given a decidable predicate `p` and a proof of existence of `a ∈ l` such that `p a`,
choose the first element with this property. This version returns both `a` and proofs
of `a ∈ l` and `p a`. -/
def choose_x {α : Type u} (p : α → Prop) [decidable_pred p] (l : List α) (hp : ∃ (a : α), a ∈ l ∧ p a) : Subtype fun (a : α) => a ∈ l ∧ p a :=
  sorry

/-- Given a decidable predicate `p` and a proof of existence of `a ∈ l` such that `p a`,
choose the first element with this property. This version returns `a : α`, and properties
are given by `choose_mem` and `choose_property`. -/
def choose {α : Type u} (p : α → Prop) [decidable_pred p] (l : List α) (hp : ∃ (a : α), a ∈ l ∧ p a) : α :=
  ↑(choose_x p l hp)

/-- Filters and maps elements of a list -/
def mmap_filter {m : Type → Type v} [Monad m] {α : Type u_1} {β : Type} (f : α → m (Option β)) : List α → m (List β) :=
  sorry

/--
`mmap_upper_triangle f l` calls `f` on all elements in the upper triangular part of `l × l`.
That is, for each `e ∈ l`, it will run `f e e` and then `f e e'`
for each `e'` that appears after `e` in `l`.

Example: suppose `l = [1, 2, 3]`. `mmap_upper_triangle f l` will produce the list
`[f 1 1, f 1 2, f 1 3, f 2 2, f 2 3, f 3 3]`.
-/
def mmap_upper_triangle {m : Type u → Type u_1} [Monad m] {α : Type u} {β : Type u} (f : α → α → m β) : List α → m (List β) :=
  sorry

/--
`mmap'_diag f l` calls `f` on all elements in the upper triangular part of `l × l`.
That is, for each `e ∈ l`, it will run `f e e` and then `f e e'`
for each `e'` that appears after `e` in `l`.

Example: suppose `l = [1, 2, 3]`. `mmap'_diag f l` will evaluate, in this order,
`f 1 1`, `f 1 2`, `f 1 3`, `f 2 2`, `f 2 3`, `f 3 3`.
-/
def mmap'_diag {m : Type → Type u_1} [Monad m] {α : Type u_2} (f : α → α → m Unit) : List α → m Unit :=
  sorry

protected def traverse {F : Type u → Type v} [Applicative F] {α : Type u_1} {β : Type u} (f : α → F β) : List α → F (List β) :=
  sorry

/-- `get_rest l l₁` returns `some l₂` if `l = l₁ ++ l₂`.
  If `l₁` is not a prefix of `l`, returns `none` -/
def get_rest {α : Type u} [DecidableEq α] : List α → List α → Option (List α) :=
  sorry

/--
`list.slice n m xs` removes a slice of length `m` at index `n` in list `xs`.
-/
def slice {α : Type u_1} : ℕ → ℕ → List α → List α :=
  sorry

/--
Left-biased version of `list.map₂`. `map₂_left' f as bs` applies `f` to each
pair of elements `aᵢ ∈ as` and `bᵢ ∈ bs`. If `bs` is shorter than `as`, `f` is
applied to `none` for the remaining `aᵢ`. Returns the results of the `f`
applications and the remaining `bs`.

```
map₂_left' prod.mk [1, 2] ['a'] = ([(1, some 'a'), (2, none)], [])

map₂_left' prod.mk [1] ['a', 'b'] = ([(1, some 'a')], ['b'])
```
-/
@[simp] def map₂_left' {α : Type u} {β : Type v} {γ : Type w} (f : α → Option β → γ) : List α → List β → List γ × List β :=
  sorry

/--
Right-biased version of `list.map₂`. `map₂_right' f as bs` applies `f` to each
pair of elements `aᵢ ∈ as` and `bᵢ ∈ bs`. If `as` is shorter than `bs`, `f` is
applied to `none` for the remaining `bᵢ`. Returns the results of the `f`
applications and the remaining `as`.

```
map₂_right' prod.mk [1] ['a', 'b'] = ([(some 1, 'a'), (none, 'b')], [])

map₂_right' prod.mk [1, 2] ['a'] = ([(some 1, 'a')], [2])
```
-/
def map₂_right' {α : Type u} {β : Type v} {γ : Type w} (f : Option α → β → γ) (as : List α) (bs : List β) : List γ × List α :=
  map₂_left' (flip f) bs as

/--
Left-biased version of `list.zip`. `zip_left' as bs` returns the list of
pairs `(aᵢ, bᵢ)` for `aᵢ ∈ as` and `bᵢ ∈ bs`. If `bs` is shorter than `as`, the
remaining `aᵢ` are paired with `none`. Also returns the remaining `bs`.

```
zip_left' [1, 2] ['a'] = ([(1, some 'a'), (2, none)], [])

zip_left' [1] ['a', 'b'] = ([(1, some 'a')], ['b'])

zip_left' = map₂_left' prod.mk

```
-/
def zip_left' {α : Type u} {β : Type v} : List α → List β → List (α × Option β) × List β :=
  map₂_left' Prod.mk

/--
Right-biased version of `list.zip`. `zip_right' as bs` returns the list of
pairs `(aᵢ, bᵢ)` for `aᵢ ∈ as` and `bᵢ ∈ bs`. If `as` is shorter than `bs`, the
remaining `bᵢ` are paired with `none`. Also returns the remaining `as`.

```
zip_right' [1] ['a', 'b'] = ([(some 1, 'a'), (none, 'b')], [])

zip_right' [1, 2] ['a'] = ([(some 1, 'a')], [2])

zip_right' = map₂_right' prod.mk
```
-/
def zip_right' {α : Type u} {β : Type v} : List α → List β → List (Option α × β) × List α :=
  map₂_right' Prod.mk

/--
Left-biased version of `list.map₂`. `map₂_left f as bs` applies `f` to each pair
`aᵢ ∈ as` and `bᵢ ∈ bs`. If `bs` is shorter than `as`, `f` is applied to `none`
for the remaining `aᵢ`.

```
map₂_left prod.mk [1, 2] ['a'] = [(1, some 'a'), (2, none)]

map₂_left prod.mk [1] ['a', 'b'] = [(1, some 'a')]

map₂_left f as bs = (map₂_left' f as bs).fst
```
-/
@[simp] def map₂_left {α : Type u} {β : Type v} {γ : Type w} (f : α → Option β → γ) : List α → List β → List γ :=
  sorry

/--
Right-biased version of `list.map₂`. `map₂_right f as bs` applies `f` to each
pair `aᵢ ∈ as` and `bᵢ ∈ bs`. If `as` is shorter than `bs`, `f` is applied to
`none` for the remaining `bᵢ`.

```
map₂_right prod.mk [1, 2] ['a'] = [(some 1, 'a')]

map₂_right prod.mk [1] ['a', 'b'] = [(some 1, 'a'), (none, 'b')]

map₂_right f as bs = (map₂_right' f as bs).fst
```
-/
def map₂_right {α : Type u} {β : Type v} {γ : Type w} (f : Option α → β → γ) (as : List α) (bs : List β) : List γ :=
  map₂_left (flip f) bs as

/--
Left-biased version of `list.zip`. `zip_left as bs` returns the list of pairs
`(aᵢ, bᵢ)` for `aᵢ ∈ as` and `bᵢ ∈ bs`. If `bs` is shorter than `as`, the
remaining `aᵢ` are paired with `none`.

```
zip_left [1, 2] ['a'] = [(1, some 'a'), (2, none)]

zip_left [1] ['a', 'b'] = [(1, some 'a')]

zip_left = map₂_left prod.mk
```
-/
def zip_left {α : Type u} {β : Type v} : List α → List β → List (α × Option β) :=
  map₂_left Prod.mk

/--
Right-biased version of `list.zip`. `zip_right as bs` returns the list of pairs
`(aᵢ, bᵢ)` for `aᵢ ∈ as` and `bᵢ ∈ bs`. If `as` is shorter than `bs`, the
remaining `bᵢ` are paired with `none`.

```
zip_right [1, 2] ['a'] = [(some 1, 'a')]

zip_right [1] ['a', 'b'] = [(some 1, 'a'), (none, 'b')]

zip_right = map₂_right prod.mk
```
-/
def zip_right {α : Type u} {β : Type v} : List α → List β → List (Option α × β) :=
  map₂_right Prod.mk

/--
If all elements of `xs` are `some xᵢ`, `all_some xs` returns the `xᵢ`. Otherwise
it returns `none`.

```
all_some [some 1, some 2] = some [1, 2]
all_some [some 1, none  ] = none
```
-/
def all_some {α : Type u} : List (Option α) → Option (List α) :=
  sorry

/--
`fill_nones xs ys` replaces the `none`s in `xs` with elements of `ys`. If there
are not enough `ys` to replace all the `none`s, the remaining `none`s are
dropped from `xs`.

```
fill_nones [none, some 1, none, none] [2, 3] = [2, 1, 3]
```
-/
def fill_nones {α : Type u_1} : List (Option α) → List α → List α :=
  sorry

/--
`take_list as ns` extracts successive sublists from `as`. For `ns = n₁ ... nₘ`,
it first takes the `n₁` initial elements from `as`, then the next `n₂` ones,
etc. It returns the sublists of `as` -- one for each `nᵢ` -- and the remaining
elements of `as`. If `as` does not have at least as many elements as the sum of
the `nᵢ`, the corresponding sublists will have less than `nᵢ` elements.

```
take_list ['a', 'b', 'c', 'd', 'e'] [2, 1, 1] = ([['a', 'b'], ['c'], ['d']], ['e'])
take_list ['a', 'b'] [3, 1] = ([['a', 'b'], []], [])
```
-/
def take_list {α : Type u_1} : List α → List ℕ → List (List α) × List α :=
  sorry

/--
`to_rbmap as` is the map that associates each index `i` of `as` with the
corresponding element of `as`.

```
to_rbmap ['a', 'b', 'c'] = rbmap_of [(0, 'a'), (1, 'b'), (2, 'c')]
```
-/
def to_rbmap {α : Type u} : List α → rbmap ℕ α :=
  foldl_with_index (fun (i : ℕ) (mapp : rbmap ℕ α) (a : α) => rbmap.insert mapp i a) (mk_rbmap ℕ α)


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Markus Himmel
-/
import category_theory.limits.shapes.equalizers
import category_theory.limits.shapes.pullbacks
import category_theory.limits.shapes.strong_epi

/-!
# Categorical images

We define the categorical image of `f` as a factorisation `f = e ≫ m` through a monomorphism `m`,
so that `m` factors through the `m'` in any other such factorisation.

## Main definitions

* A `mono_factorisation` is a factorisation `f = e ≫ m`, where `m` is a monomorphism
* `is_image F` means that a given mono factorisation `F` has the universal property of the image.
* `has_image f` means that we have chosen an image for the morphism `f : X ⟶ Y`.
  * In this case, `image f` is the image object, `image.ι f : image f ⟶ Y` is the monomorphism `m`
    of the factorisation and `factor_thru_image f : X ⟶ image f` is the morphism `e`.
* `has_images C` means that every morphism in `C` has an image.
* Let `f : X ⟶ Y` and `g : P ⟶ Q` be morphisms in `C`, which we will represent as objects of the
  arrow category `arrow C`. Then `sq : f ⟶ g` is a commutative square in `C`. If `f` and `g` have
  images, then `has_image_map sq` represents the fact that there is a morphism
  `i : image f ⟶ image g` making the diagram

  X ----→ image f ----→ Y
  |         |           |
  |         |           |
  ↓         ↓           ↓
  P ----→ image g ----→ Q

  commute, where the top row is the image factorisation of `f`, the bottom row is the image
  factorisation of `g`, and the outer rectangle is the commutative square `sq`.
* If a category `has_images`, then `has_image_maps` means that every commutative square admits an
  image map.
* If a category `has_images`, then `has_strong_epi_images` means that the morphism to the image is
  always a strong epimorphism.

## Main statements

* When `C` has equalizers, the morphism `e` appearing in an image factorisation is an epimorphism.
* When `C` has strong epi images, then these images admit image maps.

## Future work
* TODO: coimages, and abelian categories.
* TODO: connect this with existing working in the group theory and ring theory libraries.

-/

noncomputable theory

universes v u

open category_theory
open category_theory.limits.walking_parallel_pair

namespace category_theory.limits

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

variables {X Y : C} (f : X ⟶ Y)

/-- A factorisation of a morphism `f = e ≫ m`, with `m` monic. -/
structure mono_factorisation (f : X ⟶ Y) :=
(I : C)
(m : I ⟶ Y)
[m_mono : mono m]
(e : X ⟶ I)
(fac' : e ≫ m = f . obviously)

restate_axiom mono_factorisation.fac'
attribute [simp, reassoc] mono_factorisation.fac
attribute [instance] mono_factorisation.m_mono

attribute [instance] mono_factorisation.m_mono

namespace mono_factorisation

/-- The obvious factorisation of a monomorphism through itself. -/
def self [mono f] : mono_factorisation f :=
{ I := X,
  m := f,
  e := 𝟙 X }

-- I'm not sure we really need this, but the linter says that an inhabited instance
-- ought to exist...
instance [mono f] : inhabited (mono_factorisation f) := ⟨self f⟩

variables {f}

/-- The morphism `m` in a factorisation `f = e ≫ m` through a monomorphism is uniquely
determined. -/
@[ext]
lemma ext
  {F F' : mono_factorisation f} (hI : F.I = F'.I) (hm : F.m = (eq_to_hom hI) ≫ F'.m) : F = F' :=
begin
  cases F, cases F',
  cases hI,
  simp at hm,
  dsimp at F_fac' F'_fac',
  congr,
  { assumption },
  { resetI, apply (cancel_mono F_m).1,
    rw [F_fac', hm, F'_fac'], }
end

/-- Any mono factorisation of `f` gives a mono factorisation of `f ≫ g` when `g` is a mono. -/
@[simps]
def comp_mono (F : mono_factorisation f) {Y' : C} (g : Y ⟶ Y') [mono g] :
  mono_factorisation (f ≫ g) :=
{ I := F.I,
  m := F.m ≫ g,
  m_mono := mono_comp _ _,
  e := F.e, }

/-- A mono factorisation of `f ≫ g`, where `g` is an isomorphism,
gives a mono factorisation of `f`. -/
@[simps]
def of_comp_iso {Y' : C} {g : Y ⟶ Y'} [is_iso g] (F : mono_factorisation (f ≫ g)) :
  mono_factorisation f :=
{ I := F.I,
  m := F.m ≫ (inv g),
  m_mono := mono_comp _ _,
  e := F.e, }

/-- Any mono factorisation of `f` gives a mono factorisation of `g ≫ f`. -/
@[simps]
def iso_comp (F : mono_factorisation f) {X' : C} (g : X' ⟶ X) :
  mono_factorisation (g ≫ f) :=
{ I := F.I,
  m := F.m,
  e := g ≫ F.e, }

/-- A mono factorisation of `g ≫ f`, where `g` is an isomorphism,
gives a mono factorisation of `f`. -/
@[simps]
def of_iso_comp {X' : C} (g : X' ⟶ X) [is_iso g] (F : mono_factorisation (g ≫ f)) :
  mono_factorisation f :=
{ I := F.I,
  m := F.m,
  e := inv g ≫ F.e, }

end mono_factorisation

variable {f}

/-- Data exhibiting that a given factorisation through a mono is initial. -/
structure is_image (F : mono_factorisation f) :=
(lift : Π (F' : mono_factorisation f), F.I ⟶ F'.I)
(lift_fac' : Π (F' : mono_factorisation f), lift F' ≫ F'.m = F.m . obviously)

restate_axiom is_image.lift_fac'
attribute [simp, reassoc] is_image.lift_fac

@[simp, reassoc] lemma is_image.fac_lift {F : mono_factorisation f} (hF : is_image F)
  (F' : mono_factorisation f) : F.e ≫ hF.lift F' = F'.e :=
(cancel_mono F'.m).1 $ by simp

variable (f)

namespace is_image

/-- The trivial factorisation of a monomorphism satisfies the universal property. -/
@[simps]
def self [mono f] : is_image (mono_factorisation.self f) :=
{ lift := λ F', F'.e }

instance [mono f] : inhabited (is_image (mono_factorisation.self f)) :=
⟨self f⟩

variable {f}
/-- Two factorisations through monomorphisms satisfying the universal property
must factor through isomorphic objects. -/
-- TODO this is another good candidate for a future `unique_up_to_canonical_iso`.
@[simps]
def iso_ext {F F' : mono_factorisation f} (hF : is_image F) (hF' : is_image F') : F.I ≅ F'.I :=
{ hom := hF.lift F',
  inv := hF'.lift F,
  hom_inv_id' := (cancel_mono F.m).1 (by simp),
  inv_hom_id' := (cancel_mono F'.m).1 (by simp) }

variables {F F' : mono_factorisation f} (hF : is_image F) (hF' : is_image F')

lemma iso_ext_hom_m : (iso_ext hF hF').hom ≫ F'.m = F.m := by simp
lemma iso_ext_inv_m : (iso_ext hF hF').inv ≫ F.m = F'.m := by simp
lemma e_iso_ext_hom : F.e ≫ (iso_ext hF hF').hom = F'.e := by simp
lemma e_iso_ext_inv : F'.e ≫ (iso_ext hF hF').inv = F.e := by simp

end is_image

/-- Data exhibiting that a morphism `f` has an image. -/
structure image_factorisation (f : X ⟶ Y) :=
(F : mono_factorisation f)
(is_image : is_image F)

instance inhabited_image_factorisation (f : X ⟶ Y) [mono f] : inhabited (image_factorisation f) :=
⟨⟨_, is_image.self f⟩⟩

/-- `has_image f` means that there exists an image factorisation of `f`. -/
class has_image (f : X ⟶ Y) : Prop :=
mk' :: (exists_image : nonempty (image_factorisation f))

lemma has_image.mk {f : X ⟶ Y} (F : image_factorisation f) : has_image f :=
⟨nonempty.intro F⟩

section
variable [has_image f]

/-- The chosen factorisation of `f` through a monomorphism. -/
def image.mono_factorisation : mono_factorisation f :=
(classical.choice (has_image.exists_image)).F

/-- The witness of the universal property for the chosen factorisation of `f` through
a monomorphism. -/
def image.is_image : is_image (image.mono_factorisation f) :=
(classical.choice (has_image.exists_image)).is_image

/-- The categorical image of a morphism. -/
def image : C := (image.mono_factorisation f).I
/-- The inclusion of the image of a morphism into the target. -/
def image.ι : image f ⟶ Y := (image.mono_factorisation f).m
@[simp] lemma image.as_ι : (image.mono_factorisation f).m = image.ι f := rfl
instance : mono (image.ι f) := (image.mono_factorisation f).m_mono

/-- The map from the source to the image of a morphism. -/
def factor_thru_image : X ⟶ image f := (image.mono_factorisation f).e
/-- Rewrite in terms of the `factor_thru_image` interface. -/
@[simp]
lemma as_factor_thru_image : (image.mono_factorisation f).e = factor_thru_image f := rfl
@[simp, reassoc]
lemma image.fac : factor_thru_image f ≫ image.ι f = f := (image.mono_factorisation f).fac'

variable {f}

/-- Any other factorisation of the morphism `f` through a monomorphism receives a map from the
image. -/
def image.lift (F' : mono_factorisation f) : image f ⟶ F'.I := (image.is_image f).lift F'
@[simp, reassoc]
lemma image.lift_fac (F' : mono_factorisation f) : image.lift F' ≫ F'.m = image.ι f :=
(image.is_image f).lift_fac' F'
@[simp, reassoc]
lemma image.fac_lift (F' : mono_factorisation f) : factor_thru_image f ≫ image.lift F' = F'.e :=
(image.is_image f).fac_lift F'

@[simp, reassoc]
lemma is_image.lift_ι {F : mono_factorisation f} (hF : is_image F) :
  hF.lift (image.mono_factorisation f) ≫ image.ι f = F.m :=
hF.lift_fac _

-- TODO we could put a category structure on `mono_factorisation f`,
-- with the morphisms being `g : I ⟶ I'` commuting with the `m`s
-- (they then automatically commute with the `e`s)
-- and show that an `image_of f` gives an initial object there
-- (uniqueness of the lift comes for free).

instance lift_mono (F' : mono_factorisation f) : mono (image.lift F') :=
by { apply mono_of_mono _ F'.m, simpa using mono_factorisation.m_mono _ }

lemma has_image.uniq
  (F' : mono_factorisation f) (l : image f ⟶ F'.I) (w : l ≫ F'.m = image.ι f) :
  l = image.lift F' :=
(cancel_mono F'.m).1 (by simp [w])

/-- If `has_image g`, then `has_image (f ≫ g)` when `f` is an isomorphism. -/
instance {X Y Z : C} (f : X ⟶ Y) [is_iso f] (g : Y ⟶ Z) [has_image g] : has_image (f ≫ g) :=
{ exists_image := ⟨{
  F :=
  { I := image g,
    m := image.ι g,
    e := f ≫ factor_thru_image g, },
  is_image := { lift := λ F', image.lift { I := F'.I, m := F'.m, e := inv f ≫ F'.e, }, }, }⟩ }

end

section
variables (C)

/-- `has_images` represents a choice of image for every morphism -/
class has_images :=
(has_image : Π {X Y : C} (f : X ⟶ Y), has_image f)

attribute [instance, priority 100] has_images.has_image
end

section
variables (f) [has_image f]
/-- The image of a monomorphism is isomorphic to the source. -/
def image_mono_iso_source [mono f] : image f ≅ X :=
is_image.iso_ext (image.is_image f) (is_image.self f)

@[simp, reassoc]
lemma image_mono_iso_source_inv_ι [mono f] : (image_mono_iso_source f).inv ≫ image.ι f = f :=
by simp [image_mono_iso_source]
@[simp, reassoc]
lemma image_mono_iso_source_hom_self [mono f] : (image_mono_iso_source f).hom ≫ f = image.ι f :=
begin
  conv { to_lhs, congr, skip, rw ←image_mono_iso_source_inv_ι f, },
  rw [←category.assoc, iso.hom_inv_id, category.id_comp],
end

-- This is the proof that `factor_thru_image f` is an epimorphism
-- from https://en.wikipedia.org/wiki/Image_%28category_theory%29, which is in turn taken from:
-- Mitchell, Barry (1965), Theory of categories, MR 0202787, p.12, Proposition 10.1
@[ext]
lemma image.ext {W : C} {g h : image f ⟶ W} [has_limit (parallel_pair g h)]
  (w : factor_thru_image f ≫ g = factor_thru_image f ≫ h) :
  g = h :=
begin
  let q := equalizer.ι g h,
  let e' := equalizer.lift _ w,
  let F' : mono_factorisation f :=
  { I := equalizer g h,
    m := q ≫ image.ι f,
    m_mono := by apply mono_comp,
    e := e' },
  let v := image.lift F',
  have t₀ : v ≫ q ≫ image.ι f = image.ι f := image.lift_fac F',
  have t : v ≫ q = 𝟙 (image f) :=
    (cancel_mono_id (image.ι f)).1 (by { convert t₀ using 1, rw category.assoc }),
  -- The proof from wikipedia next proves `q ≫ v = 𝟙 _`,
  -- and concludes that `equalizer g h ≅ image f`,
  -- but this isn't necessary.
  calc g = 𝟙 (image f) ≫ g : by rw [category.id_comp]
     ... = v ≫ q ≫ g       : by rw [←t, category.assoc]
     ... = v ≫ q ≫ h       : by rw [equalizer.condition g h]
     ... = 𝟙 (image f) ≫ h : by rw [←category.assoc, t]
     ... = h                : by rw [category.id_comp]
end

instance [Π {Z : C} (g h : image f ⟶ Z), has_limit (parallel_pair g h)] :
  epi (factor_thru_image f) :=
⟨λ Z g h w, image.ext f w⟩

lemma epi_image_of_epi {X Y : C} (f : X ⟶ Y) [has_image f] [E : epi f] : epi (image.ι f) :=
begin
  rw ←image.fac f at E,
  resetI,
  exact epi_of_epi (factor_thru_image f) (image.ι f),
end

lemma epi_of_epi_image {X Y : C} (f : X ⟶ Y) [has_image f]
  [epi (image.ι f)] [epi (factor_thru_image f)] : epi f :=
by { rw [←image.fac f], apply epi_comp, }

end

section
variables {f} {f' : X ⟶ Y} [has_image f] [has_image f']

/--
An equation between morphisms gives a comparison map between the images
(which momentarily we prove is an iso).
-/
def image.eq_to_hom (h : f = f') : image f ⟶ image f' :=
image.lift
{ I := image f',
  m := image.ι f',
  e := factor_thru_image f', }.

instance (h : f = f') : is_iso (image.eq_to_hom h) :=
⟨⟨image.eq_to_hom h.symm,
  ⟨(cancel_mono (image.ι f)).1 (by simp [image.eq_to_hom]),
   (cancel_mono (image.ι f')).1 (by simp [image.eq_to_hom])⟩⟩⟩

/-- An equation between morphisms gives an isomorphism between the images. -/
def image.eq_to_iso (h : f = f') : image f ≅ image f' := as_iso (image.eq_to_hom h)

/--
As long as the category has equalizers,
the image inclusion maps commute with `image.eq_to_iso`.
-/
lemma image.eq_fac [has_equalizers C] (h : f = f') :
  image.ι f = (image.eq_to_iso h).hom ≫ image.ι f' :=
by { ext, simp [image.eq_to_iso, image.eq_to_hom], }

end

section
variables {Z : C} (g : Y ⟶ Z)

/-- The comparison map `image (f ≫ g) ⟶ image g`. -/
def image.pre_comp [has_image g] [has_image (f ≫ g)] : image (f ≫ g) ⟶ image g :=
image.lift
{ I := image g,
  m := image.ι g,
  e := f ≫ factor_thru_image g }

@[simp, reassoc]
lemma image.pre_comp_ι [has_image g] [has_image (f ≫ g)] :
  image.pre_comp f g ≫ image.ι g = image.ι (f ≫ g) :=
by simp [image.pre_comp]

@[simp, reassoc]
lemma image.factor_thru_image_pre_comp [has_image g] [has_image (f ≫ g)] :
  factor_thru_image (f ≫ g) ≫ image.pre_comp f g = f ≫ factor_thru_image g :=
by simp [image.pre_comp]

/--
`image.pre_comp f g` is a monomorphism.
-/
instance image.pre_comp_mono [has_image g] [has_image (f ≫ g)] : mono (image.pre_comp f g) :=
begin
  apply mono_of_mono _ (image.ι g),
  simp only [image.pre_comp_ι],
  apply_instance,
end

/--
The two step comparison map
  `image (f ≫ (g ≫ h)) ⟶ image (g ≫ h) ⟶ image h`
agrees with the one step comparison map
  `image (f ≫ (g ≫ h)) ≅ image ((f ≫ g) ≫ h) ⟶ image h`.
 -/
lemma image.pre_comp_comp {W : C} (h : Z ⟶ W)
  [has_image (g ≫ h)] [has_image (f ≫ g ≫ h)]
  [has_image h] [has_image ((f ≫ g) ≫ h)] :
  image.pre_comp f (g ≫ h) ≫ image.pre_comp g h =
    image.eq_to_hom (category.assoc f g h).symm ≫ (image.pre_comp (f ≫ g) h) :=
begin
  apply (cancel_mono (image.ι h)).1,
  simp [image.pre_comp, image.eq_to_hom],
end

variables [has_equalizers C]

instance has_image_iso_comp [is_iso f] [has_image g] : has_image (f ≫ g) :=
has_image.mk
{ F := (image.mono_factorisation g).iso_comp f,
  is_image := { lift := λ F', image.lift (F'.of_iso_comp f) }, }

/--
`image.pre_comp f g` is an isomorphism when `f` is an isomorphism
(we need `C` to have equalizers to prove this).
-/
instance image.is_iso_precomp_iso (f : X ⟶ Y) [is_iso f] [has_image g] :
  is_iso (image.pre_comp f g) :=
⟨⟨image.lift
  { I := image (f ≫ g),
    m := image.ι (f ≫ g),
    e := inv f ≫ factor_thru_image (f ≫ g) },
  ⟨by { ext, simp [image.pre_comp], }, by { ext, simp [image.pre_comp], }⟩⟩⟩

-- Note that in general we don't have the other comparison map you might expect
-- `image f ⟶ image (f ≫ g)`.

instance has_image_comp_iso [has_image f] [is_iso g] : has_image (f ≫ g) :=
has_image.mk
{ F := (image.mono_factorisation f).comp_mono g,
  is_image := { lift := λ F', image.lift F'.of_comp_iso }, }

/-- Postcomposing by an isomorphism induces an isomorphism on the image. -/
def image.comp_iso [has_image f] [is_iso g] :
  image f ≅ image (f ≫ g) :=
{ hom := image.lift (image.mono_factorisation (f ≫ g)).of_comp_iso,
  inv := image.lift ((image.mono_factorisation f).comp_mono g) }

@[simp, reassoc] lemma image.comp_iso_hom_comp_image_ι [has_image f] [is_iso g] :
  (image.comp_iso f g).hom ≫ image.ι (f ≫ g) = image.ι f ≫ g :=
by { ext, simp [image.comp_iso] }

@[simp, reassoc] lemma image.comp_iso_inv_comp_image_ι [has_image f] [is_iso g] :
  (image.comp_iso f g).inv ≫ image.ι f = image.ι (f ≫ g) ≫ inv g :=
by { ext, simp [image.comp_iso] }

end

end category_theory.limits

namespace category_theory.limits

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

section

instance {X Y : C} (f : X ⟶ Y) [has_image f] : has_image (arrow.mk f).hom :=
show has_image f, by apply_instance

end

section has_image_map

/-- An image map is a morphism `image f → image g` fitting into a commutative square and satisfying
    the obvious commutativity conditions. -/
structure image_map {f g : arrow C} [has_image f.hom] [has_image g.hom] (sq : f ⟶ g) :=
(map : image f.hom ⟶ image g.hom)
(map_ι' : map ≫ image.ι g.hom = image.ι f.hom ≫ sq.right . obviously)

instance inhabited_image_map {f : arrow C} [has_image f.hom] : inhabited (image_map (𝟙 f)) :=
⟨⟨𝟙 _, by tidy⟩⟩

restate_axiom image_map.map_ι'
attribute [simp, reassoc] image_map.map_ι

@[simp, reassoc]
lemma image_map.factor_map {f g : arrow C} [has_image f.hom] [has_image g.hom] (sq : f ⟶ g)
  (m : image_map sq) :
  factor_thru_image f.hom ≫ m.map = sq.left ≫ factor_thru_image g.hom :=
(cancel_mono (image.ι g.hom)).1 $ by simp

/-- To give an image map for a commutative square with `f` at the top and `g` at the bottom, it
    suffices to give a map between any mono factorisation of `f` and any image factorisation of
    `g`. -/
def image_map.transport {f g : arrow C} [has_image f.hom] [has_image g.hom] (sq : f ⟶ g)
  (F : mono_factorisation f.hom) {F' : mono_factorisation g.hom} (hF' : is_image F')
  {map : F.I ⟶ F'.I} (map_ι : map ≫ F'.m = F.m ≫ sq.right) : image_map sq :=
{ map := image.lift F ≫ map ≫ hF'.lift (image.mono_factorisation g.hom),
  map_ι' := by simp [map_ι] }

/-- `has_image_map sq` means that there is an `image_map` for the square `sq`. -/
class has_image_map {f g : arrow C} [has_image f.hom] [has_image g.hom] (sq : f ⟶ g) : Prop :=
mk' :: (has_image_map : nonempty (image_map sq))

lemma has_image_map.mk {f g : arrow C} [has_image f.hom] [has_image g.hom] {sq : f ⟶ g}
  (m : image_map sq) : has_image_map sq :=
⟨nonempty.intro m⟩

lemma has_image_map.transport {f g : arrow C} [has_image f.hom] [has_image g.hom] (sq : f ⟶ g)
  (F : mono_factorisation f.hom) {F' : mono_factorisation g.hom} (hF' : is_image F')
  (map : F.I ⟶ F'.I) (map_ι : map ≫ F'.m = F.m ≫ sq.right) : has_image_map sq :=
has_image_map.mk $ image_map.transport sq F hF' map_ι

/-- Obtain an `image_map` from a `has_image_map` instance. -/
def has_image_map.image_map {f g : arrow C} [has_image f.hom] [has_image g.hom] (sq : f ⟶ g)
  [has_image_map sq] : image_map sq :=
classical.choice $ @has_image_map.has_image_map _ _ _ _ _ _ sq _

variables {f g : arrow C} [has_image f.hom] [has_image g.hom] (sq : f ⟶ g)

section
local attribute [ext] image_map

instance : subsingleton (image_map sq) :=
subsingleton.intro $ λ a b, image_map.ext a b $ (cancel_mono (image.ι g.hom)).1 $
  by simp only [image_map.map_ι]

end

variable [has_image_map sq]

/-- The map on images induced by a commutative square. -/
abbreviation image.map : image f.hom ⟶ image g.hom :=
(has_image_map.image_map sq).map

lemma image.factor_map :
  factor_thru_image f.hom ≫ image.map sq = sq.left ≫ factor_thru_image g.hom :=
by simp
lemma image.map_ι : image.map sq ≫ image.ι g.hom = image.ι f.hom ≫ sq.right :=
by simp
lemma image.map_hom_mk'_ι {X Y P Q : C} {k : X ⟶ Y} [has_image k] {l : P ⟶ Q} [has_image l]
  {m : X ⟶ P} {n : Y ⟶ Q} (w : m ≫ l = k ≫ n) [has_image_map (arrow.hom_mk' w)] :
  image.map (arrow.hom_mk' w) ≫ image.ι l = image.ι k ≫ n :=
image.map_ι _

section
variables {h : arrow C} [has_image h.hom] (sq' : g ⟶ h)
variables [has_image_map sq']

/-- Image maps for composable commutative squares induce an image map in the composite square. -/
def image_map_comp : image_map (sq ≫ sq') :=
{ map := image.map sq ≫ image.map sq' }

@[simp]
lemma image.map_comp [has_image_map (sq ≫ sq')] :
  image.map (sq ≫ sq') = image.map sq ≫ image.map sq' :=
show (has_image_map.image_map (sq ≫ sq')).map = (image_map_comp sq sq').map, by congr

end

section
variables (f)

/-- The identity `image f ⟶ image f` fits into the commutative square represented by the identity
    morphism `𝟙 f` in the arrow category. -/
def image_map_id : image_map (𝟙 f) :=
{ map := 𝟙 (image f.hom) }

@[simp]
lemma image.map_id [has_image_map (𝟙 f)] : image.map (𝟙 f) = 𝟙 (image f.hom) :=
show (has_image_map.image_map (𝟙 f)).map = (image_map_id f).map, by congr

end

end has_image_map

section
variables (C) [has_images C]

/-- If a category `has_image_maps`, then all commutative squares induce morphisms on images. -/
class has_image_maps :=
(has_image_map : Π {f g : arrow C} (st : f ⟶ g), has_image_map st)

attribute [instance, priority 100] has_image_maps.has_image_map

end

section has_image_maps
variables [has_images C] [has_image_maps C]

/-- The functor from the arrow category of `C` to `C` itself that maps a morphism to its image
    and a commutative square to the induced morphism on images. -/
@[simps]
def im : arrow C ⥤ C :=
{ obj := λ f, image f.hom,
  map := λ _ _ st, image.map st }

end has_image_maps

section strong_epi_mono_factorisation

/-- A strong epi-mono factorisation is a decomposition `f = e ≫ m` with `e` a strong epimorphism
    and `m` a monomorphism. -/
structure strong_epi_mono_factorisation {X Y : C} (f : X ⟶ Y) extends mono_factorisation f :=
[e_strong_epi : strong_epi e]

attribute [instance] strong_epi_mono_factorisation.e_strong_epi

/-- Satisfying the inhabited linter -/
instance strong_epi_mono_factorisation_inhabited {X Y : C} (f : X ⟶ Y) [strong_epi f] :
  inhabited (strong_epi_mono_factorisation f) :=
⟨⟨⟨Y, 𝟙 Y, f, by simp⟩⟩⟩

/-- A mono factorisation coming from a strong epi-mono factorisation always has the universal
    property of the image. -/
def strong_epi_mono_factorisation.to_mono_is_image {X Y : C} {f : X ⟶ Y}
  (F : strong_epi_mono_factorisation f) : is_image F.to_mono_factorisation :=
{ lift := λ G, arrow.lift $ arrow.hom_mk' $
    show G.e ≫ G.m = F.e ≫ F.m, by rw [F.to_mono_factorisation.fac, G.fac] }

variable (C)

/-- A category has strong epi-mono factorisations if every morphism admits a strong epi-mono
    factorisation. -/
class has_strong_epi_mono_factorisations : Prop :=
mk' :: (has_fac : Π {X Y : C} (f : X ⟶ Y), nonempty (strong_epi_mono_factorisation f))

variable {C}

lemma has_strong_epi_mono_factorisations.mk
  (d : Π {X Y : C} (f : X ⟶ Y), strong_epi_mono_factorisation f) :
  has_strong_epi_mono_factorisations C :=
⟨λ X Y f, nonempty.intro $ d f⟩

@[priority 100]
instance has_images_of_has_strong_epi_mono_factorisations
  [has_strong_epi_mono_factorisations C] : has_images C :=
{ has_image := λ X Y f,
  let F' := classical.choice (has_strong_epi_mono_factorisations.has_fac f) in
  has_image.mk { F := F'.to_mono_factorisation,
                 is_image := F'.to_mono_is_image } }

end strong_epi_mono_factorisation

section has_strong_epi_images
variables (C) [has_images C]

/-- A category has strong epi images if it has all images and `factor_thru_image f` is a strong
    epimorphism for all `f`. -/
class has_strong_epi_images : Prop :=
(strong_factor_thru_image : Π {X Y : C} (f : X ⟶ Y), strong_epi (factor_thru_image f))

attribute [instance] has_strong_epi_images.strong_factor_thru_image
end has_strong_epi_images

section has_strong_epi_images

/-- If there is a single strong epi-mono factorisation of `f`, then every image factorisation is a
    strong epi-mono factorisation. -/
lemma strong_epi_of_strong_epi_mono_factorisation {X Y : C} {f : X ⟶ Y}
  (F : strong_epi_mono_factorisation f) {F' : mono_factorisation f} (hF' : is_image F') :
  strong_epi F'.e :=
by { rw ←is_image.e_iso_ext_hom F.to_mono_is_image hF', apply strong_epi_comp }

lemma strong_epi_factor_thru_image_of_strong_epi_mono_factorisation {X Y : C} {f : X ⟶ Y}
  [has_image f] (F : strong_epi_mono_factorisation f) : strong_epi (factor_thru_image f) :=
strong_epi_of_strong_epi_mono_factorisation F $ image.is_image f

/-- If we constructed our images from strong epi-mono factorisations, then these images are
    strong epi images. -/
@[priority 100]
instance has_strong_epi_images_of_has_strong_epi_mono_factorisations
  [has_strong_epi_mono_factorisations C] : has_strong_epi_images C :=
{ strong_factor_thru_image := λ X Y f,
    strong_epi_factor_thru_image_of_strong_epi_mono_factorisation $
      classical.choice $ has_strong_epi_mono_factorisations.has_fac f }

end has_strong_epi_images

section has_strong_epi_images
variables [has_images C]

/-- A category with strong epi images has image maps. -/
@[priority 100]
instance has_image_maps_of_has_strong_epi_images [has_strong_epi_images C] :
  has_image_maps C :=
{ has_image_map := λ f g st, has_image_map.mk
  { map := arrow.lift $ arrow.hom_mk' $ show (st.left ≫ factor_thru_image g.hom) ≫ image.ι g.hom =
      factor_thru_image f.hom ≫ (image.ι f.hom ≫ st.right), by simp } }

/-- If a category has images, equalizers and pullbacks, then images are automatically strong epi
    images. -/
@[priority 100]
instance has_strong_epi_images_of_has_pullbacks_of_has_equalizers [has_pullbacks C]
  [has_equalizers C] : has_strong_epi_images C :=
{ strong_factor_thru_image := λ X Y f,
  { epi := by apply_instance,
    has_lift := λ A B x y h h_mono w, arrow.has_lift.mk
    { lift := image.lift
      { I := pullback h y,
        m := pullback.snd ≫ image.ι f,
        m_mono := by exactI mono_comp _ _,
        e := pullback.lift _ _ w } ≫ pullback.fst } } }

end has_strong_epi_images

variables [has_strong_epi_mono_factorisations.{v} C]
variables {X Y : C} {f : X ⟶ Y}

/--
If `C` has strong epi mono factorisations, then the image is unique up to isomorphism, in that if
`f` factors as a strong epi followed by a mono, this factorisation is essentially the image
factorisation.
-/
def image.iso_strong_epi_mono {I' : C} (e : X ⟶ I') (m : I' ⟶ Y) (comm : e ≫ m = f) [strong_epi e]
  [mono m] :
  I' ≅ image f :=
is_image.iso_ext {strong_epi_mono_factorisation . I := I', m := m, e := e}.to_mono_is_image $
  image.is_image f

@[simp]
lemma image.iso_strong_epi_mono_hom_comp_ι {I' : C} (e : X ⟶ I') (m : I' ⟶ Y) (comm : e ≫ m = f)
  [strong_epi e] [mono m] :
  (image.iso_strong_epi_mono e m comm).hom ≫ image.ι f = m :=
is_image.lift_fac _ _

@[simp]
lemma image.iso_strong_epi_mono_inv_comp_mono {I' : C} (e : X ⟶ I') (m : I' ⟶ Y) (comm : e ≫ m = f)
  [strong_epi e] [mono m] :
  (image.iso_strong_epi_mono e m comm).inv ≫ m = image.ι f :=
image.lift_fac _

end category_theory.limits


/-
Copyright (c) 2023 Jannis Limperg. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jannis Limperg
-/

import Aesop

set_option aesop.check.all true

example : False := by
  aesop (options := { terminal := true })


/-
Copyright (c) 2019 Seul Baek. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Seul Baek
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.omega.nat.form
import Mathlib.PostPort

namespace Mathlib

/-
Negation elimination.
-/

namespace omega

namespace nat

/-- push_neg p returns the result of normalizing ¬ p by
    pushing the outermost negation all the way down,
    until it reaches either a negation or an atom -/
@[simp] def push_neg : preform → preform :=
  sorry

theorem push_neg_equiv {p : preform} : preform.equiv (push_neg p) (preform.not p) := sorry

/-- NNF transformation -/
def nnf : preform → preform :=
  sorry

/-- Asserts that the given preform is in NNF -/
def is_nnf : preform → Prop :=
  sorry

theorem is_nnf_push_neg (p : preform) : is_nnf p → is_nnf (push_neg p) := sorry

theorem is_nnf_nnf (p : preform) : is_nnf (nnf p) := sorry

theorem nnf_equiv {p : preform} : preform.equiv (nnf p) p := sorry

@[simp] def neg_elim_core : preform → preform :=
  sorry

theorem neg_free_neg_elim_core (p : preform) : is_nnf p → preform.neg_free (neg_elim_core p) := sorry

theorem le_and_le_iff_eq {α : Type} [partial_order α] {a : α} {b : α} : a ≤ b ∧ b ≤ a ↔ a = b := sorry

theorem implies_neg_elim_core {p : preform} : preform.implies p (neg_elim_core p) := sorry

/-- Eliminate all negations in a preform -/
def neg_elim : preform → preform :=
  neg_elim_core ∘ nnf

theorem neg_free_neg_elim {p : preform} : preform.neg_free (neg_elim p) :=
  neg_free_neg_elim_core (nnf p) (is_nnf_nnf p)

theorem implies_neg_elim {p : preform} : preform.implies p (neg_elim p) :=
  id fun (v : ℕ → ℕ) (h1 : preform.holds v p) => implies_neg_elim_core v (iff.elim_right (nnf_equiv v) h1)


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.limits.shapes.kernels
import Mathlib.category_theory.concrete_category.basic
import Mathlib.PostPort

universes u u_1

namespace Mathlib

/-!
# Facts about limits of functors into concrete categories

This file doesn't yet attempt to be exhaustive;
it just contains lemmas that are useful
while comparing categorical limits with existing constructions in concrete categories.
-/

namespace category_theory.limits

@[simp] theorem kernel_condition_apply {C : Type (u + 1)} [large_category C] [concrete_category C]
    [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_kernel f] (x : ↥(kernel f)) :
    coe_fn f (coe_fn (kernel.ι f) x) = coe_fn 0 x :=
  sorry

@[simp] theorem cokernel_condition_apply {C : Type (u + 1)} [large_category C] [concrete_category C]
    [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_cokernel f] (x : ↥X) :
    coe_fn (cokernel.π f) (coe_fn f x) = coe_fn 0 x :=
  sorry

end Mathlib


import Scratch.IntrosRwFind
universe u

variable {M: Type u}[Mul M]

set_option maxHeartbeats 5000000

theorem main_step : (∀ a b : M, (a * b) * b = a) →  (∀ a b : M, a * (a * b) = b) →  (m n: M)  →
            (m * n) * m = n := by
    intros ax1 ax2 m n
    polyFind #⟨ax1, ax2, m, n, m * n⟩ 2 save:mnn
    eqDeduc #⟨ax1, ax2, m, n⟩ 2 eqs:mnn save:mnn2
    propeqs  mnn2


import .formula .basic .dense_linear_order

open list --dnf

def get_lb : atom_dlo → option term_dlo
| (_ =' _) := none
| ((term_dlo.var 0) <' (term_dlo.var 0)) := none
| ((term_dlo.var (n+1)) <' (term_dlo.var 0)) := some (term_dlo.var n)
| ((term_dlo.cst b) <' (term_dlo.var 0)) := some (term_dlo.cst b)
| (_ <' (term_dlo.var (n+1))) := none
| (_ <' (term_dlo.cst _)) := none

lemma of_get_lb_eq_some :
  ∀ {a : atom_dlo} {t}, get_lb a = some t → a = (t.incr_idx <' V' 0) :=
begin
  intros a t h, cases a with t1 t2 t1 t2;
  cases t1 with k1 b1; cases t2 with k2 b2; try {cases h},
  { cases k1; cases k2; try {cases h}, refl },
  { cases k1; cases h },
  { cases k2; cases h, refl }
end

def lbs : list atom_dlo → list (term_dlo) := filter_map get_lb

def get_ub : atom_dlo → option (term_dlo)
| (_ =' _) := none
| ((term_dlo.var 0) <' (term_dlo.var 0)) := none
| ((term_dlo.var 0) <' (term_dlo.var (n+1))) := some (term_dlo.var n)
| ((term_dlo.var 0) <' (term_dlo.cst b)) := some (term_dlo.cst b)
| ((term_dlo.var (n+1)) <' _) := none
| ((term_dlo.cst _) <' _) := none

def ubs : list atom_dlo → list (term_dlo) := filter_map get_ub

lemma of_get_ub_eq_some :
  ∀ {a : atom_dlo} {t}, get_ub a = some t → a = (V' 0 <' t.incr_idx) :=
begin
  intros a t h, cases a with t1 t2 t1 t2;
  cases t1 with k1 b1; cases t2 with k2 b2; try {cases h};
  { cases k1; try {cases k2}; try {cases h}, refl },
end

def is_false_gnd_lt_atom_dlo : atom_dlo → Prop
| (term_dlo.cst a1 <' term_dlo.cst a2) := a2 ≤ a1
| _ := false

lemma not_eval_of_is_false_gnd_lt_atom_dlo :
  ∀ {a : atom_dlo}, is_false_gnd_lt_atom_dlo a → ∀ {bs}, ¬ a.eval bs :=
begin
  intros a ha bs, cases a with t1 t2;
  [{cases t1; cases t2}, {}]; try {cases ha},
  simp [atom_dlo.eval, term_dlo.eval], apply ha
end

instance dec_is_false_gnd_lt_atom_dlo :
  decidable_pred is_false_gnd_lt_atom_dlo :=
begin
  intro a, cases a with t1 t2; [{cases t1; cases t2}, {}];
  try {simp [is_false_gnd_lt_atom_dlo]}; apply_instance,
end

def is_not_gnd_lt_atom_dlo : atom_dlo → Prop
| (term_dlo.cst a1 <' term_dlo.cst a2) := false
| _ := true

lemma eval_of_not_false_gnd_of_gnd :
  ∀ {a : atom_dlo}, ¬ is_not_gnd_lt_atom_dlo a
    → ¬ is_false_gnd_lt_atom_dlo a → ∀ {bs}, a.eval bs :=
begin
  intros a ha1 ha2 bs, cases a with t1 t2;
  [{cases t1; cases t2}, {}];
  try {simp [is_not_gnd_lt_atom_dlo] at ha1, cases ha1},
  simp [is_false_gnd_lt_atom_dlo] at ha2, apply ha2
end

instance dec_is_not_gnd_lt_atom_dlo : ∀ (a : atom_dlo), decidable (is_not_gnd_lt_atom_dlo a) :=
begin
  intro a, cases a with t1 t2;
  [ {cases t1; cases t2}, {} ]; simp [is_not_gnd_lt_atom_dlo];
  { apply decidable.true <|> apply decidable.false }
end

def new_lt_atom_dlos (as : list atom_dlo) : list atom_dlo :=
let prs := product (lbs as) (ubs as) in
map (λ (pr : term_dlo × term_dlo), pr.fst <' pr.snd) prs

def sqe_aux (as : list atom_dlo) : list atom_dlo :=
let nas := new_lt_atom_dlos as in
if (∃ a, a ∈ nas ∧ is_false_gnd_lt_atom_dlo a)
  then [C' 0 <' C' 0]
  else (filter is_not_gnd_lt_atom_dlo nas)

def sqe (as : list atom_dlo) : list atom_dlo :=
if h : (V' 0 <' V' 0) ∈ as
  then [C' 0 <' C' 0]
  else sqe_aux as

lemma forall_mem_new_lt_atom_dlos_eval {as : list atom_dlo} {b bs} :
  (∀ t ∈ lbs as, term_dlo.eval bs t < b) → (∀ t ∈ ubs as, b < term_dlo.eval bs t)
  → ∀ a ∈ new_lt_atom_dlos as, atom_dlo.eval bs a :=
begin
  intros hb1 hb2 a ha1, simp [new_lt_atom_dlos] at ha1,
  cases ha1 with t1 ha1, cases ha1 with t2 ha1,
  cases ha1 with ha1 ha3, subst ha3, simp [atom_dlo.eval],
  apply @lt.trans _ _ _ b _ (hb1 _ ha1.left) (hb2 _ ha1.right)
end

def is_lb : atom_dlo → Prop
| (t1 <' t2) := ¬ t1 = term_dlo.var 0 ∧ t2 = term_dlo.var 0
| (t1 =' t2) := false

def is_ub : atom_dlo → Prop
| (t1 <' t2) := t1 = V' 0 ∧ ¬ t2 = V' 0
| (t1 =' t2) := false

lemma is_lb_or_is_ub {a : atom_dlo} :
  dep_0 a → ¬solv_0 a → a ≠ (V' 0<' V' 0) → is_lb a ∨ is_ub a :=
begin
  intros h1 h2 h3, cases a with t1 t2 t1 t2,
  { by_cases h1d : t1 = V' 0; by_cases h2d : t2 = V' 0,
    { subst h1d, subst h2d, exfalso, apply h3, refl },
    { apply or.inr, constructor; assumption },
    { apply or.inl, constructor; assumption },
    { cases h1; contradiction } },
  { simp [solv_0, not_or_distrib] at h2, cases h2,
    cases h1; contradiction }
end

lemma is_midpoint_iff  :
∀ {as : list atom_dlo},
  (∀ a ∈ as, is_lb a ∨ is_ub a) →
  ∀ {b bs}, ((∀ t ∈ lbs as, term_dlo.eval bs t < b) ∧ (∀ t ∈ ubs as, b < term_dlo.eval bs t))
            ↔ ∀ a ∈ as, atom_dlo.eval (b :: bs) a :=
begin
  intros as has b bs, constructor; intro h,
  {
    intros a ha, cases has _ ha with hbnd hbnd;
    cases a with t1 t2 t1 t2; cases hbnd with h1 h2,
    { subst h2, cases t1 with k r,
      { cases k, exfalso, apply h1 rfl,
        apply h.left (V' k) _, simp [lbs, mem_filter_map],
        constructor, apply and.intro ha, refl },
      { apply h.left (C' r) _, simp [lbs, mem_filter_map],
        constructor, apply and.intro ha, refl } },
    { subst h1, cases t2 with k r,
      { cases k, exfalso, apply h2 rfl,
        apply h.right (V' k) _, simp [ubs, mem_filter_map],
        constructor, apply and.intro ha, refl },
      { apply h.right (C' r) _, simp [ubs, mem_filter_map],
        constructor, apply and.intro ha, refl } } },
  {
    constructor; intros t ht,
    { simp [lbs] at ht, cases ht with a ha,
      have hrw := (of_get_lb_eq_some ha.right), subst hrw,
      rw (term_dlo.eval_incr_idx_eq.symm), apply h _ ha.left },
    { simp [ubs] at ht, cases ht with a ha,
      have hrw := (of_get_ub_eq_some ha.right), subst hrw,
      rw (term_dlo.eval_incr_idx_eq.symm), apply h _ ha.left }
  }
end

lemma eval_sqe :
∀ {as : list atom_dlo},
 (∀ a ∈ as, dep_0 a) → (∀ a ∈ as, ¬solv_0 a)
  → ∀ {bs : list rat}, avals bs (sqe as) ↔ ∃ x, avals (x :: bs) as :=
begin
  intros as has1 has2 bs, simp [sqe],
  apply @ite.rec _ _ _
  (λ φ, avals bs φ ↔ ∃ x, avals (x::bs) as); intro h1,
  { constructor; intro h,
    { exfalso, apply lt_irrefl _ (h _ (or.inl rfl)) },
    { cases h with r hr, exfalso, apply lt_irrefl _ (hr _ h1) } },
  { simp [sqe_aux],
    apply @ite.rec _ _ _
      (λ φ, avals bs φ ↔ ∃ x, avals (x :: bs) as); intro h2,
    {
      constructor; intro h; exfalso,
      { apply lt_irrefl _ (h _ (or.inl rfl)) },
      {
        cases h2 with a ha, cases h with b hb,
        apply @not_eval_of_is_false_gnd_lt_atom_dlo a ha.right bs,
        apply @forall_mem_new_lt_atom_dlos_eval as b _ _ _ _ ha.left;
        intros t ht; simp [lbs, ubs] at ht; cases ht with a' ha';
        cases ha' with ha1' ha2';
        [ { have hrw := (of_get_lb_eq_some ha2') },
          { have hrw := (of_get_ub_eq_some ha2') } ];
        { subst hrw, have h := hb _ ha1',
          simp [atom_dlo.eval, term_dlo.eval_incr_idx_eq] at h, apply h }
      }
    },
    { simp [avals],
       -- have hrw := (@forall_mem_filter _ is_not_gnd_lt_atom_dlo
       --   _ _ (new_lt_atom_dlos as)), rw hrw,
      apply calc
        (∀ a ∈ new_lt_atom_dlos as, is_not_gnd_lt_atom_dlo a → a.eval bs)
      ↔ ∃ b, (∀ t ∈ lbs as, term_dlo.eval bs t < b) ∧ (∀ t ∈ ubs as, b < term_dlo.eval bs t) :
        begin
          constructor; intro h3,
          {
            by_cases hl : lbs as = [],
            { rw hl, simp, cases exists_lower_bound (map (term_dlo.eval bs) (ubs as))
              with b hb, existsi b, intros t ht, apply hb _ (mem_map_of_mem _ ht) },
            {
              by_cases hu : ubs as = [],
              { rw hu, simp, cases exists_upper_bound (map (term_dlo.eval bs) (lbs as))
                with b hb, existsi b, intros t ht, apply hb _ (mem_map_of_mem _ ht) },
              {
                cases @exists_maximum _ _ (map (term_dlo.eval bs) (lbs as)) _ with x hx;
                [{}, {apply map_ne_nil_of_ne_nil hl}], cases hx with hx1 hx2,
                cases @exists_minimum _ _ (map (term_dlo.eval bs) (ubs as)) _ with y hy;
                [{}, {apply map_ne_nil_of_ne_nil hu}], cases hy with hy1 hy2,
                have hlt : x < y,
                  {
                    rw mem_map at hx1, cases hx1 with tx htx,
                    cases htx with htx hrw, subst hrw,
                    rw mem_map at hy1, cases hy1 with ty hty,
                    cases hty with hty hrw, subst hrw,
                    have hmem : (tx <' ty) ∈ new_lt_atom_dlos as,
                      { simp [new_lt_atom_dlos], existsi tx, existsi ty,
                        constructor; constructor; {assumption <|> refl} },
                    by_cases hgnd : is_not_gnd_lt_atom_dlo (tx <' ty),
                    { apply h3 _ hmem hgnd },
                    { apply eval_of_not_false_gnd_of_gnd hgnd _, intro hc,
                      apply h2, constructor, apply and.intro hmem hc }
                  },
                cases dense hlt with b hb, existsi b,
                constructor; intros t ht,
                { apply lt_of_le_of_lt (hx2 _ _) hb.left,
                  apply mem_map_of_mem _ ht },
                { apply lt_of_lt_of_le hb.right (hy2 _ _),
                  apply mem_map_of_mem _ ht }
              }
            }
          },
          { cases h3 with b hb, intros a ha1 _,
            apply forall_mem_new_lt_atom_dlos_eval hb.left hb.right _ ha1 }
        end
  ... ↔ ∃ b, ∀ a ∈ as, atom_dlo.eval (b::bs) a :
        begin
          apply exists_iff_exists, intro b, apply is_midpoint_iff,
          intros a ha, apply is_lb_or_is_ub (has1 _ ha) (has2 _ ha),
          intro hc, subst hc, apply h1 ha,
        end
    }
  }

end

#exit

instance dlo_rat.has_sqe_eq : has_sqe_eq rat :=
{
  sqe := dlo_rat.sqe,
  forall_mem_sqe_normal := λ _ _ _ _, trivial,
  eval_sqe_iff := λ as _ h _, @dlo_rat.eval_sqe_iff as h,
}

instance dlo_rat.dec_eval_qe := @dnf.dec_eval_qe rat _ @dlo_rat.dec_aval

meta def dlo_rat.qelim : tactic unit :=
papply ``((@dnf.eval_qe_iff rat dlo_rat.has_sqe_eq _ _ []).elim_left _)


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

! This file was ported from Lean 3 source module field_theory.intermediate_field
! leanprover-community/mathlib commit 825edd3cd735e87495b0c2a2114fc3929eefce41
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.FieldTheory.Minpoly.Field
import Mathbin.FieldTheory.Subfield
import Mathbin.FieldTheory.Tower

/-!
# Intermediate fields

Let `L / K` be a field extension, given as an instance `algebra K L`.
This file defines the type of fields in between `K` and `L`, `intermediate_field K L`.
An `intermediate_field K L` is a subfield of `L` which contains (the image of) `K`,
i.e. it is a `subfield L` and a `subalgebra K L`.

## Main definitions

* `intermediate_field K L` : the type of intermediate fields between `K` and `L`.
* `subalgebra.to_intermediate_field`: turns a subalgebra closed under `⁻¹`
  into an intermediate field
* `subfield.to_intermediate_field`: turns a subfield containing the image of `K`
  into an intermediate field
* `intermediate_field.map`: map an intermediate field along an `alg_hom`
* `intermediate_field.restrict_scalars`: restrict the scalars of an intermediate field to a smaller
  field in a tower of fields.

## Implementation notes

Intermediate fields are defined with a structure extending `subfield` and `subalgebra`.
A `subalgebra` is closed under all operations except `⁻¹`,

## Tags
intermediate field, field extension
-/

open FiniteDimensional Polynomial

open BigOperators Polynomial

variable (K L L' : Type _) [Field K] [Field L] [Field L'] [Algebra K L] [Algebra K L']

/-- `S : intermediate_field K L` is a subset of `L` such that there is a field
tower `L / S / K`. -/
structure IntermediateField extends Subalgebra K L where
  neg_mem' : ∀ x ∈ carrier, -x ∈ carrier
  inv_mem' : ∀ x ∈ carrier, x⁻¹ ∈ carrier
#align intermediate_field IntermediateField

/-- Reinterpret an `intermediate_field` as a `subalgebra`. -/
add_decl_doc IntermediateField.toSubalgebra

variable {K L L'} (S : IntermediateField K L)

namespace IntermediateField

/-- Reinterpret an `intermediate_field` as a `subfield`. -/
def toSubfield : Subfield L :=
  { S.toSubalgebra, S with }
#align intermediate_field.to_subfield IntermediateField.toSubfield

instance : SetLike (IntermediateField K L) L :=
  ⟨fun S => S.toSubalgebra.carrier, by
    rintro ⟨⟨⟩⟩ ⟨⟨⟩⟩ ⟨h⟩
    congr ⟩

instance : SubfieldClass (IntermediateField K L) L
    where
  add_mem s _ _ := s.add_mem'
  zero_mem s := s.zero_mem'
  neg_mem := neg_mem'
  mul_mem s _ _ := s.mul_mem'
  one_mem s := s.one_mem'
  inv_mem := inv_mem'

@[simp]
theorem mem_carrier {s : IntermediateField K L} {x : L} : x ∈ s.carrier ↔ x ∈ s :=
  Iff.rfl
#align intermediate_field.mem_carrier IntermediateField.mem_carrier

/-- Two intermediate fields are equal if they have the same elements. -/
@[ext]
theorem ext {S T : IntermediateField K L} (h : ∀ x, x ∈ S ↔ x ∈ T) : S = T :=
  SetLike.ext h
#align intermediate_field.ext IntermediateField.ext

@[simp]
theorem coe_toSubalgebra : (S.toSubalgebra : Set L) = S :=
  rfl
#align intermediate_field.coe_to_subalgebra IntermediateField.coe_toSubalgebra

@[simp]
theorem coe_toSubfield : (S.toSubfield : Set L) = S :=
  rfl
#align intermediate_field.coe_to_subfield IntermediateField.coe_toSubfield

@[simp]
theorem mem_mk (s : Set L) (hK : ∀ x, algebraMap K L x ∈ s) (ho hm hz ha hn hi) (x : L) :
    x ∈ IntermediateField.mk (Subalgebra.mk s ho hm hz ha hK) hn hi ↔ x ∈ s :=
  Iff.rfl
#align intermediate_field.mem_mk IntermediateField.mem_mk

@[simp]
theorem mem_toSubalgebra (s : IntermediateField K L) (x : L) : x ∈ s.toSubalgebra ↔ x ∈ s :=
  Iff.rfl
#align intermediate_field.mem_to_subalgebra IntermediateField.mem_toSubalgebra

@[simp]
theorem mem_toSubfield (s : IntermediateField K L) (x : L) : x ∈ s.toSubfield ↔ x ∈ s :=
  Iff.rfl
#align intermediate_field.mem_to_subfield IntermediateField.mem_toSubfield

/-- Copy of an intermediate field with a new `carrier` equal to the old one. Useful to fix
definitional equalities. -/
protected def copy (S : IntermediateField K L) (s : Set L) (hs : s = ↑S) : IntermediateField K L
    where
  toSubalgebra := S.toSubalgebra.copy s (hs : s = S.toSubalgebra.carrier)
  neg_mem' :=
    have hs' : (S.toSubalgebra.copy s hs).carrier = S.toSubalgebra.carrier := hs
    hs'.symm ▸ S.neg_mem'
  inv_mem' :=
    have hs' : (S.toSubalgebra.copy s hs).carrier = S.toSubalgebra.carrier := hs
    hs'.symm ▸ S.inv_mem'
#align intermediate_field.copy IntermediateField.copy

@[simp]
theorem coe_copy (S : IntermediateField K L) (s : Set L) (hs : s = ↑S) :
    (S.copy s hs : Set L) = s :=
  rfl
#align intermediate_field.coe_copy IntermediateField.coe_copy

theorem copy_eq (S : IntermediateField K L) (s : Set L) (hs : s = ↑S) : S.copy s hs = S :=
  SetLike.coe_injective hs
#align intermediate_field.copy_eq IntermediateField.copy_eq

section InheritedLemmas

/-! ### Lemmas inherited from more general structures

The declarations in this section derive from the fact that an `intermediate_field` is also a
subalgebra or subfield. Their use should be replaceable with the corresponding lemma from a
subobject class.
-/

/-- An intermediate field contains the image of the smaller field. -/
theorem algebraMap_mem (x : K) : algebraMap K L x ∈ S :=
  S.algebraMap_mem' x
#align intermediate_field.algebra_map_mem IntermediateField.algebraMap_mem

/-- An intermediate field is closed under scalar multiplication. -/
theorem smul_mem {y : L} : y ∈ S → ∀ {x : K}, x • y ∈ S :=
  S.toSubalgebra.smul_mem
#align intermediate_field.smul_mem IntermediateField.smul_mem

/-- An intermediate field contains the ring's 1. -/
protected theorem one_mem : (1 : L) ∈ S :=
  one_mem S
#align intermediate_field.one_mem IntermediateField.one_mem

/-- An intermediate field contains the ring's 0. -/
protected theorem zero_mem : (0 : L) ∈ S :=
  zero_mem S
#align intermediate_field.zero_mem IntermediateField.zero_mem

/-- An intermediate field is closed under multiplication. -/
protected theorem mul_mem {x y : L} : x ∈ S → y ∈ S → x * y ∈ S :=
  mul_mem
#align intermediate_field.mul_mem IntermediateField.mul_mem

/-- An intermediate field is closed under addition. -/
protected theorem add_mem {x y : L} : x ∈ S → y ∈ S → x + y ∈ S :=
  add_mem
#align intermediate_field.add_mem IntermediateField.add_mem

/-- An intermediate field is closed under subtraction -/
protected theorem sub_mem {x y : L} : x ∈ S → y ∈ S → x - y ∈ S :=
  sub_mem
#align intermediate_field.sub_mem IntermediateField.sub_mem

/-- An intermediate field is closed under negation. -/
protected theorem neg_mem {x : L} : x ∈ S → -x ∈ S :=
  neg_mem
#align intermediate_field.neg_mem IntermediateField.neg_mem

/-- An intermediate field is closed under inverses. -/
protected theorem inv_mem {x : L} : x ∈ S → x⁻¹ ∈ S :=
  inv_mem
#align intermediate_field.inv_mem IntermediateField.inv_mem

/-- An intermediate field is closed under division. -/
protected theorem div_mem {x y : L} : x ∈ S → y ∈ S → x / y ∈ S :=
  div_mem
#align intermediate_field.div_mem IntermediateField.div_mem

/-- Product of a list of elements in an intermediate_field is in the intermediate_field. -/
protected theorem list_prod_mem {l : List L} : (∀ x ∈ l, x ∈ S) → l.Prod ∈ S :=
  list_prod_mem
#align intermediate_field.list_prod_mem IntermediateField.list_prod_mem

/-- Sum of a list of elements in an intermediate field is in the intermediate_field. -/
protected theorem list_sum_mem {l : List L} : (∀ x ∈ l, x ∈ S) → l.Sum ∈ S :=
  list_sum_mem
#align intermediate_field.list_sum_mem IntermediateField.list_sum_mem

/-- Product of a multiset of elements in an intermediate field is in the intermediate_field. -/
protected theorem multiset_prod_mem (m : Multiset L) : (∀ a ∈ m, a ∈ S) → m.Prod ∈ S :=
  multiset_prod_mem m
#align intermediate_field.multiset_prod_mem IntermediateField.multiset_prod_mem

/-- Sum of a multiset of elements in a `intermediate_field` is in the `intermediate_field`. -/
protected theorem multiset_sum_mem (m : Multiset L) : (∀ a ∈ m, a ∈ S) → m.Sum ∈ S :=
  multiset_sum_mem m
#align intermediate_field.multiset_sum_mem IntermediateField.multiset_sum_mem

/-- Product of elements of an intermediate field indexed by a `finset` is in the intermediate_field.
-/
protected theorem prod_mem {ι : Type _} {t : Finset ι} {f : ι → L} (h : ∀ c ∈ t, f c ∈ S) :
    (∏ i in t, f i) ∈ S :=
  prod_mem h
#align intermediate_field.prod_mem IntermediateField.prod_mem

/-- Sum of elements in a `intermediate_field` indexed by a `finset` is in the `intermediate_field`.
-/
protected theorem sum_mem {ι : Type _} {t : Finset ι} {f : ι → L} (h : ∀ c ∈ t, f c ∈ S) :
    (∑ i in t, f i) ∈ S :=
  sum_mem h
#align intermediate_field.sum_mem IntermediateField.sum_mem

protected theorem pow_mem {x : L} (hx : x ∈ S) (n : ℤ) : x ^ n ∈ S :=
  zpow_mem hx n
#align intermediate_field.pow_mem IntermediateField.pow_mem

protected theorem zsmul_mem {x : L} (hx : x ∈ S) (n : ℤ) : n • x ∈ S :=
  zsmul_mem hx n
#align intermediate_field.zsmul_mem IntermediateField.zsmul_mem

protected theorem coe_int_mem (n : ℤ) : (n : L) ∈ S :=
  coe_int_mem S n
#align intermediate_field.coe_int_mem IntermediateField.coe_int_mem

protected theorem coe_add (x y : S) : (↑(x + y) : L) = ↑x + ↑y :=
  rfl
#align intermediate_field.coe_add IntermediateField.coe_add

protected theorem coe_neg (x : S) : (↑(-x) : L) = -↑x :=
  rfl
#align intermediate_field.coe_neg IntermediateField.coe_neg

protected theorem coe_mul (x y : S) : (↑(x * y) : L) = ↑x * ↑y :=
  rfl
#align intermediate_field.coe_mul IntermediateField.coe_mul

protected theorem coe_inv (x : S) : (↑x⁻¹ : L) = (↑x)⁻¹ :=
  rfl
#align intermediate_field.coe_inv IntermediateField.coe_inv

protected theorem coe_zero : ((0 : S) : L) = 0 :=
  rfl
#align intermediate_field.coe_zero IntermediateField.coe_zero

protected theorem coe_one : ((1 : S) : L) = 1 :=
  rfl
#align intermediate_field.coe_one IntermediateField.coe_one

protected theorem coe_pow (x : S) (n : ℕ) : (↑(x ^ n) : L) = ↑x ^ n :=
  SubmonoidClass.coe_pow x n
#align intermediate_field.coe_pow IntermediateField.coe_pow

end InheritedLemmas

theorem coe_nat_mem (n : ℕ) : (n : L) ∈ S := by simpa using coe_int_mem S n
#align intermediate_field.coe_nat_mem IntermediateField.coe_nat_mem

end IntermediateField

/-- Turn a subalgebra closed under inverses into an intermediate field -/
def Subalgebra.toIntermediateField (S : Subalgebra K L) (inv_mem : ∀ x ∈ S, x⁻¹ ∈ S) :
    IntermediateField K L :=
  { S with
    neg_mem' := fun x => S.neg_mem
    inv_mem' := inv_mem }
#align subalgebra.to_intermediate_field Subalgebra.toIntermediateField

@[simp]
theorem toSubalgebra_toIntermediateField (S : Subalgebra K L) (inv_mem : ∀ x ∈ S, x⁻¹ ∈ S) :
    (S.toIntermediateField inv_mem).toSubalgebra = S :=
  by
  ext
  rfl
#align to_subalgebra_to_intermediate_field toSubalgebra_toIntermediateField

@[simp]
theorem toIntermediateField_toSubalgebra (S : IntermediateField K L) :
    (S.toSubalgebra.toIntermediateField fun x => S.inv_mem) = S :=
  by
  ext
  rfl
#align to_intermediate_field_to_subalgebra toIntermediateField_toSubalgebra

/-- Turn a subalgebra satisfying `is_field` into an intermediate_field -/
def Subalgebra.toIntermediateField' (S : Subalgebra K L) (hS : IsField S) : IntermediateField K L :=
  S.toIntermediateField fun x hx => by
    by_cases hx0 : x = 0
    · rw [hx0, inv_zero]
      exact S.zero_mem
    letI hS' := hS.to_field
    obtain ⟨y, hy⟩ := hS.mul_inv_cancel (show (⟨x, hx⟩ : S) ≠ 0 from Subtype.ne_of_val_ne hx0)
    rw [Subtype.ext_iff, S.coe_mul, S.coe_one, Subtype.coe_mk, mul_eq_one_iff_inv_eq₀ hx0] at hy
    exact hy.symm ▸ y.2
#align subalgebra.to_intermediate_field' Subalgebra.toIntermediateField'

@[simp]
theorem toSubalgebra_toIntermediateField' (S : Subalgebra K L) (hS : IsField S) :
    (S.toIntermediateField' hS).toSubalgebra = S :=
  by
  ext
  rfl
#align to_subalgebra_to_intermediate_field' toSubalgebra_toIntermediateField'

@[simp]
theorem toIntermediateField'_toSubalgebra (S : IntermediateField K L) :
    S.toSubalgebra.toIntermediateField' (Field.toIsField S) = S :=
  by
  ext
  rfl
#align to_intermediate_field'_to_subalgebra toIntermediateField'_toSubalgebra

/-- Turn a subfield of `L` containing the image of `K` into an intermediate field -/
def Subfield.toIntermediateField (S : Subfield L) (algebra_map_mem : ∀ x, algebraMap K L x ∈ S) :
    IntermediateField K L :=
  { S with algebraMap_mem' := algebra_map_mem }
#align subfield.to_intermediate_field Subfield.toIntermediateField

namespace IntermediateField

/-- An intermediate field inherits a field structure -/
instance toField : Field S :=
  S.toSubfield.toField
#align intermediate_field.to_field IntermediateField.toField

@[simp, norm_cast]
theorem coe_sum {ι : Type _} [Fintype ι] (f : ι → S) : (↑(∑ i, f i) : L) = ∑ i, (f i : L) := by
  classical
    induction' Finset.univ using Finset.induction_on with i s hi H
    · simp
    · rw [Finset.sum_insert hi, AddMemClass.coe_add, H, Finset.sum_insert hi]
#align intermediate_field.coe_sum IntermediateField.coe_sum

@[simp, norm_cast]
theorem coe_prod {ι : Type _} [Fintype ι] (f : ι → S) : (↑(∏ i, f i) : L) = ∏ i, (f i : L) := by
  classical
    induction' Finset.univ using Finset.induction_on with i s hi H
    · simp
    · rw [Finset.prod_insert hi, MulMemClass.coe_mul, H, Finset.prod_insert hi]
#align intermediate_field.coe_prod IntermediateField.coe_prod

/-! `intermediate_field`s inherit structure from their `subalgebra` coercions. -/

instance module' {R} [Semiring R] [SMul R K] [Module R L] [IsScalarTower R K L] : Module R S :=
  S.toSubalgebra.module'
#align intermediate_field.module' IntermediateField.module'

instance module : Module K S :=
  S.toSubalgebra.Module
#align intermediate_field.module IntermediateField.module

instance isScalarTower {R} [Semiring R] [SMul R K] [Module R L] [IsScalarTower R K L] :
    IsScalarTower R K S :=
  S.toSubalgebra.IsScalarTower
#align intermediate_field.is_scalar_tower IntermediateField.isScalarTower

@[simp]
theorem coe_smul {R} [Semiring R] [SMul R K] [Module R L] [IsScalarTower R K L] (r : R) (x : S) :
    ↑(r • x) = (r • x : L) :=
  rfl
#align intermediate_field.coe_smul IntermediateField.coe_smul

instance algebra' {K'} [CommSemiring K'] [SMul K' K] [Algebra K' L] [IsScalarTower K' K L] :
    Algebra K' S :=
  S.toSubalgebra.algebra'
#align intermediate_field.algebra' IntermediateField.algebra'

instance algebra : Algebra K S :=
  S.toSubalgebra.Algebra
#align intermediate_field.algebra IntermediateField.algebra

instance toAlgebra {R : Type _} [Semiring R] [Algebra L R] : Algebra S R :=
  S.toSubalgebra.toAlgebra
#align intermediate_field.to_algebra IntermediateField.toAlgebra

instance isScalarTower_bot {R : Type _} [Semiring R] [Algebra L R] : IsScalarTower S L R :=
  IsScalarTower.subalgebra _ _ _ S.toSubalgebra
#align intermediate_field.is_scalar_tower_bot IntermediateField.isScalarTower_bot

instance isScalarTower_mid {R : Type _} [Semiring R] [Algebra L R] [Algebra K R]
    [IsScalarTower K L R] : IsScalarTower K S R :=
  IsScalarTower.subalgebra' _ _ _ S.toSubalgebra
#align intermediate_field.is_scalar_tower_mid IntermediateField.isScalarTower_mid

/-- Specialize `is_scalar_tower_mid` to the common case where the top field is `L` -/
instance isScalarTower_mid' : IsScalarTower K S L :=
  S.isScalarTower_mid
#align intermediate_field.is_scalar_tower_mid' IntermediateField.isScalarTower_mid'

/-- If `f : L →+* L'` fixes `K`, `S.map f` is the intermediate field between `L'` and `K`
such that `x ∈ S ↔ f x ∈ S.map f`. -/
def map (f : L →ₐ[K] L') (S : IntermediateField K L) : IntermediateField K L' :=
  {
    S.toSubalgebra.map
      f with
    inv_mem' := by
      rintro _ ⟨x, hx, rfl⟩
      exact ⟨x⁻¹, S.inv_mem hx, map_inv₀ f x⟩
    neg_mem' := fun x hx => (S.toSubalgebra.map f).neg_mem hx }
#align intermediate_field.map IntermediateField.map

@[simp]
theorem coe_map (f : L →ₐ[K] L') : (S.map f : Set L') = f '' S :=
  rfl
#align intermediate_field.coe_map IntermediateField.coe_map

theorem map_map {K L₁ L₂ L₃ : Type _} [Field K] [Field L₁] [Algebra K L₁] [Field L₂] [Algebra K L₂]
    [Field L₃] [Algebra K L₃] (E : IntermediateField K L₁) (f : L₁ →ₐ[K] L₂) (g : L₂ →ₐ[K] L₃) :
    (E.map f).map g = E.map (g.comp f) :=
  SetLike.coe_injective <| Set.image_image _ _ _
#align intermediate_field.map_map IntermediateField.map_map

/-- Given an equivalence `e : L ≃ₐ[K] L'` of `K`-field extensions and an intermediate
field `E` of `L/K`, `intermediate_field_equiv_map e E` is the induced equivalence
between `E` and `E.map e` -/
def intermediateFieldMap (e : L ≃ₐ[K] L') (E : IntermediateField K L) : E ≃ₐ[K] E.map e.toAlgHom :=
  e.subalgebraMap E.toSubalgebra
#align intermediate_field.intermediate_field_map IntermediateField.intermediateFieldMap

/- We manually add these two simp lemmas because `@[simps]` before `intermediate_field_map`
  led to a timeout. -/
@[simp]
theorem intermediateFieldMap_apply_coe (e : L ≃ₐ[K] L') (E : IntermediateField K L) (a : E) :
    ↑(intermediateFieldMap e E a) = e a :=
  rfl
#align intermediate_field.intermediate_field_map_apply_coe IntermediateField.intermediateFieldMap_apply_coe

@[simp]
theorem intermediateFieldMap_symm_apply_coe (e : L ≃ₐ[K] L') (E : IntermediateField K L)
    (a : E.map e.toAlgHom) : ↑((intermediateFieldMap e E).symm a) = e.symm a :=
  rfl
#align intermediate_field.intermediate_field_map_symm_apply_coe IntermediateField.intermediateFieldMap_symm_apply_coe

end IntermediateField

namespace AlgHom

variable (f : L →ₐ[K] L')

/-- The range of an algebra homomorphism, as an intermediate field. -/
@[simps toSubalgebra]
def fieldRange : IntermediateField K L' :=
  { f.range, (f : L →+* L').fieldRange with }
#align alg_hom.field_range AlgHom.fieldRange

@[simp]
theorem coe_fieldRange : ↑f.fieldRange = Set.range f :=
  rfl
#align alg_hom.coe_field_range AlgHom.coe_fieldRange

@[simp]
theorem fieldRange_toSubfield : f.fieldRange.toSubfield = (f : L →+* L').fieldRange :=
  rfl
#align alg_hom.field_range_to_subfield AlgHom.fieldRange_toSubfield

variable {f}

@[simp]
theorem mem_fieldRange {y : L'} : y ∈ f.fieldRange ↔ ∃ x, f x = y :=
  Iff.rfl
#align alg_hom.mem_field_range AlgHom.mem_fieldRange

end AlgHom

namespace IntermediateField

/-- The embedding from an intermediate field of `L / K` to `L`. -/
def val : S →ₐ[K] L :=
  S.toSubalgebra.val
#align intermediate_field.val IntermediateField.val

@[simp]
theorem coe_val : ⇑S.val = coe :=
  rfl
#align intermediate_field.coe_val IntermediateField.coe_val

@[simp]
theorem val_mk {x : L} (hx : x ∈ S) : S.val ⟨x, hx⟩ = x :=
  rfl
#align intermediate_field.val_mk IntermediateField.val_mk

theorem range_val : S.val.range = S.toSubalgebra :=
  S.toSubalgebra.range_val
#align intermediate_field.range_val IntermediateField.range_val

theorem aeval_coe {R : Type _} [CommRing R] [Algebra R K] [Algebra R L] [IsScalarTower R K L]
    (x : S) (P : R[X]) : aeval (x : L) P = aeval x P :=
  by
  refine' Polynomial.induction_on' P (fun f g hf hg => _) fun n r => _
  · rw [aeval_add, aeval_add, AddMemClass.coe_add, hf, hg]
  · simp only [MulMemClass.coe_mul, aeval_monomial, SubmonoidClass.coe_pow, mul_eq_mul_right_iff]
    left
    rfl
#align intermediate_field.aeval_coe IntermediateField.aeval_coe

theorem coe_isIntegral_iff {R : Type _} [CommRing R] [Algebra R K] [Algebra R L]
    [IsScalarTower R K L] {x : S} : IsIntegral R (x : L) ↔ IsIntegral R x :=
  by
  refine' ⟨fun h => _, fun h => _⟩
  · obtain ⟨P, hPmo, hProot⟩ := h
    refine' ⟨P, hPmo, (injective_iff_map_eq_zero _).1 (algebraMap (↥S) L).Injective _ _⟩
    letI : IsScalarTower R S L := IsScalarTower.of_algebraMap_eq (congr_fun rfl)
    rwa [eval₂_eq_eval_map, ← eval₂_at_apply, eval₂_eq_eval_map, Polynomial.map_map, ←
      IsScalarTower.algebraMap_eq, ← eval₂_eq_eval_map]
  · obtain ⟨P, hPmo, hProot⟩ := h
    refine' ⟨P, hPmo, _⟩
    rw [← aeval_def, aeval_coe, aeval_def, hProot, ZeroMemClass.coe_zero]
#align intermediate_field.coe_is_integral_iff IntermediateField.coe_isIntegral_iff

/-- The map `E → F` when `E` is an intermediate field contained in the intermediate field `F`.

This is the intermediate field version of `subalgebra.inclusion`. -/
def inclusion {E F : IntermediateField K L} (hEF : E ≤ F) : E →ₐ[K] F :=
  Subalgebra.inclusion hEF
#align intermediate_field.inclusion IntermediateField.inclusion

theorem inclusion_injective {E F : IntermediateField K L} (hEF : E ≤ F) :
    Function.Injective (inclusion hEF) :=
  Subalgebra.inclusion_injective hEF
#align intermediate_field.inclusion_injective IntermediateField.inclusion_injective

@[simp]
theorem inclusion_self {E : IntermediateField K L} : inclusion (le_refl E) = AlgHom.id K E :=
  Subalgebra.inclusion_self
#align intermediate_field.inclusion_self IntermediateField.inclusion_self

@[simp]
theorem inclusion_inclusion {E F G : IntermediateField K L} (hEF : E ≤ F) (hFG : F ≤ G) (x : E) :
    inclusion hFG (inclusion hEF x) = inclusion (le_trans hEF hFG) x :=
  Subalgebra.inclusion_inclusion hEF hFG x
#align intermediate_field.inclusion_inclusion IntermediateField.inclusion_inclusion

@[simp]
theorem coe_inclusion {E F : IntermediateField K L} (hEF : E ≤ F) (e : E) :
    (inclusion hEF e : L) = e :=
  rfl
#align intermediate_field.coe_inclusion IntermediateField.coe_inclusion

variable {S}

theorem toSubalgebra_injective {S S' : IntermediateField K L}
    (h : S.toSubalgebra = S'.toSubalgebra) : S = S' :=
  by
  ext
  rw [← mem_to_subalgebra, ← mem_to_subalgebra, h]
#align intermediate_field.to_subalgebra_injective IntermediateField.toSubalgebra_injective

variable (S)

theorem set_range_subset : Set.range (algebraMap K L) ⊆ S :=
  S.toSubalgebra.range_subset
#align intermediate_field.set_range_subset IntermediateField.set_range_subset

theorem fieldRange_le : (algebraMap K L).fieldRange ≤ S.toSubfield := fun x hx =>
  S.toSubalgebra.range_subset (by rwa [Set.mem_range, ← RingHom.mem_fieldRange])
#align intermediate_field.field_range_le IntermediateField.fieldRange_le

@[simp]
theorem toSubalgebra_le_toSubalgebra {S S' : IntermediateField K L} :
    S.toSubalgebra ≤ S'.toSubalgebra ↔ S ≤ S' :=
  Iff.rfl
#align intermediate_field.to_subalgebra_le_to_subalgebra IntermediateField.toSubalgebra_le_toSubalgebra

@[simp]
theorem toSubalgebra_lt_toSubalgebra {S S' : IntermediateField K L} :
    S.toSubalgebra < S'.toSubalgebra ↔ S < S' :=
  Iff.rfl
#align intermediate_field.to_subalgebra_lt_to_subalgebra IntermediateField.toSubalgebra_lt_toSubalgebra

variable {S}

section Tower

/-- Lift an intermediate_field of an intermediate_field -/
def lift {F : IntermediateField K L} (E : IntermediateField K F) : IntermediateField K L :=
  E.map (val F)
#align intermediate_field.lift IntermediateField.lift

instance hasLift {F : IntermediateField K L} :
    HasLiftT (IntermediateField K F) (IntermediateField K L) :=
  ⟨lift⟩
#align intermediate_field.has_lift IntermediateField.hasLift

section RestrictScalars

variable (K) [Algebra L' L] [IsScalarTower K L' L]

/-- Given a tower `L / ↥E / L' / K` of field extensions, where `E` is an `L'`-intermediate field of
`L`, reinterpret `E` as a `K`-intermediate field of `L`. -/
def restrictScalars (E : IntermediateField L' L) : IntermediateField K L :=
  { E.toSubfield, E.toSubalgebra.restrictScalars K with carrier := E.carrier }
#align intermediate_field.restrict_scalars IntermediateField.restrictScalars

@[simp]
theorem coe_restrictScalars {E : IntermediateField L' L} :
    (restrictScalars K E : Set L) = (E : Set L) :=
  rfl
#align intermediate_field.coe_restrict_scalars IntermediateField.coe_restrictScalars

@[simp]
theorem restrictScalars_toSubalgebra {E : IntermediateField L' L} :
    (E.restrictScalars K).toSubalgebra = E.toSubalgebra.restrictScalars K :=
  SetLike.coe_injective rfl
#align intermediate_field.restrict_scalars_to_subalgebra IntermediateField.restrictScalars_toSubalgebra

@[simp]
theorem restrictScalars_toSubfield {E : IntermediateField L' L} :
    (E.restrictScalars K).toSubfield = E.toSubfield :=
  SetLike.coe_injective rfl
#align intermediate_field.restrict_scalars_to_subfield IntermediateField.restrictScalars_toSubfield

@[simp]
theorem mem_restrictScalars {E : IntermediateField L' L} {x : L} :
    x ∈ restrictScalars K E ↔ x ∈ E :=
  Iff.rfl
#align intermediate_field.mem_restrict_scalars IntermediateField.mem_restrictScalars

theorem restrictScalars_injective :
    Function.Injective (restrictScalars K : IntermediateField L' L → IntermediateField K L) :=
  fun U V H => ext fun x => by rw [← mem_restrict_scalars K, H, mem_restrict_scalars]
#align intermediate_field.restrict_scalars_injective IntermediateField.restrictScalars_injective

end RestrictScalars

/-- This was formerly an instance called `lift2_alg`, but an instance above already provides it. -/
example {F : IntermediateField K L} {E : IntermediateField F L} : Algebra K E := by infer_instance

end Tower

section FiniteDimensional

variable (F E : IntermediateField K L)

instance finiteDimensional_left [FiniteDimensional K L] : FiniteDimensional K F :=
  left K F L
#align intermediate_field.finite_dimensional_left IntermediateField.finiteDimensional_left

instance finiteDimensional_right [FiniteDimensional K L] : FiniteDimensional F L :=
  right K F L
#align intermediate_field.finite_dimensional_right IntermediateField.finiteDimensional_right

@[simp]
theorem dim_eq_dim_subalgebra : Module.rank K F.toSubalgebra = Module.rank K F :=
  rfl
#align intermediate_field.dim_eq_dim_subalgebra IntermediateField.dim_eq_dim_subalgebra

@[simp]
theorem finrank_eq_finrank_subalgebra : finrank K F.toSubalgebra = finrank K F :=
  rfl
#align intermediate_field.finrank_eq_finrank_subalgebra IntermediateField.finrank_eq_finrank_subalgebra

variable {F} {E}

@[simp]
theorem toSubalgebra_eq_iff : F.toSubalgebra = E.toSubalgebra ↔ F = E :=
  by
  rw [SetLike.ext_iff, SetLike.ext'_iff, Set.ext_iff]
  rfl
#align intermediate_field.to_subalgebra_eq_iff IntermediateField.toSubalgebra_eq_iff

theorem eq_of_le_of_finrank_le [FiniteDimensional K L] (h_le : F ≤ E)
    (h_finrank : finrank K E ≤ finrank K F) : F = E :=
  toSubalgebra_injective <|
    Subalgebra.toSubmodule.Injective <| eq_of_le_of_finrank_le h_le h_finrank
#align intermediate_field.eq_of_le_of_finrank_le IntermediateField.eq_of_le_of_finrank_le

theorem eq_of_le_of_finrank_eq [FiniteDimensional K L] (h_le : F ≤ E)
    (h_finrank : finrank K F = finrank K E) : F = E :=
  eq_of_le_of_finrank_le h_le h_finrank.ge
#align intermediate_field.eq_of_le_of_finrank_eq IntermediateField.eq_of_le_of_finrank_eq

theorem eq_of_le_of_finrank_le' [FiniteDimensional K L] (h_le : F ≤ E)
    (h_finrank : finrank F L ≤ finrank E L) : F = E :=
  by
  apply eq_of_le_of_finrank_le h_le
  have h1 := finrank_mul_finrank K F L
  have h2 := finrank_mul_finrank K E L
  have h3 : 0 < finrank E L := finrank_pos
  nlinarith
#align intermediate_field.eq_of_le_of_finrank_le' IntermediateField.eq_of_le_of_finrank_le'

theorem eq_of_le_of_finrank_eq' [FiniteDimensional K L] (h_le : F ≤ E)
    (h_finrank : finrank F L = finrank E L) : F = E :=
  eq_of_le_of_finrank_le' h_le h_finrank.le
#align intermediate_field.eq_of_le_of_finrank_eq' IntermediateField.eq_of_le_of_finrank_eq'

end FiniteDimensional

theorem isAlgebraic_iff {x : S} : IsAlgebraic K x ↔ IsAlgebraic K (x : L) :=
  (isAlgebraic_algebraMap_iff (algebraMap S L).Injective).symm
#align intermediate_field.is_algebraic_iff IntermediateField.isAlgebraic_iff

theorem isIntegral_iff {x : S} : IsIntegral K x ↔ IsIntegral K (x : L) := by
  rw [← isAlgebraic_iff_isIntegral, is_algebraic_iff, isAlgebraic_iff_isIntegral]
#align intermediate_field.is_integral_iff IntermediateField.isIntegral_iff

theorem minpoly_eq (x : S) : minpoly K x = minpoly K (x : L) :=
  by
  by_cases hx : IsIntegral K x
  · exact minpoly.eq_of_algebraMap_eq (algebraMap S L).Injective hx rfl
  · exact (minpoly.eq_zero hx).trans (minpoly.eq_zero (mt is_integral_iff.mpr hx)).symm
#align intermediate_field.minpoly_eq IntermediateField.minpoly_eq

end IntermediateField

/-- If `L/K` is algebraic, the `K`-subalgebras of `L` are all fields.  -/
def subalgebraEquivIntermediateField (alg : Algebra.IsAlgebraic K L) :
    Subalgebra K L ≃o IntermediateField K L
    where
  toFun S := S.toIntermediateField fun x hx => S.inv_mem_of_algebraic (alg (⟨x, hx⟩ : S))
  invFun S := S.toSubalgebra
  left_inv S := toSubalgebra_toIntermediateField _ _
  right_inv := toIntermediateField_toSubalgebra
  map_rel_iff' S S' := Iff.rfl
#align subalgebra_equiv_intermediate_field subalgebraEquivIntermediateField

@[simp]
theorem mem_subalgebraEquivIntermediateField (alg : Algebra.IsAlgebraic K L) {S : Subalgebra K L}
    {x : L} : x ∈ subalgebraEquivIntermediateField alg S ↔ x ∈ S :=
  Iff.rfl
#align mem_subalgebra_equiv_intermediate_field mem_subalgebraEquivIntermediateField

@[simp]
theorem mem_subalgebraEquivIntermediateField_symm (alg : Algebra.IsAlgebraic K L)
    {S : IntermediateField K L} {x : L} :
    x ∈ (subalgebraEquivIntermediateField alg).symm S ↔ x ∈ S :=
  Iff.rfl
#align mem_subalgebra_equiv_intermediate_field_symm mem_subalgebraEquivIntermediateField_symm