inductive rtc {α : Type} (r : α → α → Prop) : α → α → Prop
| base  : ∀ a, rtc a a
| trans : ∀ {a b c}, r a b → rtc b c → rtc a c

lemma rtc_is_transitive {α : Type} {a b c: α} {r : α → α → Prop}:
  rtc r a b → rtc r b c → rtc r a c
:=
begin
  intros hab hbc,
  induction hab with a a p b hap hpb hbcpc,
  exact hbc,
  exact rtc.trans hap (hbcpc hbc)
end

definition weak_cr {α : Type} (r : α → α → Prop): Prop
:= ∀ {a b c: α}, r a b → r a c → ∃ d: α, rtc r b d ∧ rtc r c d

definition cr {α : Type} (r : α → α → Prop): Prop
:= ∀ a b c: α, rtc r a b → rtc r a c → ∃ d: α, rtc r b d ∧ rtc r c d

constant α: Type
constant r: α → α → Prop
definition ir (a b: α) := r b a
constant r_wf: well_founded ir
constant r_weak_cr: weak_cr r

lemma newmann: cr r
:=
begin
  intros x,
  apply well_founded.induction r_wf x _,
  clear x,
  intros a ih b c hab hac,
  simp [ir] at ih,
  cases hab with _ _ p _ hap hpb,
    existsi c,
    split,
      exact hac,
    exact rtc.base r c,
  cases hac with _ _ q _ haq hqc,
    existsi b,
    split,
      exact rtc.base r b,
    exact rtc.trans hap hpb,
  cases r_weak_cr hap haq with s hs,
  cases hs with hps hqs,
  cases ih q haq s c hqs hqc with t ht,
  cases ht with hst hct,
  have hpt: rtc r p t, from rtc_is_transitive hps hst,
  cases ih p hap b t hpb hpt with d hd,
  cases hd with hbd htd,
  clear hap hpb haq hqc hps hqs hst hpt p q s,
  have hcd: rtc r c d, from rtc_is_transitive hct htd,
  existsi d,
  exact ⟨hbd, hcd⟩
end


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Robert Y. Lewis
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.ring_theory.witt_vector.structure_polynomial
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Witt vectors

In this file we define the type of `p`-typical Witt vectors and ring operations on it.
The ring axioms are verified in `ring_theory/witt_vector/basic.lean`.

For a fixed commutative ring `R` and prime `p`,
a Witt vector `x : 𝕎 R` is an infinite sequence `ℕ → R` of elements of `R`.
However, the ring operations `+` and `*` are not defined in the obvious component-wise way.
Instead, these operations are defined via certain polynomials
using the machinery in `structure_polynomial.lean`.
The `n`th value of the sum of two Witt vectors can depend on the `0`-th through `n`th values
of the summands. This effectively simulates a “carrying” operation.

## Main definitions

* `witt_vector p R`: the type of `p`-typical Witt vectors with coefficients in `R`.
* `witt_vector.coeff x n`: projects the `n`th value of the Witt vector `x`.

## Notation

We use notation `𝕎 R`, entered `\bbW`, for the Witt vectors over `R`.

-/

/-- `witt_vector p R` is the ring of `p`-typical Witt vectors over the commutative ring `R`,
where `p` is a prime number.

If `p` is invertible in `R`, this ring is isomorphic to `ℕ → R` (the product of `ℕ` copies of `R`).
If `R` is a ring of characteristic `p`, then `witt_vector p R` is a ring of characteristic `0`.
The canonical example is `witt_vector p (zmod p)`,
which is isomorphic to the `p`-adic integers `ℤ_[p]`. -/
def witt_vector (p : ℕ) (R : Type u_1) :=
  ℕ → R

/- We cannot make this `localized` notation, because the `p` on the RHS doesn't occur on the left
Hiding the `p` in the notation is very convenient, so we opt for repeating the `local notation`
in other files that use Witt vectors. -/

namespace witt_vector

/-- Construct a Witt vector `mk p x : 𝕎 R` from a sequence `x` of elements of `R`. -/
def mk (p : ℕ) {R : Type u_1} (x : ℕ → R) : witt_vector p R :=
  x

protected instance inhabited {p : ℕ} {R : Type u_1} [Inhabited R] : Inhabited (witt_vector p R) :=
  { default := mk p fun (_x : ℕ) => Inhabited.default }

/--
`x.coeff n` is the `n`th coefficient of the Witt vector `x`.

This concept does not have a standard name in the literature.
-/
def coeff {p : ℕ} {R : Type u_1} (x : witt_vector p R) (n : ℕ) : R :=
  x n

theorem ext {p : ℕ} {R : Type u_1} {x : witt_vector p R} {y : witt_vector p R} (h : ∀ (n : ℕ), coeff x n = coeff y n) : x = y :=
  funext fun (n : ℕ) => h n

theorem ext_iff {p : ℕ} {R : Type u_1} {x : witt_vector p R} {y : witt_vector p R} : x = y ↔ ∀ (n : ℕ), coeff x n = coeff y n :=
  { mp := fun (h : x = y) (n : ℕ) => eq.mpr (id (Eq._oldrec (Eq.refl (coeff x n = coeff y n)) h)) (Eq.refl (coeff y n)),
    mpr := ext }

@[simp] theorem coeff_mk (p : ℕ) {R : Type u_1} (x : ℕ → R) : coeff (mk p x) = x :=
  rfl

/- These instances are not needed for the rest of the development,
but it is interesting to establish early on that `witt_vector p` is a lawful functor. -/

protected instance functor (p : ℕ) : Functor (witt_vector p) :=
  { map := fun (α β : Type u_1) (f : α → β) (v : witt_vector p α) => f ∘ v,
    mapConst := fun (α β : Type u_1) (a : α) (v : witt_vector p β) (_x : ℕ) => a }

protected instance is_lawful_functor (p : ℕ) : is_lawful_functor (witt_vector p) :=
  is_lawful_functor.mk (fun (α : Type u_1) (v : witt_vector p α) => rfl)
    fun (α β γ : Type u_1) (f : α → β) (g : β → γ) (v : witt_vector p α) => rfl

/-- The polynomials used for defining the element `0` of the ring of Witt vectors. -/
def witt_zero (p : ℕ) [hp : fact (nat.prime p)] : ℕ → mv_polynomial (fin 0 × ℕ) ℤ :=
  witt_structure_int p 0

/-- The polynomials used for defining the element `1` of the ring of Witt vectors. -/
def witt_one (p : ℕ) [hp : fact (nat.prime p)] : ℕ → mv_polynomial (fin 0 × ℕ) ℤ :=
  witt_structure_int p 1

/-- The polynomials used for defining the addition of the ring of Witt vectors. -/
def witt_add (p : ℕ) [hp : fact (nat.prime p)] : ℕ → mv_polynomial (fin (bit0 1) × ℕ) ℤ :=
  witt_structure_int p (mv_polynomial.X 0 + mv_polynomial.X 1)

/-- The polynomials used for describing the subtraction of the ring of Witt vectors. -/
def witt_sub (p : ℕ) [hp : fact (nat.prime p)] : ℕ → mv_polynomial (fin (bit0 1) × ℕ) ℤ :=
  witt_structure_int p (mv_polynomial.X 0 - mv_polynomial.X 1)

/-- The polynomials used for defining the multiplication of the ring of Witt vectors. -/
def witt_mul (p : ℕ) [hp : fact (nat.prime p)] : ℕ → mv_polynomial (fin (bit0 1) × ℕ) ℤ :=
  witt_structure_int p (mv_polynomial.X 0 * mv_polynomial.X 1)

/-- The polynomials used for defining the negation of the ring of Witt vectors. -/
def witt_neg (p : ℕ) [hp : fact (nat.prime p)] : ℕ → mv_polynomial (fin 1 × ℕ) ℤ :=
  witt_structure_int p (-mv_polynomial.X 0)

/-- An auxiliary definition used in `witt_vector.eval`.
Evaluates a polynomial whose variables come from the disjoint union of `k` copies of `ℕ`,
with a curried evaluation `x`.
This can be defined more generally but we use only a specific instance here. -/
def peval {R : Type u_1} [comm_ring R] {k : ℕ} (φ : mv_polynomial (fin k × ℕ) ℤ) (x : fin k → ℕ → R) : R :=
  coe_fn (mv_polynomial.aeval (function.uncurry x)) φ

/--
Let `φ` be a family of polynomials, indexed by natural numbers, whose variables come from the
disjoint union of `k` copies of `ℕ`, and let `xᵢ` be a Witt vector for `0 ≤ i < k`.

`eval φ x` evaluates `φ` mapping the variable `X_(i, n)` to the `n`th coefficient of `xᵢ`.

Instantiating `φ` with certain polynomials defined in `structure_polynomial.lean` establishes the
ring operations on `𝕎 R`. For example, `witt_vector.witt_add` is such a `φ` with `k = 2`;
evaluating this at `(x₀, x₁)` gives us the sum of two Witt vectors `x₀ + x₁`.
-/
def eval {p : ℕ} {R : Type u_1} [comm_ring R] {k : ℕ} (φ : ℕ → mv_polynomial (fin k × ℕ) ℤ) (x : fin k → witt_vector p R) : witt_vector p R :=
  mk p fun (n : ℕ) => peval (φ n) fun (i : fin k) => coeff (x i)

protected instance has_zero {p : ℕ} (R : Type u_1) [comm_ring R] [fact (nat.prime p)] : HasZero (witt_vector p R) :=
  { zero := eval (witt_zero p) matrix.vec_empty }

protected instance has_one {p : ℕ} (R : Type u_1) [comm_ring R] [fact (nat.prime p)] : HasOne (witt_vector p R) :=
  { one := eval (witt_one p) matrix.vec_empty }

protected instance has_add {p : ℕ} (R : Type u_1) [comm_ring R] [fact (nat.prime p)] : Add (witt_vector p R) :=
  { add := fun (x y : witt_vector p R) => eval (witt_add p) (matrix.vec_cons x (matrix.vec_cons y matrix.vec_empty)) }

protected instance has_sub {p : ℕ} (R : Type u_1) [comm_ring R] [fact (nat.prime p)] : Sub (witt_vector p R) :=
  { sub := fun (x y : witt_vector p R) => eval (witt_sub p) (matrix.vec_cons x (matrix.vec_cons y matrix.vec_empty)) }

protected instance has_mul {p : ℕ} (R : Type u_1) [comm_ring R] [fact (nat.prime p)] : Mul (witt_vector p R) :=
  { mul := fun (x y : witt_vector p R) => eval (witt_mul p) (matrix.vec_cons x (matrix.vec_cons y matrix.vec_empty)) }

protected instance has_neg {p : ℕ} (R : Type u_1) [comm_ring R] [fact (nat.prime p)] : Neg (witt_vector p R) :=
  { neg := fun (x : witt_vector p R) => eval (witt_neg p) (matrix.vec_cons x matrix.vec_empty) }

@[simp] theorem witt_zero_eq_zero (p : ℕ) [hp : fact (nat.prime p)] (n : ℕ) : witt_zero p n = 0 := sorry

@[simp] theorem witt_one_zero_eq_one (p : ℕ) [hp : fact (nat.prime p)] : witt_one p 0 = 1 := sorry

@[simp] theorem witt_one_pos_eq_zero (p : ℕ) [hp : fact (nat.prime p)] (n : ℕ) (hn : 0 < n) : witt_one p n = 0 := sorry

@[simp] theorem witt_add_zero (p : ℕ) [hp : fact (nat.prime p)] : witt_add p 0 = mv_polynomial.X (0, 0) + mv_polynomial.X (1, 0) := sorry

@[simp] theorem witt_sub_zero (p : ℕ) [hp : fact (nat.prime p)] : witt_sub p 0 = mv_polynomial.X (0, 0) - mv_polynomial.X (1, 0) := sorry

@[simp] theorem witt_mul_zero (p : ℕ) [hp : fact (nat.prime p)] : witt_mul p 0 = mv_polynomial.X (0, 0) * mv_polynomial.X (1, 0) := sorry

@[simp] theorem witt_neg_zero (p : ℕ) [hp : fact (nat.prime p)] : witt_neg p 0 = -mv_polynomial.X (0, 0) := sorry

@[simp] theorem constant_coeff_witt_add (p : ℕ) [hp : fact (nat.prime p)] (n : ℕ) : coe_fn mv_polynomial.constant_coeff (witt_add p n) = 0 := sorry

@[simp] theorem constant_coeff_witt_sub (p : ℕ) [hp : fact (nat.prime p)] (n : ℕ) : coe_fn mv_polynomial.constant_coeff (witt_sub p n) = 0 := sorry

@[simp] theorem constant_coeff_witt_mul (p : ℕ) [hp : fact (nat.prime p)] (n : ℕ) : coe_fn mv_polynomial.constant_coeff (witt_mul p n) = 0 := sorry

@[simp] theorem constant_coeff_witt_neg (p : ℕ) [hp : fact (nat.prime p)] (n : ℕ) : coe_fn mv_polynomial.constant_coeff (witt_neg p n) = 0 := sorry

@[simp] theorem zero_coeff (p : ℕ) (R : Type u_1) [hp : fact (nat.prime p)] [comm_ring R] (n : ℕ) : coeff 0 n = 0 := sorry

@[simp] theorem one_coeff_zero (p : ℕ) (R : Type u_1) [hp : fact (nat.prime p)] [comm_ring R] : coeff 1 0 = 1 := sorry

@[simp] theorem one_coeff_eq_of_pos (p : ℕ) (R : Type u_1) [hp : fact (nat.prime p)] [comm_ring R] (n : ℕ) (hn : 0 < n) : coeff 1 n = 0 := sorry

theorem add_coeff {p : ℕ} {R : Type u_1} [hp : fact (nat.prime p)] [comm_ring R] (x : witt_vector p R) (y : witt_vector p R) (n : ℕ) : coeff (x + y) n = peval (witt_add p n) (matrix.vec_cons (coeff x) (matrix.vec_cons (coeff y) matrix.vec_empty)) :=
  rfl

theorem sub_coeff {p : ℕ} {R : Type u_1} [hp : fact (nat.prime p)] [comm_ring R] (x : witt_vector p R) (y : witt_vector p R) (n : ℕ) : coeff (x - y) n = peval (witt_sub p n) (matrix.vec_cons (coeff x) (matrix.vec_cons (coeff y) matrix.vec_empty)) :=
  rfl

theorem mul_coeff {p : ℕ} {R : Type u_1} [hp : fact (nat.prime p)] [comm_ring R] (x : witt_vector p R) (y : witt_vector p R) (n : ℕ) : coeff (x * y) n = peval (witt_mul p n) (matrix.vec_cons (coeff x) (matrix.vec_cons (coeff y) matrix.vec_empty)) :=
  rfl

theorem neg_coeff {p : ℕ} {R : Type u_1} [hp : fact (nat.prime p)] [comm_ring R] (x : witt_vector p R) (n : ℕ) : coeff (-x) n = peval (witt_neg p n) (matrix.vec_cons (coeff x) matrix.vec_empty) :=
  rfl

theorem witt_add_vars (p : ℕ) [hp : fact (nat.prime p)] (n : ℕ) : mv_polynomial.vars (witt_add p n) ⊆ finset.product finset.univ (finset.range (n + 1)) :=
  witt_structure_int_vars p (mv_polynomial.X 0 + mv_polynomial.X 1) n

theorem witt_sub_vars (p : ℕ) [hp : fact (nat.prime p)] (n : ℕ) : mv_polynomial.vars (witt_sub p n) ⊆ finset.product finset.univ (finset.range (n + 1)) :=
  witt_structure_int_vars p (mv_polynomial.X 0 - mv_polynomial.X 1) n

theorem witt_mul_vars (p : ℕ) [hp : fact (nat.prime p)] (n : ℕ) : mv_polynomial.vars (witt_mul p n) ⊆ finset.product finset.univ (finset.range (n + 1)) :=
  witt_structure_int_vars p (mv_polynomial.X 0 * mv_polynomial.X 1) n

theorem witt_neg_vars (p : ℕ) [hp : fact (nat.prime p)] (n : ℕ) : mv_polynomial.vars (witt_neg p n) ⊆ finset.product finset.univ (finset.range (n + 1)) :=
  witt_structure_int_vars p (-mv_polynomial.X 0) n


import data.set
import logic.function.iterate
import algebra.group_power
import tactic.nth_rewrite
import data.list.basic

open set

namespace languages

variable {S : Type}

@[simp] def append_lang (L M: set (list S)) :=
    { w : list S | ∃ {left right}, left ∈ L ∧ right ∈ M ∧ w = left ++ right}

@[simp] lemma append_eps (A : set (list S)) : append_lang A {[]} = A :=
begin
    apply subset.antisymm, {
        rintro _ ⟨left, right, hleft, hright, rfl⟩,
        rw mem_singleton_iff at hright,
        rwa [hright, list.append_nil],
    }, {
        rintro x xa,
        use [x, [], xa, mem_singleton [], (list.append_nil x).symm],
    },
end

@[simp] lemma eps_append (A : set (list S)) : append_lang {[]} A = A :=
begin
    apply subset.antisymm, {
        rintro _ ⟨ left, right, hleft, hright, rfl ⟩,
        rw mem_singleton_iff at hleft,
        rwa [hleft, list.nil_append],
    }, {
        rintro x xa,
        use [[], x, xa, (list.nil_append x).symm],
    },
end

lemma append_assoc (A B C : set (list S)):
    append_lang (append_lang A B) C = append_lang A (append_lang B C) :=
begin
    apply subset.antisymm, {
        rintro _ ⟨_, right, ⟨ left, mid, hleft, hmid, rfl ⟩, hright, rfl ⟩,
        use [left, mid ++ right, hleft, mid, right, hmid, hright],
        exact list.append_assoc left mid right,
    }, {
        rintro _ ⟨left, _, hleft, ⟨ mid, right, hmid, hright, rfl ⟩, rfl ⟩,
        use [left ++ mid, right, left, mid, hleft, hmid, hright],
        exact (list.append_assoc left mid right).symm,
    },
end

instance : monoid (set (list S)) := {
    mul := append_lang,
    mul_assoc := append_assoc,
    one := {[]},
    one_mul := eps_append,
    mul_one := append_eps,
}

@[simp] lemma one_def : (1 : set (list S)) = {list.nil} := rfl

lemma append_subset_of_subset {A B C D : set (list S)} : A ⊆ C → B ⊆ D → A * B ⊆ C * D :=
begin
    rintro hAC hBD x ⟨left, right, hleft, hright, rfl⟩,
    use [left, right, hAC hleft, hBD hright],
end

lemma power_subset_of_subset {A B : set (list S)} {n : ℕ} : A ⊆ B → A^n ⊆ B^n :=
begin
    intro hAB,
    induction n with n hyp, {
        simp only [pow_zero],
    }, {
        rw pow_succ,
        apply append_subset_of_subset;
        assumption,
    },
end

lemma contain_eps_subset_power {A : set (list S)} {n : ℕ} {heps : 1 ⊆ A} : A ⊆ A^n.succ :=
begin
    induction n with n hyp, {
        rw pow_one,
    }, {
        rw pow_succ,
        nth_rewrite 0 ←one_mul A,
        apply append_subset_of_subset heps hyp,
    }
end

lemma power_eq_list_join {L : set (list S)} {w : list S} {n : ℕ} :
    w ∈ L^n ↔ ∃ l (h : ∀ x, x ∈ l → x ∈ L), w = list.join l ∧ l.length = n :=
begin
    split, {
        rintro hw,
        induction n with n hyp generalizing w hw, {
            use list.nil,
            simp only [mem_singleton_iff, one_def, pow_zero] at hw,
            simp only [hw, list.not_mem_nil, list.join, forall_const, forall_prop_of_false, list.length, eq_self_iff_true, not_false_iff,
  and_self],
        }, {
            rw pow_succ at hw,
            rcases hw with ⟨left, right, hleft, hright, rfl⟩,
            rcases hyp hright with ⟨l, h, rfl, rfl⟩,
            use [left :: l],
            simpa only [hleft, true_and, list.join, forall_eq_or_imp, and_true, list.mem_cons_iff, list.length, eq_self_iff_true],
        }
    }, {
        rintro ⟨l, h, rfl, rfl⟩,
        induction l with head tail hyp, {
            simp only [list.join, list.length, one_def, pow_zero, mem_singleton],
        }, {
            use [head, tail.join],
            split, {
                apply h head,
                apply list.mem_cons_self,
            },
            split, {
                apply hyp,
                intros x hx,
                refine (h _ _),
                simp only [hx, list.mem_cons_iff, or_true],
            },
            refl,
        },
    }
end

end languages


-- Diversion from LTL_Diff. What if we prove that the standard smooth maximum
-- actually approximates the maximum.

-- First attempt using vector ℝ n.

import data.real.basic
import data.list.min_max
import data.complex.exponential
import analysis.complex.basic
import analysis.special_functions.exp_log
import analysis.calculus.times_cont_diff

import vector

noncomputable theory

open real classical

-- Definition of soft_max.
section soft_max

variable (n : ℕ)

def soft_max (α : ℝ) : vector ℝ n → ℝ :=
λ v,
let num := (list.map (λ x, x * exp (α * x)) v.val).sum in
let den := (list.map (λ x, exp (α * x)) v.val).sum in
num / den

def Rn_norm : vector ℝ n → ℝ :=
λ v, sqrt (list.map (λ x, x ^ 2) v.val).sum

instance : has_norm (vector ℝ n) := ⟨Rn_norm n⟩

instance : add_comm_group (vector ℝ n) := {
    zero := vector.repeat 0 n,
    add := λ v₁ v₂, ⟨(list.map (λ i, vector.nth v₁ i + vector.nth v₂ i) (list.fin_range n)), by simp⟩,
    -- The proof of property should probably be by simp.
    neg := λ v, ⟨list.map (λ x, -x) v.val, by rw list.length_map _ _; exact v.property⟩,
    add_zero := λ v, begin
       ext,
       rw vector.nth_eq_nth_le,
       rw vector.nth_eq_nth_le,
       simp only [has_add.add, vector.to_list, vector.nth_map],
       sorry
    end,
    zero_add := λ v, sorry,
    add_left_neg := sorry,
    add_comm := sorry,
    add_assoc := sorry,
}

instance : metric_space (vector ℝ n) := {
    dist_self := sorry,
    eq_of_dist_eq_zero := sorry,
    dist_comm := sorry,
    dist_triangle := sorry,
}

instance : normed_group (vector ℝ n) := {
    dist_eq := sorry,
}

instance : normed_space ℝ (vector ℝ n) := sorry

-- Lemma 1: soft_max is smooth.
lemma smoothness : ∀ α, times_cont_diff ℝ ⊤ (soft_max n α) :=
sorry

end soft_max


/-
Copyright (c) 2020 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa, Jujian Zhang
-/
import number_theory.liouville.basic
/-!

# Liouville constants

This file contains a construction of a family of Liouville numbers, indexed by a natural number $m$.
The most important property is that they are examples of transcendental real numbers.
This fact is recorded in `liouville.is_transcendental`.

More precisely, for a real number $m$, Liouville's constant is
$$
\sum_{i=0}^\infty\frac{1}{m^{i!}}.
$$
The series converges only for $1 < m$.  However, there is no restriction on $m$, since,
if the series does not converge, then the sum of the series is defined to be zero.

We prove that, for $m \in \mathbb{N}$ satisfying $2 \le m$, Liouville's constant associated to $m$
is a transcendental number.  Classically, the Liouville number for $m = 2$ is the one called
``Liouville's constant''.

## Implementation notes

The indexing $m$ is eventually a natural number satisfying $2 ≤ m$.  However, we prove the first few
lemmas for $m \in \mathbb{R}$.
-/

noncomputable theory
open_locale nat big_operators
open real finset

namespace liouville

/--
For a real number `m`, Liouville's constant is
$$
\sum_{i=0}^\infty\frac{1}{m^{i!}}.
$$
The series converges only for `1 < m`.  However, there is no restriction on `m`, since,
if the series does not converge, then the sum of the series is defined to be zero.
-/
def liouville_number (m : ℝ) : ℝ := ∑' (i : ℕ), 1 / m ^ i!

/--
`liouville_number_initial_terms` is the sum of the first `k + 1` terms of Liouville's constant,
i.e.
$$
\sum_{i=0}^k\frac{1}{m^{i!}}.
$$
-/
def liouville_number_initial_terms (m : ℝ) (k : ℕ) : ℝ := ∑ i in range (k+1), 1 / m ^ i!

/--
`liouville_number_tail` is the sum of the series of the terms in `liouville_number m`
starting from `k+1`, i.e
$$
\sum_{i=k+1}^\infty\frac{1}{m^{i!}}.
$$
-/
def liouville_number_tail (m : ℝ) (k : ℕ) : ℝ := ∑' i, 1 / m ^ (i + (k+1))!

lemma liouville_number_tail_pos {m : ℝ} (hm : 1 < m) (k : ℕ) :
  0 < liouville_number_tail m k :=
-- replace `0` with the constantly zero series `∑ i : ℕ, 0`
calc  (0 : ℝ) = ∑' i : ℕ, 0 : tsum_zero.symm
          ... < liouville_number_tail m k :
  -- to show that a series with non-negative terms has strictly positive sum it suffices
  -- to prove that
  tsum_lt_tsum_of_nonneg
    -- 1. the terms of the zero series are indeed non-negative
    (λ _, rfl.le)
    -- 2. the terms of our series are non-negative
    (λ i, one_div_nonneg.mpr (pow_nonneg (zero_le_one.trans hm.le) _))
    -- 3. one term of our series is strictly positive -- they all are, we use the first term
    (one_div_pos.mpr (pow_pos (zero_lt_one.trans hm) (0 + (k + 1))!)) $
    -- 4. our series converges -- it does since it is the tail of a converging series, though
    -- this is not the argument here.
    summable_one_div_pow_of_le hm (λ i, trans le_self_add (nat.self_le_factorial _))

/--  Split the sum definining a Liouville number into the first `k` term and the rest. -/
lemma liouville_number_eq_initial_terms_add_tail {m : ℝ} (hm : 1 < m) (k : ℕ) :
  liouville_number m = liouville_number_initial_terms m k +
  liouville_number_tail m k :=
(sum_add_tsum_nat_add _ (summable_one_div_pow_of_le hm (λ i, i.self_le_factorial))).symm

/-! We now prove two useful inequalities, before collecting everything together. -/

/--  Partial inequality, works with `m ∈ ℝ` satisfying `1 < m`. -/
lemma tsum_one_div_pow_factorial_lt (n : ℕ) {m : ℝ} (m1 : 1 < m) :
  ∑' (i : ℕ), 1 / m ^ (i + (n + 1))! < (1 - 1 / m)⁻¹ * (1 / m ^ (n + 1)!) :=
-- two useful inequalities
have m0 : 0 < m := (zero_lt_one.trans m1),
have mi : |1 / m| < 1 :=
  (le_of_eq (abs_of_pos (one_div_pos.mpr m0))).trans_lt ((div_lt_one m0).mpr m1),
calc (∑' i, 1 / m ^ (i + (n + 1))!)
    < ∑' i, 1 / m ^ (i + (n + 1)!) :
    -- to show the strict inequality between these series, we prove that:
    tsum_lt_tsum_of_nonneg
      -- 1. the first series has non-negative terms
      (λ b, one_div_nonneg.mpr (pow_nonneg m0.le _))
      -- 2. the second series dominates the first
      (λ b, one_div_pow_le_one_div_pow_of_le m1.le (b.add_factorial_succ_le_factorial_add_succ n))
      -- 3. the term with index `i = 2` of the first series is strictly smaller than
      -- the corresponding term of the second series
      (one_div_pow_strict_anti m1 (n.add_factorial_succ_lt_factorial_add_succ rfl.le))
      -- 4. the second series is summable, since its terms grow quickly
      (summable_one_div_pow_of_le m1 (λ j, nat.le.intro rfl))
... = ∑' i, (1 / m) ^ i * (1 / m ^ (n + 1)!) :
    -- split the sum in the exponent and massage
    by { congr, ext i, rw [pow_add, ← div_div, div_eq_mul_one_div, one_div_pow] }
-- factor the constant `(1 / m ^ (n + 1)!)` out of the series
... = (∑' i, (1 / m) ^ i) * (1 / m ^ (n + 1)!) : tsum_mul_right
... = (1 - 1 / m)⁻¹ * (1 / m ^ (n + 1)!) :
    -- the series if the geometric series
    mul_eq_mul_right_iff.mpr (or.inl (tsum_geometric_of_abs_lt_1 mi))

lemma aux_calc (n : ℕ) {m : ℝ} (hm : 2 ≤ m) :
  (1 - 1 / m)⁻¹ * (1 / m ^ (n + 1)!) ≤ 1 / (m ^ n!) ^ n :=
calc (1 - 1 / m)⁻¹ * (1 / m ^ (n + 1)!) ≤ 2 * (1 / m ^ (n + 1)!) :
  -- the second factors coincide (and are non-negative),
  -- the first factors, satisfy the inequality `sub_one_div_inv_le_two`
  mul_le_mul_of_nonneg_right (sub_one_div_inv_le_two hm) (by positivity)
... = 2 / m ^ (n + 1)! : mul_one_div 2 _
... = 2 / m ^ (n! * (n + 1)) : congr_arg ((/) 2) (congr_arg (pow m) (mul_comm _ _))
... ≤ 1 / m ^ (n! * n) :
  begin
    -- [ NB: in this block, I do not follow the brace convention for subgoals -- I wait until
    --   I solve all extraneous goals at once with `exact pow_pos (zero_lt_two.trans_le hm) _`. ]
    -- Clear denominators and massage*
    apply (div_le_div_iff _ _).mpr,
    conv_rhs { rw [one_mul, mul_add, pow_add, mul_one, pow_mul, mul_comm, ← pow_mul] },
    -- the second factors coincide, so we prove the inequality of the first factors*
    refine (mul_le_mul_right _).mpr _,
    -- solve all the inequalities `0 < m ^ ??`
    any_goals { exact pow_pos (zero_lt_two.trans_le hm) _ },
    -- `2 ≤ m ^ n!` is a consequence of monotonicity of exponentiation at `2 ≤ m`.
    exact trans (trans hm (pow_one _).symm.le) (pow_mono (one_le_two.trans hm) n.factorial_pos)
  end
... = 1 / (m ^ n!) ^ n : congr_arg ((/) 1) (pow_mul m n! n)

/-!  Starting from here, we specialize to the case in which `m` is a natural number. -/

/--  The sum of the `k` initial terms of the Liouville number to base `m` is a ratio of natural
numbers where the denominator is `m ^ k!`. -/
lemma liouville_number_rat_initial_terms {m : ℕ} (hm : 0 < m) (k : ℕ) :
∃ p : ℕ, liouville_number_initial_terms m k = p / m ^ k! :=
begin
  induction k with k h,
  { exact ⟨1, by rw [liouville_number_initial_terms, range_one, sum_singleton, nat.cast_one]⟩ },
  { rcases h with ⟨p_k, h_k⟩,
    use p_k * (m ^ ((k + 1)! - k!)) + 1,
    unfold liouville_number_initial_terms at h_k ⊢,
    rw [sum_range_succ, h_k, div_add_div, div_eq_div_iff, add_mul],
    { norm_cast,
      rw [add_mul, one_mul, nat.factorial_succ,
        show k.succ * k! - k! = (k.succ - 1) * k!, by rw [tsub_mul, one_mul],
        nat.succ_sub_one, add_mul, one_mul, pow_add],
      simp [mul_assoc] },
    refine mul_ne_zero_iff.mpr ⟨_, _⟩,
    all_goals { exact pow_ne_zero _ (nat.cast_ne_zero.mpr hm.ne.symm) } }
end

theorem is_liouville {m : ℕ} (hm : 2 ≤ m) :
  liouville (liouville_number m) :=
begin
  -- two useful inequalities
  have mZ1 : 1 < (m : ℤ), { norm_cast, exact one_lt_two.trans_le hm },
  have m1 : 1 < (m : ℝ), { norm_cast, exact one_lt_two.trans_le hm },
  intro n,
  -- the first `n` terms sum to `p / m ^ k!`
  rcases liouville_number_rat_initial_terms (zero_lt_two.trans_le hm) n with ⟨p, hp⟩,
  refine ⟨p, m ^ n!, one_lt_pow mZ1 n.factorial_ne_zero, _⟩,
  push_cast,
  -- separate out the sum of the first `n` terms and the rest
  rw [liouville_number_eq_initial_terms_add_tail m1 n,
    ← hp, add_sub_cancel', abs_of_nonneg (liouville_number_tail_pos m1 _).le],
  exact ⟨((lt_add_iff_pos_right _).mpr (liouville_number_tail_pos m1 n)).ne.symm,
    (tsum_one_div_pow_factorial_lt n m1).trans_le
    (aux_calc _ (nat.cast_two.symm.le.trans (nat.cast_le.mpr hm)))⟩
end

/- Placing this lemma outside of the `open/closed liouville`-namespace would allow to remove
`_root_.`, at the cost of some other small weirdness. -/
lemma is_transcendental {m : ℕ} (hm : 2 ≤ m) :
  _root_.transcendental ℤ (liouville_number m) :=
transcendental (is_liouville hm)

end liouville


import analysis.mean_inequalities extra.periodic.big_operators extra.real_prop.real_quadratic_sol

/-! # IMO 2018 A7 -/

namespace IMOSL
namespace IMO2018A7

open finset nnreal function
open_locale nnreal

noncomputable def target_sum (q : ℝ≥0) (a : ℕ → ℝ≥0) (n : ℕ) :=
  (range n).sum (λ i, (a i / (a (i + 1) + q)) ^ (3⁻¹ : ℝ))

section extra_lemmas

private lemma classical_cauchy_schwarz {α : Type*} (S : finset α) (a b : α → ℝ≥0) :
  S.sum (λ i, sqrt (a i * b i)) ^ 2 ≤ S.sum a * S.sum b :=
begin
  rw [← le_sqrt_iff, sqrt_eq_rpow, mul_rpow],
  convert nnreal.inner_le_Lp_mul_Lq
    S (λ i, sqrt (a i)) (λ i, sqrt (b i)) ⟨one_lt_two, add_halves' 1⟩,
  funext i; rw sqrt_mul,
  all_goals { funext i; rw [← nat.cast_two, rpow_nat_cast, sq_sqrt] }
end

private lemma lem1 {q : ℝ≥0} (hq : 0 < q) (x c : ℝ≥0) :
  2 * c * sqrt x + c ^ 2 * q * (x + q)⁻¹ ≤ x + q + c ^ 2 :=
begin
  have X := add_pos_of_nonneg_of_pos (zero_le x) hq,
  rw [← mul_le_mul_right X, add_mul, mul_assoc (c ^ 2 * q), inv_mul_cancel (ne_of_gt X),
      mul_one, add_mul, ← sq, mul_add (c ^ 2), ← add_assoc, add_le_add_iff_right],
  obtain ⟨y, rfl⟩ : ∃ y : ℝ≥0, y ^ 2 = x := ⟨sqrt x, sq_sqrt x⟩,
  rw [sqrt_sq, ← mul_pow, mul_assoc 2 c],
  generalizes [y ^ 2 + q = r, c * y = s],
  rw [← nnreal.coe_le_coe, nnreal.coe_mul, nnreal.coe_mul, nnreal.coe_add, nnreal.coe_pow,
      nnreal.coe_pow, nnreal.coe_bit0, nnreal.coe_one, mul_right_comm],
  exact two_mul_le_add_sq ↑r ↑s
end

private lemma lem2 (a b : ℝ≥0) : (a ^ 2 / b) ^ (3⁻¹ : ℝ) = a / (a * b) ^ (3⁻¹ : ℝ) :=
begin
  have X : (3 : ℝ) ≠ 0 := three_ne_zero,
  rw [← rpow_eq_rpow_iff X, inv_eq_one_div, rpow_self_rpow_inv X,
      div_rpow, rpow_self_rpow_inv X, ← div_div],
  congr; rcases eq_or_ne a 0 with rfl | ha,
  rw [sq, zero_mul, div_zero],
  rw [eq_div_iff ha, ← pow_succ', ← rpow_nat_cast, ← bit1, nat.cast_bit1, nat.cast_one]
end

end extra_lemmas

section upper_bound

variables {a : ℕ → ℝ≥0} {n : ℕ} (hn : 0 < n) {q t r : ℝ≥0} (hq : 0 < q)
  (ht : (range n).sum (λ i, sqrt (a i)) = n • t) (hr : (range n).sum (λ i, (a i + q)⁻¹) = n • r)
include hn hq ht hr

private lemma holder_target (h : periodic a n) : target_sum q a n ≤ n • (t ^ 2 * r) ^ (3⁻¹ : ℝ) :=
begin
  have X : (3 / 2 : ℝ).is_conjugate_exponent 3 := by rw real.is_conjugate_exponent_iff; norm_num,
  unfold target_sum; convert nnreal.inner_le_Lp_mul_Lq (range n)
    (λ i, a i ^ (3⁻¹ : ℝ)) (λ i, (a (i + 1) + q)⁻¹ ^ (3⁻¹ : ℝ)) X,
  funext; rw [div_eq_mul_inv, mul_rpow],
  replace X : (3 : ℝ) ≠ 0 := three_ne_zero,
  rw [one_div_div, ← rpow_eq_rpow_iff X, nsmul_eq_mul, mul_rpow, ← rpow_mul, inv_mul_cancel X,
      rpow_one, mul_rpow, ← rpow_mul, div_mul_cancel 2 X, ← rpow_mul, div_mul_cancel 1 X, rpow_one],
  conv_rhs {
    congr, congr, congr, skip, funext, rw [← rpow_mul, mul_div, inv_mul_cancel X, ← sqrt_eq_rpow],
    skip, skip, congr, skip, funext, rw [← rpow_mul, inv_mul_cancel X, rpow_one] },
  replace h : periodic (λ i, (a i + q)⁻¹) n := λ i, by simp only []; rw h,
  rw [ht, extra.periodic_sum_const h, hr, nsmul_eq_mul, mul_rpow, nsmul_eq_mul,
      mul_mul_mul_comm, ← rpow_nat_cast, nat.cast_two, bit1, rpow_add, rpow_one],
  rw nat.cast_ne_zero; exact ne_of_gt hn
end

variables {p : ℝ≥0} (hp : (range n).sum a = n • p)
include hp

private lemma case_p_le_q_step1 : t ^ 2 + q * r * (p + q) ≤ p + q :=
begin
  replace hn : 0 < (n : ℝ≥0) := nat.cast_pos.mpr hn,
  rw [← mul_le_mul_left (pow_pos hn 2), mul_add, ← mul_pow, ← nsmul_eq_mul],
  have X : ∀ i : ℕ, a i + q ≠ 0 := λ i, ne_of_gt (add_pos_of_nonneg_of_pos ((zero_le (a i))) hq),
  suffices : (n • t) ^ 2 ≤ (range n).sum (λ i, a i / (a i + q)) * (n * (p + q)),
  { convert add_le_add_right this _,
    rw [← mul_assoc, ← mul_assoc, ← add_mul]; congr' 1,
    rw [mul_comm, sq, mul_assoc, ← mul_add]; congr' 1,
    rw [mul_left_comm, ← nsmul_eq_mul, ← hr, mul_sum, ← sum_add_distrib],
    conv_rhs { congr, skip, funext, rw [← div_eq_mul_inv, ← add_div, div_self (X x)] },
    rw [sum_const, nsmul_one, card_range] },
  rw ← ht; convert classical_cauchy_schwarz (range n) (λ i, a i / (a i + q)) (λ i, a i + q),
  funext i; rw div_mul_cancel _ (X i),
  rw [sum_add_distrib, hp, sum_const, card_range, ← nsmul_add, nsmul_eq_mul]
end

private lemma case_p_le_q_step2 (h : p ≤ q) : t ^ 2 * r ≤ p / (p + q) :=
begin
  rw [nnreal.le_div_iff (ne_of_gt (add_pos_of_nonneg_of_pos (zero_le p) hq)),
      ← mul_le_mul_left hq, mul_assoc, mul_left_comm, ← mul_assoc q, mul_comm q p],
  suffices h0 : t ^ 2 ≤ p,
  { have h1 := case_p_le_q_step1 hn hq ht hr hp,
    set c := q * r * (p + q) with hc,
    rw le_iff_exists_add at h0,
    rw ← hc; rcases h0 with ⟨a, rfl⟩,
    rw [add_assoc, add_le_add_iff_left] at h1,
    refine le_trans (mul_le_mul_left' h1 _) _,
    rw [add_comm, mul_add, add_mul, add_le_add_iff_left, mul_comm],
    exact mul_le_mul_left' (le_trans le_self_add h) a },
  replace hn : 0 < (n : ℝ≥0) := nat.cast_pos.mpr hn,
  rw [← mul_le_mul_left (pow_pos hn 2), ← mul_pow, ← nsmul_eq_mul,
      ← ht, sq (n : ℝ≥0), mul_assoc, ← nsmul_eq_mul n p, ← hp],
  convert classical_cauchy_schwarz (range n) (λ _, 1) a,
  funext i; rw one_mul,
  rw [sum_const, nsmul_one, card_range]
end

private lemma case_p_ge_q_step1 (c : ℝ≥0) : 2 * c * t + c ^ 2 * q * r ≤ p + q + c ^ 2 :=
begin
  replace hn : 0 < (n : ℝ≥0) := nat.cast_pos.mpr hn,
  rw [← mul_le_mul_left hn, mul_add, mul_left_comm, ← nsmul_eq_mul, ← ht,
      mul_left_comm, ← nsmul_eq_mul, ← hr, mul_sum, mul_sum, ← sum_add_distrib],
  refine le_of_le_of_eq (sum_le_sum (λ i _, lem1 hq (a i) c)) _,
  rw [sum_add_distrib, sum_const, sum_add_distrib, sum_const,
      hp, card_range, ← smul_add, ← smul_add, ← nsmul_eq_mul]
end

private lemma case_p_ge_q_step2 : t ^ 2 * r ≤ (p + q) / (4 * q) :=
begin
  have X : (3 : ℝ≥0) ≠ 0 := by norm_num,
  have h : ∀ a b : ℝ≥0, 3 * (a ^ 2 * b) ^ (3⁻¹ : ℝ) ≤ 2 * a + b :=
  begin
    intros a b,
    rw [mul_le_iff_le_inv X, mul_comm (3⁻¹ : ℝ≥0), ← div_eq_mul_inv, add_div, mul_div_right_comm,
        div_eq_mul_one_div b, mul_comm b, mul_rpow, ← rpow_nat_cast, nat.cast_two, ← rpow_mul],
    convert geom_mean_le_arith_mean2_weighted _ _ _ _ _,
    rw [nonneg.coe_div, nnreal.coe_bit1, nnreal.coe_bit0, nnreal.coe_one, div_eq_mul_inv],
    rw [← inv_eq_one_div, nnreal.coe_inv, nnreal.coe_bit1, nnreal.coe_one],
    rw [← add_div, ← bit1, div_self X]
  end,

  replace h := h (sqrt (2 * (p + q)) * t) (sqrt (2 * (p + q)) ^ 2 * q * r),
  rw ← mul_assoc 2 (sqrt (2 * (p + q))) at h,
  replace h := le_trans h (case_p_ge_q_step1 hn hq ht hr hp _),
  rw [mul_pow, sq_sqrt, ← one_add_mul, add_comm (1 : ℝ≥0), ← bit1, mul_le_mul_left₀ X,
      inv_eq_one_div, rpow_one_div_le_iff zero_lt_three, mul_mul_mul_comm] at h,
  generalize_hyp h0 : p + q = d at h ⊢,
  generalize_hyp h1 : t ^ 2 * r = f at h ⊢,
  rw [← mul_assoc, ← sq, mul_comm 2 d, mul_pow, sq (2 : ℝ≥0), mul_two, ← bit0] at h,
  replace X : 0 < d := by rw ← h0; exact add_pos_of_nonneg_of_pos (zero_le p) hq,
  rwa [mul_assoc (d ^ 2), mul_assoc, bit1, rpow_add (ne_of_gt X), rpow_one, ← rpow_nat_cast,
       nat.cast_two, mul_le_mul_left (rpow_pos X), mul_comm, ← nnreal.le_div_iff] at h,
  exact mul_ne_zero four_ne_zero (ne_of_gt hq)
end

end upper_bound

/-- Final solution, case `p ≤ q` -/
theorem final_solution_case_p_le_q {q p : ℝ≥0} (hq : 0 < q) (h : p ≤ q) (n : ℕ) :
  is_greatest ((λ a : ℕ → ℝ≥0, target_sum q a n) ''
    {a | (range n).sum a = n • p ∧ periodic a n})
  (n • (p / (p + q)) ^ (3⁻¹ : ℝ)) :=
begin
  refine ⟨⟨λ _, p, ⟨by rw [sum_const, card_range], λ i, rfl⟩, _⟩, λ c h, _⟩,
  unfold target_sum; rw [sum_const, card_range],
  rcases h with ⟨a, ⟨h0, h1⟩, rfl⟩,
  rcases n.eq_zero_or_pos with rfl | hn,
  unfold target_sum; rw [sum_range_zero, zero_smul],
  have X : (n : ℝ≥0) ≠ 0 := ne_of_gt (nat.cast_pos.mpr hn),
  obtain ⟨t, ht⟩ : ∃ t : ℝ≥0, (range n).sum (λ i, sqrt (a i)) = n • t :=
    ⟨(range n).sum (λ i, sqrt (a i)) / n, by rw [nsmul_eq_mul, mul_div_cancel' _ X]⟩,
  obtain ⟨r, hr⟩ : ∃ r : ℝ≥0, (range n).sum (λ i, (a i + q)⁻¹) = n • r :=
    ⟨(range n).sum (λ i, (a i + q)⁻¹) / n, by rw [nsmul_eq_mul, mul_div_cancel' _ X]⟩,
  refine le_trans (holder_target hn hq ht hr h1) (smul_le_smul_of_nonneg _ n.zero_le),
  exact rpow_le_rpow (case_p_le_q_step2 hn hq ht hr h0 h) (inv_nonneg.mpr zero_le_three)
end

/-- Final solution, case `q ≤ p` -/
theorem final_solution_case_q_le_p {q p : ℝ≥0} (hq : 0 < q) (h : q ≤ p) (n : ℕ) :
  is_greatest ((λ a : ℕ → ℝ≥0, target_sum q a (2 * n)) ''
    {a | (range (2 * n)).sum a = (2 * n) • p ∧ periodic a (2 * n)})
  ((2 * n) • ((p + q) / (4 * q)) ^ (3⁻¹ : ℝ)) :=
begin
  refine ⟨_, λ c h, _⟩,
  { obtain ⟨u, v, h0, h1⟩ : ∃ u v : ℝ≥0, u + v = 2 * p ∧ u * v = q ^ 2 :=
    begin
      let x := sqrt (p ^ 2 - q ^ 2),
      have hx : x ≤ p := by rw sqrt_le_iff; exact tsub_le_self,
      refine ⟨p + x, p - x, _, _⟩,
      rw [add_assoc, add_tsub_cancel_of_le hx, two_mul],
      rw [← nnreal.coe_eq, nnreal.coe_mul, nnreal.coe_add, nnreal.coe_sub hx, ← sq_sub_sq,
          ← nnreal.coe_pow, ← nnreal.coe_pow, sq_sqrt, nnreal.coe_sub, sub_sub_cancel],
      rwa [← sqrt_le_iff, sqrt_sq]
    end,

    refine ⟨λ n, ite (even n) u v, ⟨_, λ i, _⟩, _⟩,
    { induction n with n n_ih,
      rw [mul_zero, sum_range_zero, zero_smul],
      rw [nat.mul_succ, sum_range_add, n_ih, sum_range_succ, sum_range_one, add_zero],
      simp only [nat.even_add_one, if_true, if_false, even.mul_right even_two n, not_true],
      rw [h0, add_smul, nsmul_eq_mul 2, nat.cast_two] },
    simp only [nat.even_add, even.mul_right even_two n, iff_true],
    suffices h2 : (u / (v + q)) ^ (3⁻¹ : ℝ) + (v / (u + q)) ^ (3⁻¹ : ℝ) =
      2 • ((p + q) / (4 * q)) ^ (3⁻¹ : ℝ),
    { simp only [target_sum, nat.even_add_one, ite_not],
      induction n with n n_ih,
      rw [mul_zero, zero_smul, sum_range_zero],
      rw [nat.mul_succ, sum_range_add, n_ih, add_smul, sum_range_succ, sum_range_one, add_zero],
      simp only [nat.even_add_one, if_true, if_false, even.mul_right even_two n, not_true, h2] },
    { obtain ⟨x, rfl⟩ : ∃ x : ℝ≥0, x ^ 2 = u := ⟨sqrt u, by rw sq_sqrt⟩,
      obtain ⟨y, rfl⟩ : ∃ y : ℝ≥0, y ^ 2 = v := ⟨sqrt v, by rw sq_sqrt⟩,
      rw [← mul_pow, sq_eq_sq (zero_le (x * y)) (zero_le q)] at h1,
      rw [← add_left_inj (2 * x * y), ← add_sq', mul_assoc, ← mul_add, h1] at h0,
      rw [nsmul_eq_mul, ← rpow_inv_rpow_self three_ne_zero ↑2, nat.cast_two, ← inv_eq_one_div,
          ← mul_rpow, mul_comm, mul_comm 4 q, lem2, lem2, ← div_div, div_mul_comm],
      change (4 : ℝ≥0) with (2 + 2 : ℝ≥0),
      rw [← two_mul, ← sq, ← rpow_nat_cast 2, nat.cast_two, ← rpow_sub two_ne_zero,
          bit1, add_sub_cancel', rpow_one, ← bit1, ← mul_div_assoc, ← h0, lem2, ← h1],
      convert (add_div x y (((x + y) * (x * y)) ^ (3⁻¹ : ℝ))).symm using 4,
      rw [sq, ← add_mul, add_comm, mul_left_comm],
      rw [sq, ← mul_add, ← mul_assoc, mul_comm, mul_comm y x] } },

  { rcases h with ⟨a, ⟨h0, h1⟩, rfl⟩,
    rcases n.eq_zero_or_pos with rfl | hn,
    unfold target_sum; rw [mul_zero, sum_range_zero, zero_smul],
    replace hn : 0 < 2 * n := mul_pos two_pos hn,
    have X : ((2 * n : ℕ) : ℝ≥0) ≠ 0 := nat.cast_ne_zero.mpr (ne_of_gt hn),
    obtain ⟨t, ht⟩ : ∃ t : ℝ≥0, (range (2 * n)).sum (λ i, sqrt (a i)) = (2 * n) • t :=
      ⟨(range (2 * n)).sum (λ i, sqrt (a i)) / ↑(2 * n),
        by rw [nsmul_eq_mul, mul_div_cancel' _ X]⟩,
    obtain ⟨r, hr⟩ : ∃ r : ℝ≥0, (range (2 * n)).sum (λ i, (a i + q)⁻¹) = (2 * n) • r :=
      ⟨(range (2 * n)).sum (λ i, (a i + q)⁻¹) / ↑(2 * n),
        by rw [nsmul_eq_mul, mul_div_cancel' _ X]⟩,
    refine le_trans (holder_target hn hq ht hr h1) (smul_le_smul_of_nonneg _ (le_of_lt hn)),
    exact rpow_le_rpow (case_p_ge_q_step2 hn hq ht hr h0) (inv_nonneg.mpr zero_le_three) }
end

end IMO2018A7
end IMOSL


inductive Foo : Bool → Type
| Z  : Foo false
| O  : Foo false → Foo true
| E  : Foo true → Foo false

open Foo

def toNat : {b : Bool} → Foo b → Nat
| _, Z   => 0
| _, O n => toNat n + 1
| _, E n => toNat n + 1

example : toNat (E (O Z)) = 2 :=
rfl

example : toNat Z = 0 :=
rfl

example (a : Foo false) : toNat (O a) = toNat a + 1 :=
rfl

example (a : Foo true) : toNat (E a) = toNat a + 1 :=
rfl


import .group_representation
import linear_algebra.determinant
import linear_algebra.matrix
import data.complex.basic
open linear_map
notation `Σ` := finset.sum finset.univ
universe variables u v w
open matrix
namespace character
variables {G : Type u} {R : Type v} [group G] [comm_ring R]
variables {n : Type w} [fintype n] [decidable_eq n]
variables (ρ : group_representation G R (n → R))
def mat (ρ : group_representation G R (n → R))(g : G) : matrix n n R :=
                 to_matrix (ρ g : (n → R) →ₗ[R] (n→ R))
namespace tools

/-
     Technical
     C'est vraiment trop leger !
-/
lemma proof_strategy (A B : matrix n n R) : to_lin A = to_lin B → A = B := begin
     intro hyp,
     have RR : to_matrix (to_lin A) = to_matrix (to_lin B),
          congr',
     iterate 2 {rw  to_lin_to_matrix  at RR},
     exact RR,
end
@[simp]lemma mat_ext (ρ : group_representation G R (n → R))(g : G) : mat ρ = λ g, to_matrix (ρ g : (n → R) →ₗ[R] (n→ R))  := rfl
lemma coersion₇ (g1 g2 : G) : (↑(ρ g1 * ρ g2) : (n → R) →ₗ[R] (n→ R)) = (ρ g1 :  (n → R) →ₗ[R] (n→ R) ) *  ρ g2  := rfl

@[simp]lemma  mat_mul' (g1 g2 : G) :
to_matrix (ρ (g1 * g2) : (n → R) →ₗ[R] (n→ R) ) =
to_matrix (ρ g1 : (n → R) →ₗ[R] (n→ R)) *  to_matrix (ρ g2) := begin
    rw ρ.map_mul, rw  coersion₇, apply proof_strategy, rw mul_eq_mul,
     rw mul_to_lin, rw to_matrix_to_lin, rw to_matrix_to_lin, rw to_matrix_to_lin, exact rfl,
end
end tools
open tools
#check  mat ρ
def χ  : G →  R :=  λ g, matrix.trace n R R (mat ρ g)

lemma chi_apply (g : G) : χ ρ g = matrix.trace n R R (mat ρ g) := rfl
#check χ ρ
variables (g : G)
#check χ ρ

@[simp]lemma mat_mul (g1 g2 : G) : mat ρ (g1 * g2)  = mat ρ g1 * mat ρ g2 := begin
    exact mat_mul' ρ g1 g2,
end
def   trace_mul_com (A B : matrix n n R)  :  matrix.trace n R R (A * B) = matrix.trace n R R (B *A)  :=
 begin rw mul_eq_mul,rw trace_mul_comm, rw ← mul_eq_mul, end  --homotopy

@[simp]theorem χ_is_central ( s t : G) : χ ρ (s * t) = χ ρ (t *  s ):=
begin
    rw chi_apply,rw chi_apply, rw mat_mul, rw trace_mul_com, rw ← mat_mul,
 end

@[simp]theorem χ_is_constante_on_conjugacy_classes ( s t : G) : χ ρ ( t⁻¹ * s * t) = χ ρ (  s ):= begin
    rw χ_is_central, rw ← mul_assoc, rw mul_inv_self, rw one_mul,
end
@[simp]lemma to_matrix_one : to_matrix (↑(ρ 1 ) : (n → R) →ₗ[R] (n→ R) ) = 1 := begin
     rw ρ.map_one,
     apply proof_strategy,
     rw to_matrix_to_lin,
     rw to_lin_one, exact rfl,   --- there is not this function in mathlib
end
@[simp]lemma mat_one : mat ρ 1 = 1 := to_matrix_one ρ
@[simp]lemma mat_mul_inv_self (g : G) : mat ρ g * mat ρ g⁻¹ = 1 := begin rw ← mat_mul,rw mul_inv_self, rw mat_one, end
@[simp]theorem χ_one : χ ρ 1 =  fintype.card n := begin
     rw chi_apply, rw mat_one, rw trace_one,
end
end character
section
variables {G :Type u} (R : Type v) [group G] [comm_ring R][fintype G][decidable_eq G]
def central_function  (f : G → R) :=  ∀ s t : G, f (s * t) = f (t * s)
lemma central (f : G → R)[hyp : central_function   R f] (s t : G) :  f (s * t) = f (t * s) := hyp s t

theorem central_function_are_constant_on_conujugacy_classses (f : G → R)[hyp : central_function  R f]
               : ∀ s t : G, f (t⁻¹ * s * t) =  f s :=
begin
    intros s t, rw hyp,rw ← mul_assoc, rw mul_inv_self, rw one_mul,
end
notation  `inv` G  := ((1 / fintype.card G) : ℂ )
noncomputable def scalar_product   (φ ψ : G → ℂ  ) :=
       (inv G)   * (Σ  (λ t : G, (φ t) *  (complex.conj (ψ t))))

variables (φ ψ :  G → ℂ  )
notation `《 ` φ ` | ` ψ ` 》` := scalar_product φ ψ
/--
     `《 φ + γ | ψ 》 = 《 φ | ψ 》 + 《 γ  | ψ 》`
-/
theorem add_first  (φ ψ γ  : G → ℂ  ) : 《 φ + γ | ψ 》 = 《 φ | ψ 》 + 《 γ  | ψ 》 :=
begin
      unfold scalar_product,rw ← left_distrib, erw ← multiset.sum_map_add,
     have f : (λ (a : G), φ a * complex.conj (ψ a) + γ a * complex.conj (ψ a)) = (λ (a : G), (φ a  + γ a ) * complex.conj (ψ a)),
          funext,
          rw ← right_distrib,
     erw f,
     exact rfl,
end
/--
     `《 r • φ  | ψ 》 = r • 《 φ | ψ 》`
-/
theorem smul_first  (r : ℂ) (φ ψ   : G → ℂ  ) : 《 r • φ  | ψ 》 = r • 《 φ | ψ 》 := begin
      unfold scalar_product,
      change 1 / ↑(fintype.card G) * Σ (λ (t : G), r * (φ t) * complex.conj (ψ t)) = _,
      have re : (λ (t : G), r * (φ t) * complex.conj (ψ t)) =  (λ (t : G), r •((φ t) * complex.conj (ψ t))),
          funext,
          rw mul_assoc, exact rfl,
     rw re,
     erw  ←  finset.mul_sum ,erw ← mul_assoc, erw mul_comm _ r , simp, rw mul_assoc,
end
lemma Sum.morp
{X : Type u}[fintype X] (g : X → ℂ )  : complex.conj ( Σ (λ t,  g t )) =  Σ (λ t, complex.conj ( g t) )    := begin
    exact eq.symm (finset.sum_hom finset.univ complex.conj),
end
theorem conj_scalar (φ ψ   : G → ℂ  ) : complex.conj(《  φ  | ψ 》) = 《 ψ  | φ 》 := begin
     unfold scalar_product, rw complex.conj_mul,
     --have : complex.conj (Σ (λ (t : G), φ t * complex.conj (ψ t))) =   Σ (λ (t : G), complex.conj (φ t * complex.conj (ψ t))),
          erw Sum.morp,simp,
end
#check is_add_monoid_hom (complex.conj)
end


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

import ..isomorphism

open category_theory

namespace category_theory.initial

universes u v

structure initial_object (C : Type u) [category.{u v} C] :=
(obj        : C)
(to         : ∀ Y : C, obj ⟶ Y)
(uniqueness : ∀ Y : C, ∀ f g : obj ⟶ Y, f = g . obviously)

attribute [back] initial_object.to
restate_axiom initial_object.uniqueness
attribute [back,ematch] initial_object.uniqueness_lemma

structure terminal_object (C : Type u) [category.{u v} C]  :=
(obj                            : C)
(«from»            : ∀ Y : C, Y ⟶ obj)
(uniqueness : ∀ Y : C, ∀ f g : Y ⟶ obj, f = g . obviously)

attribute [back] terminal_object.«from»
restate_axiom terminal_object.uniqueness
attribute [back,ematch] terminal_object.uniqueness_lemma

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

instance initial_object_coe : has_coe (initial_object C) C :=
{ coe := initial_object.obj }

structure is_initial (X : C) :=
(to         : ∀ Y : C, X ⟶ Y)
(uniqueness : ∀ Y : C, ∀ f g : X ⟶ Y, f = g)

-- set_option pp.all true
lemma initial_objects_unique (X Y : initial_object C) : X.obj ≅ Y.obj :=
begin
  -- `obviously'` says:
  fsplit,
  apply initial_object.to,
  apply initial_object.to,
  apply initial_object.uniqueness_lemma,
  apply initial_object.uniqueness_lemma
end

instance terminal_object_coe : has_coe (terminal_object C) C :=
{ coe := terminal_object.obj }

structure is_terminal (X : C) :=
(«from»     : ∀ Y : C, Y ⟶ X)
(uniqueness : ∀ Y : C, ∀ f g : Y ⟶ X, f = g)

lemma terminal_objects_unique (X Y : terminal_object C) : X.obj ≅ Y.obj :=
begin
  -- `obviously'` says:
  fsplit,
  apply terminal_object.«from»,
  apply terminal_object.«from»,
  apply terminal_object.uniqueness_lemma,
  apply terminal_object.uniqueness_lemma
end

end

structure zero_object (C : Type u) [category.{u v} C] :=
(obj         : C)
(is_initial  : is_initial.{u v}  obj)
(is_terminal : is_terminal.{u v} obj)

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

instance zero_object_coe : has_coe (zero_object C) C :=
{ coe := zero_object.obj }

-- TODO get rid of this
definition ZeroObject.zero_morphism (Z : zero_object C) (X Y : C) : X ⟶ Y := (Z.is_terminal.«from» X) ≫ (Z.is_initial.to Y)

end category_theory.initial


/-
Copyright (c) 2020 Alexander Bentkamp. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Alexander Bentkamp.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.field_theory.algebraic_closure
import Mathlib.linear_algebra.finsupp
import Mathlib.linear_algebra.matrix
import Mathlib.PostPort

universes v w u_1 u_2

namespace Mathlib

/-!
# Eigenvectors and eigenvalues

This file defines eigenspaces, eigenvalues, and eigenvalues, as well as their generalized
counterparts. We follow Axler's approach [axler2015] because it allows us to derive many properties
without choosing a basis and without using matrices.

An eigenspace of a linear map `f` for a scalar `μ` is the kernel of the map `(f - μ • id)`. The
nonzero elements of an eigenspace are eigenvectors `x`. They have the property `f x = μ • x`. If
there are eigenvectors for a scalar `μ`, the scalar `μ` is called an eigenvalue.

There is no consensus in the literature whether `0` is an eigenvector. Our definition of
`has_eigenvector` permits only nonzero vectors. For an eigenvector `x` that may also be `0`, we
write `x ∈ f.eigenspace μ`.

A generalized eigenspace of a linear map `f` for a natural number `k` and a scalar `μ` is the kernel
of the map `(f - μ • id) ^ k`. The nonzero elements of a generalized eigenspace are generalized
eigenvectors `x`. If there are generalized eigenvectors for a natural number `k` and a scalar `μ`,
the scalar `μ` is called a generalized eigenvalue.

## References

* [Sheldon Axler, *Linear Algebra Done Right*][axler2015]
* https://en.wikipedia.org/wiki/Eigenvalues_and_eigenvectors

## Tags

eigenspace, eigenvector, eigenvalue, eigen
-/

namespace module

namespace End

/-- The submodule `eigenspace f μ` for a linear map `f` and a scalar `μ` consists of all vectors `x`
    such that `f x = μ • x`. (Def 5.36 of [axler2015])-/
def eigenspace {R : Type v} {M : Type w} [comm_ring R] [add_comm_group M] [module R M] (f : End R M) (μ : R) : submodule R M :=
  linear_map.ker (f - coe_fn (algebra_map R (End R M)) μ)

/-- A nonzero element of an eigenspace is an eigenvector. (Def 5.7 of [axler2015]) -/
def has_eigenvector {R : Type v} {M : Type w} [comm_ring R] [add_comm_group M] [module R M] (f : End R M) (μ : R) (x : M) :=
  x ≠ 0 ∧ x ∈ eigenspace f μ

/-- A scalar `μ` is an eigenvalue for a linear map `f` if there are nonzero vectors `x`
    such that `f x = μ • x`. (Def 5.5 of [axler2015]) -/
def has_eigenvalue {R : Type v} {M : Type w} [comm_ring R] [add_comm_group M] [module R M] (f : End R M) (a : R) :=
  eigenspace f a ≠ ⊥

theorem mem_eigenspace_iff {R : Type v} {M : Type w} [comm_ring R] [add_comm_group M] [module R M] {f : End R M} {μ : R} {x : M} : x ∈ eigenspace f μ ↔ coe_fn f x = μ • x := sorry

theorem eigenspace_div {K : Type v} {V : Type w} [field K] [add_comm_group V] [vector_space K V] (f : End K V) (a : K) (b : K) (hb : b ≠ 0) : eigenspace f (a / b) = linear_map.ker (b • f - coe_fn (algebra_map K (End K V)) a) := sorry

theorem eigenspace_aeval_polynomial_degree_1 {K : Type v} {V : Type w} [field K] [add_comm_group V] [vector_space K V] (f : End K V) (q : polynomial K) (hq : polynomial.degree q = 1) : eigenspace f (-polynomial.coeff q 0 / polynomial.leading_coeff q) = linear_map.ker (coe_fn (polynomial.aeval f) q) := sorry

theorem ker_aeval_ring_hom'_unit_polynomial {K : Type v} {V : Type w} [field K] [add_comm_group V] [vector_space K V] (f : End K V) (c : units (polynomial K)) : linear_map.ker (coe_fn (polynomial.aeval f) ↑c) = ⊥ := sorry

theorem aeval_apply_of_has_eigenvector {K : Type v} {V : Type w} [field K] [add_comm_group V] [vector_space K V] {f : End K V} {p : polynomial K} {μ : K} {x : V} (h : has_eigenvector f μ x) : coe_fn (coe_fn (polynomial.aeval f) p) x = polynomial.eval μ p • x := sorry

theorem is_root_of_has_eigenvalue {K : Type v} {V : Type w} [field K] [add_comm_group V] [vector_space K V] {f : End K V} {μ : K} (h : has_eigenvalue f μ) : polynomial.is_root (minpoly K f) μ := sorry

protected theorem is_integral {K : Type v} {V : Type w} [field K] [add_comm_group V] [vector_space K V] [finite_dimensional K V] (f : End K V) : is_integral K f :=
  is_integral_of_noetherian (finite_dimensional.linear_map K V V) f

theorem has_eigenvalue_of_is_root {K : Type v} {V : Type w} [field K] [add_comm_group V] [vector_space K V] [finite_dimensional K V] {f : End K V} {μ : K} (h : polynomial.is_root (minpoly K f) μ) : has_eigenvalue f μ := sorry

theorem has_eigenvalue_iff_is_root {K : Type v} {V : Type w} [field K] [add_comm_group V] [vector_space K V] [finite_dimensional K V] {f : End K V} {μ : K} : has_eigenvalue f μ ↔ polynomial.is_root (minpoly K f) μ :=
  { mp := is_root_of_has_eigenvalue, mpr := has_eigenvalue_of_is_root }

/-- Every linear operator on a vector space over an algebraically closed field has
    an eigenvalue. (Lemma 5.21 of [axler2015]) -/
theorem exists_eigenvalue {K : Type v} {V : Type w} [field K] [add_comm_group V] [vector_space K V] [is_alg_closed K] [finite_dimensional K V] [nontrivial V] (f : End K V) : ∃ (c : K), has_eigenvalue f c := sorry

/-- Eigenvectors corresponding to distinct eigenvalues of a linear operator are linearly
    independent. (Lemma 5.10 of [axler2015])

    We use the eigenvalues as indexing set to ensure that there is only one eigenvector for each
    eigenvalue in the image of `xs`. -/
theorem eigenvectors_linear_independent {K : Type v} {V : Type w} [field K] [add_comm_group V] [vector_space K V] (f : End K V) (μs : set K) (xs : ↥μs → V) (h_eigenvec : ∀ (μ : ↥μs), has_eigenvector f (↑μ) (xs μ)) : linear_independent K xs := sorry

/-- The generalized eigenspace for a linear map `f`, a scalar `μ`, and an exponent `k ∈ ℕ` is the
    kernel of `(f - μ • id) ^ k`. (Def 8.10 of [axler2015])-/
def generalized_eigenspace {R : Type v} {M : Type w} [comm_ring R] [add_comm_group M] [module R M] (f : End R M) (μ : R) (k : ℕ) : submodule R M :=
  linear_map.ker ((f - coe_fn (algebra_map R (End R M)) μ) ^ k)

/-- A nonzero element of a generalized eigenspace is a generalized eigenvector.
    (Def 8.9 of [axler2015])-/
def has_generalized_eigenvector {R : Type v} {M : Type w} [comm_ring R] [add_comm_group M] [module R M] (f : End R M) (μ : R) (k : ℕ) (x : M) :=
  x ≠ 0 ∧ x ∈ generalized_eigenspace f μ k

/-- A scalar `μ` is a generalized eigenvalue for a linear map `f` and an exponent `k ∈ ℕ` if there
    are generalized eigenvectors for `f`, `k`, and `μ`. -/
def has_generalized_eigenvalue {R : Type v} {M : Type w} [comm_ring R] [add_comm_group M] [module R M] (f : End R M) (μ : R) (k : ℕ) :=
  generalized_eigenspace f μ k ≠ ⊥

/-- The generalized eigenrange for a linear map `f`, a scalar `μ`, and an exponent `k ∈ ℕ` is the
    range of `(f - μ • id) ^ k`. -/
def generalized_eigenrange {R : Type v} {M : Type w} [comm_ring R] [add_comm_group M] [module R M] (f : End R M) (μ : R) (k : ℕ) : submodule R M :=
  linear_map.range ((f - coe_fn (algebra_map R (End R M)) μ) ^ k)

/-- The exponent of a generalized eigenvalue is never 0. -/
theorem exp_ne_zero_of_has_generalized_eigenvalue {R : Type v} {M : Type w} [comm_ring R] [add_comm_group M] [module R M] {f : End R M} {μ : R} {k : ℕ} (h : has_generalized_eigenvalue f μ k) : k ≠ 0 :=
  id fun (ᾰ : k = 0) => Eq._oldrec (fun (h : has_generalized_eigenvalue f μ 0) => h linear_map.ker_id) (Eq.symm ᾰ) h

/-- A generalized eigenspace for some exponent `k` is contained in
    the generalized eigenspace for exponents larger than `k`. -/
theorem generalized_eigenspace_mono {K : Type v} {V : Type w} [field K] [add_comm_group V] [vector_space K V] {f : End K V} {μ : K} {k : ℕ} {m : ℕ} (hm : k ≤ m) : generalized_eigenspace f μ k ≤ generalized_eigenspace f μ m := sorry

/-- A generalized eigenvalue for some exponent `k` is also
    a generalized eigenvalue for exponents larger than `k`. -/
theorem has_generalized_eigenvalue_of_has_generalized_eigenvalue_of_le {K : Type v} {V : Type w} [field K] [add_comm_group V] [vector_space K V] {f : End K V} {μ : K} {k : ℕ} {m : ℕ} (hm : k ≤ m) (hk : has_generalized_eigenvalue f μ k) : has_generalized_eigenvalue f μ m := sorry

/-- The eigenspace is a subspace of the generalized eigenspace. -/
theorem eigenspace_le_generalized_eigenspace {K : Type v} {V : Type w} [field K] [add_comm_group V] [vector_space K V] {f : End K V} {μ : K} {k : ℕ} (hk : 0 < k) : eigenspace f μ ≤ generalized_eigenspace f μ k :=
  generalized_eigenspace_mono (nat.succ_le_of_lt hk)

/-- All eigenvalues are generalized eigenvalues. -/
theorem has_generalized_eigenvalue_of_has_eigenvalue {K : Type v} {V : Type w} [field K] [add_comm_group V] [vector_space K V] {f : End K V} {μ : K} {k : ℕ} (hk : 0 < k) (hμ : has_eigenvalue f μ) : has_generalized_eigenvalue f μ k := sorry

/-- Every generalized eigenvector is a generalized eigenvector for exponent `findim K V`.
    (Lemma 8.11 of [axler2015]) -/
theorem generalized_eigenspace_le_generalized_eigenspace_findim {K : Type v} {V : Type w} [field K] [add_comm_group V] [vector_space K V] [finite_dimensional K V] (f : End K V) (μ : K) (k : ℕ) : generalized_eigenspace f μ k ≤ generalized_eigenspace f μ (finite_dimensional.findim K V) :=
  ker_pow_le_ker_pow_findim (f - coe_fn (algebra_map K (End K V)) μ) k

/-- Generalized eigenspaces for exponents at least `findim K V` are equal to each other. -/
theorem generalized_eigenspace_eq_generalized_eigenspace_findim_of_le {K : Type v} {V : Type w} [field K] [add_comm_group V] [vector_space K V] [finite_dimensional K V] (f : End K V) (μ : K) {k : ℕ} (hk : finite_dimensional.findim K V ≤ k) : generalized_eigenspace f μ k = generalized_eigenspace f μ (finite_dimensional.findim K V) :=
  ker_pow_eq_ker_pow_findim_of_le hk

/-- If `f` maps a subspace `p` into itself, then the generalized eigenspace of the restriction
    of `f` to `p` is the part of the generalized eigenspace of `f` that lies in `p`. -/
theorem generalized_eigenspace_restrict {K : Type v} {V : Type w} [field K] [add_comm_group V] [vector_space K V] (f : End K V) (p : submodule K V) (k : ℕ) (μ : K) (hfp : ∀ (x : V), x ∈ p → coe_fn f x ∈ p) : generalized_eigenspace (linear_map.restrict f hfp) μ k =
  submodule.comap (submodule.subtype p) (generalized_eigenspace f μ k) := sorry

/-- Generalized eigenrange and generalized eigenspace for exponent `findim K V` are disjoint. -/
theorem generalized_eigenvec_disjoint_range_ker {K : Type v} {V : Type w} [field K] [add_comm_group V] [vector_space K V] [finite_dimensional K V] (f : End K V) (μ : K) : disjoint (generalized_eigenrange f μ (finite_dimensional.findim K V))
  (generalized_eigenspace f μ (finite_dimensional.findim K V)) := sorry

/-- The generalized eigenspace of an eigenvalue has positive dimension for positive exponents. -/
theorem pos_findim_generalized_eigenspace_of_has_eigenvalue {K : Type v} {V : Type w} [field K] [add_comm_group V] [vector_space K V] [finite_dimensional K V] {f : End K V} {k : ℕ} {μ : K} (hx : has_eigenvalue f μ) (hk : 0 < k) : 0 < finite_dimensional.findim K ↥(generalized_eigenspace f μ k) := sorry

/-- A linear map maps a generalized eigenrange into itself. -/
theorem map_generalized_eigenrange_le {K : Type v} {V : Type w} [field K] [add_comm_group V] [vector_space K V] {f : End K V} {μ : K} {n : ℕ} : submodule.map f (generalized_eigenrange f μ n) ≤ generalized_eigenrange f μ n := sorry

/-- The generalized eigenvectors span the entire vector space (Lemma 8.21 of [axler2015]). -/
theorem supr_generalized_eigenspace_eq_top {K : Type v} {V : Type w} [field K] [add_comm_group V] [vector_space K V] [is_alg_closed K] [finite_dimensional K V] (f : End K V) : (supr fun (μ : K) => supr fun (k : ℕ) => generalized_eigenspace f μ k) = ⊤ := sorry

end End

end module

protected theorem linear_map.is_integral {K : Type u_1} {V : Type u_2} [field K] [add_comm_group V] [vector_space K V] [finite_dimensional K V] (f : linear_map K V V) : is_integral K f :=
  module.End.is_integral f


import data.matrix.pequiv data.rat.basic tactic.fin_cases data.list.min_max partition

open matrix fintype finset function pequiv

local notation `rvec`:2000 n := matrix (fin 1) (fin n) ℚ
local notation `cvec`:2000 m := matrix (fin m) (fin 1) ℚ
local infix ` ⬝ `:70 := matrix.mul
local postfix `ᵀ` : 1500 := transpose

section
universes u v
variables {l m n o : Type u} [fintype l] [fintype m] [fintype n] [fintype o] {R : Type v}

/- Belongs in mathlib -/
lemma mul_right_eq_of_mul_eq [semiring R] {M : matrix l m R} {N : matrix m n R} {O : matrix l n R}
  {P : matrix n o R} (h : M ⬝ N = O) : M ⬝ (N ⬝ P) = O ⬝ P :=
by rw [← matrix.mul_assoc, h]

end

variables {m n : ℕ}

/-- The tableau consists of a matrix and a kant `const` column.
  `to_partition` stores the indices of the current row and column variables.
  `restricted` is the set of variables that are restricted to be nonnegative  -/
structure tableau (m n : ℕ) extends partition m n :=
(to_matrix : matrix (fin m) (fin n) ℚ)
(const : cvec m)
(restricted : finset (fin (m + n)))

namespace tableau
open partition

section predicates
variable (T : tableau m n)

/-- The affine subspace represented by the tableau ignoring nonnegativity restrictiions -/
def flat : set (cvec (m + n)) :=
{ x | T.to_partition.rowp.to_matrix ⬝ x = T.to_matrix ⬝ T.to_partition.colp.to_matrix ⬝ x + T.const }

/-- The sol_set is the subset of ℚ^(m+n) that satisifies the tableau -/
def sol_set : set (cvec (m + n)) := flat T ∩ { x | ∀ i, i ∈ T.restricted → 0 ≤ x i 0 }

/-- Predicate for a variable being unbounded above in the `sol_set` -/
def is_unbounded_above (i : fin (m + n)) : Prop :=
∀ q : ℚ, ∃ x : cvec (m + n), x ∈ sol_set T ∧ q ≤ x i 0

/-- Predicate for a variable being unbounded below in the `sol_set` -/
def is_unbounded_below (i : fin (m + n)) : Prop :=
∀ q : ℚ, ∃ x : cvec (m + n), x ∈ sol_set T ∧ x i 0 ≤ q

def is_optimal (x : cvec (m + n)) (i : fin (m + n)) : Prop :=
x ∈ T.sol_set ∧ ∀ y : cvec (m + n), y ∈ sol_set T → y i 0 ≤ x i 0

/-- Is this equivalent to `∀ (x : cvec (m + n)), x ∈ sol_set T → x i 0 = x j 0`? No -/
def equal_in_flat (i j : fin (m + n)) : Prop :=
∀ (x : cvec (m + n)), x ∈ flat T → x i 0 = x j 0

/-- Returns an element of the `flat` after assigning values to the column variables -/
def of_col (T : tableau m n) (x : cvec n) : cvec (m + n) :=
T.to_partition.colp.to_matrixᵀ ⬝ x + T.to_partition.rowp.to_matrixᵀ ⬝ (T.to_matrix ⬝ x + T.const)

/-- A `tableau` is feasible if its `const` column is nonnegative in restricted rows -/
def feasible : Prop :=
∀ i, T.to_partition.rowg i ∈ T.restricted → 0 ≤ T.const i 0

instance : decidable_pred (@feasible m n) := λ _, by dunfold feasible; apply_instance

/-- Given a row index `r` and a column index `s` it returns a tableau with `r` and `s` switched,
  but with the same `sol_set` -/
def pivot (r : fin m) (c : fin n) : tableau m n :=
let p := (T.to_matrix r c)⁻¹ in
{ to_matrix := λ i j,
    if i = r
      then if j = c
        then p
        else -T.to_matrix r j * p
      else if j = c
        then T.to_matrix i c * p
        else T.to_matrix i j - T.to_matrix i c * T.to_matrix r j * p,
  to_partition := T.to_partition.swap r c,
  const := λ i k,
    if i = r
      then -T.const r k * p
      else T.const i k - T.to_matrix i c * T.const r k * p,
  restricted := T.restricted }

end predicates

section predicate_lemmas
variable {T : tableau m n}

lemma mem_flat_iff {x : cvec (m + n)} : x ∈ T.flat ↔
  ∀ r, x (T.to_partition.rowg r) 0 = univ.sum
    (λ c : fin n, T.to_matrix r c * x (T.to_partition.colg c) 0) +
  T.const r 0 :=
have hx : x ∈ T.flat ↔ ∀ i, (T.to_partition.rowp.to_matrix ⬝ x) i 0 =
    (T.to_matrix ⬝ T.to_partition.colp.to_matrix ⬝ x + T.const) i 0,
  by rw [flat, set.mem_set_of_eq, matrix.ext_iff.symm, forall_swap,
      unique.forall_iff];
    refl,
begin
  rw hx,
  refine forall_congr (λ i, _),
  rw [mul_matrix_apply, add_val, rowp_eq_some_rowg, matrix.mul_assoc, matrix.mul],
  conv in (T.to_matrix _ _ * (T.to_partition.colp.to_matrix ⬝ x) _ _)
  { rw [mul_matrix_apply, colp_eq_some_colg] },
end

variable (T)

@[simp] lemma colp_mul_of_col (x : cvec n) :
  T.to_partition.colp.to_matrix ⬝ of_col T x = x :=
by simp [matrix.mul_assoc, matrix.mul_add, of_col, flat,
    mul_right_eq_of_mul_eq (rowp_mul_colp_transpose _),
    mul_right_eq_of_mul_eq (rowp_mul_rowp_transpose _),
    mul_right_eq_of_mul_eq (colp_mul_colp_transpose _),
    mul_right_eq_of_mul_eq (colp_mul_rowp_transpose _)]

@[simp] lemma rowp_mul_of_col (x : cvec n) :
  T.to_partition.rowp.to_matrix ⬝ of_col T x = T.to_matrix ⬝ x + T.const :=
by simp [matrix.mul_assoc, matrix.mul_add, of_col, flat,
    mul_right_eq_of_mul_eq (rowp_mul_colp_transpose _),
    mul_right_eq_of_mul_eq (rowp_mul_rowp_transpose _),
    mul_right_eq_of_mul_eq (colp_mul_colp_transpose _),
    mul_right_eq_of_mul_eq (colp_mul_rowp_transpose _)]

lemma of_col_mem_flat (x : cvec n) : T.of_col x ∈ T.flat :=
by simp [matrix.mul_assoc, matrix.mul_add, flat]

@[simp] lemma of_col_colg (x : cvec n) (c : fin n) :
  of_col T x (T.to_partition.colg c) = x c :=
funext $ λ v,
  calc of_col T x (T.to_partition.colg c) v =
      (T.to_partition.colp.to_matrix ⬝ of_col T x) c v :
    by rw [mul_matrix_apply, colp_eq_some_colg]
  ... = x c v : by rw [colp_mul_of_col]

lemma of_col_rowg (c : cvec n) (r : fin m) :
  of_col T c (T.to_partition.rowg r) = (T.to_matrix ⬝ c + T.const) r :=
funext $ λ v,
  calc of_col T c (T.to_partition.rowg r) v =
      (T.to_partition.rowp.to_matrix ⬝ of_col T c) r v :
    by rw [mul_matrix_apply, rowp_eq_some_rowg]
  ... = (T.to_matrix ⬝ c + T.const) r v : by rw [rowp_mul_of_col]

variable {T}

lemma of_col_single_rowg {q : ℚ} {r c} {k} :
  T.of_col (q • (single c 0).to_matrix) (T.to_partition.rowg r) k =
    q * T.to_matrix r c + T.const r k:=
begin
  fin_cases k,
  erw [of_col_rowg, matrix.mul_smul, matrix.add_val, matrix.smul_val,
    matrix_mul_apply, pequiv.symm_single_apply]
end

/-- Condition for the solution given by setting column index `j` to `q` and all other columns to
  zero being in the `sol_set` -/
lemma of_col_single_mem_sol_set {q : ℚ} {c : fin n} (hT : T.feasible)
  (hi : ∀ i, T.to_partition.rowg i ∈ T.restricted → 0 ≤ q * T.to_matrix i c)
  (hj : T.to_partition.colg c ∉ T.restricted ∨ 0 ≤ q) :
  T.of_col (q • (single c 0).to_matrix) ∈ T.sol_set :=
⟨of_col_mem_flat _ _,
  λ v, (T.to_partition.eq_rowg_or_colg v).elim
    begin
      rintros ⟨r, hr⟩ hres,
      subst hr,
      rw [of_col_single_rowg],
      exact add_nonneg (hi _ hres) (hT _ hres)
    end
    begin
      rintros ⟨j, hj⟩ hres,
      subst hj,
      simp [of_col_colg, smul_val, pequiv.single, pequiv.to_matrix],
      by_cases hjc : j = c; simp [*, le_refl] at *
    end⟩

@[simp] lemma of_col_zero_mem_sol_set_iff : T.of_col 0 ∈ T.sol_set ↔ T.feasible :=
suffices (∀ v : fin (m + n), v ∈ T.restricted → (0 : ℚ) ≤ T.of_col 0 v 0) ↔
    (∀ i : fin m, T.to_partition.rowg i ∈ T.restricted → 0 ≤ T.const i 0),
  by simpa [sol_set, feasible, of_col_mem_flat],
⟨λ h i hi, by simpa [of_col_rowg] using h _ hi,
  λ h v hv, (T.to_partition.eq_rowg_or_colg v).elim
    (by rintros ⟨i, hi⟩; subst hi; simp [of_col_rowg]; tauto)
    (by rintros ⟨j, hj⟩; subst hj; simp)⟩

lemma is_unbounded_above_colg_aux {c : fin n} (hT : T.feasible)
  (h : ∀ i : fin m, T.to_partition.rowg i ∈ T.restricted → 0 ≤ T.to_matrix i c) (q : ℚ):
  of_col T (max q 0 • (single c 0).to_matrix) ∈ sol_set T ∧
    q ≤ of_col T (max q 0 • (single c 0).to_matrix) (T.to_partition.colg c) 0 :=
⟨of_col_single_mem_sol_set hT (λ i hi, mul_nonneg (le_max_right _ _) (h _ hi))
    (or.inr (le_max_right _ _)),
  by simp [of_col_colg, smul_val, pequiv.single, pequiv.to_matrix, le_refl q]⟩

/-- A column variable is unbounded above if it is in a column where every negative entry is
  in a row owned by an unrestricted variable -/
lemma is_unbounded_above_colg {c : fin n} (hT : T.feasible)
  (h : ∀ i : fin m, T.to_partition.rowg i ∈ T.restricted → 0 ≤ T.to_matrix i c) :
  T.is_unbounded_above (T.to_partition.colg c) :=
λ q, ⟨_, is_unbounded_above_colg_aux hT h q⟩

lemma is_unbounded_below_colg_aux {c : fin n} (hT : T.feasible)
  (hres : T.to_partition.colg c ∉ T.restricted)
  (h : ∀ i : fin m, T.to_partition.rowg i ∈ T.restricted → T.to_matrix i c ≤ 0) (q : ℚ) :
  of_col T (min q 0 • (single c 0).to_matrix) ∈ sol_set T ∧
    of_col T (min q 0 • (single c 0).to_matrix) (T.to_partition.colg c) 0 ≤ q :=
⟨of_col_single_mem_sol_set hT
    (λ i hi, mul_nonneg_of_nonpos_of_nonpos (min_le_right _ _) (h _ hi))
    (or.inl hres),
  by simp [of_col_colg, smul_val, pequiv.single, pequiv.to_matrix, le_refl q]⟩

/-- A column variable is unbounded below if it is unrestricted and it is in a column where every
  positive entry is in a row owned by an unrestricted variable -/
lemma is_unbounded_below_colg {c : fin n} (hT : T.feasible)
  (hres : T.to_partition.colg c ∉ T.restricted)
  (h : ∀ i : fin m, T.to_partition.rowg i ∈ T.restricted → T.to_matrix i c ≤ 0) :
  T.is_unbounded_below (T.to_partition.colg c) :=
λ q, ⟨_, is_unbounded_below_colg_aux hT hres h q⟩

/-- A row variable `r` is unbounded above if it is unrestricted and there is a column `s`
  where every restricted row variable has a nonpositive entry in that column, and
  `r` has a negative entry in that column. -/
lemma is_unbounded_above_rowg_of_nonpos {r : fin m} (hT : T.feasible) (s : fin n)
  (hres : T.to_partition.colg s ∉ T.restricted)
  (h : ∀ i : fin m, T.to_partition.rowg i ∈ T.restricted → T.to_matrix i s ≤ 0)
  (his : T.to_matrix r s < 0) : is_unbounded_above T (T.to_partition.rowg r) :=
λ q, ⟨T.of_col (min ((q - T.const r 0) / T.to_matrix r s) 0 • (single s 0).to_matrix),
  of_col_single_mem_sol_set hT
    (λ i' hi', mul_nonneg_of_nonpos_of_nonpos (min_le_right _ _) (h _ hi'))
    (or.inl hres),
  begin
    rw [of_col_rowg, add_val, matrix.mul_smul, smul_val, matrix_mul_apply,
      symm_single_apply],
    cases le_total 0 ((q - T.const r 0) / T.to_matrix r s) with hq hq,
    { rw [min_eq_right hq],
      rw [le_div_iff_of_neg his, zero_mul, sub_nonpos] at hq,
      simpa },
    { rw [min_eq_left hq, div_mul_cancel _ (ne_of_lt his)],
      simp }
  end⟩

/-- A row variable `r` is unbounded above if there is a column `s`
  where every restricted row variable has a nonpositive entry in that column, and
  `r` has a positive entry in that column. -/
lemma is_unbounded_above_rowg_of_nonneg {r : fin m} (hT : T.feasible) (s : fin n)
  (hs : ∀ i : fin m, T.to_partition.rowg i ∈ T.restricted → 0 ≤ T.to_matrix i s)
  (his : 0 < T.to_matrix r s) : is_unbounded_above T (T.to_partition.rowg r) :=
λ q, ⟨T.of_col (max ((q - T.const r 0) / T.to_matrix r s) 0 • (single s 0).to_matrix),
  of_col_single_mem_sol_set hT
    (λ i hi, mul_nonneg (le_max_right _ _) (hs i hi))
    (or.inr (le_max_right _ _)),
  begin
    rw [of_col_rowg, add_val, matrix.mul_smul, smul_val, matrix_mul_apply,
      symm_single_apply],
    cases le_total ((q - T.const r 0) / T.to_matrix r s) 0 with hq hq,
    { rw [max_eq_right hq],
      rw [div_le_iff his, zero_mul, sub_nonpos] at hq,
      simpa },
    { rw [max_eq_left hq, div_mul_cancel _ (ne_of_gt his)],
      simp }
  end⟩

/-- The sample solution of a feasible tableau maximises the variable in row `r`,
  if every entry in that row is nonpositive and every entry in that row owned by a restricted
  variable is `0`  -/
lemma is_optimal_of_col_zero {r : fin m} (hf : T.feasible)
  (h : ∀ j, T.to_matrix r j ≤ 0 ∧ (T.to_partition.colg j ∉ T.restricted → T.to_matrix r j = 0)) :
  T.is_optimal (T.of_col 0) (T.to_partition.rowg r) :=
⟨of_col_zero_mem_sol_set_iff.2 hf, λ x hx, begin
  rw [of_col_rowg, matrix.mul_zero, zero_add, mem_flat_iff.1 hx.1],
  refine add_le_of_nonpos_of_le _ (le_refl _),
  refine sum_nonpos (λ j _, _),
  by_cases hj : (T.to_partition.colg j) ∈ T.restricted,
  { refine mul_nonpos_of_nonpos_of_nonneg (h _).1 (hx.2 _ hj) },
  { rw [(h _).2 hj, _root_.zero_mul] }
end⟩

lemma not_optimal_of_unbounded_above {v : fin (m + n)} {x : cvec (m + n)}
  (hu : is_unbounded_above T v) : ¬is_optimal T x v :=
λ hm, let ⟨y, hy⟩ := hu (x v 0 + 1) in
  not_le_of_gt (lt_add_one (x v 0)) (le_trans hy.2 (hm.2 y hy.1))

/-- Expression for the sum of all but one entries in the a row of a tableau. -/
lemma row_sum_erase_eq {x : cvec (m + n)} (hx : x ∈ T.flat) {r : fin m} {s : fin n} :
  (univ.erase s).sum (λ j : fin n, T.to_matrix r j * x (T.to_partition.colg j) 0) =
    x (T.to_partition.rowg r) 0 - T.const r 0 - T.to_matrix r s * x (T.to_partition.colg s) 0 :=
begin
  rw [mem_flat_iff] at hx,
  conv_rhs { rw [hx r, ← insert_erase (mem_univ s), sum_insert (not_mem_erase _ _)] },
  simp
end

/-- An expression for a column variable in terms of row variables. -/
lemma colg_eq {x : cvec (m + n)} (hx : x ∈ T.flat) {r : fin m} {s : fin n}
  (hrs : T.to_matrix r s ≠ 0) : x (T.to_partition.colg s) 0 =
    (x (T.to_partition.rowg r) 0
    -(univ.erase s).sum (λ j : fin n, T.to_matrix r j * x (T.to_partition.colg j) 0)
        - T.const r 0) * (T.to_matrix r s)⁻¹ :=
by simp [row_sum_erase_eq hx, mul_left_comm (T.to_matrix r s)⁻¹, mul_assoc,
    mul_left_comm (T.to_matrix r s), mul_inv_cancel hrs]

/-- Another expression for a column variable in terms of row variables. -/
lemma colg_eq' {x : cvec (m + n)} (hx : x ∈ T.flat) {r : fin m} {s : fin n}
  (hrs : T.to_matrix r s ≠ 0) : x (T.to_partition.colg s) 0 =
  univ.sum (λ (j : fin n), (if j = s then (T.to_matrix r s)⁻¹
    else (-(T.to_matrix r j * (T.to_matrix r s)⁻¹))) *
      x (colg (swap (T.to_partition) r s) j) 0) -
  (T.const r 0) * (T.to_matrix r s)⁻¹ :=
have (univ.erase s).sum
    (λ j : fin n, ite (j = s) (T.to_matrix r s)⁻¹ (-(T.to_matrix r j * (T.to_matrix r s)⁻¹)) *
      x (colg (swap (T.to_partition) r s) j) 0) =
    (univ.erase s).sum (λ j : fin n,
      -T.to_matrix r j * x (T.to_partition.colg j) 0 * (T.to_matrix r s)⁻¹),
  from finset.sum_congr rfl $ λ j hj,
    by simp [if_neg (mem_erase.1 hj).1, colg_swap_of_ne _ (mem_erase.1 hj).1,
      mul_comm, mul_assoc, mul_left_comm],
by rw [← finset.insert_erase (mem_univ s), finset.sum_insert (not_mem_erase _ _),
    if_pos rfl, colg_swap, colg_eq hx hrs, this, ← finset.sum_mul];
  simp [_root_.add_mul, mul_comm, _root_.mul_add]

/-- Pivoting twice in the same place does nothing -/
@[simp] lemma pivot_pivot {r : fin m} {s : fin n} (hrs : T.to_matrix r s ≠ 0) :
  (T.pivot r s).pivot r s = T :=
begin
  cases T,
  simp [pivot, function.funext_iff],
  split; intros; split_ifs;
  simp [*, mul_assoc, mul_left_comm (T_to_matrix r s), mul_left_comm (T_to_matrix r s)⁻¹,
    mul_comm (T_to_matrix r s), inv_mul_cancel hrs]
end

/- These two sets are equal_in_flat, the stronger lemma is `flat_pivot` -/
private lemma subset_flat_pivot {r : fin m} {s : fin n} (h : T.to_matrix r s ≠ 0) :
  T.flat ⊆ (T.pivot r s).flat :=
λ x hx,
have ∀ i : fin m, (univ.erase s).sum (λ j : fin n,
  ite (j = s) (T.to_matrix i s * (T.to_matrix r s)⁻¹)
    (T.to_matrix i j + -(T.to_matrix i s * T.to_matrix r j * (T.to_matrix r s)⁻¹))
      * x ((T.to_partition.swap r s).colg j) 0) =
  (univ.erase s).sum (λ j : fin n, T.to_matrix i j * x (T.to_partition.colg j) 0 -
    T.to_matrix r j *
      x (T.to_partition.colg j) 0 * T.to_matrix i s * (T.to_matrix r s)⁻¹),
  from λ i, finset.sum_congr rfl (λ j hj,
    by rw [if_neg (mem_erase.1 hj).1, colg_swap_of_ne _ (mem_erase.1 hj).1];
      simp [mul_add, add_mul, mul_comm, mul_assoc, mul_left_comm]),
begin
  rw mem_flat_iff,
  assume i,
  by_cases hir : i = r,
  { rw eq_comm at hir,
    subst hir,
    dsimp [pivot],
    simp [mul_inv_cancel h, neg_mul_eq_neg_mul_symm, if_true,
      add_comm, mul_inv_cancel, rowg_swap, eq_self_iff_true, colg_eq' hx h],
    congr, funext, congr },
  { dsimp [pivot],
    simp only [if_neg hir],
    rw [← insert_erase (mem_univ s), sum_insert (not_mem_erase _ _),
      if_pos rfl, colg_swap, this, sum_sub_distrib, ← sum_mul, ← sum_mul,
      row_sum_erase_eq hx, rowg_swap_of_ne _ hir],
    simp [row_sum_erase_eq hx, mul_add, add_mul,
      mul_comm, mul_left_comm, mul_assoc],
    simp [mul_assoc, mul_left_comm (T.to_matrix r s), mul_left_comm (T.to_matrix r s)⁻¹,
      mul_comm (T.to_matrix r s), inv_mul_cancel h] }
end

variable (T)

@[simp] lemma pivot_pivot_element (r : fin m) (s : fin n) :
  (T.pivot r s).to_matrix r s = (T.to_matrix r s)⁻¹ :=
by simp [pivot, if_pos rfl]

@[simp] lemma pivot_pivot_row {r : fin m} {j s : fin n} (h : j ≠ s) :
  (T.pivot r s).to_matrix r j = -T.to_matrix r j / T.to_matrix r s :=
by dsimp [pivot]; rw [if_pos rfl, if_neg h, div_eq_mul_inv]

@[simp] lemma pivot_pivot_column {i r : fin m} {s : fin n} (h : i ≠ r) :
  (T.pivot r s).to_matrix i s = T.to_matrix i s / T.to_matrix r s :=
by dsimp [pivot]; rw [if_neg h, if_pos rfl, div_eq_mul_inv]

@[simp] lemma pivot_of_ne_of_ne {i r : fin m} {j s : fin n} (hir : i ≠ r)
  (hjs : j ≠ s) : (T.pivot r s).to_matrix i j =
  T.to_matrix i j - T.to_matrix i s * T.to_matrix r j / T.to_matrix r s :=
by dsimp [pivot]; rw [if_neg hir, if_neg hjs, div_eq_mul_inv]

@[simp] lemma const_pivot_row {r : fin m} {s : fin n} : (T.pivot r s).const r 0 =
  -T.const r 0 / T.to_matrix r s :=
by simp [pivot, if_pos rfl, div_eq_mul_inv]

@[simp] lemma const_pivot_of_ne {i r : fin m} {s : fin n} (hir : i ≠ r) : (T.pivot r s).const i 0
  = T.const i 0 - T.to_matrix i s * T.const r 0 / T.to_matrix r s :=
by dsimp [pivot]; rw [if_neg hir, div_eq_mul_inv]

@[simp] lemma restricted_pivot (r s) : (T.pivot r s).restricted = T.restricted := rfl

@[simp] lemma to_partition_pivot (r s) : (T.pivot r s).to_partition = T.to_partition.swap r s := rfl

variable {T}

@[simp] lemma flat_pivot {r : fin m} {s : fin n} (hrs : T.to_matrix r s ≠ 0) :
  (T.pivot r s).flat = T.flat :=
set.subset.antisymm
  (by conv_rhs { rw ← pivot_pivot hrs };
    exact subset_flat_pivot (by simp [hrs]))
  (subset_flat_pivot hrs)

@[simp] lemma sol_set_pivot {r : fin m} {s : fin n} (hrs : T.to_matrix r s ≠ 0) :
  (T.pivot r s).sol_set = T.sol_set :=
by rw [sol_set, flat_pivot hrs]; refl

/-- Two row variables are `equal_in_flat` iff the corresponding rows of the tableau are equal -/
lemma equal_in_flat_row_row {i i' : fin m} :
  T.equal_in_flat (T.to_partition.rowg i) (T.to_partition.rowg i')
  ↔ (T.const i 0 = T.const i' 0 ∧ ∀ j : fin n, T.to_matrix i j = T.to_matrix i' j) :=
⟨λ h, have Hconst : T.const i 0 = T.const i' 0,
    by simpa [of_col_rowg] using h (T.of_col 0) (of_col_mem_flat _ _),
  ⟨Hconst,
    λ j, begin
      have := h (T.of_col (single j (0 : fin 1)).to_matrix) (of_col_mem_flat _ _),
      rwa [of_col_rowg, of_col_rowg, add_val, add_val, matrix_mul_apply, matrix_mul_apply,
        symm_single_apply, Hconst, add_right_cancel_iff] at this,
    end⟩,
λ h x hx, by simp [mem_flat_iff.1 hx, h.1, h.2]⟩

/-- A row variable is equal_in_flat to a column variable iff its row has zeros, and a single
  one in that column. -/
lemma equal_in_flat_row_col {i : fin m} {j : fin n} :
  T.equal_in_flat (T.to_partition.rowg i) (T.to_partition.colg j)
  ↔ (∀ j', j' ≠ j → T.to_matrix i j' = 0) ∧ T.const i 0 = 0 ∧ T.to_matrix i j = 1 :=
⟨λ h, have Hconst : T.const i 0 = 0,
    by simpa [of_col_rowg] using h (T.of_col 0) (of_col_mem_flat _ _),
  ⟨assume j' hj', begin
      have := h (T.of_col (single j' (0 : fin 1)).to_matrix) (of_col_mem_flat _ _),
      rwa [of_col_rowg, of_col_colg, add_val, Hconst, add_zero, matrix_mul_apply,
        symm_single_apply, pequiv.to_matrix, single_apply_of_ne hj',
        if_neg (option.not_mem_none _)] at this
    end,
  Hconst,
  begin
    have := h (T.of_col (single j (0 : fin 1)).to_matrix) (of_col_mem_flat _ _),
    rwa [of_col_rowg, of_col_colg, add_val, Hconst, add_zero, matrix_mul_apply,
        symm_single_apply, pequiv.to_matrix, single_apply] at this
  end⟩,
by rintros ⟨h₁, h₂, h₃⟩ x hx;
  rw [mem_flat_iff.1 hx, h₂, sum_eq_single j]; simp *; tauto⟩

lemma mul_single_ext {R : Type*} {m n : ℕ} [semiring R]
  {A B : matrix (fin m) (fin n) R} (h : ∀ j : fin n, A ⬝ (single j (0 : fin 1)).to_matrix = B ⬝
    (single j (0 : fin 1)).to_matrix) : A = B :=
by ext i j; simpa [matrix_mul_apply] using congr_fun (congr_fun (h j) i) 0

lemma single_mul_ext {R : Type*} {m n : ℕ} [semiring R]
  {A B : matrix (fin m) (fin n) R} (h : ∀ i, (single (0 : fin 1) i).to_matrix ⬝ A =
    (single (0 : fin 1) i).to_matrix ⬝ B) : A = B :=
by ext i j; simpa [mul_matrix_apply] using congr_fun (congr_fun (h i) 0) j

lemma ext {T₁ T₂ : tableau m n} (hflat : T₁.flat = T₂.flat)
  (hpartition : T₁.to_partition = T₂.to_partition)
  (hres : T₁.restricted = T₂.restricted) : T₁ = T₂ :=
have hconst : T₁.const = T₂.const,
  by rw [set.ext_iff] at hflat; simpa [of_col, flat, hpartition, matrix.mul_assoc,
    mul_right_eq_of_mul_eq (rowp_mul_rowp_transpose _),
    mul_right_eq_of_mul_eq (colp_mul_rowp_transpose _)] using
  (hflat (T₁.of_col 0)).1 (of_col_mem_flat _ _),
have hmatrix : T₁.to_matrix = T₂.to_matrix,
  from mul_single_ext $ λ j, begin
    rw [set.ext_iff] at hflat,
    have := (hflat (T₁.of_col (single j 0).to_matrix)).1 (of_col_mem_flat _ _),
    simpa [of_col, hconst, hpartition, flat, matrix.mul_add, matrix.mul_assoc,
      mul_right_eq_of_mul_eq (rowp_mul_rowp_transpose _),
      mul_right_eq_of_mul_eq (colp_mul_rowp_transpose _),
      mul_right_eq_of_mul_eq (colp_mul_colp_transpose _),
      mul_right_eq_of_mul_eq (rowp_mul_colp_transpose _)] using
      (hflat (T₁.of_col (single j 0).to_matrix)).1 (of_col_mem_flat _ _)
  end,
by cases T₁; cases T₂; simp * at *

end predicate_lemmas

/-- Conditions for unboundedness based on reading the tableau. The conditions are equivalent to the
  simplex pivot rule failing to find a pivot row. -/
lemma unbounded_of_tableau {T : tableau m n} {obj : fin m} {c : fin n} (hT : T.feasible)
  (hrow : ∀ r, obj ≠ r → T.to_partition.rowg r ∈ T.restricted →
    0 ≤ T.to_matrix obj c / T.to_matrix r c)
  (hc : (T.to_matrix obj c ≠ 0 ∧ T.to_partition.colg c ∉ T.restricted)
    ∨ (0 < T.to_matrix obj c ∧ T.to_partition.colg c ∈ T.restricted)) :
  T.is_unbounded_above (T.to_partition.rowg obj) :=
have hToc : T.to_matrix obj c ≠ 0, from λ h, by simpa [h, lt_irrefl] using hc,
(lt_or_gt_of_ne hToc).elim
  (λ hToc : T.to_matrix obj c < 0, is_unbounded_above_rowg_of_nonpos hT c
    (hc.elim and.right (λ h, (not_lt_of_gt hToc h.1).elim))
    (λ i hi, classical.by_cases
      (λ hoi : obj = i, le_of_lt (hoi ▸ hToc))
      (λ hoi : obj ≠ i, inv_nonpos.1 $ nonpos_of_mul_nonneg_right (hrow _ hoi hi) hToc))
    hToc)
  (λ hToc : 0 < T.to_matrix obj c, is_unbounded_above_rowg_of_nonneg hT c
    (λ i hi, classical.by_cases
      (λ hoi : obj = i, le_of_lt (hoi ▸ hToc))
      (λ hoi : obj ≠ i, inv_nonneg.1 $ nonneg_of_mul_nonneg_left (hrow _ hoi hi) hToc))
    hToc)

/-- Conditions for the tableau being feasible, that must be satisified by a simplex pivot rule -/
lemma feasible_pivot {T : tableau m n} (hT : T.feasible) {r c}
  (hres : T.to_partition.rowg r ∈ T.restricted)
  (hpos : T.to_partition.colg c ∈ T.restricted → T.to_matrix r c < 0)
  (hrmin : ∀ (i : fin m), T.to_partition.rowg i ∈ T.restricted →
          0 < T.to_matrix i c / T.to_matrix r c →
          abs (T.const r 0 / T.to_matrix r c) ≤ abs (T.const i 0 / T.to_matrix i c)) :
  (T.pivot r c).feasible :=
begin
  assume i hi,
  dsimp only [pivot],
  by_cases hir : i = r,
  { subst i,
    rw [if_pos rfl, neg_mul_eq_neg_mul_symm, neg_nonneg],
    exact mul_nonpos_of_nonneg_of_nonpos (hT _ hres) (inv_nonpos.2 $ le_of_lt (by simp * at *)) },
  { rw if_neg hir,
    rw [to_partition_pivot, rowg_swap_of_ne _ hir, restricted_pivot] at hi,
    by_cases hTir : 0 < T.to_matrix i c / T.to_matrix r c,
    { have hTic0 : T.to_matrix i c ≠ 0, from λ h, by simpa [h, lt_irrefl] using hTir,
      have hTrc0 : T.to_matrix r c ≠ 0, from λ h, by simpa [h, lt_irrefl] using hTir,
      have := hrmin _ hi hTir,
      rwa [abs_div, abs_div, abs_of_nonneg (hT _ hres), abs_of_nonneg (hT _ hi),
        le_div_iff (abs_pos_iff.2 hTic0), div_eq_mul_inv, mul_right_comm, ← abs_inv, mul_assoc,
        ← abs_mul, ← div_eq_mul_inv, abs_of_nonneg (le_of_lt hTir), ← sub_nonneg,
        ← mul_div_assoc, div_eq_mul_inv, mul_comm (T.const r 0)] at this },
    { refine add_nonneg (hT _ hi) (neg_nonneg.2 _),
      rw [mul_assoc, mul_left_comm],
      exact mul_nonpos_of_nonneg_of_nonpos (hT _ hres) (le_of_not_gt hTir) } }
end

lemma feasible_simplex_pivot {T : tableau m n} {obj : fin m} (hT : T.feasible) {r c}
  (hres : T.to_partition.rowg r ∈ T.restricted)
  (hrneg : T.to_matrix obj c / T.to_matrix r c < 0)
  (hrmin : ∀ (r' : fin m), obj ≠ r' → T.to_partition.rowg r' ∈ T.restricted →
          T.to_matrix obj c / T.to_matrix r' c < 0 →
          abs (T.const r 0 / T.to_matrix r c) ≤ abs (T.const r' 0 / T.to_matrix r' c))
  (hc : T.to_partition.colg c ∈ T.restricted → 0 < T.to_matrix obj c) :
  (T.pivot r c).feasible :=
feasible_pivot hT hres (λ hcres, inv_neg'.1 (neg_of_mul_neg_left hrneg (le_of_lt (hc hcres))))
  (λ i hires hir,
    have hobji : obj ≠ i,
      from λ hobji, not_lt_of_gt hir (hobji ▸ hrneg),
    (hrmin _ hobji hires $
      have hTrc0 : T.to_matrix r c ≠ 0, from λ _, by simp [*, lt_irrefl] at *,
      suffices (T.to_matrix obj c / T.to_matrix r c) / (T.to_matrix i c / T.to_matrix r c) < 0,
        by rwa [div_div_div_cancel_right _ _ hTrc0] at this,
      div_neg_of_neg_of_pos hrneg hir))

lemma simplex_const_obj_le {T : tableau m n} {obj : fin m} (hT : T.feasible) {r c}
  (hres : T.to_partition.rowg r ∈ T.restricted)
  (hrneg : T.to_matrix obj c / T.to_matrix r c < 0) :
  T.const obj 0 ≤ (T.pivot r c).const obj 0 :=
have obj ≠ r, from λ hor, begin
  subst hor,
  by_cases h0 : T.to_matrix obj c = 0,
  { simp [lt_irrefl, *] at * },
  { simp [div_self h0, not_lt_of_le zero_le_one, *] at * }
end,
by simp only [le_add_iff_nonneg_right, sub_eq_add_neg, neg_nonneg, mul_assoc, div_eq_mul_inv,
    mul_left_comm (T.to_matrix obj c), const_pivot_of_ne _ this];
  exact mul_nonpos_of_nonneg_of_nonpos (hT _ hres) (le_of_lt hrneg)

lemma const_eq_zero_of_const_obj_eq {T : tableau m n} {obj : fin m} (hT : T.feasible) {r c}
  (hc : T.to_matrix obj c ≠ 0) (hrc : T.to_matrix r c ≠ 0) (hobjr : obj ≠ r)
  (hobj : (T.pivot r c).const obj 0 = T.const obj 0) :
  T.const r 0 = 0 :=
by rw [const_pivot_of_ne _ hobjr, sub_eq_iff_eq_add, ← sub_eq_iff_eq_add', sub_self,
    eq_comm, div_eq_mul_inv, mul_eq_zero, mul_eq_zero, inv_eq_zero] at hobj; tauto

end tableau


import data.real.basic
import data.real.nnreal

theorem USAMO_problem_5_1997 (a b c : nnreal) :
a*b*c = 1 →
1 / (a^3 * (b+c)) + 1 / (b^3 *(a+c)) + 1 /(c^3 * (a + b)) ≥ 3/2 := sorry


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

! This file was ported from Lean 3 source module algebra.gcd_monoid.div
! leanprover-community/mathlib commit b537794f8409bc9598febb79cd510b1df5f4539d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.GcdMonoid.Finset
import Mathbin.Algebra.GcdMonoid.Basic
import Mathbin.RingTheory.Int.Basic
import Mathbin.RingTheory.Polynomial.Content

/-!
# Basic results about setwise gcds on normalized gcd monoid with a division.

## Main results

* `finset.nat.gcd_div_eq_one`: given a nonempty finset `s` and a function `f` from `s` to
  `ℕ`, if `d = s.gcd`, then the `gcd` of `(f i) / d` equals `1`.
* `finset.int.gcd_div_eq_one`: given a nonempty finset `s` and a function `f` from `s` to
  `ℤ`, if `d = s.gcd`, then the `gcd` of `(f i) / d` equals `1`.
* `finset.polynomial.gcd_div_eq_one`: given a nonempty finset `s` and a function `f` from
  `s` to `K[X]`, if `d = s.gcd`, then the `gcd` of `(f i) / d` equals `1`.

## TODO
Add a typeclass to state these results uniformly.

-/

namespace Finset

namespace Nat

/- warning: finset.nat.gcd_div_eq_one -> Finset.Nat.gcd_div_eq_one is a dubious translation:
lean 3 declaration is
  forall {β : Type.{u1}} {f : β -> Nat} (s : Finset.{u1} β) {x : β}, (Membership.Mem.{u1, u1} β (Finset.{u1} β) (Finset.hasMem.{u1} β) x s) -> (Ne.{1} Nat (f x) (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero)))) -> (Eq.{1} Nat (Finset.gcd.{0, u1} Nat β Nat.cancelCommMonoidWithZero Nat.normalizedGcdMonoid s (fun (b : β) => HDiv.hDiv.{0, 0, 0} Nat Nat Nat (instHDiv.{0} Nat Nat.hasDiv) (f b) (Finset.gcd.{0, u1} Nat β Nat.cancelCommMonoidWithZero Nat.normalizedGcdMonoid s f))) (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))
but is expected to have type
  forall {β : Type.{u1}} {f : β -> Nat} (s : Finset.{u1} β) {x : β}, (Membership.mem.{u1, u1} β (Finset.{u1} β) (Finset.instMembershipFinset.{u1} β) x s) -> (Ne.{1} Nat (f x) (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))) -> (Eq.{1} Nat (Finset.gcd.{0, u1} Nat β Nat.cancelCommMonoidWithZero instNormalizedGCDMonoidNatCancelCommMonoidWithZero s (fun (b : β) => HDiv.hDiv.{0, 0, 0} Nat Nat Nat (instHDiv.{0} Nat Nat.instDivNat) (f b) (Finset.gcd.{0, u1} Nat β Nat.cancelCommMonoidWithZero instNormalizedGCDMonoidNatCancelCommMonoidWithZero s f))) (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))
Case conversion may be inaccurate. Consider using '#align finset.nat.gcd_div_eq_one Finset.Nat.gcd_div_eq_oneₓ'. -/
/-- Given a nonempty finset `s` and a function `f` from `s` to `ℕ`, if `d = s.gcd`,
then the `gcd` of `(f i) / d` is equal to `1`. -/
theorem gcd_div_eq_one {β : Type _} {f : β → ℕ} (s : Finset β) {x : β} (hx : x ∈ s)
    (hfz : f x ≠ 0) : (s.gcd fun b => f b / s.gcd f) = 1 :=
  by
  obtain ⟨g, he, hg⟩ := Finset.extract_gcd f ⟨x, hx⟩
  refine' (Finset.gcd_congr rfl fun a ha => _).trans hg
  rw [he a ha, Nat.mul_div_cancel_left]
  exact Nat.pos_of_ne_zero (mt Finset.gcd_eq_zero_iff.1 fun h => hfz <| h x hx)
#align finset.nat.gcd_div_eq_one Finset.Nat.gcd_div_eq_one

/- warning: finset.nat.gcd_div_id_eq_one -> Finset.Nat.gcd_div_id_eq_one is a dubious translation:
lean 3 declaration is
  forall {s : Finset.{0} Nat} {x : Nat}, (Membership.Mem.{0, 0} Nat (Finset.{0} Nat) (Finset.hasMem.{0} Nat) x s) -> (Ne.{1} Nat x (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero)))) -> (Eq.{1} Nat (Finset.gcd.{0, 0} Nat Nat Nat.cancelCommMonoidWithZero Nat.normalizedGcdMonoid s (fun (b : Nat) => HDiv.hDiv.{0, 0, 0} Nat Nat Nat (instHDiv.{0} Nat Nat.hasDiv) b (Finset.gcd.{0, 0} Nat Nat Nat.cancelCommMonoidWithZero Nat.normalizedGcdMonoid s (id.{1} Nat)))) (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))
but is expected to have type
  forall {s : Finset.{0} Nat} {x : Nat}, (Membership.mem.{0, 0} Nat (Finset.{0} Nat) (Finset.instMembershipFinset.{0} Nat) x s) -> (Ne.{1} Nat x (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))) -> (Eq.{1} Nat (Finset.gcd.{0, 0} Nat Nat Nat.cancelCommMonoidWithZero instNormalizedGCDMonoidNatCancelCommMonoidWithZero s (fun (b : Nat) => HDiv.hDiv.{0, 0, 0} Nat Nat Nat (instHDiv.{0} Nat Nat.instDivNat) b (Finset.gcd.{0, 0} Nat Nat Nat.cancelCommMonoidWithZero instNormalizedGCDMonoidNatCancelCommMonoidWithZero s (id.{1} Nat)))) (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))
Case conversion may be inaccurate. Consider using '#align finset.nat.gcd_div_id_eq_one Finset.Nat.gcd_div_id_eq_oneₓ'. -/
theorem gcd_div_id_eq_one {s : Finset ℕ} {x : ℕ} (hx : x ∈ s) (hnz : x ≠ 0) :
    (s.gcd fun b => b / s.gcd id) = 1 :=
  gcd_div_eq_one s hx hnz
#align finset.nat.gcd_div_id_eq_one Finset.Nat.gcd_div_id_eq_one

end Nat

namespace Int

/- warning: finset.int.gcd_div_eq_one -> Finset.Int.gcd_div_eq_one is a dubious translation:
lean 3 declaration is
  forall {β : Type.{u1}} {f : β -> Int} (s : Finset.{u1} β) {x : β}, (Membership.Mem.{u1, u1} β (Finset.{u1} β) (Finset.hasMem.{u1} β) x s) -> (Ne.{1} Int (f x) (OfNat.ofNat.{0} Int 0 (OfNat.mk.{0} Int 0 (Zero.zero.{0} Int Int.hasZero)))) -> (Eq.{1} Int (Finset.gcd.{0, u1} Int β (IsDomain.toCancelCommMonoidWithZero.{0} Int Int.commSemiring (LinearOrderedRing.isDomain.{0} Int (LinearOrderedCommRing.toLinearOrderedRing.{0} Int Int.linearOrderedCommRing))) Int.normalizedGcdMonoid s (fun (b : β) => HDiv.hDiv.{0, 0, 0} Int Int Int (instHDiv.{0} Int Int.hasDiv) (f b) (Finset.gcd.{0, u1} Int β (IsDomain.toCancelCommMonoidWithZero.{0} Int Int.commSemiring (LinearOrderedRing.isDomain.{0} Int (LinearOrderedCommRing.toLinearOrderedRing.{0} Int Int.linearOrderedCommRing))) Int.normalizedGcdMonoid s f))) (OfNat.ofNat.{0} Int 1 (OfNat.mk.{0} Int 1 (One.one.{0} Int Int.hasOne))))
but is expected to have type
  forall {β : Type.{u1}} {f : β -> Int} (s : Finset.{u1} β) {x : β}, (Membership.mem.{u1, u1} β (Finset.{u1} β) (Finset.instMembershipFinset.{u1} β) x s) -> (Ne.{1} Int (f x) (OfNat.ofNat.{0} Int 0 (instOfNatInt 0))) -> (Eq.{1} Int (Finset.gcd.{0, u1} Int β (IsDomain.toCancelCommMonoidWithZero.{0} Int Int.instCommSemiringInt (LinearOrderedRing.isDomain.{0} Int (LinearOrderedCommRing.toLinearOrderedRing.{0} Int Int.linearOrderedCommRing))) Int.instNormalizedGCDMonoidIntToCancelCommMonoidWithZeroInstCommSemiringIntIsDomainToLinearOrderedRingLinearOrderedCommRing s (fun (b : β) => HDiv.hDiv.{0, 0, 0} Int Int Int (instHDiv.{0} Int Int.instDivInt_1) (f b) (Finset.gcd.{0, u1} Int β (IsDomain.toCancelCommMonoidWithZero.{0} Int Int.instCommSemiringInt (LinearOrderedRing.isDomain.{0} Int (LinearOrderedCommRing.toLinearOrderedRing.{0} Int Int.linearOrderedCommRing))) Int.instNormalizedGCDMonoidIntToCancelCommMonoidWithZeroInstCommSemiringIntIsDomainToLinearOrderedRingLinearOrderedCommRing s f))) (OfNat.ofNat.{0} Int 1 (instOfNatInt 1)))
Case conversion may be inaccurate. Consider using '#align finset.int.gcd_div_eq_one Finset.Int.gcd_div_eq_oneₓ'. -/
/-- Given a nonempty finset `s` and a function `f` from `s` to `ℤ`, if `d = s.gcd`,
then the `gcd` of `(f i) / d` is equal to `1`. -/
theorem gcd_div_eq_one {β : Type _} {f : β → ℤ} (s : Finset β) {x : β} (hx : x ∈ s)
    (hfz : f x ≠ 0) : (s.gcd fun b => f b / s.gcd f) = 1 :=
  by
  obtain ⟨g, he, hg⟩ := Finset.extract_gcd f ⟨x, hx⟩
  refine' (Finset.gcd_congr rfl fun a ha => _).trans hg
  rw [he a ha, Int.mul_ediv_cancel_left]
  exact mt Finset.gcd_eq_zero_iff.1 fun h => hfz <| h x hx
#align finset.int.gcd_div_eq_one Finset.Int.gcd_div_eq_one

/- warning: finset.int.gcd_div_id_eq_one -> Finset.Int.gcd_div_id_eq_one is a dubious translation:
lean 3 declaration is
  forall {s : Finset.{0} Int} {x : Int}, (Membership.Mem.{0, 0} Int (Finset.{0} Int) (Finset.hasMem.{0} Int) x s) -> (Ne.{1} Int x (OfNat.ofNat.{0} Int 0 (OfNat.mk.{0} Int 0 (Zero.zero.{0} Int Int.hasZero)))) -> (Eq.{1} Int (Finset.gcd.{0, 0} Int Int (IsDomain.toCancelCommMonoidWithZero.{0} Int Int.commSemiring (LinearOrderedRing.isDomain.{0} Int (LinearOrderedCommRing.toLinearOrderedRing.{0} Int Int.linearOrderedCommRing))) Int.normalizedGcdMonoid s (fun (b : Int) => HDiv.hDiv.{0, 0, 0} Int Int Int (instHDiv.{0} Int Int.hasDiv) b (Finset.gcd.{0, 0} Int Int (IsDomain.toCancelCommMonoidWithZero.{0} Int Int.commSemiring (LinearOrderedRing.isDomain.{0} Int (LinearOrderedCommRing.toLinearOrderedRing.{0} Int Int.linearOrderedCommRing))) Int.normalizedGcdMonoid s (id.{1} Int)))) (OfNat.ofNat.{0} Int 1 (OfNat.mk.{0} Int 1 (One.one.{0} Int Int.hasOne))))
but is expected to have type
  forall {s : Finset.{0} Int} {x : Int}, (Membership.mem.{0, 0} Int (Finset.{0} Int) (Finset.instMembershipFinset.{0} Int) x s) -> (Ne.{1} Int x (OfNat.ofNat.{0} Int 0 (instOfNatInt 0))) -> (Eq.{1} Int (Finset.gcd.{0, 0} Int Int (IsDomain.toCancelCommMonoidWithZero.{0} Int Int.instCommSemiringInt (LinearOrderedRing.isDomain.{0} Int (LinearOrderedCommRing.toLinearOrderedRing.{0} Int Int.linearOrderedCommRing))) Int.instNormalizedGCDMonoidIntToCancelCommMonoidWithZeroInstCommSemiringIntIsDomainToLinearOrderedRingLinearOrderedCommRing s (fun (b : Int) => HDiv.hDiv.{0, 0, 0} Int Int Int (instHDiv.{0} Int Int.instDivInt_1) b (Finset.gcd.{0, 0} Int Int (IsDomain.toCancelCommMonoidWithZero.{0} Int Int.instCommSemiringInt (LinearOrderedRing.isDomain.{0} Int (LinearOrderedCommRing.toLinearOrderedRing.{0} Int Int.linearOrderedCommRing))) Int.instNormalizedGCDMonoidIntToCancelCommMonoidWithZeroInstCommSemiringIntIsDomainToLinearOrderedRingLinearOrderedCommRing s (id.{1} Int)))) (OfNat.ofNat.{0} Int 1 (instOfNatInt 1)))
Case conversion may be inaccurate. Consider using '#align finset.int.gcd_div_id_eq_one Finset.Int.gcd_div_id_eq_oneₓ'. -/
theorem gcd_div_id_eq_one {s : Finset ℤ} {x : ℤ} (hx : x ∈ s) (hnz : x ≠ 0) :
    (s.gcd fun b => b / s.gcd id) = 1 :=
  gcd_div_eq_one s hx hnz
#align finset.int.gcd_div_id_eq_one Finset.Int.gcd_div_id_eq_one

end Int

namespace Polynomial

open Polynomial Classical

noncomputable section

variable {K : Type _} [Field K]

#print Finset.Polynomial.gcd_div_eq_one /-
/-- Given a nonempty finset `s` and a function `f` from `s` to `K[X]`, if `d = s.gcd f`,
then the `gcd` of `(f i) / d` is equal to `1`. -/
theorem gcd_div_eq_one {β : Type _} {f : β → K[X]} (s : Finset β) {x : β} (hx : x ∈ s)
    (hfz : f x ≠ 0) : (s.gcd fun b => f b / s.gcd f) = 1 :=
  by
  obtain ⟨g, he, hg⟩ := Finset.extract_gcd f ⟨x, hx⟩
  refine' (Finset.gcd_congr rfl fun a ha => _).trans hg
  rw [he a ha, EuclideanDomain.mul_div_cancel_left]
  exact mt Finset.gcd_eq_zero_iff.1 fun h => hfz <| h x hx
#align finset.polynomial.gcd_div_eq_one Finset.Polynomial.gcd_div_eq_one
-/

#print Finset.Polynomial.gcd_div_id_eq_one /-
theorem gcd_div_id_eq_one {s : Finset K[X]} {x : K[X]} (hx : x ∈ s) (hnz : x ≠ 0) :
    (s.gcd fun b => b / s.gcd id) = 1 :=
  gcd_div_eq_one s hx hnz
#align finset.polynomial.gcd_div_id_eq_one Finset.Polynomial.gcd_div_id_eq_one
-/

end Polynomial

end Finset