/-
Copyright (c) 2017 Daniel Selsam. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Daniel Selsam

Properties of gradients.
-/
import .tensor .tfacts .tactics

namespace certigrad
namespace T
open list

-- is_cdifferentiable

axiom is_cdifferentiable_binary {shape : S} (k : T shape → T shape → ℝ) (θ : T shape) :
  is_cdifferentiable (λ θ₀, k θ₀ θ) θ → is_cdifferentiable (λ θ₀, k θ θ₀) θ →
  is_cdifferentiable (λ θ₀, k θ₀ θ₀) θ

axiom is_cdifferentiable_multiple_args {fshape : S} (tgt : reference) (parents : list reference) (m : env) (f : dvec T parents^.p2 → T fshape)
                                      (θ : T tgt.2) (k : T fshape → ℝ) :
  (∀ (idx : ℕ) (H_idx_in_riota: idx ∈ riota (length parents)) (H_tgt_eq_dnth_idx : tgt = dnth parents idx),
     is_cdifferentiable (λ θ₀, k (f (dvec.update_at θ₀ (env.get_ks parents (env.insert tgt θ m)) idx))) θ) →
  is_cdifferentiable (λ θ₀, k (f (env.get_ks parents (env.insert tgt θ₀ m)))) θ

axiom is_cdifferentiable_integral : ∀ {ishape tshape : S} (f : T ishape → T tshape → ℝ) (θ : T tshape),
  (∀ x, is_cdifferentiable (f x) θ) →
  is_uniformly_integrable_around (λ θ₀ x, f x θ₀) θ →
  is_uniformly_integrable_around (λ θ₀ x, ∇ (λ θ₁, f x θ₁) θ₀) θ →
  is_cdifferentiable (λ θ₀, ∫ (λ x, f x θ₀)) θ

axiom is_cdifferentiable_const {ishape : S} (θ : T ishape) (x : ℝ) : is_cdifferentiable (λ (θ₀ : T ishape), x) θ
axiom is_cdifferentiable_id (θ : ℝ) : is_cdifferentiable (λ (θ₀ : ℝ), θ₀) θ

axiom is_cdifferentiable_exp {shape : S} (k : T shape → ℝ) (θ : T shape) :
  is_cdifferentiable k (exp θ) → is_cdifferentiable (λ θ, k (exp θ)) θ

axiom is_cdifferentiable_log {shape : S} (k : T shape → ℝ) (θ : T shape) : θ > 0 →
  is_cdifferentiable k (log θ) → is_cdifferentiable (λ θ, k (log θ)) θ

axiom is_cdifferentiable_sqrt {shape : S} (k : T shape → ℝ) (θ : T shape) :
  is_cdifferentiable k (sqrt θ) → is_cdifferentiable (λ θ, k (sqrt θ)) θ

axiom is_cdifferentiable_inv {shape : S} (k : T shape → ℝ) (θ : T shape) : θ > 0 →
  is_cdifferentiable k θ⁻¹ → is_cdifferentiable (λ θ, k θ⁻¹) θ

axiom is_cdifferentiable_scale {shape : S} (k : T shape → ℝ) (α : ℝ) (x : T shape) :
  is_cdifferentiable k (α ⬝ x) → is_cdifferentiable (λ x, k (α ⬝ x)) x

axiom is_cdifferentiable_neg {shape : S} (k : T shape → ℝ) (θ : T shape) :
  is_cdifferentiable k (- θ) → is_cdifferentiable (λ θ, k (- θ)) θ

axiom is_cdifferentiable_add₁ {shape : S} (k : T shape → ℝ) (x₁ x₂ : T shape) :
  is_cdifferentiable k (x₁ + x₂) → is_cdifferentiable (λ x₁, k (x₁ + x₂)) x₁

axiom is_cdifferentiable_add₂ {shape : S} (k : T shape → ℝ) (x₁ x₂ : T shape) :
  is_cdifferentiable k (x₁ + x₂) → is_cdifferentiable (λ x₂, k (x₁ + x₂)) x₂

axiom is_cdifferentiable_sub₁ {shape : S} (k : T shape → ℝ) (x₁ x₂ : T shape) :
  is_cdifferentiable k (x₁ - x₂) → is_cdifferentiable (λ x₁, k (x₁ - x₂)) x₁

axiom is_cdifferentiable_sub₂ {shape : S} (k : T shape → ℝ) (x₁ x₂ : T shape) :
  is_cdifferentiable k (x₁ - x₂) → is_cdifferentiable (λ x₂, k (x₁ - x₂)) x₂

axiom is_cdifferentiable_mul₁ {shape : S} (k : T shape → ℝ) (x₁ x₂ : T shape) :
  is_cdifferentiable k (x₁ * x₂) → is_cdifferentiable (λ x₁, k (x₁ * x₂)) x₁

axiom is_cdifferentiable_mul₂ {shape : S} (k : T shape → ℝ) (x₁ x₂ : T shape) :
  is_cdifferentiable k (x₁ * x₂) → is_cdifferentiable (λ x₂, k (x₁ * x₂)) x₂

axiom is_cdifferentiable_div₁ {shape : S} (k : T shape → ℝ) (x₁ x₂ : T shape) : square x₂ > 0 →
  is_cdifferentiable k (x₁ / x₂) → is_cdifferentiable (λ x₁, k (x₁ / x₂)) x₁

axiom is_cdifferentiable_div₂ {shape : S} (k : T shape → ℝ) (x₁ x₂ : T shape) : square x₂ > 0 →
  is_cdifferentiable k (x₁ / x₂) → is_cdifferentiable (λ x₂, k (x₁ / x₂)) x₂

axiom is_cdifferentiable_sum (k : ℝ → ℝ) (shape : S) (x : T shape) :
  is_cdifferentiable k (sum x) → is_cdifferentiable (λ x, k (sum x)) x

axiom is_cdifferentiable_prod (k : ℝ → ℝ) (shape : S) (x : T shape) :
  is_cdifferentiable k (prod x) → is_cdifferentiable (λ x, k (prod x)) x

axiom is_cdifferentiable_square {shape : S} (k : T shape → ℝ) (x : T shape) :
  is_cdifferentiable k (square x) → is_cdifferentiable (λ x, k (square x)) x

axiom is_cdifferentiable_gemm₁ {m p : ℕ} (k : T [m, p] → ℝ) (n : ℕ) (M : T [m, n]) (N : T [n, p]) :
  is_cdifferentiable k (gemm M N) → is_cdifferentiable (λ M, k (gemm M N)) M

axiom is_cdifferentiable_gemm₂ {m p : ℕ} (k : T [m, p] → ℝ) (n : ℕ) (M : T [m, n]) (N : T [n, p]) :
  is_cdifferentiable k (gemm M N) → is_cdifferentiable (λ N, k (gemm M N)) N

axiom is_cdifferentiable_add_fs {shape : S} (f₁ f₂ : T shape → ℝ) (θ : T shape):
  (is_cdifferentiable f₁ θ ∧ is_cdifferentiable f₂ θ) ↔ is_cdifferentiable (λ θ₀, f₁ θ₀ + f₂ θ₀) θ

axiom is_cdifferentiable_scale_f {shape : S} (α : ℝ) (f : T shape → ℝ) (θ : T shape):
  is_cdifferentiable f θ ↔ is_cdifferentiable (λ x, α ⬝ f x) θ

axiom is_cdifferentiable_fscale {shape : S} (f : T shape → ℝ) (y : ℝ) (θ : T shape):
  is_cdifferentiable f θ ↔ is_cdifferentiable (λ x, f x ⬝ y) θ

-- Provable
axiom is_cdifferentiable_sumr {X : Type} {shape : S} (θ : T shape) (f : T shape → X → ℝ) :
  Π (xs : list X),
    (∀ (x : X), x ∈ xs → is_cdifferentiable (λ θ₀, f θ₀ x) θ) →
    is_cdifferentiable (λ (θ₀ : T shape), sumr (map (f θ₀) xs)) θ

--

axiom grad_binary {shape : S} (k : T shape → T shape → ℝ) (θ : T shape) :
  is_cdifferentiable (λ θ₀, k θ₀ θ) θ → is_cdifferentiable (λ θ₀, k θ θ₀) θ →
  ∇ (λ θ₀, k θ₀ θ₀) θ = ∇ (λ θ₀, k θ₀ θ) θ + ∇ (λ θ₀, k θ θ₀) θ

axiom grad_tmulT {ishape oshape : S} : ∀ (f : T ishape → T oshape) (k : T oshape → ℝ) (θ : T ishape),
  ∇ (λ θ₀, k (f θ₀)) θ = tmulT (D (λ θ₀, f θ₀) θ) (∇ k (f θ))

axiom grad_chain_rule : ∀ {shape₁ shape₂ : S} (f : T shape₁ → T shape₂) (g : T shape₂ → ℝ) (θ : T shape₁),
  ∇ (λ (θ₀ : T shape₁), g (f θ₀)) θ = tmulT (D f θ) (∇ g (f θ))

-- See Lang (Page 340, Theorem 3.4)
-- f continuously differentiable
-- f and grad_2 f both uniformly integrable
axiom grad_integral : ∀ {ishape tshape : S} (f : T ishape → T tshape → ℝ) (θ : T tshape),
  (∀ x, is_cdifferentiable (f x) θ) →
  is_uniformly_integrable_around (λ θ₀ x, f x θ₀) θ →
  is_uniformly_integrable_around (λ θ₀ x, ∇ (λ θ₁, f x θ₁) θ₀) θ →
  ∇ (λ θ₀, ∫ (λ x, f x θ₀)) θ = ∫ (λ x, ∇ (λ θ₀, f x θ₀) θ)

lemma grad_congr {shape : S} {f g : T shape → ℝ} {x : T shape} (H : ∀ x, f x = g x) : ∇ f x = ∇ g x :=
begin change (∇ (λ x, f x) x = ∇ (λ x, g x) x), rw (funext H) end

axiom grad_const : ∀ {ishape : S} (θ : T ishape) (x : ℝ), ∇ (λ (θ₀ : T ishape), x) θ = 0
axiom grad_id : ∀ (θ : ℝ), ∇ (λ θ, θ) θ = 1

-- Unary
axiom grad_exp {shape : S} (k : T shape → ℝ) (θ : T shape) :
  ∇ (λ θ, k (exp θ)) θ = ∇ k (exp θ) * exp θ

axiom grad_log {shape : S} (k : T shape → ℝ) (θ : T shape) : θ > 0 →
  ∇ (λ θ, k (log θ)) θ = ∇ k (log θ) / θ

axiom grad_sqrt {shape : S} (k : T shape → ℝ) (θ : T shape) : θ > 0 →
  ∇ (λ θ, k (sqrt θ)) θ = ∇ k (sqrt θ) / (2 * sqrt θ)

axiom grad_scale {shape : S} (k : T shape → ℝ) (α : ℝ) (x : T shape) :
  ∇ (λ x, k (α ⬝ x)) x = α ⬝ ∇ k (α ⬝ x)

axiom grad_neg {shape : S} (k : T shape → ℝ) (θ : T shape) :
  ∇ (λ θ, k (- θ)) θ = - (∇ k (- θ))

-- Binary
axiom grad_add₁ {shape : S} (k : T shape → ℝ) (x₁ x₂ : T shape) :
  ∇ (λ x₁, k (x₁ + x₂)) x₁ = ∇ k (x₁ + x₂)

axiom grad_add₂ {shape : S} (k : T shape → ℝ) (x₁ x₂ : T shape) :
  ∇ (λ x₂, k (x₁ + x₂)) x₂ = ∇ k (x₁ + x₂)

axiom grad_sub₁ {shape : S} (k : T shape → ℝ) (x₁ x₂ : T shape) :
  ∇ (λ x₁, k (x₁ - x₂)) x₁ = ∇ k (x₁ - x₂)

axiom grad_sub₂ {shape : S} (k : T shape → ℝ) (x₁ x₂ : T shape) :
  ∇ (λ x₂, k (x₁ - x₂)) x₂ = - ∇ k (x₁ - x₂)

axiom grad_mul₁ {shape : S} (k : T shape → ℝ) (x₁ x₂ : T shape) :
  ∇ (λ x₁, k (x₁ * x₂)) x₁ = ∇ k (x₁ * x₂) * x₂

axiom grad_mul₂ {shape : S} (k : T shape → ℝ) (x₁ x₂ : T shape) :
  ∇ (λ x₂, k (x₁ * x₂)) x₂ = ∇ k (x₁ * x₂) * x₁

-- Note: can be proved from grad_binary and grad_mul*, but resulting theorem
-- would have `is_cdifferentiable k` as a pre-condition.
-- It is safe to avoid that here because of the symmetry of the function.
axiom grad_square {shape : S} (k : T shape → ℝ) (x : T shape) :
  ∇ (λ x, k (square x)) x = ∇ k (square x) * 2 * x

axiom grad_div₁ {shape : S} (k : T shape → ℝ) (x₁ x₂ : T shape) : square x₂ > 0 →
  ∇ (λ x₁, k (x₁ / x₂)) x₁ = ∇ k (x₁ / x₂) / x₂

axiom grad_div₂ {shape : S} (k : T shape → ℝ) (x₁ x₂ : T shape) : square x₂ > 0 →
  ∇ (λ x₂, k (x₁ / x₂)) x₂ = - (∇ k (x₁ / x₂) * x₁) / (square x₂)

-- Tensors
axiom grad_sum (k : ℝ → ℝ) (shape : S) (x : T shape) :
  ∇ (λ x, k (sum x)) x = ∇ k (sum x) ⬝ 1

axiom grad_dot₁ {shape : S} (x₁ x₂ : T shape) : ∇ (λ x₁, dot x₁ x₂) x₁ = x₂
axiom grad_dot₂ {shape : S} (x₁ x₂ : T shape) : ∇ (λ x₂, dot x₁ x₂) x₂ = x₁

axiom grad_gemm₁ {m p : ℕ} (k : T [m, p] → ℝ) (n : ℕ) (M : T [m, n]) (N : T [n, p]) :
∇ (λ M, k (gemm M N)) M = gemm (∇ k (gemm M N)) (transpose N)

axiom grad_gemm₂ {m p : ℕ} (k : T [m, p] → ℝ) (n : ℕ) (M : T [m, n]) (N : T [n, p]) :
∇ (λ N, k (gemm M N)) N = gemm (transpose M) (∇ k (gemm M N))

-- Congruences
axiom grad_congr_pos {shape : S} (f g : T shape → ℝ) (θ : T shape) :
  θ > 0 → (∀ (θ₀ : T shape), θ₀ > 0 → f θ₀ = g θ₀) → ∇ f θ = ∇ g θ

-- Compound
lemma grad_softplus {shape : S} (k : T shape → ℝ) (θ : T shape) :
  ∇ (λ θ, k (softplus θ)) θ = ∇ k (softplus θ) / (1 + exp (- θ)) :=
have H : (exp θ) / (exp θ + 1) = 1 / (1 + exp (- θ)), from
calc  (exp θ) / (exp θ + 1)
    = ((exp θ) / (exp θ + 1)) * ((exp θ)⁻¹ / (exp θ)⁻¹) : by simp [T.div_self (inv_pos (@exp_pos _ θ))]
... = ((exp θ * (exp θ)⁻¹) / ((exp θ + 1) * (exp θ)⁻¹)) : by simp [T.div_mul_div]
... = (1 / ((exp θ + 1) * (exp θ)⁻¹)) : by simp only [T.mul_inv_cancel (@exp_pos _ θ)]
... = 1 / ((exp θ * (exp θ)⁻¹) + 1 * (exp θ)⁻¹) : by simp only [right_distrib]
... = 1 / (1 + exp (- θ)) : by { simp only [T.mul_inv_cancel (@exp_pos _ θ), one_mul], rw exp_inv},

calc  ∇ (λ θ, k (softplus θ)) θ
    = ∇ (λ θ, k (log (exp θ + 1))) θ : rfl
... = ∇ (λ θ, k (log (θ + 1))) (exp θ) * exp θ : by rw T.grad_exp (λ θ, k (log (θ + 1)))
... = ∇ (λ θ, k (log θ)) (exp θ + 1) * exp θ : by rw T.grad_add₁ (λ θ, k (log θ))
... = ∇ k (log (exp θ + 1)) / (exp θ + 1) * exp θ : by rw (T.grad_log k (exp θ + 1) (plus_one_pos exp_pos))
... = ∇ k (softplus θ) * (exp θ / (exp θ + 1)) : by { rw [-T.mul_div_mul], reflexivity }
... = ∇ k (softplus θ) * (1 / (1 + exp (- θ))) : by rw H
... = ∇ k (softplus θ) / (1 + exp (- θ)) : by simp [T.one_div_inv, T.div_mul_inv]

lemma grad_sigmoid {shape : S} (k : T shape → ℝ) (θ : T shape) :
  ∇ (λ θ, k (sigmoid θ)) θ = ∇ k (sigmoid θ) * sigmoid θ * (1 - sigmoid θ) :=
have H_pre : 1 + exp (- θ) > 0, from one_plus_pos exp_pos,
have H : exp (- θ) / (1 + exp (- θ)) = 1 - sigmoid θ, from
calc  exp (- θ) / (1 + exp (- θ))
    = ((1 + exp (- θ)) - 1) / (1 + exp (- θ)) : by simp [sub_add_eq_sub_sub]
... = ((1 + exp (- θ)) / (1 + exp (- θ))) - 1 / (1 + exp (- θ)) : by simp [T.div_sub_div_same]
... = 1 - sigmoid θ : by { rw T.div_self (one_plus_pos exp_pos), reflexivity },

calc  ∇ (λ θ, k (sigmoid θ)) θ
    = ∇ (λ θ, k (1 / (1 + exp (- θ)))) θ : rfl
... = - ∇ (λ θ, k (1 / (1 + exp θ))) (- θ) : by rw T.grad_neg (λ θ, k (1 / (1 + exp θ)))
... = - (∇ (λ θ, k (1 / (1 + θ))) (exp (- θ)) * exp (- θ)) : by rw T.grad_exp (λ θ, k (1 / (1 + θ)))
... = - (∇ (λ θ, k (1 / θ)) (1 + exp (- θ)) * exp (- θ)) : by rw T.grad_add₂ (λ θ, k (1 / θ))
... = -(-(∇ k (1 / (1 + exp (-θ))) * 1) / square (1 + exp (-θ)) * exp (-θ)) : by rw (T.grad_div₂ k 1 (1 + exp (- θ)) (square_pos_of_pos $ one_plus_pos exp_pos))
... = (∇ k (1 / (1 + exp (-θ)))) / square (1 + exp (-θ)) * exp (-θ) : begin rw T.neg_div, simp [mul_neg_eq_neg_mul_symm] end
... = (∇ k (sigmoid θ)) / square (1 + exp (-θ)) * exp (-θ) : rfl
... = (∇ k (sigmoid θ)) * (1 / (1 + exp (-θ))) * (exp (-θ) / (1 + exp (- θ))) : by simp [square, T.div_mul_inv, T.mul_inv_pos H_pre H_pre]
... = (∇ k (sigmoid θ)) * sigmoid θ * (exp (-θ) / (1 + exp (- θ))) : rfl
... = ∇ k (sigmoid θ) * sigmoid θ * (1 - sigmoid θ) : by rw H

-- Gradients wrt arbitrary functions
lemma grad_add_fs {ishape : S} (θ : T ishape) (f₁ f₂ : T ishape → ℝ) :
  is_cdifferentiable f₁ θ → is_cdifferentiable f₂ θ →
  ∇ (λ θ₀, f₁ θ₀ + f₂ θ₀) θ = ∇ (λ θ₀, f₁ θ₀) θ + ∇ (λ θ₀, f₂ θ₀) θ :=
assume H_f₁ H_f₂,
have H₁ : is_cdifferentiable (λ θ₀, f₁ θ₀ + f₂ θ) θ,
  begin apply iff.mp (is_cdifferentiable_add_fs _ _ _), split, exact H_f₁, apply is_cdifferentiable_const end,

have H₂ : is_cdifferentiable (λ θ₀, f₁ θ + f₂ θ₀) θ,
  begin apply iff.mp (is_cdifferentiable_add_fs _ _ _), split, apply is_cdifferentiable_const, exact H_f₂ end,

begin
rw grad_binary (λ θ₁ θ₂, f₁ θ₁ + f₂ θ₂) _ H₁ H₂,
rw [grad_chain_rule _ (λ θ₀, θ₀ + f₂ θ) θ, grad_chain_rule _ (λ θ₀, f₁ θ + θ₀) θ],
rw [tmulT_scalar, D_scalar, tmulT_scalar, D_scalar],
rw [grad_add₁ (λ θ, θ), grad_id, one_smul],
rw [grad_add₂ (λ θ, θ), grad_id, one_smul]
end

lemma grad_scale_f {ishape : S} (θ : T ishape) (α : ℝ) (f : T ishape → ℝ) :
  ∇ (λ θ₀, α ⬝ f θ₀) θ = α ⬝ ∇ (λ θ₀, f θ₀) θ :=
begin
rw grad_chain_rule f (λ θ, α ⬝ θ) θ,
rw grad_scale (λ θ, θ),
rw grad_id,
rw smul.def,
rw mul_one,
rw tmulT_scalar,
rw D_scalar,
dunfold smul has_smul.smul scalar_mul,
rw const_scalar
end

lemma grad_log_f {shape : S} (θ : T shape) (f : T shape → ℝ) : f θ > 0 → ∇ (λ θ₀, log (f θ₀)) θ = (f θ)⁻¹ ⬝ ∇ f θ :=
assume H_pos,
have H_grad_log_simple : Π {θ : ℝ}, θ > 0 → ∇ log θ = θ⁻¹, from
begin
intros θ H_pos,
rw grad_log (λ θ, θ) _ H_pos,
rw grad_id,
apply T.one_div_inv
end,
by rw [grad_chain_rule, tmulT_scalar, D_scalar, H_grad_log_simple H_pos]

section simplify_grad
open list expr tactic

lemma id_rule {A : Type*} (a : A) : id a = a := rfl

meta def reduce_k (k : expr) : tactic expr :=
do slss ← simp_lemmas.add_simp simp_lemmas.mk `certigrad.T.id_rule,
   slss^.dsimplify k <|> return k

meta def has_x (x e : expr) : bool := expr.fold e ff (λ (m : expr) (d : nat) (b : bool), if m = x then tt else b)

meta def compute_outer_inner_functions_core (x : expr) : Π (k e : expr), tactic expr :=
λ (k e :  expr),
do let f := get_app_fn e,
   let args := get_app_args e,
   let n := length args,
   let barg₁ := dnth args (n-2),
   let barg₂ := dnth args (n-1),
   barg₁_type ← infer_type barg₁,
   barg₂_type ← infer_type barg₂,
   if barg₁ = x ∨ barg₂ = x
     then return k
     else if has_x x barg₁
          then compute_outer_inner_functions_core (lam `x binder_info.default barg₁_type (app k $ mk_app f $ update_nth args (n-2) (var 0))) barg₁
          else if has_x x barg₂
               then compute_outer_inner_functions_core (lam `x binder_info.default barg₂_type (app k $ mk_app f $ update_nth args (n-1) (var 0))) barg₂
               else tactic.fail "no var0"

meta def compute_outer_inner_functions (grad : expr) : tactic expr :=
let g := app_arg (app_fn grad) in
do f ← head_eta_expand g,
   x ← mk_local_def `x (binding_domain f),
   body ← return (instantiate_var (binding_body f) x),
   body_type ← infer_type body,
   initial_k ← return (lam `x binder_info.default body_type (var 0)),
   compute_outer_inner_functions_core x initial_k body <|> return initial_k

meta def compute_k (grad : expr) : tactic expr :=
do k ← compute_outer_inner_functions grad,
   k_simp ← reduce_k k,
   head_eta_expand k_simp

meta def check_grad (e : expr) : tactic expr :=
if is_napp_of e `certigrad.T.grad 3 then head_eta_expand e else tactic.fail "not ∇"

meta def try_add_simp (s : simp_lemmas) (p : pexpr) : tactic simp_lemmas :=
do oe ← try_core $ to_expr p,
   match oe with
   | none := return s
   | (some e) := simp_lemmas.add s e
   end

meta def build_simplify_grad_simp_lemmas (k : expr) : tactic simp_lemmas :=
do es ← monad.mapm to_expr
                   [``(@certigrad.T.grad_const)
                  , ``(@certigrad.T.grad_id)
                  , ``(certigrad.T.grad_exp %%k)
                  , ``(certigrad.T.grad_log %%k)
                  , ``(certigrad.T.grad_scale %%k)
                  , ``(certigrad.T.grad_neg %%k)
                  , ``(certigrad.T.grad_add₁ %%k)
                  , ``(certigrad.T.grad_add₂ %%k)
                  , ``(certigrad.T.grad_sub₁ %%k)
                  , ``(certigrad.T.grad_sub₂ %%k)
                  , ``(certigrad.T.grad_mul₁ %%k)
                  , ``(certigrad.T.grad_mul₂ %%k)
                  , ``(certigrad.T.grad_div₁ %%k)
                  , ``(certigrad.T.grad_div₂ %%k)
                  , ``(@certigrad.T.grad_dot₁)
                  , ``(@certigrad.T.grad_dot₂)
                  , ``(certigrad.T.grad_square %%k)
                  , ``(certigrad.T.grad_sqrt %%k)
                  , ``(certigrad.T.grad_softplus %%k)
                  , ``(certigrad.T.grad_sigmoid %%k)
],
   s ← simp_lemmas.append simp_lemmas.mk es,
   -- These have shape requirements that may cause `to_expr` to fail
   s ← try_add_simp s ``(certigrad.T.grad_gemm₁ %%k),
   s ← try_add_simp s ``(certigrad.T.grad_gemm₂ %%k),
   s ← try_add_simp s ``(certigrad.T.grad_sum %%k),
   -- These haven't been defined yet
   s ← try_add_simp s ```(certigrad.T.grad_mvn_kl₁ %%k),
   s ← try_add_simp s ```(certigrad.T.grad_mvn_kl₂ %%k),
   s ← try_add_simp s ```(certigrad.T.grad_bernoulli_neglogpdf₁ %%k),
   s ← try_add_simp s ```(certigrad.T.grad_bernoulli_neglogpdf₂ %%k),

   s ← try_add_simp s ``(@certigrad.T.grad_scale_f),
   return s

meta def simplify_grad_core_helper (tac : tactic unit) : conv unit :=
λ r e, do guard $ r = `eq,
          grad ← check_grad e,
          k ← compute_k grad,
          s ← build_simplify_grad_simp_lemmas k,
          conv.apply_lemmas_core reducible s tac r e

meta def simplify_grad_core (tac : tactic unit) : tactic unit :=
at_target (λ e, do (a, new_e, pf) ← ext_simplify_core () {zeta := ff, beta := ff, eta := ff, proj := ff} simp_lemmas.mk
                                                      (λ u, failed)
                                                      (λ a s r p e, failed)
                                                      (λ a s r p e, do ⟨u, new_e, pr⟩ ← simplify_grad_core_helper tac r e,
                                                                       return ((), new_e, pr, tt))
                                                      `eq e,
                return (new_e, pf))

meta def check_is_cdifferentiable (e : expr) : tactic expr :=
if is_napp_of e `certigrad.T.is_cdifferentiable 3 then head_eta_expand e else tactic.fail "not is_cdifferentiable"

meta def prove_differentiable_core_helper (grad : expr) : tactic unit :=
do k ← compute_k grad,
   first [applyc `certigrad.T.is_cdifferentiable_const
        , applyc `certigrad.T.is_cdifferentiable_id
          -- these haven't been defined yet
        , to_expr ```(T.is_cdifferentiable_sigmoid %%k) >>= apply
        , to_expr ```(T.is_cdifferentiable_softplus %%k) >>= apply
        , to_expr ```(T.is_cdifferentiable_mvn_kl₁ %%k) >>= apply
        , to_expr ```(T.is_cdifferentiable_mvn_kl₂ %%k) >>= apply
        , to_expr ```(T.is_cdifferentiable_bernoulli_neglogpdf₁ %%k) >>= apply
        , to_expr ```(T.is_cdifferentiable_bernoulli_neglogpdf₂ %%k) >>= apply

        , to_expr ``(T.is_cdifferentiable_exp %%k) >>= apply
        , to_expr ``(T.is_cdifferentiable_log %%k) >>= apply
        , to_expr ``(T.is_cdifferentiable_sqrt %%k) >>= apply
        , to_expr ``(T.is_cdifferentiable_scale %%k) >>= apply
        , to_expr ``(T.is_cdifferentiable_neg %%k) >>= apply
        , to_expr ``(T.is_cdifferentiable_inv %%k) >>= apply
        , to_expr ``(T.is_cdifferentiable_add₁ %%k) >>= apply
        , to_expr ``(T.is_cdifferentiable_add₂ %%k) >>= apply
        , to_expr ``(T.is_cdifferentiable_sub₁ %%k) >>= apply
        , to_expr ``(T.is_cdifferentiable_sub₂ %%k) >>= apply
        , to_expr ``(T.is_cdifferentiable_mul₁ %%k) >>= apply
        , to_expr ``(T.is_cdifferentiable_mul₂ %%k) >>= apply
        , to_expr ``(T.is_cdifferentiable_div₁ %%k) >>= apply
        , to_expr ``(T.is_cdifferentiable_div₂ %%k) >>= apply
        , to_expr ``(T.is_cdifferentiable_square %%k) >>= apply
        , to_expr ``(T.is_cdifferentiable_sum %%k) >>= apply
        , to_expr ``(T.is_cdifferentiable_prod %%k) >>= apply
        , to_expr ``(T.is_cdifferentiable_gemm₁ %%k) >>= apply
        , to_expr ``(T.is_cdifferentiable_gemm₂ %%k) >>= apply
]

meta def prove_differentiable_core : tactic unit := target >>= check_is_cdifferentiable >>= prove_differentiable_core_helper
meta def prove_differentiable : tactic unit := repeat (prove_differentiable_core <|> prove_preconditions_core)

meta def simplify_grad : tactic unit := simplify_grad_core (repeat $ prove_preconditions_core <|> prove_differentiable_core)
end simplify_grad

-- Compounds with simplify_grad

lemma grad_mvn_kl₁ (k : ℝ → ℝ) (shape : S) (μ σ : T shape) : ∇ (λ μ, k (mvn_kl μ σ)) μ = ∇ k (mvn_kl μ σ) ⬝ μ :=
begin
dunfold T.mvn_kl,
simplify_grad,
simp [T.smul.def, T.const_neg, T.const_mul, T.const_zero, T.const_one, T.const_bit0, T.const_bit1, T.const_inv],
rw [-(mul_assoc (2 : T shape) 2⁻¹), T.mul_inv_cancel two_pos],
simp
end

lemma grad_mvn_kl₂ (k : ℝ → ℝ) (shape : S) (μ σ : T shape) (H_σ : σ > 0) (H_k : is_cdifferentiable k (mvn_kl μ σ)) :
  ∇ (λ σ, k (mvn_kl μ σ)) σ = ∇ k (mvn_kl μ σ) ⬝ (σ - (1 / σ)) :=
have H_σ₂ : square σ > 0, from square_pos_of_pos H_σ,
have H_diff₁ : is_cdifferentiable (λ (θ₀ : T shape), k (-2⁻¹ * T.sum (1 + T.log (square θ₀) - square μ - square σ))) σ, by prove_differentiable,
have H_diff₂ : is_cdifferentiable (λ (θ₀ : T shape), k (-2⁻¹ * T.sum (1 + T.log (square σ) - square μ - square θ₀))) σ, by prove_differentiable,

begin
dunfold T.mvn_kl,
rw (T.grad_binary (λ θ₁ θ₂, k ((- 2⁻¹) * T.sum (1 + T.log (square θ₁) - square μ - square θ₂))) _ H_diff₁ H_diff₂),
dsimp,
simplify_grad,
simp [T.smul.def, T.const_neg, T.const_mul, T.const_zero,
      T.const_one, T.const_bit0, T.const_bit1, T.const_inv,
      left_distrib, right_distrib],
rw [-(mul_assoc (2 : T shape) 2⁻¹), T.mul_inv_cancel two_pos],
erw T.neg_div,
simp [mul_neg_eq_neg_mul_symm, neg_mul_eq_neg_mul_symm],
apply congr_arg, apply congr_arg,
simp only [T.mul_div_mul, square],
rw [-mul_assoc, T.mul_div_mul, (@T.div_self_square _ σ H_σ)],
simp,
rw [-(mul_assoc (2 : T shape) 2⁻¹), T.mul_inv_cancel two_pos],
simp,
rw T.div_mul_inv,
simp
end

lemma grad_bernoulli_neglogpdf₁ (k : ℝ → ℝ) (shape : S) (p z : T shape)
                                (H_p₁ : 0 < p) (H_p₂ : 0 < 1 - p) (H_k : is_cdifferentiable k (bernoulli_neglogpdf p z)) :
  ∇ (λ p, k (bernoulli_neglogpdf p z)) p = ∇ k (bernoulli_neglogpdf p z) ⬝ ((1 - z) / (eps shape + (1 - p)) - z / (eps shape + p)) :=
have H_diff₁ : is_cdifferentiable (λ (θ₀ : T shape), k (-T.sum (z * T.log (eps shape + θ₀) + (1 - z) * T.log (eps shape + (1 - p))))) p, by prove_differentiable,
have H_diff₂ : is_cdifferentiable (λ (θ₀ : T shape), k (-T.sum (z * T.log (eps shape + p) + (1 - z) * T.log (eps shape + (1 - θ₀))))) p, by prove_differentiable,

begin
dunfold T.bernoulli_neglogpdf,
rw T.grad_binary (λ θ₁ θ₂, k ( - T.sum (z * T.log (eps shape + θ₁) + (1 - z) * T.log (eps shape + (1 - θ₂))))) _ H_diff₁ H_diff₂,
dsimp,
simplify_grad,
simp [T.smul.def, const_neg, T.neg_div, T.div_mul_inv, left_distrib, right_distrib],
end

lemma grad_bernoulli_neglogpdf₂ (k : ℝ → ℝ) (shape : S) (p z : T shape)
                                (H_p₁ : 0 < p) (H_p₂ : 0 < 1 - p) (H_k : is_cdifferentiable k (bernoulli_neglogpdf p z)) :
  ∇ (λ z, k (bernoulli_neglogpdf p z)) z = ∇ k (bernoulli_neglogpdf p z) ⬝ (log (eps shape + (1 - p)) - log (eps shape + p)) :=
have H_diff₁ : is_cdifferentiable (λ (θ₀ : T shape), k (-T.sum (θ₀ * T.log (eps shape + p) + (1 - z) * T.log (eps shape + (1 - p))))) z, by prove_differentiable,
have H_diff₂ : is_cdifferentiable (λ (θ₀ : T shape), k (-T.sum (z * T.log (eps shape + p) + (1 - θ₀) * T.log (eps shape + (1 - p))))) z, by prove_differentiable,

begin
dunfold T.bernoulli_neglogpdf,
rw T.grad_binary (λ θ₁ θ₂, k (- T.sum (θ₁ * T.log (eps shape + p) + (1 - θ₂) * T.log (eps shape + (1 - p))))) _ H_diff₁ H_diff₂,
dsimp,
simplify_grad,
simp [T.smul.def, const_neg, left_distrib, right_distrib],
end

-- Compounds with prove_differentiable
lemma is_cdifferentiable_sigmoid {shape : S} (k : T shape → ℝ) (θ : T shape) :
  is_cdifferentiable k (sigmoid θ) → is_cdifferentiable (λ θ, k (sigmoid θ)) θ :=
begin intro H, dunfold sigmoid, prove_differentiable end

lemma is_cdifferentiable_softplus {shape : S} (k : T shape → ℝ) (θ : T shape) :
  is_cdifferentiable k (softplus θ) → is_cdifferentiable (λ θ, k (softplus θ)) θ :=
begin intro H, dunfold softplus, prove_differentiable end

lemma is_cdifferentiable_mvn_kl₁ (k : ℝ → ℝ) (shape : S) (μ σ : T shape) :
  is_cdifferentiable k (mvn_kl μ σ) → is_cdifferentiable (λ μ, k (mvn_kl μ σ)) μ :=
begin intro H, dunfold mvn_kl, prove_differentiable end

lemma is_cdifferentiable_mvn_kl₂ (k : ℝ → ℝ) (shape : S) (μ σ : T shape) (H_σ : σ > 0) :
  is_cdifferentiable k (mvn_kl μ σ) → is_cdifferentiable (λ σ, k (mvn_kl μ σ)) σ :=
begin
intro H, dunfold mvn_kl,
apply is_cdifferentiable_binary (λ θ₁ θ₂, k (-2⁻¹ * T.sum (1 + T.log (square θ₁) + -square μ + -square θ₂))),
{ dsimp, prove_differentiable },
{ dsimp, prove_differentiable }
 end

lemma is_cdifferentiable_bernoulli_neglogpdf₁ (k : ℝ → ℝ) (shape : S) (p z : T shape) (H_p₁ : p > 0) (H_p₂ : p < 1) :
  is_cdifferentiable k (bernoulli_neglogpdf p z) → is_cdifferentiable (λ p, k (bernoulli_neglogpdf p z)) p :=
begin
intro H, dunfold bernoulli_neglogpdf,
apply is_cdifferentiable_binary (λ θ₁ θ₂, k (-T.sum (z * T.log (eps shape + θ₁) + (1 + -z) * T.log (eps shape + (1 + -θ₂))))),
{ dsimp, prove_differentiable },
{ dsimp, prove_differentiable }
end

lemma is_cdifferentiable_bernoulli_neglogpdf₂ (k : ℝ → ℝ) (shape : S) (p z : T shape) :
  is_cdifferentiable k (bernoulli_neglogpdf p z) → is_cdifferentiable (λ z, k (bernoulli_neglogpdf p z)) z :=
begin
intro H, dunfold bernoulli_neglogpdf,
apply is_cdifferentiable_binary (λ θ₁ θ₂, k (-T.sum (θ₁ * T.log (eps shape + p) + (1 + -θ₂) * T.log (eps shape + (1 + -p))))),
{ dsimp, prove_differentiable },
{ dsimp, prove_differentiable }
end

-- Random

lemma mvn_grad_logpdf_μ_correct {shape : S} (μ σ x : T shape) (H_σ : σ > 0) :
  ∇ (λ θ, mvn_logpdf θ σ x) μ = mvn_grad_logpdf_μ μ σ x :=
begin
dunfold mvn_logpdf,
note H := square_pos_of_pos H_σ,
simplify_grad,
simp [smul.def, const_bit0, const_one, const_neg, const_inv, T.neg_div],
rw -mul_assoc, rw T.mul_inv_cancel two_pos,
simp, rw T.div_div_eq_div_mul,
reflexivity
end

lemma mvn_grad_logpdf_σ_correct {shape : S} (μ σ x : T shape) (H_σ : σ > 0) :
  ∇ (λ θ, mvn_logpdf μ θ x) σ = mvn_grad_logpdf_σ μ σ x :=
have H_σ₂ : square σ > 0, from square_pos_of_pos H_σ,
have H_d₁ : is_cdifferentiable (λ θ₀, -2⁻¹ * sum (square ((x - μ) / θ₀) + log (2 * pi shape) + log (square σ))) σ, by prove_differentiable,
have H_d₂ : is_cdifferentiable (λ θ₀, -2⁻¹ * sum (square ((x - μ) / σ) + log (2 * pi shape) + log (square θ₀))) σ, by prove_differentiable,

have H₁ : (2 * (2⁻¹ / square σ)) = σ⁻¹ * σ⁻¹,
  begin dunfold square, rw [T.mul_div_mul_alt, T.mul_inv_cancel two_pos, one_div_inv, T.mul_inv_pos H_σ H_σ] end,

have H₂ : 2 * ((x + -μ) * ((x + -μ) * 2⁻¹)) = (2 * 2⁻¹) * square (x - μ), by simp [square],

begin
dunfold mvn_logpdf,
rw grad_binary (λ θ₁ θ₂, -2⁻¹ * sum (square ((x - μ) / θ₁) + log (2 * pi shape) + log (square θ₂))) _ H_d₁ H_d₂, dsimp,
simplify_grad,
simp [smul.def, const_bit0, const_one, const_neg, const_inv, T.neg_div, T.div_div_eq_div_mul],
rw H₁,
rw -mul_assoc, rw T.mul_inv_cancel H_σ,
simp [T.mul_div_mul_alt, T.div_div_eq_div_mul],
rw [H₂, T.mul_inv_cancel two_pos],
simp [mvn_grad_logpdf_σ]
end

-- With data structures
lemma grad_sumr {X : Type} {shape : S} (θ : T shape) (f : T shape → X → ℝ) :
  Π (xs : list X),
    is_cdifferentiable (λ (θ₀ : T shape), sumr (map (f θ₀) xs)) θ →
    ∇ (λ (θ₀ : T shape), list.sumr (map (f θ₀) xs)) θ
    =
    list.sumr (map (λ x, ∇ (λ θ₀, f θ₀ x) θ) xs)
| []      H_diff := by { dunfold map sumr, rw grad_const }
| (x::xs) H_diff :=
begin
dunfold map sumr,
dunfold map sumr at H_diff,

rw grad_add_fs _ _ _ (iff.mpr (is_cdifferentiable_add_fs _ _ _) H_diff)^.left (iff.mpr (is_cdifferentiable_add_fs _ _ _) H_diff)^.right,
rw grad_sumr _ (iff.mpr (is_cdifferentiable_add_fs _ _ _) H_diff)^.right
end

-- Note: this could be proved from a `select`/`replicate` formulation,
-- but it is arguably a more natural way of axiomatizing the property anyway.
axiom multiple_args_general :
  ∀ (parents : list reference) (tgt : reference) (m : env)
    (f : dvec T parents^.p2 → T tgt.2 → ℝ) (θ : T tgt.2),
    is_cdifferentiable (λ θ₀, f (env.get_ks parents (env.insert tgt θ m)) θ₀) θ →
    is_cdifferentiable (λ θ₀, sumr (map (λ (idx : ℕ), f (dvec.update_at θ₀ (env.get_ks parents (env.insert tgt θ m)) idx) θ)
                                       (filter (λ idx, tgt = dnth parents idx) (riota $ length parents)))) θ →
∇ (λ (θ₀ : T tgt.2), f (env.get_ks parents (env.insert tgt θ₀ m)) θ₀) θ
=
∇ (λ θ₀, f (env.get_ks parents (env.insert tgt θ m)) θ₀) θ +
sumr (map (λ (idx : ℕ),
            ∇ (λ θ₀, f (dvec.update_at θ₀ (env.get_ks parents (env.insert tgt θ m)) idx) θ) θ)
         (filter (λ idx, tgt = dnth parents idx) (riota $ length parents)))

end T
end certigrad


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.limits.colimit_limit
import category_theory.limits.preserves.functor_category
import category_theory.limits.preserves.finite
import category_theory.limits.shapes.finite_limits
import category_theory.limits.preserves.filtered

/-!
# Filtered colimits commute with finite limits.

We show that for a functor `F : J × K ⥤ Type v`, when `J` is finite and `K` is filtered,
the universal morphism `colimit_limit_to_limit_colimit F` comparing the
colimit (over `K`) of the limits (over `J`) with the limit of the colimits is an isomorphism.

(In fact, to prove that it is injective only requires that `J` has finitely many objects.)

## References
* Borceux, Handbook of categorical algebra 1, Theorem 2.13.4
* [Stacks: Filtered colimits](https://stacks.math.columbia.edu/tag/002W)
-/

universes v u

open category_theory
open category_theory.category
open category_theory.limits.types
open category_theory.limits.types.filtered_colimit

namespace category_theory.limits

variables {J K : Type v} [small_category J] [small_category K]
variables (F : J × K ⥤ Type v)

open category_theory.prod

variables [is_filtered K]

section
/-!
Injectivity doesn't need that we have finitely many morphisms in `J`,
only that there are finitely many objects.
-/
variables [fintype J]

/--
This follows this proof from
* Borceux, Handbook of categorical algebra 1, Theorem 2.13.4
-/
lemma colimit_limit_to_limit_colimit_injective :
  function.injective (colimit_limit_to_limit_colimit F) :=
begin
  classical,

  -- Suppose we have two terms `x y` in the colimit (over `K`) of the limits (over `J`),
  -- and that these have the same image under `colimit_limit_to_limit_colimit F`.
  intros x y h,
  -- These elements of the colimit have representatives somewhere:
  obtain ⟨kx, x, rfl⟩ := jointly_surjective' x,
  obtain ⟨ky, y, rfl⟩ := jointly_surjective' y,
  dsimp at x y,

  -- Since the images of `x` and `y` are equal in a limit, they are equal componentwise
  -- (indexed by `j : J`),
  replace h := λ j, congr_arg (limit.π ((curry.obj F) ⋙ colim) j) h,
  -- and they are equations in a filtered colimit,
  -- so for each `j` we have some place `k j` to the right of both `kx` and `ky`
  simp [colimit_eq_iff] at h,
  let k := λ j, (h j).some,
  let f : Π j, kx ⟶ k j := λ j, (h j).some_spec.some,
  let g : Π j, ky ⟶ k j := λ j, (h j).some_spec.some_spec.some,
  -- where the images of the components of the representatives become equal:
  have w : Π j,
    F.map ((𝟙 j, f j) : (j, kx) ⟶ (j, k j)) (limit.π ((curry.obj (swap K J ⋙ F)).obj kx) j x) =
    F.map ((𝟙 j, g j) : (j, ky) ⟶ (j, k j)) (limit.π ((curry.obj (swap K J ⋙ F)).obj ky) j y) :=
    λ j, (h j).some_spec.some_spec.some_spec,

  -- We now use that `K` is filtered, picking some point to the right of all these
  -- morphisms `f j` and `g j`.
  let O : finset K := (finset.univ).image k ∪ {kx, ky},
  have kxO : kx ∈ O := finset.mem_union.mpr (or.inr (by simp)),
  have kyO : ky ∈ O := finset.mem_union.mpr (or.inr (by simp)),
  have kjO : ∀ j, k j ∈ O := λ j, finset.mem_union.mpr (or.inl (by simp)),

  let H : finset (Σ' (X Y : K) (mX : X ∈ O) (mY : Y ∈ O), X ⟶ Y) :=
    (finset.univ).image (λ j : J, ⟨kx, k j, kxO,
      finset.mem_union.mpr (or.inl (by simp)),
      f j⟩) ∪
    (finset.univ).image (λ j : J, ⟨ky, k j, kyO,
      finset.mem_union.mpr (or.inl (by simp)),
      g j⟩),
  obtain ⟨S, T, W⟩ := is_filtered.sup_exists O H,

  have fH :
    ∀ j, (⟨kx, k j, kxO, kjO j, f j⟩ : (Σ' (X Y : K) (mX : X ∈ O) (mY : Y ∈ O), X ⟶ Y)) ∈ H :=
    λ j, (finset.mem_union.mpr (or.inl
    begin
      simp only [true_and, finset.mem_univ, eq_self_iff_true, exists_prop_of_true,
        finset.mem_image, heq_iff_eq],
      refine ⟨j, rfl, _⟩,
      simp only [heq_iff_eq],
      exact ⟨rfl, rfl, rfl⟩,
    end)),
  have gH :
    ∀ j, (⟨ky, k j, kyO, kjO j, g j⟩ : (Σ' (X Y : K) (mX : X ∈ O) (mY : Y ∈ O), X ⟶ Y)) ∈ H :=
    λ j, (finset.mem_union.mpr (or.inr
    begin
      simp only [true_and, finset.mem_univ, eq_self_iff_true, exists_prop_of_true,
        finset.mem_image, heq_iff_eq],
      refine ⟨j, rfl, _⟩,
      simp only [heq_iff_eq],
      exact ⟨rfl, rfl, rfl⟩,
    end)),

  -- Our goal is now an equation between equivalence classes of representatives of a colimit,
  -- and so it suffices to show those representative become equal somewhere, in particular at `S`.
  apply colimit_sound' (T kxO) (T kyO),

  -- We can check if two elements of a limit (in `Type`) are equal by comparing them componentwise.
  ext,

  -- Now it's just a calculation using `W` and `w`.
  simp only [functor.comp_map, limit.map_π_apply, curry.obj_map_app, swap_map],
  rw ←W _ _ (fH j),
  rw ←W _ _ (gH j),
  simp [w],
end

end

variables [fin_category J]

/--
This follows this proof from
* Borceux, Handbook of categorical algebra 1, Theorem 2.13.4
although with different names.
-/
lemma colimit_limit_to_limit_colimit_surjective :
  function.surjective (colimit_limit_to_limit_colimit F) :=
begin
  classical,
  -- We begin with some element `x` in the limit (over J) over the colimits (over K),
  intro x,
  -- This consists of some coherent family of elements in the various colimits,
  -- and so our first task is to pick representatives of these elements.
  have z := λ j, jointly_surjective' (limit.π (curry.obj F ⋙ limits.colim) j x),
  -- `k : J ⟶ K` records where the representative of the element in the `j`-th element of `x` lives
  let k : J → K := λ j, (z j).some,
  -- `y j : F.obj (j, k j)` is the representative
  let y : Π j, F.obj (j, k j) := λ j, (z j).some_spec.some,
  -- and we record that these representatives, when mapped back into the relevant colimits,
  -- are actually the components of `x`.
  have e : ∀ j,
    colimit.ι ((curry.obj F).obj j) (k j) (y j) =
    limit.π (curry.obj F ⋙ limits.colim) j x := λ j, (z j).some_spec.some_spec,
  clear_value k y, -- A little tidying up of things we no longer need.
  clear z,

  -- As a first step, we use that `K` is filtered to pick some point `k' : K` above all the `k j`
  let k' : K := is_filtered.sup (finset.univ.image k) ∅,
  -- and name the morphisms as `g j : k j ⟶ k'`.
  have g : Π j, k j ⟶ k' := λ j, is_filtered.to_sup (finset.univ.image k) ∅ (by simp),
  clear_value k',

  -- Recalling that the components of `x`, which are indexed by `j : J`, are "coherent",
  -- in other words preserved by morphisms in the `J` direction,
  -- we see that for any morphism `f : j ⟶ j'` in `J`,
  -- the images of `y j` and `y j'`, when mapped to `F.obj (j', k')` respectively by
  -- `(f, g j)` and `(𝟙 j', g j')`, both represent the same element in the colimit.
  have w : ∀ {j j' : J} (f : j ⟶ j'),
    colimit.ι ((curry.obj F).obj j') k' (F.map ((𝟙 j', g j') : (j', k j') ⟶ (j', k')) (y j')) =
    colimit.ι ((curry.obj F).obj j') k' (F.map ((f, g j) : (j, k j) ⟶ (j', k')) (y j)),
  { intros j j' f,
    have t : (f, g j) = (((f, 𝟙 (k j)) : (j, k j) ⟶ (j', k j)) ≫ (𝟙 j', g j) : (j, k j) ⟶ (j', k')),
    { simp only [id_comp, comp_id, prod_comp], },
    erw [colimit.w_apply, t, functor_to_types.map_comp_apply, colimit.w_apply, e,
      ←limit.w_apply f, ←e],
    simp, },

  -- Because `K` is filtered, we can restate this as saying that
  -- for each such `f`, there is some place to the right of `k'`
  -- where these images of `y j` and `y j'` become equal.
  simp_rw colimit_eq_iff at w,

  -- We take a moment to restate `w` more conveniently.
  let kf : Π {j j'} (f : j ⟶ j'), K := λ _ _ f, (w f).some,
  let gf : Π {j j'} (f : j ⟶ j'), k' ⟶ kf f := λ _ _ f, (w f).some_spec.some,
  let hf : Π {j j'} (f : j ⟶ j'), k' ⟶ kf f := λ _ _ f, (w f).some_spec.some_spec.some,
  have wf : Π {j j'} (f : j ⟶ j'),
    F.map ((𝟙 j', g j' ≫ gf f) : (j', k j') ⟶ (j', kf f)) (y j') =
    F.map ((f, g j ≫ hf f) : (j, k j) ⟶ (j', kf f)) (y j) := λ j j' f,
  begin
    have q :
      ((curry.obj F).obj j').map (gf f) (F.map _ (y j')) =
      ((curry.obj F).obj j').map (hf f) (F.map _ (y j)) :=
      (w f).some_spec.some_spec.some_spec,
    dsimp at q,
    simp_rw ←functor_to_types.map_comp_apply at q,
    convert q; simp only [comp_id],
  end,
  clear_value kf gf hf, -- and clean up some things that are no longer needed.
  clear w,

  -- We're now ready to use the fact that `K` is filtered a second time,
  -- picking some place to the right of all of
  -- the morphisms `gf f : k' ⟶ kh f` and `hf f : k' ⟶ kf f`.
  -- At this point we're relying on there being only finitely morphisms in `J`.
  let O := finset.univ.bUnion (λ j, finset.univ.bUnion (λ j', finset.univ.image (@kf j j'))) ∪ {k'},
  have kfO : ∀ {j j'} (f : j ⟶ j'), kf f ∈ O := λ j j' f, finset.mem_union.mpr (or.inl (
  begin
    rw [finset.mem_bUnion],
    refine ⟨j, finset.mem_univ j, _⟩,
    rw [finset.mem_bUnion],
    refine ⟨j', finset.mem_univ j', _⟩,
    rw [finset.mem_image],
    refine ⟨f, finset.mem_univ _, _⟩,
    refl,
  end)),
  have k'O : k' ∈ O := finset.mem_union.mpr (or.inr (finset.mem_singleton.mpr rfl)),
  let H : finset (Σ' (X Y : K) (mX : X ∈ O) (mY : Y ∈ O), X ⟶ Y) :=
    finset.univ.bUnion (λ j : J, finset.univ.bUnion (λ j' : J, finset.univ.bUnion (λ f : j ⟶ j',
      {⟨k', kf f, k'O, kfO f, gf f⟩, ⟨k', kf f, k'O, kfO f, hf f⟩}))),

  obtain ⟨k'', i', s'⟩ := is_filtered.sup_exists O H,
  -- We then restate this slightly more conveniently, as a family of morphism `i f : kf f ⟶ k''`,
  -- satisfying `gf f ≫ i f = hf f' ≫ i f'`.
  let i : Π {j j'} (f : j ⟶ j'), kf f ⟶ k'' := λ j j' f, i' (kfO f),
  have s : ∀ {j₁ j₂ j₃ j₄} (f : j₁ ⟶ j₂) (f' : j₃ ⟶ j₄), gf f ≫ i f = hf f' ≫ i f' :=
  begin
    intros,
    rw [s', s'],
    swap 2,
    exact k'O,
    swap 2,
    { rw [finset.mem_bUnion],
      refine ⟨j₁, finset.mem_univ _, _⟩,
      rw [finset.mem_bUnion],
      refine ⟨j₂, finset.mem_univ _, _⟩,
      rw [finset.mem_bUnion],
      refine ⟨f, finset.mem_univ _, _⟩,
      simp only [true_or, eq_self_iff_true, and_self, finset.mem_insert, heq_iff_eq], },
    { rw [finset.mem_bUnion],
      refine ⟨j₃, finset.mem_univ _, _⟩,
      rw [finset.mem_bUnion],
      refine ⟨j₄, finset.mem_univ _, _⟩,
      rw [finset.mem_bUnion],
      refine ⟨f', finset.mem_univ _, _⟩,
      simp only [eq_self_iff_true, or_true, and_self, finset.mem_insert, finset.mem_singleton,
        heq_iff_eq], }
  end,
  clear_value i,
  clear s' i' H kfO k'O O,

  -- We're finally ready to construct the pre-image, and verify it really maps to `x`.
  fsplit,

  { -- We construct the pre-image (which, recall is meant to be a point
    -- in the colimit (over `K`) of the limits (over `J`)) via a representative at `k''`.
    apply colimit.ι (curry.obj (swap K J ⋙ F) ⋙ limits.lim) k'' _,
    dsimp,
    -- This representative is meant to be an element of a limit,
    -- so we need to construct a family of elements in `F.obj (j, k'')` for varying `j`,
    -- then show that are coherent with respect to morphisms in the `j` direction.
    ext, swap,
    { -- We construct the elements as the images of the `y j`.
      exact λ j, F.map (⟨𝟙 j, g j ≫ gf (𝟙 j) ≫ i (𝟙 j)⟩ : (j, k j) ⟶ (j, k'')) (y j), },
    { -- After which it's just a calculation, using `s` and `wf`, to see they are coherent.
      dsimp,
      simp only [←functor_to_types.map_comp_apply, prod_comp, id_comp, comp_id],
      calc F.map ((f, g j ≫ gf (𝟙 j) ≫ i (𝟙 j)) : (j, k j) ⟶ (j', k'')) (y j)
          = F.map ((f, g j ≫ hf f ≫ i f) : (j, k j) ⟶ (j', k'')) (y j)
                : by rw s (𝟙 j) f
      ... = F.map ((𝟙 j', i f) : (j', kf f) ⟶ (j', k''))
              (F.map ((f, g j ≫ hf f) : (j, k j) ⟶ (j', kf f)) (y j))
                : by rw [←functor_to_types.map_comp_apply, prod_comp, comp_id, assoc]
      ... = F.map ((𝟙 j', i f) : (j', kf f) ⟶ (j', k''))
              (F.map ((𝟙 j', g j' ≫ gf f) : (j', k j') ⟶ (j', kf f)) (y j'))
                : by rw ←wf f
      ... = F.map ((𝟙 j', g j' ≫ gf f ≫ i f) : (j', k j') ⟶ (j', k'')) (y j')
                : by rw [←functor_to_types.map_comp_apply, prod_comp, id_comp, assoc]
      ... = F.map ((𝟙 j', g j' ≫ gf (𝟙 j') ≫ i (𝟙 j')) : (j', k j') ⟶ (j', k'')) (y j')
                : by rw [s f (𝟙 j'), ←s (𝟙 j') (𝟙 j')], }, },

  -- Finally we check that this maps to `x`.
  { -- We can do this componentwise:
    apply limit_ext,
    intro j,

    -- and as each component is an equation in a colimit, we can verify it by
    -- pointing out the morphism which carries one representative to the other:
    simp only [←e, colimit_eq_iff, curry.obj_obj_map, limit.π_mk,
      bifunctor.map_id_comp, id.def, types_comp_apply,
      limits.ι_colimit_limit_to_limit_colimit_π_apply],
    refine ⟨k'', 𝟙 k'', g j ≫ gf (𝟙 j) ≫ i (𝟙 j), _⟩,
    simp only [bifunctor.map_id_comp, types_comp_apply, bifunctor.map_id, types_id_apply], },
end

instance colimit_limit_to_limit_colimit_is_iso :
  is_iso (colimit_limit_to_limit_colimit F) :=
(is_iso_iff_bijective _).mpr
  ⟨colimit_limit_to_limit_colimit_injective F, colimit_limit_to_limit_colimit_surjective F⟩

instance colimit_limit_to_limit_colimit_cone_iso (F : J ⥤ K ⥤ Type v) :
  is_iso (colimit_limit_to_limit_colimit_cone F) :=
begin
  haveI : is_iso (colimit_limit_to_limit_colimit_cone F).hom,
  { dsimp only [colimit_limit_to_limit_colimit_cone], apply_instance },
  apply cones.cone_iso_of_hom_iso,
end

noncomputable
instance filtered_colim_preserves_finite_limits_of_types :
  preserves_finite_limits (colim : (K ⥤ Type v) ⥤ _) := ⟨λ J _ _, by exactI ⟨λ F, ⟨λ c hc,
begin
  apply is_limit.of_iso_limit (limit.is_limit _),
  symmetry,
  transitivity (colim.map_cone (limit.cone F)),
  exact functor.map_iso _ (hc.unique_up_to_iso (limit.is_limit F)),
  exact as_iso (colimit_limit_to_limit_colimit_cone F),
end ⟩⟩⟩

variables {C : Type u} [category.{v} C] [concrete_category.{v} C]
section
variables [has_limits_of_shape J C] [has_colimits_of_shape K C]
variables [reflects_limits_of_shape J (forget C)] [preserves_colimits_of_shape K (forget C)]
variables [preserves_limits_of_shape J (forget C)]

noncomputable
instance filtered_colim_preserves_finite_limits :
  preserves_limits_of_shape J (colim : (K ⥤ C) ⥤ _) :=
begin
  haveI : preserves_limits_of_shape J ((colim : (K ⥤ C) ⥤ _) ⋙ forget C) :=
    preserves_limits_of_shape_of_nat_iso (preserves_colimit_nat_iso _).symm,
  exactI preserves_limits_of_shape_of_reflects_of_preserves _ (forget C)
end
end

local attribute [instance] reflects_limits_of_shape_of_reflects_isomorphisms

noncomputable
instance [preserves_finite_limits (forget C)] [preserves_filtered_colimits (forget C)]
  [has_finite_limits C] [has_colimits_of_shape K C] [reflects_isomorphisms (forget C)] :
    preserves_finite_limits (colim : (K ⥤ C) ⥤ _) :=
⟨λ _ _ _, by exactI category_theory.limits.filtered_colim_preserves_finite_limits⟩

section

variables [has_limits_of_shape J C] [has_colimits_of_shape K C]
variables [reflects_limits_of_shape J (forget C)] [preserves_colimits_of_shape K (forget C)]
variables [preserves_limits_of_shape J (forget C)]

/-- A curried version of the fact that filtered colimits commute with finite limits. -/
noncomputable def colimit_limit_iso (F : J ⥤ K ⥤ C) :
  colimit (limit F) ≅ limit (colimit F.flip) :=
(is_limit_of_preserves colim (limit.is_limit _)).cone_point_unique_up_to_iso (limit.is_limit _) ≪≫
  (has_limit.iso_of_nat_iso (colimit_flip_iso_comp_colim _).symm)

@[simp, reassoc]
lemma ι_colimit_limit_iso_limit_π (F : J ⥤ K ⥤ C) (a) (b) :
  colimit.ι (limit F) a ≫ (colimit_limit_iso F).hom ≫ limit.π (colimit F.flip) b =
  (limit.π F b).app a ≫ (colimit.ι F.flip a).app b :=
begin
  dsimp [colimit_limit_iso],
  simp only [functor.map_cone_π_app, iso.symm_hom,
    limits.limit.cone_point_unique_up_to_iso_hom_comp_assoc, limits.limit.cone_π,
    limits.colimit.ι_map_assoc, limits.colimit_flip_iso_comp_colim_inv_app, assoc,
    limits.has_limit.iso_of_nat_iso_hom_π],
  congr' 1,
  simp only [← category.assoc, iso.comp_inv_eq,
    limits.colimit_obj_iso_colimit_comp_evaluation_ι_app_hom,
    limits.has_colimit.iso_of_nat_iso_ι_hom, nat_iso.of_components.hom_app],
  dsimp,
  simp,
end

end

end category_theory.limits


/-
Copyright (c) 2022 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta

! This file was ported from Lean 3 source module combinatorics.simple_graph.triangle.basic
! leanprover-community/mathlib commit ee05e9ce1322178f0c12004eb93c00d2c8c00ed2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Combinatorics.SimpleGraph.Clique

/-!
# Triangles in graphs

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

A *triangle* in a simple graph is a `3`-clique, namely a set of three vertices that are
pairwise adjacent.

This module defines and proves properties about triangles in simple graphs.

## Main declarations

* `simple_graph.far_from_triangle_free`: Predicate for a graph to have enough triangles that, to
  remove all of them, one must one must remove a lot of edges. This is the crux of the Triangle
  Removal lemma.

## TODO

* Generalise `far_from_triangle_free` to other graphs, to state and prove the Graph Removal Lemma.
* Find a better name for `far_from_triangle_free`. Added 4/26/2022. Remove this TODO if it gets old.
-/

open Finset Fintype Nat

open Classical

namespace SimpleGraph

variable {α 𝕜 : Type _} [Fintype α] [LinearOrderedField 𝕜] {G H : SimpleGraph α} {ε δ : 𝕜} {n : ℕ}
  {s : Finset α}

#print SimpleGraph.FarFromTriangleFree /-
/-- A simple graph is *`ε`-triangle-free far* if one must remove at least `ε * (card α)^2` edges to
make it triangle-free. -/
def FarFromTriangleFree (G : SimpleGraph α) (ε : 𝕜) : Prop :=
  (G.DeleteFar fun H => H.CliqueFree 3) <| ε * (card α ^ 2 : ℕ)
#align simple_graph.far_from_triangle_free SimpleGraph.FarFromTriangleFree
-/

/- warning: simple_graph.far_from_triangle_free_iff -> SimpleGraph.farFromTriangleFree_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {𝕜 : Type.{u2}} [_inst_1 : Fintype.{u1} α] [_inst_2 : LinearOrderedField.{u2} 𝕜] {G : SimpleGraph.{u1} α} {ε : 𝕜}, Iff (SimpleGraph.FarFromTriangleFree.{u1, u2} α 𝕜 _inst_1 _inst_2 G ε) (forall {{H : SimpleGraph.{u1} α}}, (LE.le.{u1} (SimpleGraph.{u1} α) (SimpleGraph.hasLe.{u1} α) H G) -> (SimpleGraph.CliqueFree.{u1} α H (OfNat.ofNat.{0} Nat 3 (OfNat.mk.{0} Nat 3 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))) -> (LE.le.{u2} 𝕜 (Preorder.toLE.{u2} 𝕜 (PartialOrder.toPreorder.{u2} 𝕜 (OrderedAddCommGroup.toPartialOrder.{u2} 𝕜 (StrictOrderedRing.toOrderedAddCommGroup.{u2} 𝕜 (LinearOrderedRing.toStrictOrderedRing.{u2} 𝕜 (LinearOrderedCommRing.toLinearOrderedRing.{u2} 𝕜 (LinearOrderedField.toLinearOrderedCommRing.{u2} 𝕜 _inst_2))))))) (HMul.hMul.{u2, u2, u2} 𝕜 𝕜 𝕜 (instHMul.{u2} 𝕜 (Distrib.toHasMul.{u2} 𝕜 (Ring.toDistrib.{u2} 𝕜 (DivisionRing.toRing.{u2} 𝕜 (Field.toDivisionRing.{u2} 𝕜 (LinearOrderedField.toField.{u2} 𝕜 _inst_2)))))) ε ((fun (a : Type) (b : Type.{u2}) [self : HasLiftT.{1, succ u2} a b] => self.0) Nat 𝕜 (HasLiftT.mk.{1, succ u2} Nat 𝕜 (CoeTCₓ.coe.{1, succ u2} Nat 𝕜 (Nat.castCoe.{u2} 𝕜 (AddMonoidWithOne.toNatCast.{u2} 𝕜 (AddGroupWithOne.toAddMonoidWithOne.{u2} 𝕜 (AddCommGroupWithOne.toAddGroupWithOne.{u2} 𝕜 (Ring.toAddCommGroupWithOne.{u2} 𝕜 (DivisionRing.toRing.{u2} 𝕜 (Field.toDivisionRing.{u2} 𝕜 (LinearOrderedField.toField.{u2} 𝕜 _inst_2)))))))))) (HPow.hPow.{0, 0, 0} Nat Nat Nat (instHPow.{0, 0} Nat Nat (Monoid.Pow.{0} Nat Nat.monoid)) (Fintype.card.{u1} α _inst_1) (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))) (HSub.hSub.{u2, u2, u2} 𝕜 𝕜 𝕜 (instHSub.{u2} 𝕜 (SubNegMonoid.toHasSub.{u2} 𝕜 (AddGroup.toSubNegMonoid.{u2} 𝕜 (AddGroupWithOne.toAddGroup.{u2} 𝕜 (AddCommGroupWithOne.toAddGroupWithOne.{u2} 𝕜 (Ring.toAddCommGroupWithOne.{u2} 𝕜 (DivisionRing.toRing.{u2} 𝕜 (Field.toDivisionRing.{u2} 𝕜 (LinearOrderedField.toField.{u2} 𝕜 _inst_2))))))))) ((fun (a : Type) (b : Type.{u2}) [self : HasLiftT.{1, succ u2} a b] => self.0) Nat 𝕜 (HasLiftT.mk.{1, succ u2} Nat 𝕜 (CoeTCₓ.coe.{1, succ u2} Nat 𝕜 (Nat.castCoe.{u2} 𝕜 (AddMonoidWithOne.toNatCast.{u2} 𝕜 (AddGroupWithOne.toAddMonoidWithOne.{u2} 𝕜 (AddCommGroupWithOne.toAddGroupWithOne.{u2} 𝕜 (Ring.toAddCommGroupWithOne.{u2} 𝕜 (DivisionRing.toRing.{u2} 𝕜 (Field.toDivisionRing.{u2} 𝕜 (LinearOrderedField.toField.{u2} 𝕜 _inst_2)))))))))) (Finset.card.{u1} (Sym2.{u1} α) (SimpleGraph.edgeFinset.{u1} α G (SimpleGraph.fintypeEdgeSet.{u1} α G (fun (a : α) (b : α) => Classical.propDecidable (Eq.{succ u1} α a b)) _inst_1 (fun (a : α) (b : α) => Classical.propDecidable (SimpleGraph.Adj.{u1} α G a b)))))) ((fun (a : Type) (b : Type.{u2}) [self : HasLiftT.{1, succ u2} a b] => self.0) Nat 𝕜 (HasLiftT.mk.{1, succ u2} Nat 𝕜 (CoeTCₓ.coe.{1, succ u2} Nat 𝕜 (Nat.castCoe.{u2} 𝕜 (AddMonoidWithOne.toNatCast.{u2} 𝕜 (AddGroupWithOne.toAddMonoidWithOne.{u2} 𝕜 (AddCommGroupWithOne.toAddGroupWithOne.{u2} 𝕜 (Ring.toAddCommGroupWithOne.{u2} 𝕜 (DivisionRing.toRing.{u2} 𝕜 (Field.toDivisionRing.{u2} 𝕜 (LinearOrderedField.toField.{u2} 𝕜 _inst_2)))))))))) (Finset.card.{u1} (Sym2.{u1} α) (SimpleGraph.edgeFinset.{u1} α H (SimpleGraph.fintypeEdgeSet.{u1} α H (fun (a : α) (b : α) => Classical.propDecidable (Eq.{succ u1} α a b)) _inst_1 (fun (a : α) (b : α) => Classical.propDecidable (SimpleGraph.Adj.{u1} α H a b)))))))))
but is expected to have type
  forall {α : Type.{u2}} {𝕜 : Type.{u1}} [_inst_1 : Fintype.{u2} α] [_inst_2 : LinearOrderedField.{u1} 𝕜] {G : SimpleGraph.{u2} α} {ε : 𝕜}, Iff (SimpleGraph.FarFromTriangleFree.{u2, u1} α 𝕜 _inst_1 _inst_2 G ε) (forall {{H : SimpleGraph.{u2} α}}, (LE.le.{u2} (SimpleGraph.{u2} α) (SimpleGraph.instLESimpleGraph.{u2} α) H G) -> (SimpleGraph.CliqueFree.{u2} α H (OfNat.ofNat.{0} Nat 3 (instOfNatNat 3))) -> (LE.le.{u1} 𝕜 (Preorder.toLE.{u1} 𝕜 (PartialOrder.toPreorder.{u1} 𝕜 (StrictOrderedRing.toPartialOrder.{u1} 𝕜 (LinearOrderedRing.toStrictOrderedRing.{u1} 𝕜 (LinearOrderedCommRing.toLinearOrderedRing.{u1} 𝕜 (LinearOrderedField.toLinearOrderedCommRing.{u1} 𝕜 _inst_2)))))) (HMul.hMul.{u1, u1, u1} 𝕜 𝕜 𝕜 (instHMul.{u1} 𝕜 (NonUnitalNonAssocRing.toMul.{u1} 𝕜 (NonAssocRing.toNonUnitalNonAssocRing.{u1} 𝕜 (Ring.toNonAssocRing.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_2))))))) ε (Nat.cast.{u1} 𝕜 (NonAssocRing.toNatCast.{u1} 𝕜 (Ring.toNonAssocRing.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_2))))) (HPow.hPow.{0, 0, 0} Nat Nat Nat (instHPow.{0, 0} Nat Nat instPowNat) (Fintype.card.{u2} α _inst_1) (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))))) (HSub.hSub.{u1, u1, u1} 𝕜 𝕜 𝕜 (instHSub.{u1} 𝕜 (Ring.toSub.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_2))))) (Nat.cast.{u1} 𝕜 (NonAssocRing.toNatCast.{u1} 𝕜 (Ring.toNonAssocRing.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_2))))) (Finset.card.{u2} (Sym2.{u2} α) (SimpleGraph.edgeFinset.{u2} α G (SimpleGraph.fintypeEdgeSet.{u2} α G (Quotient.fintype.{u2} (Prod.{u2, u2} α α) (instFintypeProd.{u2, u2} α α _inst_1 _inst_1) (Sym2.Rel.setoid.{u2} α) (fun (a : Prod.{u2, u2} α α) (b : Prod.{u2, u2} α α) => Sym2.instRelDecidable'.{u2} α (fun (a : α) (b : α) => Classical.propDecidable (Eq.{succ u2} α a b)) a b)) (fun (a : α) (b : α) => Classical.propDecidable (SimpleGraph.Adj.{u2} α G a b)))))) (Nat.cast.{u1} 𝕜 (NonAssocRing.toNatCast.{u1} 𝕜 (Ring.toNonAssocRing.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_2))))) (Finset.card.{u2} (Sym2.{u2} α) (SimpleGraph.edgeFinset.{u2} α H (SimpleGraph.fintypeEdgeSet.{u2} α H (Quotient.fintype.{u2} (Prod.{u2, u2} α α) (instFintypeProd.{u2, u2} α α _inst_1 _inst_1) (Sym2.Rel.setoid.{u2} α) (fun (a : Prod.{u2, u2} α α) (b : Prod.{u2, u2} α α) => Sym2.instRelDecidable'.{u2} α (fun (a : α) (b : α) => Classical.propDecidable (Eq.{succ u2} α a b)) a b)) (fun (a : α) (b : α) => Classical.propDecidable (SimpleGraph.Adj.{u2} α H a b)))))))))
Case conversion may be inaccurate. Consider using '#align simple_graph.far_from_triangle_free_iff SimpleGraph.farFromTriangleFree_iffₓ'. -/
theorem farFromTriangleFree_iff :
    G.FarFromTriangleFree ε ↔
      ∀ ⦃H⦄,
        H ≤ G → H.CliqueFree 3 → ε * (card α ^ 2 : ℕ) ≤ G.edgeFinset.card - H.edgeFinset.card :=
  deleteFar_iff
#align simple_graph.far_from_triangle_free_iff SimpleGraph.farFromTriangleFree_iff

/- warning: simple_graph.far_from_triangle_free.le_card_sub_card -> SimpleGraph.farFromTriangleFree.le_card_sub_card is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {𝕜 : Type.{u2}} [_inst_1 : Fintype.{u1} α] [_inst_2 : LinearOrderedField.{u2} 𝕜] {G : SimpleGraph.{u1} α} {ε : 𝕜}, (SimpleGraph.FarFromTriangleFree.{u1, u2} α 𝕜 _inst_1 _inst_2 G ε) -> (forall {{H : SimpleGraph.{u1} α}}, (LE.le.{u1} (SimpleGraph.{u1} α) (SimpleGraph.hasLe.{u1} α) H G) -> (SimpleGraph.CliqueFree.{u1} α H (OfNat.ofNat.{0} Nat 3 (OfNat.mk.{0} Nat 3 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))) -> (LE.le.{u2} 𝕜 (Preorder.toLE.{u2} 𝕜 (PartialOrder.toPreorder.{u2} 𝕜 (OrderedAddCommGroup.toPartialOrder.{u2} 𝕜 (StrictOrderedRing.toOrderedAddCommGroup.{u2} 𝕜 (LinearOrderedRing.toStrictOrderedRing.{u2} 𝕜 (LinearOrderedCommRing.toLinearOrderedRing.{u2} 𝕜 (LinearOrderedField.toLinearOrderedCommRing.{u2} 𝕜 _inst_2))))))) (HMul.hMul.{u2, u2, u2} 𝕜 𝕜 𝕜 (instHMul.{u2} 𝕜 (Distrib.toHasMul.{u2} 𝕜 (Ring.toDistrib.{u2} 𝕜 (DivisionRing.toRing.{u2} 𝕜 (Field.toDivisionRing.{u2} 𝕜 (LinearOrderedField.toField.{u2} 𝕜 _inst_2)))))) ε ((fun (a : Type) (b : Type.{u2}) [self : HasLiftT.{1, succ u2} a b] => self.0) Nat 𝕜 (HasLiftT.mk.{1, succ u2} Nat 𝕜 (CoeTCₓ.coe.{1, succ u2} Nat 𝕜 (Nat.castCoe.{u2} 𝕜 (AddMonoidWithOne.toNatCast.{u2} 𝕜 (AddGroupWithOne.toAddMonoidWithOne.{u2} 𝕜 (AddCommGroupWithOne.toAddGroupWithOne.{u2} 𝕜 (Ring.toAddCommGroupWithOne.{u2} 𝕜 (DivisionRing.toRing.{u2} 𝕜 (Field.toDivisionRing.{u2} 𝕜 (LinearOrderedField.toField.{u2} 𝕜 _inst_2)))))))))) (HPow.hPow.{0, 0, 0} Nat Nat Nat (instHPow.{0, 0} Nat Nat (Monoid.Pow.{0} Nat Nat.monoid)) (Fintype.card.{u1} α _inst_1) (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))) (HSub.hSub.{u2, u2, u2} 𝕜 𝕜 𝕜 (instHSub.{u2} 𝕜 (SubNegMonoid.toHasSub.{u2} 𝕜 (AddGroup.toSubNegMonoid.{u2} 𝕜 (AddGroupWithOne.toAddGroup.{u2} 𝕜 (AddCommGroupWithOne.toAddGroupWithOne.{u2} 𝕜 (Ring.toAddCommGroupWithOne.{u2} 𝕜 (DivisionRing.toRing.{u2} 𝕜 (Field.toDivisionRing.{u2} 𝕜 (LinearOrderedField.toField.{u2} 𝕜 _inst_2))))))))) ((fun (a : Type) (b : Type.{u2}) [self : HasLiftT.{1, succ u2} a b] => self.0) Nat 𝕜 (HasLiftT.mk.{1, succ u2} Nat 𝕜 (CoeTCₓ.coe.{1, succ u2} Nat 𝕜 (Nat.castCoe.{u2} 𝕜 (AddMonoidWithOne.toNatCast.{u2} 𝕜 (AddGroupWithOne.toAddMonoidWithOne.{u2} 𝕜 (AddCommGroupWithOne.toAddGroupWithOne.{u2} 𝕜 (Ring.toAddCommGroupWithOne.{u2} 𝕜 (DivisionRing.toRing.{u2} 𝕜 (Field.toDivisionRing.{u2} 𝕜 (LinearOrderedField.toField.{u2} 𝕜 _inst_2)))))))))) (Finset.card.{u1} (Sym2.{u1} α) (SimpleGraph.edgeFinset.{u1} α G (SimpleGraph.fintypeEdgeSet.{u1} α G (fun (a : α) (b : α) => Classical.propDecidable (Eq.{succ u1} α a b)) _inst_1 (fun (a : α) (b : α) => Classical.propDecidable (SimpleGraph.Adj.{u1} α G a b)))))) ((fun (a : Type) (b : Type.{u2}) [self : HasLiftT.{1, succ u2} a b] => self.0) Nat 𝕜 (HasLiftT.mk.{1, succ u2} Nat 𝕜 (CoeTCₓ.coe.{1, succ u2} Nat 𝕜 (Nat.castCoe.{u2} 𝕜 (AddMonoidWithOne.toNatCast.{u2} 𝕜 (AddGroupWithOne.toAddMonoidWithOne.{u2} 𝕜 (AddCommGroupWithOne.toAddGroupWithOne.{u2} 𝕜 (Ring.toAddCommGroupWithOne.{u2} 𝕜 (DivisionRing.toRing.{u2} 𝕜 (Field.toDivisionRing.{u2} 𝕜 (LinearOrderedField.toField.{u2} 𝕜 _inst_2)))))))))) (Finset.card.{u1} (Sym2.{u1} α) (SimpleGraph.edgeFinset.{u1} α H (SimpleGraph.fintypeEdgeSet.{u1} α H (fun (a : α) (b : α) => Classical.propDecidable (Eq.{succ u1} α a b)) _inst_1 (fun (a : α) (b : α) => Classical.propDecidable (SimpleGraph.Adj.{u1} α H a b)))))))))
but is expected to have type
  forall {α : Type.{u2}} {𝕜 : Type.{u1}} [_inst_1 : Fintype.{u2} α] [_inst_2 : LinearOrderedField.{u1} 𝕜] {G : SimpleGraph.{u2} α} {ε : 𝕜}, (SimpleGraph.FarFromTriangleFree.{u2, u1} α 𝕜 _inst_1 _inst_2 G ε) -> (forall {{H : SimpleGraph.{u2} α}}, (LE.le.{u2} (SimpleGraph.{u2} α) (SimpleGraph.instLESimpleGraph.{u2} α) H G) -> (SimpleGraph.CliqueFree.{u2} α H (OfNat.ofNat.{0} Nat 3 (instOfNatNat 3))) -> (LE.le.{u1} 𝕜 (Preorder.toLE.{u1} 𝕜 (PartialOrder.toPreorder.{u1} 𝕜 (StrictOrderedRing.toPartialOrder.{u1} 𝕜 (LinearOrderedRing.toStrictOrderedRing.{u1} 𝕜 (LinearOrderedCommRing.toLinearOrderedRing.{u1} 𝕜 (LinearOrderedField.toLinearOrderedCommRing.{u1} 𝕜 _inst_2)))))) (HMul.hMul.{u1, u1, u1} 𝕜 𝕜 𝕜 (instHMul.{u1} 𝕜 (NonUnitalNonAssocRing.toMul.{u1} 𝕜 (NonAssocRing.toNonUnitalNonAssocRing.{u1} 𝕜 (Ring.toNonAssocRing.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_2))))))) ε (Nat.cast.{u1} 𝕜 (NonAssocRing.toNatCast.{u1} 𝕜 (Ring.toNonAssocRing.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_2))))) (HPow.hPow.{0, 0, 0} Nat Nat Nat (instHPow.{0, 0} Nat Nat instPowNat) (Fintype.card.{u2} α _inst_1) (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))))) (HSub.hSub.{u1, u1, u1} 𝕜 𝕜 𝕜 (instHSub.{u1} 𝕜 (Ring.toSub.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_2))))) (Nat.cast.{u1} 𝕜 (NonAssocRing.toNatCast.{u1} 𝕜 (Ring.toNonAssocRing.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_2))))) (Finset.card.{u2} (Sym2.{u2} α) (SimpleGraph.edgeFinset.{u2} α G (SimpleGraph.fintypeEdgeSet.{u2} α G (Quotient.fintype.{u2} (Prod.{u2, u2} α α) (instFintypeProd.{u2, u2} α α _inst_1 _inst_1) (Sym2.Rel.setoid.{u2} α) (fun (a : Prod.{u2, u2} α α) (b : Prod.{u2, u2} α α) => Sym2.instRelDecidable'.{u2} α (fun (a : α) (b : α) => Classical.propDecidable (Eq.{succ u2} α a b)) a b)) (fun (a : α) (b : α) => Classical.propDecidable (SimpleGraph.Adj.{u2} α G a b)))))) (Nat.cast.{u1} 𝕜 (NonAssocRing.toNatCast.{u1} 𝕜 (Ring.toNonAssocRing.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_2))))) (Finset.card.{u2} (Sym2.{u2} α) (SimpleGraph.edgeFinset.{u2} α H (SimpleGraph.fintypeEdgeSet.{u2} α H (Quotient.fintype.{u2} (Prod.{u2, u2} α α) (instFintypeProd.{u2, u2} α α _inst_1 _inst_1) (Sym2.Rel.setoid.{u2} α) (fun (a : Prod.{u2, u2} α α) (b : Prod.{u2, u2} α α) => Sym2.instRelDecidable'.{u2} α (fun (a : α) (b : α) => Classical.propDecidable (Eq.{succ u2} α a b)) a b)) (fun (a : α) (b : α) => Classical.propDecidable (SimpleGraph.Adj.{u2} α H a b)))))))))
Case conversion may be inaccurate. Consider using '#align simple_graph.far_from_triangle_free.le_card_sub_card SimpleGraph.farFromTriangleFree.le_card_sub_cardₓ'. -/
alias far_from_triangle_free_iff ↔ far_from_triangle_free.le_card_sub_card _
#align simple_graph.far_from_triangle_free.le_card_sub_card SimpleGraph.farFromTriangleFree.le_card_sub_card

/- warning: simple_graph.far_from_triangle_free.mono -> SimpleGraph.farFromTriangleFree.mono is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {𝕜 : Type.{u2}} [_inst_1 : Fintype.{u1} α] [_inst_2 : LinearOrderedField.{u2} 𝕜] {G : SimpleGraph.{u1} α} {ε : 𝕜} {δ : 𝕜}, (SimpleGraph.FarFromTriangleFree.{u1, u2} α 𝕜 _inst_1 _inst_2 G ε) -> (LE.le.{u2} 𝕜 (Preorder.toLE.{u2} 𝕜 (PartialOrder.toPreorder.{u2} 𝕜 (OrderedAddCommGroup.toPartialOrder.{u2} 𝕜 (StrictOrderedRing.toOrderedAddCommGroup.{u2} 𝕜 (LinearOrderedRing.toStrictOrderedRing.{u2} 𝕜 (LinearOrderedCommRing.toLinearOrderedRing.{u2} 𝕜 (LinearOrderedField.toLinearOrderedCommRing.{u2} 𝕜 _inst_2))))))) δ ε) -> (SimpleGraph.FarFromTriangleFree.{u1, u2} α 𝕜 _inst_1 _inst_2 G δ)
but is expected to have type
  forall {α : Type.{u2}} {𝕜 : Type.{u1}} [_inst_1 : Fintype.{u2} α] [_inst_2 : LinearOrderedField.{u1} 𝕜] {G : SimpleGraph.{u2} α} {ε : 𝕜} {δ : 𝕜}, (SimpleGraph.FarFromTriangleFree.{u2, u1} α 𝕜 _inst_1 _inst_2 G ε) -> (LE.le.{u1} 𝕜 (Preorder.toLE.{u1} 𝕜 (PartialOrder.toPreorder.{u1} 𝕜 (StrictOrderedRing.toPartialOrder.{u1} 𝕜 (LinearOrderedRing.toStrictOrderedRing.{u1} 𝕜 (LinearOrderedCommRing.toLinearOrderedRing.{u1} 𝕜 (LinearOrderedField.toLinearOrderedCommRing.{u1} 𝕜 _inst_2)))))) δ ε) -> (SimpleGraph.FarFromTriangleFree.{u2, u1} α 𝕜 _inst_1 _inst_2 G δ)
Case conversion may be inaccurate. Consider using '#align simple_graph.far_from_triangle_free.mono SimpleGraph.farFromTriangleFree.monoₓ'. -/
theorem farFromTriangleFree.mono (hε : G.FarFromTriangleFree ε) (h : δ ≤ ε) :
    G.FarFromTriangleFree δ :=
  hε.mono <| mul_le_mul_of_nonneg_right h <| cast_nonneg _
#align simple_graph.far_from_triangle_free.mono SimpleGraph.farFromTriangleFree.mono

/- warning: simple_graph.far_from_triangle_free.clique_finset_nonempty' -> SimpleGraph.FarFromTriangleFree.cliqueFinset_nonempty' is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {𝕜 : Type.{u2}} [_inst_1 : Fintype.{u1} α] [_inst_2 : LinearOrderedField.{u2} 𝕜] {G : SimpleGraph.{u1} α} {H : SimpleGraph.{u1} α} {ε : 𝕜}, (LE.le.{u1} (SimpleGraph.{u1} α) (SimpleGraph.hasLe.{u1} α) H G) -> (SimpleGraph.FarFromTriangleFree.{u1, u2} α 𝕜 _inst_1 _inst_2 G ε) -> (LT.lt.{u2} 𝕜 (Preorder.toLT.{u2} 𝕜 (PartialOrder.toPreorder.{u2} 𝕜 (OrderedAddCommGroup.toPartialOrder.{u2} 𝕜 (StrictOrderedRing.toOrderedAddCommGroup.{u2} 𝕜 (LinearOrderedRing.toStrictOrderedRing.{u2} 𝕜 (LinearOrderedCommRing.toLinearOrderedRing.{u2} 𝕜 (LinearOrderedField.toLinearOrderedCommRing.{u2} 𝕜 _inst_2))))))) (HSub.hSub.{u2, u2, u2} 𝕜 𝕜 𝕜 (instHSub.{u2} 𝕜 (SubNegMonoid.toHasSub.{u2} 𝕜 (AddGroup.toSubNegMonoid.{u2} 𝕜 (AddGroupWithOne.toAddGroup.{u2} 𝕜 (AddCommGroupWithOne.toAddGroupWithOne.{u2} 𝕜 (Ring.toAddCommGroupWithOne.{u2} 𝕜 (DivisionRing.toRing.{u2} 𝕜 (Field.toDivisionRing.{u2} 𝕜 (LinearOrderedField.toField.{u2} 𝕜 _inst_2))))))))) ((fun (a : Type) (b : Type.{u2}) [self : HasLiftT.{1, succ u2} a b] => self.0) Nat 𝕜 (HasLiftT.mk.{1, succ u2} Nat 𝕜 (CoeTCₓ.coe.{1, succ u2} Nat 𝕜 (Nat.castCoe.{u2} 𝕜 (AddMonoidWithOne.toNatCast.{u2} 𝕜 (AddGroupWithOne.toAddMonoidWithOne.{u2} 𝕜 (AddCommGroupWithOne.toAddGroupWithOne.{u2} 𝕜 (Ring.toAddCommGroupWithOne.{u2} 𝕜 (DivisionRing.toRing.{u2} 𝕜 (Field.toDivisionRing.{u2} 𝕜 (LinearOrderedField.toField.{u2} 𝕜 _inst_2)))))))))) (Finset.card.{u1} (Sym2.{u1} α) (SimpleGraph.edgeFinset.{u1} α G (SimpleGraph.fintypeEdgeSet.{u1} α G (fun (a : α) (b : α) => Classical.propDecidable (Eq.{succ u1} α a b)) _inst_1 (fun (a : α) (b : α) => Classical.propDecidable (SimpleGraph.Adj.{u1} α G a b)))))) ((fun (a : Type) (b : Type.{u2}) [self : HasLiftT.{1, succ u2} a b] => self.0) Nat 𝕜 (HasLiftT.mk.{1, succ u2} Nat 𝕜 (CoeTCₓ.coe.{1, succ u2} Nat 𝕜 (Nat.castCoe.{u2} 𝕜 (AddMonoidWithOne.toNatCast.{u2} 𝕜 (AddGroupWithOne.toAddMonoidWithOne.{u2} 𝕜 (AddCommGroupWithOne.toAddGroupWithOne.{u2} 𝕜 (Ring.toAddCommGroupWithOne.{u2} 𝕜 (DivisionRing.toRing.{u2} 𝕜 (Field.toDivisionRing.{u2} 𝕜 (LinearOrderedField.toField.{u2} 𝕜 _inst_2)))))))))) (Finset.card.{u1} (Sym2.{u1} α) (SimpleGraph.edgeFinset.{u1} α H (SimpleGraph.fintypeEdgeSet.{u1} α H (fun (a : α) (b : α) => Classical.propDecidable (Eq.{succ u1} α a b)) _inst_1 (fun (a : α) (b : α) => Classical.propDecidable (SimpleGraph.Adj.{u1} α H a b))))))) (HMul.hMul.{u2, u2, u2} 𝕜 𝕜 𝕜 (instHMul.{u2} 𝕜 (Distrib.toHasMul.{u2} 𝕜 (Ring.toDistrib.{u2} 𝕜 (DivisionRing.toRing.{u2} 𝕜 (Field.toDivisionRing.{u2} 𝕜 (LinearOrderedField.toField.{u2} 𝕜 _inst_2)))))) ε ((fun (a : Type) (b : Type.{u2}) [self : HasLiftT.{1, succ u2} a b] => self.0) Nat 𝕜 (HasLiftT.mk.{1, succ u2} Nat 𝕜 (CoeTCₓ.coe.{1, succ u2} Nat 𝕜 (Nat.castCoe.{u2} 𝕜 (AddMonoidWithOne.toNatCast.{u2} 𝕜 (AddGroupWithOne.toAddMonoidWithOne.{u2} 𝕜 (AddCommGroupWithOne.toAddGroupWithOne.{u2} 𝕜 (Ring.toAddCommGroupWithOne.{u2} 𝕜 (DivisionRing.toRing.{u2} 𝕜 (Field.toDivisionRing.{u2} 𝕜 (LinearOrderedField.toField.{u2} 𝕜 _inst_2)))))))))) (HPow.hPow.{0, 0, 0} Nat Nat Nat (instHPow.{0, 0} Nat Nat (Monoid.Pow.{0} Nat Nat.monoid)) (Fintype.card.{u1} α _inst_1) (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne)))))))) -> (Finset.Nonempty.{u1} (Finset.{u1} α) (SimpleGraph.cliqueFinset.{u1} α H _inst_1 (fun (a : α) (b : α) => Classical.propDecidable (Eq.{succ u1} α a b)) (fun (a : α) (b : α) => Classical.propDecidable (SimpleGraph.Adj.{u1} α H a b)) (OfNat.ofNat.{0} Nat 3 (OfNat.mk.{0} Nat 3 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))
but is expected to have type
  forall {α : Type.{u2}} {𝕜 : Type.{u1}} [_inst_1 : Fintype.{u2} α] [_inst_2 : LinearOrderedField.{u1} 𝕜] {G : SimpleGraph.{u2} α} {H : SimpleGraph.{u2} α} {ε : 𝕜}, (LE.le.{u2} (SimpleGraph.{u2} α) (SimpleGraph.instLESimpleGraph.{u2} α) H G) -> (SimpleGraph.FarFromTriangleFree.{u2, u1} α 𝕜 _inst_1 _inst_2 G ε) -> (LT.lt.{u1} 𝕜 (Preorder.toLT.{u1} 𝕜 (PartialOrder.toPreorder.{u1} 𝕜 (StrictOrderedRing.toPartialOrder.{u1} 𝕜 (LinearOrderedRing.toStrictOrderedRing.{u1} 𝕜 (LinearOrderedCommRing.toLinearOrderedRing.{u1} 𝕜 (LinearOrderedField.toLinearOrderedCommRing.{u1} 𝕜 _inst_2)))))) (HSub.hSub.{u1, u1, u1} 𝕜 𝕜 𝕜 (instHSub.{u1} 𝕜 (Ring.toSub.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_2))))) (Nat.cast.{u1} 𝕜 (NonAssocRing.toNatCast.{u1} 𝕜 (Ring.toNonAssocRing.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_2))))) (Finset.card.{u2} (Sym2.{u2} α) (SimpleGraph.edgeFinset.{u2} α G (SimpleGraph.fintypeEdgeSet.{u2} α G (Quotient.fintype.{u2} (Prod.{u2, u2} α α) (instFintypeProd.{u2, u2} α α _inst_1 _inst_1) (Sym2.Rel.setoid.{u2} α) (fun (a : Prod.{u2, u2} α α) (b : Prod.{u2, u2} α α) => Sym2.instRelDecidable'.{u2} α (fun (a : α) (b : α) => Classical.propDecidable (Eq.{succ u2} α a b)) a b)) (fun (a : α) (b : α) => Classical.propDecidable (SimpleGraph.Adj.{u2} α G a b)))))) (Nat.cast.{u1} 𝕜 (NonAssocRing.toNatCast.{u1} 𝕜 (Ring.toNonAssocRing.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_2))))) (Finset.card.{u2} (Sym2.{u2} α) (SimpleGraph.edgeFinset.{u2} α H (SimpleGraph.fintypeEdgeSet.{u2} α H (Quotient.fintype.{u2} (Prod.{u2, u2} α α) (instFintypeProd.{u2, u2} α α _inst_1 _inst_1) (Sym2.Rel.setoid.{u2} α) (fun (a : Prod.{u2, u2} α α) (b : Prod.{u2, u2} α α) => Sym2.instRelDecidable'.{u2} α (fun (a : α) (b : α) => Classical.propDecidable (Eq.{succ u2} α a b)) a b)) (fun (a : α) (b : α) => Classical.propDecidable (SimpleGraph.Adj.{u2} α H a b))))))) (HMul.hMul.{u1, u1, u1} 𝕜 𝕜 𝕜 (instHMul.{u1} 𝕜 (NonUnitalNonAssocRing.toMul.{u1} 𝕜 (NonAssocRing.toNonUnitalNonAssocRing.{u1} 𝕜 (Ring.toNonAssocRing.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_2))))))) ε (Nat.cast.{u1} 𝕜 (NonAssocRing.toNatCast.{u1} 𝕜 (Ring.toNonAssocRing.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_2))))) (HPow.hPow.{0, 0, 0} Nat Nat Nat (instHPow.{0, 0} Nat Nat instPowNat) (Fintype.card.{u2} α _inst_1) (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2)))))) -> (Finset.Nonempty.{u2} (Finset.{u2} α) (SimpleGraph.cliqueFinset.{u2} α H _inst_1 (fun (a : α) (b : α) => Classical.propDecidable (Eq.{succ u2} α a b)) (fun (a : α) (b : α) => Classical.propDecidable (SimpleGraph.Adj.{u2} α H a b)) (OfNat.ofNat.{0} Nat 3 (instOfNatNat 3))))
Case conversion may be inaccurate. Consider using '#align simple_graph.far_from_triangle_free.clique_finset_nonempty' SimpleGraph.FarFromTriangleFree.cliqueFinset_nonempty'ₓ'. -/
theorem FarFromTriangleFree.cliqueFinset_nonempty' (hH : H ≤ G) (hG : G.FarFromTriangleFree ε)
    (hcard : (G.edgeFinset.card - H.edgeFinset.card : 𝕜) < ε * (card α ^ 2 : ℕ)) :
    (H.cliqueFinset 3).Nonempty :=
  nonempty_of_ne_empty <|
    H.cliqueFinset_eq_empty_iff.Not.2 fun hH' => (hG.le_card_sub_card hH hH').not_lt hcard
#align simple_graph.far_from_triangle_free.clique_finset_nonempty' SimpleGraph.FarFromTriangleFree.cliqueFinset_nonempty'

variable [Nonempty α]

/- warning: simple_graph.far_from_triangle_free.nonpos -> SimpleGraph.FarFromTriangleFree.nonpos is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {𝕜 : Type.{u2}} [_inst_1 : Fintype.{u1} α] [_inst_2 : LinearOrderedField.{u2} 𝕜] {G : SimpleGraph.{u1} α} {ε : 𝕜} [_inst_3 : Nonempty.{succ u1} α], (SimpleGraph.FarFromTriangleFree.{u1, u2} α 𝕜 _inst_1 _inst_2 G ε) -> (SimpleGraph.CliqueFree.{u1} α G (OfNat.ofNat.{0} Nat 3 (OfNat.mk.{0} Nat 3 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))) -> (LE.le.{u2} 𝕜 (Preorder.toLE.{u2} 𝕜 (PartialOrder.toPreorder.{u2} 𝕜 (OrderedAddCommGroup.toPartialOrder.{u2} 𝕜 (StrictOrderedRing.toOrderedAddCommGroup.{u2} 𝕜 (LinearOrderedRing.toStrictOrderedRing.{u2} 𝕜 (LinearOrderedCommRing.toLinearOrderedRing.{u2} 𝕜 (LinearOrderedField.toLinearOrderedCommRing.{u2} 𝕜 _inst_2))))))) ε (OfNat.ofNat.{u2} 𝕜 0 (OfNat.mk.{u2} 𝕜 0 (Zero.zero.{u2} 𝕜 (MulZeroClass.toHasZero.{u2} 𝕜 (NonUnitalNonAssocSemiring.toMulZeroClass.{u2} 𝕜 (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u2} 𝕜 (NonAssocRing.toNonUnitalNonAssocRing.{u2} 𝕜 (Ring.toNonAssocRing.{u2} 𝕜 (DivisionRing.toRing.{u2} 𝕜 (Field.toDivisionRing.{u2} 𝕜 (LinearOrderedField.toField.{u2} 𝕜 _inst_2))))))))))))
but is expected to have type
  forall {α : Type.{u2}} {𝕜 : Type.{u1}} [_inst_1 : Fintype.{u2} α] [_inst_2 : LinearOrderedField.{u1} 𝕜] {G : SimpleGraph.{u2} α} {ε : 𝕜} [_inst_3 : Nonempty.{succ u2} α], (SimpleGraph.FarFromTriangleFree.{u2, u1} α 𝕜 _inst_1 _inst_2 G ε) -> (SimpleGraph.CliqueFree.{u2} α G (OfNat.ofNat.{0} Nat 3 (instOfNatNat 3))) -> (LE.le.{u1} 𝕜 (Preorder.toLE.{u1} 𝕜 (PartialOrder.toPreorder.{u1} 𝕜 (StrictOrderedRing.toPartialOrder.{u1} 𝕜 (LinearOrderedRing.toStrictOrderedRing.{u1} 𝕜 (LinearOrderedCommRing.toLinearOrderedRing.{u1} 𝕜 (LinearOrderedField.toLinearOrderedCommRing.{u1} 𝕜 _inst_2)))))) ε (OfNat.ofNat.{u1} 𝕜 0 (Zero.toOfNat0.{u1} 𝕜 (CommMonoidWithZero.toZero.{u1} 𝕜 (CommGroupWithZero.toCommMonoidWithZero.{u1} 𝕜 (Semifield.toCommGroupWithZero.{u1} 𝕜 (LinearOrderedSemifield.toSemifield.{u1} 𝕜 (LinearOrderedField.toLinearOrderedSemifield.{u1} 𝕜 _inst_2))))))))
Case conversion may be inaccurate. Consider using '#align simple_graph.far_from_triangle_free.nonpos SimpleGraph.FarFromTriangleFree.nonposₓ'. -/
theorem FarFromTriangleFree.nonpos (h₀ : G.FarFromTriangleFree ε) (h₁ : G.CliqueFree 3) : ε ≤ 0 :=
  by
  have := h₀ (empty_subset _)
  rw [coe_empty, Finset.card_empty, cast_zero, delete_edges_empty_eq] at this
  exact nonpos_of_mul_nonpos_left (this h₁) (cast_pos.2 <| sq_pos_of_pos Fintype.card_pos)
#align simple_graph.far_from_triangle_free.nonpos SimpleGraph.FarFromTriangleFree.nonpos

/- warning: simple_graph.clique_free.not_far_from_triangle_free -> SimpleGraph.CliqueFree.not_farFromTriangleFree is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {𝕜 : Type.{u2}} [_inst_1 : Fintype.{u1} α] [_inst_2 : LinearOrderedField.{u2} 𝕜] {G : SimpleGraph.{u1} α} {ε : 𝕜} [_inst_3 : Nonempty.{succ u1} α], (SimpleGraph.CliqueFree.{u1} α G (OfNat.ofNat.{0} Nat 3 (OfNat.mk.{0} Nat 3 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))) -> (LT.lt.{u2} 𝕜 (Preorder.toLT.{u2} 𝕜 (PartialOrder.toPreorder.{u2} 𝕜 (OrderedAddCommGroup.toPartialOrder.{u2} 𝕜 (StrictOrderedRing.toOrderedAddCommGroup.{u2} 𝕜 (LinearOrderedRing.toStrictOrderedRing.{u2} 𝕜 (LinearOrderedCommRing.toLinearOrderedRing.{u2} 𝕜 (LinearOrderedField.toLinearOrderedCommRing.{u2} 𝕜 _inst_2))))))) (OfNat.ofNat.{u2} 𝕜 0 (OfNat.mk.{u2} 𝕜 0 (Zero.zero.{u2} 𝕜 (MulZeroClass.toHasZero.{u2} 𝕜 (NonUnitalNonAssocSemiring.toMulZeroClass.{u2} 𝕜 (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u2} 𝕜 (NonAssocRing.toNonUnitalNonAssocRing.{u2} 𝕜 (Ring.toNonAssocRing.{u2} 𝕜 (DivisionRing.toRing.{u2} 𝕜 (Field.toDivisionRing.{u2} 𝕜 (LinearOrderedField.toField.{u2} 𝕜 _inst_2))))))))))) ε) -> (Not (SimpleGraph.FarFromTriangleFree.{u1, u2} α 𝕜 _inst_1 _inst_2 G ε))
but is expected to have type
  forall {α : Type.{u2}} {𝕜 : Type.{u1}} [_inst_1 : Fintype.{u2} α] [_inst_2 : LinearOrderedField.{u1} 𝕜] {G : SimpleGraph.{u2} α} {ε : 𝕜} [_inst_3 : Nonempty.{succ u2} α], (SimpleGraph.CliqueFree.{u2} α G (OfNat.ofNat.{0} Nat 3 (instOfNatNat 3))) -> (LT.lt.{u1} 𝕜 (Preorder.toLT.{u1} 𝕜 (PartialOrder.toPreorder.{u1} 𝕜 (StrictOrderedRing.toPartialOrder.{u1} 𝕜 (LinearOrderedRing.toStrictOrderedRing.{u1} 𝕜 (LinearOrderedCommRing.toLinearOrderedRing.{u1} 𝕜 (LinearOrderedField.toLinearOrderedCommRing.{u1} 𝕜 _inst_2)))))) (OfNat.ofNat.{u1} 𝕜 0 (Zero.toOfNat0.{u1} 𝕜 (CommMonoidWithZero.toZero.{u1} 𝕜 (CommGroupWithZero.toCommMonoidWithZero.{u1} 𝕜 (Semifield.toCommGroupWithZero.{u1} 𝕜 (LinearOrderedSemifield.toSemifield.{u1} 𝕜 (LinearOrderedField.toLinearOrderedSemifield.{u1} 𝕜 _inst_2))))))) ε) -> (Not (SimpleGraph.FarFromTriangleFree.{u2, u1} α 𝕜 _inst_1 _inst_2 G ε))
Case conversion may be inaccurate. Consider using '#align simple_graph.clique_free.not_far_from_triangle_free SimpleGraph.CliqueFree.not_farFromTriangleFreeₓ'. -/
theorem CliqueFree.not_farFromTriangleFree (hG : G.CliqueFree 3) (hε : 0 < ε) :
    ¬G.FarFromTriangleFree ε := fun h => (h.nonpos hG).not_lt hε
#align simple_graph.clique_free.not_far_from_triangle_free SimpleGraph.CliqueFree.not_farFromTriangleFree

/- warning: simple_graph.far_from_triangle_free.not_clique_free -> SimpleGraph.FarFromTriangleFree.not_cliqueFree is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {𝕜 : Type.{u2}} [_inst_1 : Fintype.{u1} α] [_inst_2 : LinearOrderedField.{u2} 𝕜] {G : SimpleGraph.{u1} α} {ε : 𝕜} [_inst_3 : Nonempty.{succ u1} α], (SimpleGraph.FarFromTriangleFree.{u1, u2} α 𝕜 _inst_1 _inst_2 G ε) -> (LT.lt.{u2} 𝕜 (Preorder.toLT.{u2} 𝕜 (PartialOrder.toPreorder.{u2} 𝕜 (OrderedAddCommGroup.toPartialOrder.{u2} 𝕜 (StrictOrderedRing.toOrderedAddCommGroup.{u2} 𝕜 (LinearOrderedRing.toStrictOrderedRing.{u2} 𝕜 (LinearOrderedCommRing.toLinearOrderedRing.{u2} 𝕜 (LinearOrderedField.toLinearOrderedCommRing.{u2} 𝕜 _inst_2))))))) (OfNat.ofNat.{u2} 𝕜 0 (OfNat.mk.{u2} 𝕜 0 (Zero.zero.{u2} 𝕜 (MulZeroClass.toHasZero.{u2} 𝕜 (NonUnitalNonAssocSemiring.toMulZeroClass.{u2} 𝕜 (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u2} 𝕜 (NonAssocRing.toNonUnitalNonAssocRing.{u2} 𝕜 (Ring.toNonAssocRing.{u2} 𝕜 (DivisionRing.toRing.{u2} 𝕜 (Field.toDivisionRing.{u2} 𝕜 (LinearOrderedField.toField.{u2} 𝕜 _inst_2))))))))))) ε) -> (Not (SimpleGraph.CliqueFree.{u1} α G (OfNat.ofNat.{0} Nat 3 (OfNat.mk.{0} Nat 3 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))
but is expected to have type
  forall {α : Type.{u2}} {𝕜 : Type.{u1}} [_inst_1 : Fintype.{u2} α] [_inst_2 : LinearOrderedField.{u1} 𝕜] {G : SimpleGraph.{u2} α} {ε : 𝕜} [_inst_3 : Nonempty.{succ u2} α], (SimpleGraph.FarFromTriangleFree.{u2, u1} α 𝕜 _inst_1 _inst_2 G ε) -> (LT.lt.{u1} 𝕜 (Preorder.toLT.{u1} 𝕜 (PartialOrder.toPreorder.{u1} 𝕜 (StrictOrderedRing.toPartialOrder.{u1} 𝕜 (LinearOrderedRing.toStrictOrderedRing.{u1} 𝕜 (LinearOrderedCommRing.toLinearOrderedRing.{u1} 𝕜 (LinearOrderedField.toLinearOrderedCommRing.{u1} 𝕜 _inst_2)))))) (OfNat.ofNat.{u1} 𝕜 0 (Zero.toOfNat0.{u1} 𝕜 (CommMonoidWithZero.toZero.{u1} 𝕜 (CommGroupWithZero.toCommMonoidWithZero.{u1} 𝕜 (Semifield.toCommGroupWithZero.{u1} 𝕜 (LinearOrderedSemifield.toSemifield.{u1} 𝕜 (LinearOrderedField.toLinearOrderedSemifield.{u1} 𝕜 _inst_2))))))) ε) -> (Not (SimpleGraph.CliqueFree.{u2} α G (OfNat.ofNat.{0} Nat 3 (instOfNatNat 3))))
Case conversion may be inaccurate. Consider using '#align simple_graph.far_from_triangle_free.not_clique_free SimpleGraph.FarFromTriangleFree.not_cliqueFreeₓ'. -/
theorem FarFromTriangleFree.not_cliqueFree (hG : G.FarFromTriangleFree ε) (hε : 0 < ε) :
    ¬G.CliqueFree 3 := fun h => (hG.nonpos h).not_lt hε
#align simple_graph.far_from_triangle_free.not_clique_free SimpleGraph.FarFromTriangleFree.not_cliqueFree

/- warning: simple_graph.far_from_triangle_free.clique_finset_nonempty -> SimpleGraph.FarFromTriangleFree.cliqueFinset_nonempty is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {𝕜 : Type.{u2}} [_inst_1 : Fintype.{u1} α] [_inst_2 : LinearOrderedField.{u2} 𝕜] {G : SimpleGraph.{u1} α} {ε : 𝕜} [_inst_3 : Nonempty.{succ u1} α], (SimpleGraph.FarFromTriangleFree.{u1, u2} α 𝕜 _inst_1 _inst_2 G ε) -> (LT.lt.{u2} 𝕜 (Preorder.toLT.{u2} 𝕜 (PartialOrder.toPreorder.{u2} 𝕜 (OrderedAddCommGroup.toPartialOrder.{u2} 𝕜 (StrictOrderedRing.toOrderedAddCommGroup.{u2} 𝕜 (LinearOrderedRing.toStrictOrderedRing.{u2} 𝕜 (LinearOrderedCommRing.toLinearOrderedRing.{u2} 𝕜 (LinearOrderedField.toLinearOrderedCommRing.{u2} 𝕜 _inst_2))))))) (OfNat.ofNat.{u2} 𝕜 0 (OfNat.mk.{u2} 𝕜 0 (Zero.zero.{u2} 𝕜 (MulZeroClass.toHasZero.{u2} 𝕜 (NonUnitalNonAssocSemiring.toMulZeroClass.{u2} 𝕜 (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u2} 𝕜 (NonAssocRing.toNonUnitalNonAssocRing.{u2} 𝕜 (Ring.toNonAssocRing.{u2} 𝕜 (DivisionRing.toRing.{u2} 𝕜 (Field.toDivisionRing.{u2} 𝕜 (LinearOrderedField.toField.{u2} 𝕜 _inst_2))))))))))) ε) -> (Finset.Nonempty.{u1} (Finset.{u1} α) (SimpleGraph.cliqueFinset.{u1} α G _inst_1 (fun (a : α) (b : α) => Classical.propDecidable (Eq.{succ u1} α a b)) (fun (a : α) (b : α) => Classical.propDecidable (SimpleGraph.Adj.{u1} α G a b)) (OfNat.ofNat.{0} Nat 3 (OfNat.mk.{0} Nat 3 (bit1.{0} Nat Nat.hasOne Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))
but is expected to have type
  forall {α : Type.{u2}} {𝕜 : Type.{u1}} [_inst_1 : Fintype.{u2} α] [_inst_2 : LinearOrderedField.{u1} 𝕜] {G : SimpleGraph.{u2} α} {ε : 𝕜} [_inst_3 : Nonempty.{succ u2} α], (SimpleGraph.FarFromTriangleFree.{u2, u1} α 𝕜 _inst_1 _inst_2 G ε) -> (LT.lt.{u1} 𝕜 (Preorder.toLT.{u1} 𝕜 (PartialOrder.toPreorder.{u1} 𝕜 (StrictOrderedRing.toPartialOrder.{u1} 𝕜 (LinearOrderedRing.toStrictOrderedRing.{u1} 𝕜 (LinearOrderedCommRing.toLinearOrderedRing.{u1} 𝕜 (LinearOrderedField.toLinearOrderedCommRing.{u1} 𝕜 _inst_2)))))) (OfNat.ofNat.{u1} 𝕜 0 (Zero.toOfNat0.{u1} 𝕜 (CommMonoidWithZero.toZero.{u1} 𝕜 (CommGroupWithZero.toCommMonoidWithZero.{u1} 𝕜 (Semifield.toCommGroupWithZero.{u1} 𝕜 (LinearOrderedSemifield.toSemifield.{u1} 𝕜 (LinearOrderedField.toLinearOrderedSemifield.{u1} 𝕜 _inst_2))))))) ε) -> (Finset.Nonempty.{u2} (Finset.{u2} α) (SimpleGraph.cliqueFinset.{u2} α G _inst_1 (fun (a : α) (b : α) => Classical.propDecidable (Eq.{succ u2} α a b)) (fun (a : α) (b : α) => Classical.propDecidable (SimpleGraph.Adj.{u2} α G a b)) (OfNat.ofNat.{0} Nat 3 (instOfNatNat 3))))
Case conversion may be inaccurate. Consider using '#align simple_graph.far_from_triangle_free.clique_finset_nonempty SimpleGraph.FarFromTriangleFree.cliqueFinset_nonemptyₓ'. -/
theorem FarFromTriangleFree.cliqueFinset_nonempty (hG : G.FarFromTriangleFree ε) (hε : 0 < ε) :
    (G.cliqueFinset 3).Nonempty :=
  nonempty_of_ne_empty <| G.cliqueFinset_eq_empty_iff.Not.2 <| hG.not_cliqueFree hε
#align simple_graph.far_from_triangle_free.clique_finset_nonempty SimpleGraph.FarFromTriangleFree.cliqueFinset_nonempty

end SimpleGraph


/-
Copyright (c) 2019 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Yury Kudryashov
-/
import data.list.big_operators.basic

/-!
# Free monoid over a given alphabet

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

## Main definitions

* `free_monoid α`: free monoid over alphabet `α`; defined as a synonym for `list α`
  with multiplication given by `(++)`.
* `free_monoid.of`: embedding `α → free_monoid α` sending each element `x` to `[x]`;
* `free_monoid.lift`: natural equivalence between `α → M` and `free_monoid α →* M`
* `free_monoid.map`: embedding of `α → β` into `free_monoid α →* free_monoid β` given by `list.map`.
-/

variables {α : Type*} {β : Type*} {γ : Type*} {M : Type*} [monoid M] {N : Type*} [monoid N]

/-- Free monoid over a given alphabet. -/
@[to_additive "Free nonabelian additive monoid over a given alphabet"]
def free_monoid (α) := list α

namespace free_monoid

@[to_additive] instance [decidable_eq α] : decidable_eq (free_monoid α) := list.decidable_eq

/-- The identity equivalence between `free_monoid α` and `list α`. -/
@[to_additive "The identity equivalence between `free_add_monoid α` and `list α`."]
def to_list : free_monoid α ≃ list α := equiv.refl _

/-- The identity equivalence between `list α` and `free_monoid α`. -/
@[to_additive "The identity equivalence between `list α` and `free_add_monoid α`."]
def of_list : list α ≃ free_monoid α := equiv.refl _

@[simp, to_additive] lemma to_list_symm : (@to_list α).symm = of_list := rfl
@[simp, to_additive] lemma of_list_symm : (@of_list α).symm = to_list := rfl
@[simp, to_additive] lemma to_list_of_list (l : list α) : to_list (of_list l) = l := rfl
@[simp, to_additive] lemma of_list_to_list (xs : free_monoid α) : of_list (to_list xs) = xs := rfl
@[simp, to_additive] lemma to_list_comp_of_list : @to_list α ∘ of_list = id := rfl
@[simp, to_additive] lemma of_list_comp_to_list : @of_list α ∘ to_list = id := rfl

@[to_additive]
instance : cancel_monoid (free_monoid α) :=
{ one := of_list [],
  mul := λ x y, of_list (x.to_list ++ y.to_list),
  mul_one := list.append_nil,
  one_mul := list.nil_append,
  mul_assoc := list.append_assoc,
  mul_left_cancel := λ _ _ _, list.append_left_cancel,
  mul_right_cancel := λ _ _ _, list.append_right_cancel }

@[to_additive]
instance : inhabited (free_monoid α) := ⟨1⟩

@[simp, to_additive] lemma to_list_one : (1 : free_monoid α).to_list = [] := rfl
@[simp, to_additive] lemma of_list_nil : of_list ([] : list α) = 1 := rfl

@[simp, to_additive]
lemma to_list_mul (xs ys : free_monoid α) : (xs * ys).to_list = xs.to_list ++ ys.to_list := rfl

@[simp, to_additive]
lemma of_list_append (xs ys : list α) :
  of_list (xs ++ ys) = of_list xs * of_list ys :=
rfl

@[simp, to_additive]
lemma to_list_prod (xs : list (free_monoid α)) : to_list xs.prod = (xs.map to_list).join :=
by induction xs; simp [*, list.join]

@[simp, to_additive]
lemma of_list_join (xs : list (list α)) : of_list xs.join = (xs.map of_list).prod :=
to_list.injective $ by simp

/-- Embeds an element of `α` into `free_monoid α` as a singleton list. -/
@[to_additive "Embeds an element of `α` into `free_add_monoid α` as a singleton list." ]
def of (x : α) : free_monoid α := of_list [x]

@[simp, to_additive] lemma to_list_of (x : α) : to_list (of x) = [x] := rfl
@[to_additive]

@[simp, to_additive] lemma of_list_cons (x : α) (xs : list α) :
  of_list (x :: xs) = of x * of_list xs :=
rfl

@[to_additive] lemma to_list_of_mul (x : α) (xs : free_monoid α) :
  to_list (of x * xs) = x :: xs.to_list :=
rfl

@[to_additive] lemma of_injective : function.injective (@of α) := list.singleton_injective

/-- Recursor for `free_monoid` using `1` and `free_monoid.of x * xs` instead of `[]` and
`x :: xs`. -/
@[elab_as_eliminator, to_additive
  "Recursor for `free_add_monoid` using `0` and `free_add_monoid.of x + xs` instead of `[]` and
  `x :: xs`."]
def rec_on {C : free_monoid α → Sort*} (xs : free_monoid α) (h0 : C 1)
  (ih : Π x xs, C xs → C (of x * xs)) : C xs := list.rec_on xs h0 ih

@[simp, to_additive] lemma rec_on_one {C : free_monoid α → Sort*} (h0 : C 1)
  (ih : Π x xs, C xs → C (of x * xs)) :
  @rec_on α C 1 h0 ih = h0 :=
rfl

@[simp, to_additive] lemma rec_on_of_mul {C : free_monoid α → Sort*} (x : α) (xs : free_monoid α)
  (h0 : C 1) (ih : Π x xs, C xs → C (of x * xs)) :
  @rec_on α C (of x * xs) h0 ih = ih x xs (rec_on xs h0 ih) :=
rfl

/-- A version of `list.cases_on` for `free_monoid` using `1` and `free_monoid.of x * xs` instead of
`[]` and `x :: xs`. -/
@[elab_as_eliminator, to_additive
  "A version of `list.cases_on` for `free_add_monoid` using `0` and `free_add_monoid.of x + xs`
  instead of `[]` and `x :: xs`."]
def cases_on {C : free_monoid α → Sort*} (xs : free_monoid α) (h0 : C 1)
  (ih : Π x xs, C (of x * xs)) : C xs := list.cases_on xs h0 ih

@[simp, to_additive] lemma cases_on_one {C : free_monoid α → Sort*} (h0 : C 1)
  (ih : Π x xs, C (of x * xs)) :
  @cases_on α C 1 h0 ih = h0 :=
rfl

@[simp, to_additive] lemma cases_on_of_mul {C : free_monoid α → Sort*} (x : α) (xs : free_monoid α)
  (h0 : C 1) (ih : Π x xs, C (of x * xs)) :
  @cases_on α C (of x * xs) h0 ih = ih x xs :=
rfl

@[ext, to_additive]
lemma hom_eq ⦃f g : free_monoid α →* M⦄ (h : ∀ x, f (of x) = g (of x)) :
  f = g :=
monoid_hom.ext $ λ l, rec_on l (f.map_one.trans g.map_one.symm) $
  λ x xs hxs, by simp only [h, hxs, monoid_hom.map_mul]

/-- A variant of `list.prod` that has `[x].prod = x` true definitionally.

The purpose is to make `free_monoid.lift_eval_of` true by `rfl`. -/
@[to_additive "A variant of `list.sum` that has `[x].sum = x` true definitionally.

The purpose is to make `free_add_monoid.lift_eval_of` true by `rfl`."]
def prod_aux {M} [monoid M] (l : list M) : M :=
l.rec_on 1 (λ x xs (_ : M), list.foldl (*) x xs)

@[to_additive]
lemma prod_aux_eq : ∀ l : list M, free_monoid.prod_aux l = l.prod
| [] := rfl
| (x :: xs) := congr_arg (λ x, list.foldl (*) x xs) (one_mul _).symm

/-- Equivalence between maps `α → M` and monoid homomorphisms `free_monoid α →* M`. -/
@[to_additive "Equivalence between maps `α → A` and additive monoid homomorphisms
`free_add_monoid α →+ A`."]
def lift : (α → M) ≃ (free_monoid α →* M) :=
{ to_fun := λ f, ⟨λ l, free_monoid.prod_aux (l.to_list.map f), rfl,
    λ l₁ l₂, by simp only [prod_aux_eq, to_list_mul, list.map_append, list.prod_append]⟩,
  inv_fun := λ f x, f (of x),
  left_inv := λ f, rfl,
  right_inv := λ f, hom_eq $ λ x, rfl }

@[simp, to_additive]
lemma lift_symm_apply (f : free_monoid α →* M) : lift.symm f = f ∘ of := rfl

@[to_additive]
lemma lift_apply (f : α → M) (l : free_monoid α) : lift f l = (l.to_list.map f).prod :=
prod_aux_eq _

@[to_additive] lemma lift_comp_of (f : α → M) : lift f ∘ of = f := rfl

@[simp, to_additive]
lemma lift_eval_of (f : α → M) (x : α) : lift f (of x) = f x := rfl

@[simp, to_additive]
lemma lift_restrict (f : free_monoid α →* M) : lift (f ∘ of) = f :=
lift.apply_symm_apply f

@[to_additive]
lemma comp_lift (g : M →* N) (f : α → M) : g.comp (lift f) = lift (g ∘ f) :=
by { ext, simp }

@[to_additive]
lemma hom_map_lift (g : M →* N) (f : α → M) (x : free_monoid α) : g (lift f x) = lift (g ∘ f) x :=
monoid_hom.ext_iff.1 (comp_lift g f) x

/-- Define a multiplicative action of `free_monoid α` on `β`. -/
@[to_additive "Define an additive action of `free_add_monoid α` on `β`."]
def mk_mul_action (f : α → β → β) : mul_action (free_monoid α) β :=
{ smul := λ l b, l.to_list.foldr f b,
  one_smul := λ x, rfl,
  mul_smul := λ xs ys b, list.foldr_append _ _ _ _ }

@[to_additive] lemma smul_def (f : α → β → β) (l : free_monoid α) (b : β) :
  (by haveI := mk_mul_action f; exact l • b = l.to_list.foldr f b) :=
rfl

@[to_additive] lemma of_list_smul (f : α → β → β) (l : list α) (b : β) :
  (by haveI := mk_mul_action f; exact (of_list l) • b = l.foldr f b) :=
rfl

@[simp, to_additive] lemma of_smul (f : α → β → β) (x : α) (y : β) :
  (by haveI := mk_mul_action f; exact of x • y) = f x y :=
rfl

/-- The unique monoid homomorphism `free_monoid α →* free_monoid β` that sends
each `of x` to `of (f x)`. -/
@[to_additive "The unique additive monoid homomorphism `free_add_monoid α →+ free_add_monoid β`
that sends each `of x` to `of (f x)`."]
def map (f : α → β) : free_monoid α →* free_monoid β :=
{ to_fun := λ l, of_list $ l.to_list.map f,
  map_one' := rfl,
  map_mul' := λ l₁ l₂, list.map_append _ _ _ }

@[simp, to_additive] lemma map_of (f : α → β) (x : α) : map f (of x) = of (f x) := rfl

@[to_additive] lemma to_list_map (f : α → β) (xs : free_monoid α) :
  (map f xs).to_list = xs.to_list.map f :=
rfl

@[to_additive] lemma of_list_map (f : α → β) (xs : list α) :
  of_list (xs.map f) = map f (of_list xs) :=
rfl

@[to_additive]
lemma lift_of_comp_eq_map (f : α → β) :
  lift (λ x, of (f x)) = map f :=
hom_eq $ λ x, rfl

@[to_additive]
lemma map_comp (g : β → γ) (f : α → β) : map (g ∘ f) = (map g).comp (map f) :=
hom_eq $ λ x, rfl

@[simp, to_additive] lemma map_id : map (@id α) = monoid_hom.id (free_monoid α) :=
hom_eq $ λ x, rfl

end free_monoid


import pseudo_normed_group.breen_deligne
import analysis.normed.group.SemiNormedGroup.kernels

/-!

# Constructions on the filtration on a profinitely filtered pseudo-normed group

## Main definitions

- `FiltrationPow r' c n`: the functor sending a profinitely filtered `M` to `M_c^n`.
- `φ.eval_FP r' c₁ c₂`: The map M_c₁^m → M_c₂^n induced by a (c₁, c₂)-suitable φ.

-/
open_locale classical nnreal big_operators kronecker
noncomputable theory
local attribute [instance] type_pow

universe variables u

@[simps]
def pseudo_normed_group.filtration_obj
  (M) [profinitely_filtered_pseudo_normed_group M] (c) : Profinite :=
Profinite.of (pseudo_normed_group.filtration M c)

open profinitely_filtered_pseudo_normed_group category_theory
  comphaus_filtered_pseudo_normed_group

namespace Filtration
variables (M : Type u) [profinitely_filtered_pseudo_normed_group M]
@[simps]
def cast_le (c₁ c₂ : ℝ≥0) [h : fact (c₁ ≤ c₂)] :
  pseudo_normed_group.filtration_obj.{u} M c₁ ⟶ pseudo_normed_group.filtration_obj.{u} M c₂ :=
{ to_fun := pseudo_normed_group.cast_le,
  continuous_to_fun := continuous_cast_le c₁ c₂ }

theorem cast_le_refl (c : ℝ≥0) : cast_le M c c = 𝟙 _ := by { ext, refl }

theorem cast_le_comp (c₁ c₂ c₃ : ℝ≥0) [h₁ : fact (c₁ ≤ c₂)] [h₂ : fact (c₂ ≤ c₃)] :
  cast_le M c₁ c₂ ≫ cast_le M c₂ c₃ = @cast_le M _ c₁ c₃ ⟨le_trans h₁.1 h₂.1⟩ :=
by { ext, refl }

end Filtration

@[simps obj_obj obj_map_to_fun map_app {fully_applied := ff}]
def Filtration (r' : ℝ≥0) : ℝ≥0 ⥤ ProFiltPseuNormGrpWithTinv.{u} r' ⥤ Profinite.{u} :=
{ obj := λ c,
  { obj := λ M, pseudo_normed_group.filtration_obj M c,
    map := λ M N f, ⟨f.level c, f.level_continuous c⟩,
    map_id' := by { intros, ext, refl },
    map_comp' := by { intros, ext, refl } },
  map := λ c₁ c₂ h,
  { app := λ M, @Filtration.cast_le _ _ c₁ c₂ ⟨le_of_hom h⟩ },
  map_id' := by { intros, ext, refl },
  map_comp' := by { intros, ext, refl } }

open SemiNormedGroup opposite Profinite pseudo_normed_group category_theory breen_deligne
open profinitely_filtered_pseudo_normed_group
open profinitely_filtered_pseudo_normed_group_with_Tinv

/-- The functor that sends `A` to `A^n` -/
@[simps obj map]
def Pow (n : ℕ) : Profinite ⥤ Profinite :=
{ obj := λ A, of (A^n),
  map := λ A B f, {
    to_fun := λ x j, f (x j),
    continuous_to_fun := continuous_pi $ λ j, f.2.comp (continuous_apply j) } }

@[simps]
def Pow_Pow_X (N n : ℕ) (X) : (Pow N ⋙ Pow n).obj X ≅ (Pow (N * n)).obj X :=
Profinite.iso_of_homeo
{ to_equiv := (equiv.curry _ _ _).symm.trans (((equiv.prod_comm _ _).trans fin_prod_fin_equiv).arrow_congr (equiv.refl X)),
  continuous_to_fun :=
  begin
    apply continuous_pi,
    intro ij,
    let k := ((equiv.prod_comm _ _).trans fin_prod_fin_equiv).symm ij,
    convert (@continuous_apply _ (λ i, X) _ k.2).comp (@continuous_apply _ (λ i, (X^N)) _ k.1),
  end,
  continuous_inv_fun :=
  begin
    apply continuous_pi,
    intro i,
    refine continuous_pi _,
    intro j,
    exact continuous_apply _,
  end }
.

@[simps hom inv]
def Pow_mul (N n : ℕ) : Pow (N * n) ≅ Pow N ⋙ Pow n :=
nat_iso.of_components (λ X, (Pow_Pow_X N n X).symm)
begin
  intros X Y f,
  ext x i j,
  refl,
end

@[simps]
def profinitely_filtered_pseudo_normed_group_with_Tinv.Tinv₀_hom
  {r' : ℝ≥0} (M : Type*) [profinitely_filtered_pseudo_normed_group_with_Tinv r' M]
  (c c₂ : ℝ≥0) [fact (c ≤ r' * c₂)] : filtration_obj M c ⟶ filtration_obj M c₂ :=
by exact ⟨Tinv₀ c c₂, Tinv₀_continuous _ _⟩

open profinitely_filtered_pseudo_normed_group_with_Tinv

namespace Filtration

@[simps]
def res (r' c₁ c₂ : ℝ≥0) [h : fact (c₁ ≤ c₂)] :
  (Filtration r').obj c₁ ⟶ (Filtration r').obj c₂ :=
(Filtration r').map (hom_of_le h.1)

theorem res_refl (r' c : ℝ≥0) : res r' c c = 𝟙 _ := by { ext, refl }

theorem res_comp (r' c₁ c₂ c₃ : ℝ≥0) [h₁ : fact (c₁ ≤ c₂)] [h₂ : fact (c₂ ≤ c₃)] :
  res r' c₁ c₂ ≫ res r' c₂ c₃ = @res r' c₁ c₃ ⟨le_trans h₁.1 h₂.1⟩ :=
by { ext, refl }

@[simps] def Tinv₀ {r' : ℝ≥0} (c c₂ : ℝ≥0) [fact (c ≤ r' * c₂)] :
  (Filtration.{u} r').obj c ⟶ (Filtration r').obj c₂ :=
{ app := λ M, Tinv₀_hom M c c₂,
  naturality' := λ M₁ M₂ f, by { ext x, exact (f.map_Tinv _).symm } }

theorem Tinv₀_comp_res {r' : ℝ≥0} (c₁ c₂ c₃ c₄ : ℝ≥0)
  [fact (c₁ ≤ r' * c₂)] [fact (c₃ ≤ r' * c₄)] [fact (c₂ ≤ c₄)] [fact (c₁ ≤ c₃)] :
  Tinv₀ c₁ c₂ ≫ res r' c₂ c₄ = res r' c₁ c₃ ≫ Tinv₀ c₃ c₄ := rfl

def pi_iso (r' c : ℝ≥0) (M : ProFiltPseuNormGrpWithTinv r') (N : ℕ) :
  Profinite.of (filtration (M^N) c) ≅ Profinite.of ((filtration M c)^N) :=
Profinite.iso_of_homeo $ filtration_pi_homeo _ _

end Filtration

/-- `FiltrationPow r' c n` is the functor sending a profinitely filtered `M` to `M_c^n`. -/
@[simps obj map {fully_applied := ff}]
def FiltrationPow (r' : ℝ≥0) (c : ℝ≥0) (n : ℕ) :
  ProFiltPseuNormGrpWithTinv r' ⥤ Profinite :=
ProFiltPseuNormGrpWithTinv.Pow r' n ⋙ (Filtration r').obj c

namespace FiltrationPow

@[simps]
def cast_le (r' c₁ c₂ : ℝ≥0) [fact (c₁ ≤ c₂)] (n : ℕ) :
  FiltrationPow.{u} r' c₁ n ⟶ FiltrationPow r' c₂ n :=
{ app := λ M, (Filtration.cast_le _ c₁ c₂),
  naturality' := λ M N f, by { ext, refl } }

theorem cast_le_refl (r' c : ℝ≥0) (n : ℕ) : cast_le r' c c n = 𝟙 _ :=
by { ext, refl }

theorem cast_le_comp (r' c₁ c₂ c₃ : ℝ≥0) [h₁ : fact (c₁ ≤ c₂)] [h₂ : fact (c₂ ≤ c₃)] (n : ℕ) :
  cast_le r' c₁ c₂ n ≫ cast_le r' c₂ c₃ n =
  @cast_le r' c₁ c₃ ⟨le_trans h₁.1 h₂.1⟩ n :=
by { ext, refl }

@[simps]
def Tinv (r' : ℝ≥0) (c c₂) [fact (c ≤ r' * c₂)] (n) :
  FiltrationPow r' c n ⟶ FiltrationPow r' c₂ n :=
whisker_left _ (Filtration.Tinv₀ c c₂)

lemma Tinv_app (r' : ℝ≥0) (c c₂) [fact (c ≤ r' * c₂)] (n M) :
  (Tinv r' c c₂ n).app M = (Tinv₀_hom _ c c₂) := rfl

lemma cast_le_vcomp_Tinv (r' c₁ c₂ c₃ : ℝ≥0)
  [fact (c₁ ≤ c₂)] [fact (c₂ ≤ c₃)] [fact (c₁ ≤ r' * c₂)] [fact (c₂ ≤ r' * c₃)] (n : ℕ) :
  cast_le r' c₁ c₂ n ≫ Tinv r' c₂ c₃ n = Tinv r' c₁ c₂ n ≫ cast_le r' c₂ c₃ n :=
by { ext, refl }

@[simps hom inv]
def mul_iso (r' c : ℝ≥0) (M : ProFiltPseuNormGrpWithTinv r') (N n : ℕ) :
  (FiltrationPow r' c n).obj (ProFiltPseuNormGrpWithTinv.of r' (↥M ^ N)) ≅
  (FiltrationPow r' c (N * n)).obj M :=
((Filtration r').obj c).map_iso $ (ProFiltPseuNormGrpWithTinv.Pow_mul r' N n).symm.app _

end FiltrationPow

namespace breen_deligne
namespace basic_universal_map

variables (r' c c₁ c₂ c₃ c₄ : ℝ≥0) {l m n : ℕ} (ϕ : basic_universal_map m n)

open FiltrationPow comphaus_filtered_pseudo_normed_group_with_Tinv_hom

@[simps]
def eval_FP [ϕ.suitable c₁ c₂] : FiltrationPow.{u} r' c₁ m ⟶ FiltrationPow r' c₂ n :=
{ app := λ M,
  { to_fun := ϕ.eval_png₀ M c₁ c₂,
    continuous_to_fun := ϕ.eval_png₀_continuous M c₁ c₂ },
  naturality' := λ M₁ M₂ f, begin
    ext1 x,
    change ϕ.eval_png₀ M₂ c₁ c₂ ((FiltrationPow r' c₁ m).map f x) =
      (FiltrationPow r' c₂ n).map f (ϕ.eval_png₀ M₁ c₁ c₂ x),
    ext j,
    dsimp only [FiltrationPow_map, Filtration_obj_map_to_fun,basic_universal_map.eval_png₀_coe,
      comphaus_filtered_pseudo_normed_group_with_Tinv_hom.level_coe,
      comp_to_fun, coe_to_add_monoid_hom],
    simp only [basic_universal_map.eval_png_apply, pi_map_to_fun, f.map_sum, f.map_zsmul],
  end }

lemma eval_FP_comp (g : basic_universal_map m n) (f : basic_universal_map l m)
  [hg : g.suitable c₂ c₃] [hf : f.suitable c₁ c₂]
  [(basic_universal_map.comp g f).suitable c₁ c₃] :
  (basic_universal_map.comp g f).eval_FP r' c₁ c₃ = f.eval_FP r' c₁ c₂ ≫ g.eval_FP r' c₂ c₃ :=
by { ext, dsimp, rw eval_png_comp, refl }

lemma cast_le_comp_eval_FP
  [fact (c₁ ≤ c₂)] [ϕ.suitable c₂ c₄] [ϕ.suitable c₁ c₃] [fact (c₃ ≤ c₄)] :
  cast_le r' c₁ c₂ m ≫ ϕ.eval_FP r' c₂ c₄ = ϕ.eval_FP r' c₁ c₃ ≫ cast_le r' c₃ c₄ n :=
by { ext, refl }

open FiltrationPow

lemma Tinv_comp_eval_FP (r' c₁ c₂ c₃ c₄ : ℝ≥0)
  [fact (c₁ ≤ r' * c₂)] [fact (c₃ ≤ r' * c₄)] [ϕ.suitable c₁ c₃] [ϕ.suitable c₂ c₄] :
  Tinv r' c₁ c₂ m ≫ ϕ.eval_FP r' c₂ c₄ = ϕ.eval_FP r' c₁ c₃ ≫ Tinv r' c₃ c₄ n :=
begin
  ext M x : 3,
  change ϕ.eval_png₀ M c₂ c₄ ((Tinv r' c₁ c₂ m).app M x) =
    (Tinv r' c₃ c₄ n).app M (ϕ.eval_png₀ M c₁ c₃ x),
  ext j,
  dsimp,
  simp only [eval_png_apply, comphaus_filtered_pseudo_normed_group_hom.map_sum,
    comphaus_filtered_pseudo_normed_group_hom.map_zsmul, pi_Tinv_apply],
end
.

lemma mul_iso_eval_FP (N : ℕ) [ϕ.suitable c₂ c₁] (M) :
  (FiltrationPow.mul_iso.{u u} r' c₂ M N m).inv ≫
    (basic_universal_map.eval_FP r' c₂ c₁ ϕ).app (ProFiltPseuNormGrpWithTinv.of r' (M ^ N)) =
  (basic_universal_map.eval_FP r' c₂ c₁ ((basic_universal_map.mul N) ϕ)).app M ≫
    (FiltrationPow.mul_iso.{u u} r' c₁ M N n).inv :=
begin
  ext x i j,
  dsimp [mul],
  simp only [eval_png_apply, equiv.symm_apply_apply, matrix.minor_apply, matrix.kronecker],
  rw [← fin_prod_fin_equiv.sum_comp, ← finset.univ_product_univ, finset.sum_product,
      finset.sum_comm],
  simp only [equiv.symm_apply_apply, matrix.one_apply, boole_mul, ite_smul, zero_smul,
    finset.sum_ite_eq, finset.mem_univ, if_true, matrix.kronecker_map, matrix.kronecker_apply],
  convert finset.sum_apply j (finset.univ : finset (fin m)) _ using 1,
end

end basic_universal_map

end breen_deligne