/-
Copyright (c) 2021 Kalle Kytölä. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kalle Kytölä

! This file was ported from Lean 3 source module analysis.normed_space.is_R_or_C
! leanprover-community/mathlib commit 468b141b14016d54b479eb7a0fff1e360b7e3cf6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.IsROrC.Basic
import Mathbin.Analysis.NormedSpace.OperatorNorm
import Mathbin.Analysis.NormedSpace.Pointwise

/-!
# Normed spaces over R or C

This file is about results on normed spaces over the fields `ℝ` and `ℂ`.

## Main definitions

None.

## Main theorems

* `continuous_linear_map.op_norm_bound_of_ball_bound`: A bound on the norms of values of a linear
  map in a ball yields a bound on the operator norm.

## Notes

This file exists mainly to avoid importing `is_R_or_C` in the main normed space theory files.
-/

open Metric

variable {𝕜 : Type _} [IsROrC 𝕜] {E : Type _} [NormedAddCommGroup E]

theorem IsROrC.norm_coe_norm {z : E} : ‖(‖z‖ : 𝕜)‖ = ‖z‖ := by simp
#align is_R_or_C.norm_coe_norm IsROrC.norm_coe_norm

variable [NormedSpace 𝕜 E]

/-- Lemma to normalize a vector in a normed space `E` over either `ℂ` or `ℝ` to unit length. -/
@[simp]
theorem norm_smul_inv_norm {x : E} (hx : x ≠ 0) : ‖(‖x‖⁻¹ : 𝕜) • x‖ = 1 :=
  by
  have : ‖x‖ ≠ 0 := by simp [hx]
  field_simp [norm_smul]
#align norm_smul_inv_norm norm_smul_inv_norm

/-- Lemma to normalize a vector in a normed space `E` over either `ℂ` or `ℝ` to length `r`. -/
theorem norm_smul_inv_norm' {r : ℝ} (r_nonneg : 0 ≤ r) {x : E} (hx : x ≠ 0) :
    ‖(r * ‖x‖⁻¹ : 𝕜) • x‖ = r := by
  have : ‖x‖ ≠ 0 := by simp [hx]
  field_simp [norm_smul, IsROrC.norm_eq_abs, r_nonneg, is_R_or_C_simps]
#align norm_smul_inv_norm' norm_smul_inv_norm'

theorem LinearMap.bound_of_sphere_bound {r : ℝ} (r_pos : 0 < r) (c : ℝ) (f : E →ₗ[𝕜] 𝕜)
    (h : ∀ z ∈ sphere (0 : E) r, ‖f z‖ ≤ c) (z : E) : ‖f z‖ ≤ c / r * ‖z‖ :=
  by
  by_cases z_zero : z = 0
  · rw [z_zero]
    simp only [LinearMap.map_zero, norm_zero, MulZeroClass.mul_zero]
  set z₁ := (r * ‖z‖⁻¹ : 𝕜) • z with hz₁
  have norm_f_z₁ : ‖f z₁‖ ≤ c := by
    apply h
    rw [mem_sphere_zero_iff_norm]
    exact norm_smul_inv_norm' r_pos.le z_zero
  have r_ne_zero : (r : 𝕜) ≠ 0 := is_R_or_C.of_real_ne_zero.mpr r_pos.ne'
  have eq : f z = ‖z‖ / r * f z₁ :=
    by
    rw [hz₁, LinearMap.map_smul, smul_eq_mul]
    rw [← mul_assoc, ← mul_assoc, div_mul_cancel _ r_ne_zero, mul_inv_cancel, one_mul]
    simp only [z_zero, IsROrC.of_real_eq_zero, norm_eq_zero, Ne.def, not_false_iff]
  rw [Eq, norm_mul, norm_div, IsROrC.norm_coe_norm, IsROrC.norm_of_nonneg r_pos.le,
    div_mul_eq_mul_div, div_mul_eq_mul_div, mul_comm]
  apply div_le_div _ _ r_pos rfl.ge
  · exact mul_nonneg ((norm_nonneg _).trans norm_f_z₁) (norm_nonneg z)
  apply mul_le_mul norm_f_z₁ rfl.le (norm_nonneg z) ((norm_nonneg _).trans norm_f_z₁)
#align linear_map.bound_of_sphere_bound LinearMap.bound_of_sphere_bound

/-- `linear_map.bound_of_ball_bound` is a version of this over arbitrary nontrivially normed fields.
It produces a less precise bound so we keep both versions. -/
theorem LinearMap.bound_of_ball_bound' {r : ℝ} (r_pos : 0 < r) (c : ℝ) (f : E →ₗ[𝕜] 𝕜)
    (h : ∀ z ∈ closedBall (0 : E) r, ‖f z‖ ≤ c) (z : E) : ‖f z‖ ≤ c / r * ‖z‖ :=
  f.bound_of_sphere_bound r_pos c (fun z hz => h z hz.le) z
#align linear_map.bound_of_ball_bound' LinearMap.bound_of_ball_bound'

theorem ContinuousLinearMap.op_norm_bound_of_ball_bound {r : ℝ} (r_pos : 0 < r) (c : ℝ)
    (f : E →L[𝕜] 𝕜) (h : ∀ z ∈ closedBall (0 : E) r, ‖f z‖ ≤ c) : ‖f‖ ≤ c / r :=
  by
  apply ContinuousLinearMap.op_norm_le_bound
  · apply div_nonneg _ r_pos.le
    exact
      (norm_nonneg _).trans
        (h 0 (by simp only [norm_zero, mem_closed_ball, dist_zero_left, r_pos.le]))
  apply LinearMap.bound_of_ball_bound' r_pos
  exact fun z hz => h z hz
#align continuous_linear_map.op_norm_bound_of_ball_bound ContinuousLinearMap.op_norm_bound_of_ball_bound

variable (𝕜)

include 𝕜

theorem NormedSpace.sphere_nonempty_isROrC [Nontrivial E] {r : ℝ} (hr : 0 ≤ r) :
    Nonempty (sphere (0 : E) r) :=
  letI : NormedSpace ℝ E := NormedSpace.restrictScalars ℝ 𝕜 E
  (normed_space.sphere_nonempty.mpr hr).coeSort
#align normed_space.sphere_nonempty_is_R_or_C NormedSpace.sphere_nonempty_isROrC


/-
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.clique
! 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.Basic
import Mathbin.Data.Finset.Pairwise

/-!
# Graph cliques

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

This file defines cliques in simple graphs. A clique is a set of vertices that are pairwise
adjacent.

## Main declarations

* `simple_graph.is_clique`: Predicate for a set of vertices to be a clique.
* `simple_graph.is_n_clique`: Predicate for a set of vertices to be a `n`-clique.
* `simple_graph.clique_finset`: Finset of `n`-cliques of a graph.
* `simple_graph.clique_free`: Predicate for a graph to have no `n`-cliques.

## TODO

* Clique numbers
* Do we need `clique_set`, a version of `clique_finset` for infinite graphs?
-/

open Finset Fintype

namespace SimpleGraph

variable {α : Type _} (G H : SimpleGraph α)

/-! ### Cliques -/

section Clique

variable {s t : Set α}

#print SimpleGraph.IsClique /-
/-- A clique in a graph is a set of vertices that are pairwise adjacent. -/
abbrev IsClique (s : Set α) : Prop :=
  s.Pairwise G.Adj
#align simple_graph.is_clique SimpleGraph.IsClique
-/

#print SimpleGraph.isClique_iff /-
theorem isClique_iff : G.IsClique s ↔ s.Pairwise G.Adj :=
  Iff.rfl
#align simple_graph.is_clique_iff SimpleGraph.isClique_iff
-/

/- warning: simple_graph.is_clique_iff_induce_eq -> SimpleGraph.isClique_iff_induce_eq is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (G : SimpleGraph.{u1} α) {s : Set.{u1} α}, Iff (SimpleGraph.IsClique.{u1} α G s) (Eq.{succ u1} (SimpleGraph.{u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s)) (SimpleGraph.induce.{u1} α s G) (Top.top.{u1} (SimpleGraph.{u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s)) (CompleteLattice.toHasTop.{u1} (SimpleGraph.{u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s)) (Order.Coframe.toCompleteLattice.{u1} (SimpleGraph.{u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s)) (CompleteDistribLattice.toCoframe.{u1} (SimpleGraph.{u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s)) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (SimpleGraph.{u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s)) (SimpleGraph.completeBooleanAlgebra.{u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s))))))))
but is expected to have type
  forall {α : Type.{u1}} (G : SimpleGraph.{u1} α) {s : Set.{u1} α}, Iff (SimpleGraph.IsClique.{u1} α G s) (Eq.{succ u1} (SimpleGraph.{u1} (Set.Elem.{u1} α s)) (SimpleGraph.induce.{u1} α s G) (Top.top.{u1} (SimpleGraph.{u1} (Set.Elem.{u1} α s)) (CompleteLattice.toTop.{u1} (SimpleGraph.{u1} (Set.Elem.{u1} α s)) (Order.Coframe.toCompleteLattice.{u1} (SimpleGraph.{u1} (Set.Elem.{u1} α s)) (CompleteDistribLattice.toCoframe.{u1} (SimpleGraph.{u1} (Set.Elem.{u1} α s)) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (SimpleGraph.{u1} (Set.Elem.{u1} α s)) (SimpleGraph.completeBooleanAlgebra.{u1} (Set.Elem.{u1} α s))))))))
Case conversion may be inaccurate. Consider using '#align simple_graph.is_clique_iff_induce_eq SimpleGraph.isClique_iff_induce_eqₓ'. -/
/-- A clique is a set of vertices whose induced graph is complete. -/
theorem isClique_iff_induce_eq : G.IsClique s ↔ G.induce s = ⊤ :=
  by
  rw [is_clique_iff]
  constructor
  · intro h
    ext (⟨v, hv⟩⟨w, hw⟩)
    simp only [comap_adj, Subtype.coe_mk, top_adj, Ne.def, Subtype.mk_eq_mk]
    exact ⟨adj.ne, h hv hw⟩
  · intro h v hv w hw hne
    have : (G.induce s).Adj ⟨v, hv⟩ ⟨w, hw⟩ = _ := rfl
    conv_lhs at this => rw [h]
    simpa [hne]
#align simple_graph.is_clique_iff_induce_eq SimpleGraph.isClique_iff_induce_eq

instance [DecidableEq α] [DecidableRel G.Adj] {s : Finset α} : Decidable (G.IsClique s) :=
  decidable_of_iff' _ G.isClique_iff

variable {G H}

#print SimpleGraph.IsClique.mono /-
theorem IsClique.mono (h : G ≤ H) : G.IsClique s → H.IsClique s :=
  by
  simp_rw [is_clique_iff]
  exact Set.Pairwise.mono' h
#align simple_graph.is_clique.mono SimpleGraph.IsClique.mono
-/

#print SimpleGraph.IsClique.subset /-
theorem IsClique.subset (h : t ⊆ s) : G.IsClique s → G.IsClique t :=
  by
  simp_rw [is_clique_iff]
  exact Set.Pairwise.mono h
#align simple_graph.is_clique.subset SimpleGraph.IsClique.subset
-/

/- warning: simple_graph.is_clique_bot_iff -> SimpleGraph.isClique_bot_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {s : Set.{u1} α}, Iff (SimpleGraph.IsClique.{u1} α (Bot.bot.{u1} (SimpleGraph.{u1} α) (CompleteLattice.toHasBot.{u1} (SimpleGraph.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (SimpleGraph.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (SimpleGraph.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (SimpleGraph.{u1} α) (SimpleGraph.completeBooleanAlgebra.{u1} α)))))) s) (Set.Subsingleton.{u1} α s)
but is expected to have type
  forall {α : Type.{u1}} {s : Set.{u1} α}, Iff (SimpleGraph.IsClique.{u1} α (Bot.bot.{u1} (SimpleGraph.{u1} α) (CompleteLattice.toBot.{u1} (SimpleGraph.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (SimpleGraph.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (SimpleGraph.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (SimpleGraph.{u1} α) (SimpleGraph.completeBooleanAlgebra.{u1} α)))))) s) (Set.Subsingleton.{u1} α s)
Case conversion may be inaccurate. Consider using '#align simple_graph.is_clique_bot_iff SimpleGraph.isClique_bot_iffₓ'. -/
@[simp]
theorem isClique_bot_iff : (⊥ : SimpleGraph α).IsClique s ↔ (s : Set α).Subsingleton :=
  Set.pairwise_bot_iff
#align simple_graph.is_clique_bot_iff SimpleGraph.isClique_bot_iff

/- warning: simple_graph.is_clique.subsingleton -> SimpleGraph.IsClique.subsingleton is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {s : Set.{u1} α}, (SimpleGraph.IsClique.{u1} α (Bot.bot.{u1} (SimpleGraph.{u1} α) (CompleteLattice.toHasBot.{u1} (SimpleGraph.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (SimpleGraph.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (SimpleGraph.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (SimpleGraph.{u1} α) (SimpleGraph.completeBooleanAlgebra.{u1} α)))))) s) -> (Set.Subsingleton.{u1} α s)
but is expected to have type
  forall {α : Type.{u1}} {s : Set.{u1} α}, (SimpleGraph.IsClique.{u1} α (Bot.bot.{u1} (SimpleGraph.{u1} α) (CompleteLattice.toBot.{u1} (SimpleGraph.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (SimpleGraph.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (SimpleGraph.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (SimpleGraph.{u1} α) (SimpleGraph.completeBooleanAlgebra.{u1} α)))))) s) -> (Set.Subsingleton.{u1} α s)
Case conversion may be inaccurate. Consider using '#align simple_graph.is_clique.subsingleton SimpleGraph.IsClique.subsingletonₓ'. -/
alias is_clique_bot_iff ↔ is_clique.subsingleton _
#align simple_graph.is_clique.subsingleton SimpleGraph.IsClique.subsingleton

end Clique

/-! ### `n`-cliques -/

section NClique

variable {n : ℕ} {s : Finset α}

#print SimpleGraph.IsNClique /-
/-- A `n`-clique in a graph is a set of `n` vertices which are pairwise connected. -/
structure IsNClique (n : ℕ) (s : Finset α) : Prop where
  clique : G.IsClique s
  card_eq : s.card = n
#align simple_graph.is_n_clique SimpleGraph.IsNClique
-/

#print SimpleGraph.isNClique_iff /-
theorem isNClique_iff : G.IsNClique n s ↔ G.IsClique s ∧ s.card = n :=
  ⟨fun h => ⟨h.1, h.2⟩, fun h => ⟨h.1, h.2⟩⟩
#align simple_graph.is_n_clique_iff SimpleGraph.isNClique_iff
-/

instance [DecidableEq α] [DecidableRel G.Adj] {n : ℕ} {s : Finset α} :
    Decidable (G.IsNClique n s) :=
  decidable_of_iff' _ G.isNClique_iff

variable {G H}

#print SimpleGraph.IsNClique.mono /-
theorem IsNClique.mono (h : G ≤ H) : G.IsNClique n s → H.IsNClique n s :=
  by
  simp_rw [is_n_clique_iff]
  exact And.imp_left (is_clique.mono h)
#align simple_graph.is_n_clique.mono SimpleGraph.IsNClique.mono
-/

/- warning: simple_graph.is_n_clique_bot_iff -> SimpleGraph.isNClique_bot_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {n : Nat} {s : Finset.{u1} α}, Iff (SimpleGraph.IsNClique.{u1} α (Bot.bot.{u1} (SimpleGraph.{u1} α) (CompleteLattice.toHasBot.{u1} (SimpleGraph.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (SimpleGraph.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (SimpleGraph.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (SimpleGraph.{u1} α) (SimpleGraph.completeBooleanAlgebra.{u1} α)))))) n s) (And (LE.le.{0} Nat Nat.hasLe n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))) (Eq.{1} Nat (Finset.card.{u1} α s) n))
but is expected to have type
  forall {α : Type.{u1}} {n : Nat} {s : Finset.{u1} α}, Iff (SimpleGraph.IsNClique.{u1} α (Bot.bot.{u1} (SimpleGraph.{u1} α) (CompleteLattice.toBot.{u1} (SimpleGraph.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (SimpleGraph.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (SimpleGraph.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (SimpleGraph.{u1} α) (SimpleGraph.completeBooleanAlgebra.{u1} α)))))) n s) (And (LE.le.{0} Nat instLENat n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) (Eq.{1} Nat (Finset.card.{u1} α s) n))
Case conversion may be inaccurate. Consider using '#align simple_graph.is_n_clique_bot_iff SimpleGraph.isNClique_bot_iffₓ'. -/
@[simp]
theorem isNClique_bot_iff : (⊥ : SimpleGraph α).IsNClique n s ↔ n ≤ 1 ∧ s.card = n :=
  by
  rw [is_n_clique_iff, is_clique_bot_iff]
  refine' and_congr_left _
  rintro rfl
  exact card_le_one.symm
#align simple_graph.is_n_clique_bot_iff SimpleGraph.isNClique_bot_iff

variable [DecidableEq α] {a b c : α}

#print SimpleGraph.is3Clique_triple_iff /-
theorem is3Clique_triple_iff : G.IsNClique 3 {a, b, c} ↔ G.Adj a b ∧ G.Adj a c ∧ G.Adj b c :=
  by
  simp only [is_n_clique_iff, is_clique_iff, Set.pairwise_insert_of_symmetric G.symm, coe_insert]
  have : ¬1 + 1 = 3 := by norm_num
  by_cases hab : a = b <;> by_cases hbc : b = c <;> by_cases hac : a = c <;> subst_vars <;>
    simp [G.ne_of_adj, and_rotate, *]
#align simple_graph.is_3_clique_triple_iff SimpleGraph.is3Clique_triple_iff
-/

#print SimpleGraph.is3Clique_iff /-
theorem is3Clique_iff :
    G.IsNClique 3 s ↔ ∃ a b c, G.Adj a b ∧ G.Adj a c ∧ G.Adj b c ∧ s = {a, b, c} :=
  by
  refine' ⟨fun h => _, _⟩
  · obtain ⟨a, b, c, -, -, -, rfl⟩ := card_eq_three.1 h.card_eq
    refine' ⟨a, b, c, _⟩
    rw [is_3_clique_triple_iff] at h
    tauto
  · rintro ⟨a, b, c, hab, hbc, hca, rfl⟩
    exact is_3_clique_triple_iff.2 ⟨hab, hbc, hca⟩
#align simple_graph.is_3_clique_iff SimpleGraph.is3Clique_iff
-/

end NClique

/-! ### Graphs without cliques -/

section CliqueFree

variable {m n : ℕ}

#print SimpleGraph.CliqueFree /-
/-- `G.clique_free n` means that `G` has no `n`-cliques. -/
def CliqueFree (n : ℕ) : Prop :=
  ∀ t, ¬G.IsNClique n t
#align simple_graph.clique_free SimpleGraph.CliqueFree
-/

variable {G H} {s : Finset α}

#print SimpleGraph.IsNClique.not_cliqueFree /-
theorem IsNClique.not_cliqueFree (hG : G.IsNClique n s) : ¬G.CliqueFree n := fun h => h _ hG
#align simple_graph.is_n_clique.not_clique_free SimpleGraph.IsNClique.not_cliqueFree
-/

/- warning: simple_graph.not_clique_free_of_top_embedding -> SimpleGraph.not_cliqueFree_of_top_embedding is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {G : SimpleGraph.{u1} α} {n : Nat}, (SimpleGraph.Embedding.{0, u1} (Fin n) α (Top.top.{0} (SimpleGraph.{0} (Fin n)) (CompleteLattice.toHasTop.{0} (SimpleGraph.{0} (Fin n)) (Order.Coframe.toCompleteLattice.{0} (SimpleGraph.{0} (Fin n)) (CompleteDistribLattice.toCoframe.{0} (SimpleGraph.{0} (Fin n)) (CompleteBooleanAlgebra.toCompleteDistribLattice.{0} (SimpleGraph.{0} (Fin n)) (SimpleGraph.completeBooleanAlgebra.{0} (Fin n))))))) G) -> (Not (SimpleGraph.CliqueFree.{u1} α G n))
but is expected to have type
  forall {α : Type.{u1}} {G : SimpleGraph.{u1} α} {n : Nat}, (SimpleGraph.Embedding.{0, u1} (Fin n) α (Top.top.{0} (SimpleGraph.{0} (Fin n)) (CompleteLattice.toTop.{0} (SimpleGraph.{0} (Fin n)) (Order.Coframe.toCompleteLattice.{0} (SimpleGraph.{0} (Fin n)) (CompleteDistribLattice.toCoframe.{0} (SimpleGraph.{0} (Fin n)) (CompleteBooleanAlgebra.toCompleteDistribLattice.{0} (SimpleGraph.{0} (Fin n)) (SimpleGraph.completeBooleanAlgebra.{0} (Fin n))))))) G) -> (Not (SimpleGraph.CliqueFree.{u1} α G n))
Case conversion may be inaccurate. Consider using '#align simple_graph.not_clique_free_of_top_embedding SimpleGraph.not_cliqueFree_of_top_embeddingₓ'. -/
theorem not_cliqueFree_of_top_embedding {n : ℕ} (f : (⊤ : SimpleGraph (Fin n)) ↪g G) :
    ¬G.CliqueFree n :=
  by
  simp only [clique_free, is_n_clique_iff, is_clique_iff_induce_eq, not_forall, Classical.not_not]
  use finset.univ.map f.to_embedding
  simp only [card_map, Finset.card_fin, eq_self_iff_true, and_true_iff]
  ext (⟨v, hv⟩⟨w, hw⟩)
  simp only [coe_map, RelEmbedding.coeFn_toEmbedding, Set.mem_image, coe_univ, Set.mem_univ,
    true_and_iff] at hv hw
  obtain ⟨v', rfl⟩ := hv
  obtain ⟨w', rfl⟩ := hw
  simp only [f.map_adj_iff, comap_adj, Function.Embedding.coe_subtype, Subtype.coe_mk, top_adj,
    Ne.def, Subtype.mk_eq_mk]
  exact (Function.Embedding.apply_eq_iff_eq _ _ _).symm.Not
#align simple_graph.not_clique_free_of_top_embedding SimpleGraph.not_cliqueFree_of_top_embedding

/- warning: simple_graph.top_embedding_of_not_clique_free -> SimpleGraph.topEmbeddingOfNotCliqueFree is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {G : SimpleGraph.{u1} α} {n : Nat}, (Not (SimpleGraph.CliqueFree.{u1} α G n)) -> (SimpleGraph.Embedding.{0, u1} (Fin n) α (Top.top.{0} (SimpleGraph.{0} (Fin n)) (CompleteLattice.toHasTop.{0} (SimpleGraph.{0} (Fin n)) (Order.Coframe.toCompleteLattice.{0} (SimpleGraph.{0} (Fin n)) (CompleteDistribLattice.toCoframe.{0} (SimpleGraph.{0} (Fin n)) (CompleteBooleanAlgebra.toCompleteDistribLattice.{0} (SimpleGraph.{0} (Fin n)) (SimpleGraph.completeBooleanAlgebra.{0} (Fin n))))))) G)
but is expected to have type
  forall {α : Type.{u1}} {G : SimpleGraph.{u1} α} {n : Nat}, (Not (SimpleGraph.CliqueFree.{u1} α G n)) -> (SimpleGraph.Embedding.{0, u1} (Fin n) α (Top.top.{0} (SimpleGraph.{0} (Fin n)) (CompleteLattice.toTop.{0} (SimpleGraph.{0} (Fin n)) (Order.Coframe.toCompleteLattice.{0} (SimpleGraph.{0} (Fin n)) (CompleteDistribLattice.toCoframe.{0} (SimpleGraph.{0} (Fin n)) (CompleteBooleanAlgebra.toCompleteDistribLattice.{0} (SimpleGraph.{0} (Fin n)) (SimpleGraph.completeBooleanAlgebra.{0} (Fin n))))))) G)
Case conversion may be inaccurate. Consider using '#align simple_graph.top_embedding_of_not_clique_free SimpleGraph.topEmbeddingOfNotCliqueFreeₓ'. -/
/-- An embedding of a complete graph that witnesses the fact that the graph is not clique-free. -/
noncomputable def topEmbeddingOfNotCliqueFree {n : ℕ} (h : ¬G.CliqueFree n) :
    (⊤ : SimpleGraph (Fin n)) ↪g G :=
  by
  simp only [clique_free, is_n_clique_iff, is_clique_iff_induce_eq, not_forall,
    Classical.not_not] at h
  obtain ⟨ha, hb⟩ := h.some_spec
  have : (⊤ : SimpleGraph (Fin h.some.card)) ≃g (⊤ : SimpleGraph h.some) :=
    by
    apply iso.complete_graph
    simpa using (Fintype.equivFin h.some).symm
  rw [← ha] at this
  convert(embedding.induce ↑h.some).comp this.to_embedding <;> exact hb.symm
#align simple_graph.top_embedding_of_not_clique_free SimpleGraph.topEmbeddingOfNotCliqueFree

/- warning: simple_graph.not_clique_free_iff -> SimpleGraph.not_cliqueFree_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {G : SimpleGraph.{u1} α} (n : Nat), Iff (Not (SimpleGraph.CliqueFree.{u1} α G n)) (Nonempty.{succ u1} (SimpleGraph.Embedding.{0, u1} (Fin n) α (Top.top.{0} (SimpleGraph.{0} (Fin n)) (CompleteLattice.toHasTop.{0} (SimpleGraph.{0} (Fin n)) (Order.Coframe.toCompleteLattice.{0} (SimpleGraph.{0} (Fin n)) (CompleteDistribLattice.toCoframe.{0} (SimpleGraph.{0} (Fin n)) (CompleteBooleanAlgebra.toCompleteDistribLattice.{0} (SimpleGraph.{0} (Fin n)) (SimpleGraph.completeBooleanAlgebra.{0} (Fin n))))))) G))
but is expected to have type
  forall {α : Type.{u1}} {G : SimpleGraph.{u1} α} (n : Nat), Iff (Not (SimpleGraph.CliqueFree.{u1} α G n)) (Nonempty.{succ u1} (SimpleGraph.Embedding.{0, u1} (Fin n) α (Top.top.{0} (SimpleGraph.{0} (Fin n)) (CompleteLattice.toTop.{0} (SimpleGraph.{0} (Fin n)) (Order.Coframe.toCompleteLattice.{0} (SimpleGraph.{0} (Fin n)) (CompleteDistribLattice.toCoframe.{0} (SimpleGraph.{0} (Fin n)) (CompleteBooleanAlgebra.toCompleteDistribLattice.{0} (SimpleGraph.{0} (Fin n)) (SimpleGraph.completeBooleanAlgebra.{0} (Fin n))))))) G))
Case conversion may be inaccurate. Consider using '#align simple_graph.not_clique_free_iff SimpleGraph.not_cliqueFree_iffₓ'. -/
theorem not_cliqueFree_iff (n : ℕ) : ¬G.CliqueFree n ↔ Nonempty ((⊤ : SimpleGraph (Fin n)) ↪g G) :=
  by
  constructor
  · exact fun h => ⟨top_embedding_of_not_clique_free h⟩
  · rintro ⟨f⟩
    exact not_clique_free_of_top_embedding f
#align simple_graph.not_clique_free_iff SimpleGraph.not_cliqueFree_iff

/- warning: simple_graph.clique_free_iff -> SimpleGraph.cliqueFree_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {G : SimpleGraph.{u1} α} {n : Nat}, Iff (SimpleGraph.CliqueFree.{u1} α G n) (IsEmpty.{succ u1} (SimpleGraph.Embedding.{0, u1} (Fin n) α (Top.top.{0} (SimpleGraph.{0} (Fin n)) (CompleteLattice.toHasTop.{0} (SimpleGraph.{0} (Fin n)) (Order.Coframe.toCompleteLattice.{0} (SimpleGraph.{0} (Fin n)) (CompleteDistribLattice.toCoframe.{0} (SimpleGraph.{0} (Fin n)) (CompleteBooleanAlgebra.toCompleteDistribLattice.{0} (SimpleGraph.{0} (Fin n)) (SimpleGraph.completeBooleanAlgebra.{0} (Fin n))))))) G))
but is expected to have type
  forall {α : Type.{u1}} {G : SimpleGraph.{u1} α} {n : Nat}, Iff (SimpleGraph.CliqueFree.{u1} α G n) (IsEmpty.{succ u1} (SimpleGraph.Embedding.{0, u1} (Fin n) α (Top.top.{0} (SimpleGraph.{0} (Fin n)) (CompleteLattice.toTop.{0} (SimpleGraph.{0} (Fin n)) (Order.Coframe.toCompleteLattice.{0} (SimpleGraph.{0} (Fin n)) (CompleteDistribLattice.toCoframe.{0} (SimpleGraph.{0} (Fin n)) (CompleteBooleanAlgebra.toCompleteDistribLattice.{0} (SimpleGraph.{0} (Fin n)) (SimpleGraph.completeBooleanAlgebra.{0} (Fin n))))))) G))
Case conversion may be inaccurate. Consider using '#align simple_graph.clique_free_iff SimpleGraph.cliqueFree_iffₓ'. -/
theorem cliqueFree_iff {n : ℕ} : G.CliqueFree n ↔ IsEmpty ((⊤ : SimpleGraph (Fin n)) ↪g G) := by
  rw [← not_iff_not, not_clique_free_iff, not_isEmpty_iff]
#align simple_graph.clique_free_iff SimpleGraph.cliqueFree_iff

/- warning: simple_graph.not_clique_free_card_of_top_embedding -> SimpleGraph.not_cliqueFree_card_of_top_embedding is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {G : SimpleGraph.{u1} α} [_inst_1 : Fintype.{u1} α], (SimpleGraph.Embedding.{u1, u1} α α (Top.top.{u1} (SimpleGraph.{u1} α) (CompleteLattice.toHasTop.{u1} (SimpleGraph.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (SimpleGraph.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (SimpleGraph.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (SimpleGraph.{u1} α) (SimpleGraph.completeBooleanAlgebra.{u1} α)))))) G) -> (Not (SimpleGraph.CliqueFree.{u1} α G (Fintype.card.{u1} α _inst_1)))
but is expected to have type
  forall {α : Type.{u1}} {G : SimpleGraph.{u1} α} [_inst_1 : Fintype.{u1} α], (SimpleGraph.Embedding.{u1, u1} α α (Top.top.{u1} (SimpleGraph.{u1} α) (CompleteLattice.toTop.{u1} (SimpleGraph.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (SimpleGraph.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (SimpleGraph.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (SimpleGraph.{u1} α) (SimpleGraph.completeBooleanAlgebra.{u1} α)))))) G) -> (Not (SimpleGraph.CliqueFree.{u1} α G (Fintype.card.{u1} α _inst_1)))
Case conversion may be inaccurate. Consider using '#align simple_graph.not_clique_free_card_of_top_embedding SimpleGraph.not_cliqueFree_card_of_top_embeddingₓ'. -/
theorem not_cliqueFree_card_of_top_embedding [Fintype α] (f : (⊤ : SimpleGraph α) ↪g G) :
    ¬G.CliqueFree (card α) := by
  rw [not_clique_free_iff]
  use (iso.complete_graph (Fintype.equivFin α)).symm.toEmbedding.trans f
#align simple_graph.not_clique_free_card_of_top_embedding SimpleGraph.not_cliqueFree_card_of_top_embedding

/- warning: simple_graph.clique_free_bot -> SimpleGraph.cliqueFree_bot is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {n : Nat}, (LE.le.{0} Nat Nat.hasLe (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne)))) n) -> (SimpleGraph.CliqueFree.{u1} α (Bot.bot.{u1} (SimpleGraph.{u1} α) (CompleteLattice.toHasBot.{u1} (SimpleGraph.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (SimpleGraph.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (SimpleGraph.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (SimpleGraph.{u1} α) (SimpleGraph.completeBooleanAlgebra.{u1} α)))))) n)
but is expected to have type
  forall {α : Type.{u1}} {n : Nat}, (LE.le.{0} Nat instLENat (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2)) n) -> (SimpleGraph.CliqueFree.{u1} α (Bot.bot.{u1} (SimpleGraph.{u1} α) (CompleteLattice.toBot.{u1} (SimpleGraph.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (SimpleGraph.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (SimpleGraph.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (SimpleGraph.{u1} α) (SimpleGraph.completeBooleanAlgebra.{u1} α)))))) n)
Case conversion may be inaccurate. Consider using '#align simple_graph.clique_free_bot SimpleGraph.cliqueFree_botₓ'. -/
theorem cliqueFree_bot (h : 2 ≤ n) : (⊥ : SimpleGraph α).CliqueFree n :=
  by
  rintro t ht
  rw [is_n_clique_bot_iff] at ht
  linarith
#align simple_graph.clique_free_bot SimpleGraph.cliqueFree_bot

#print SimpleGraph.CliqueFree.mono /-
theorem CliqueFree.mono (h : m ≤ n) : G.CliqueFree m → G.CliqueFree n :=
  by
  rintro hG s hs
  obtain ⟨t, hts, ht⟩ := s.exists_smaller_set _ (h.trans hs.card_eq.ge)
  exact hG _ ⟨hs.clique.subset hts, ht⟩
#align simple_graph.clique_free.mono SimpleGraph.CliqueFree.mono
-/

#print SimpleGraph.CliqueFree.anti /-
theorem CliqueFree.anti (h : G ≤ H) : H.CliqueFree n → G.CliqueFree n :=
  forall_imp fun s => mt <| IsNClique.mono h
#align simple_graph.clique_free.anti SimpleGraph.CliqueFree.anti
-/

#print SimpleGraph.cliqueFree_of_card_lt /-
/-- See `simple_graph.clique_free_chromatic_number_succ` for a tighter bound. -/
theorem cliqueFree_of_card_lt [Fintype α] (hc : card α < n) : G.CliqueFree n :=
  by
  by_contra h
  refine' Nat.lt_le_antisymm hc _
  rw [clique_free_iff, not_isEmpty_iff] at h
  simpa using Fintype.card_le_of_embedding h.some.to_embedding
#align simple_graph.clique_free_of_card_lt SimpleGraph.cliqueFree_of_card_lt
-/

end CliqueFree

/-! ### Set of cliques -/

section CliqueSet

variable (G) {n : ℕ} {a b c : α} {s : Finset α}

#print SimpleGraph.cliqueSet /-
/-- The `n`-cliques in a graph as a set. -/
def cliqueSet (n : ℕ) : Set (Finset α) :=
  { s | G.IsNClique n s }
#align simple_graph.clique_set SimpleGraph.cliqueSet
-/

#print SimpleGraph.mem_cliqueSet_iff /-
theorem mem_cliqueSet_iff : s ∈ G.cliqueSet n ↔ G.IsNClique n s :=
  Iff.rfl
#align simple_graph.mem_clique_set_iff SimpleGraph.mem_cliqueSet_iff
-/

#print SimpleGraph.cliqueSet_eq_empty_iff /-
@[simp]
theorem cliqueSet_eq_empty_iff : G.cliqueSet n = ∅ ↔ G.CliqueFree n := by
  simp_rw [clique_free, Set.eq_empty_iff_forall_not_mem, mem_clique_set_iff]
#align simple_graph.clique_set_eq_empty_iff SimpleGraph.cliqueSet_eq_empty_iff
-/

alias clique_set_eq_empty_iff ↔ _ clique_free.clique_set
#align simple_graph.clique_free.clique_set SimpleGraph.CliqueFree.cliqueSet

attribute [protected] clique_free.clique_set

variable {G H}

#print SimpleGraph.cliqueSet_mono /-
@[mono]
theorem cliqueSet_mono (h : G ≤ H) : G.cliqueSet n ⊆ H.cliqueSet n := fun _ => IsNClique.mono h
#align simple_graph.clique_set_mono SimpleGraph.cliqueSet_mono
-/

#print SimpleGraph.cliqueSet_mono' /-
theorem cliqueSet_mono' (h : G ≤ H) : G.cliqueSet ≤ H.cliqueSet := fun _ => cliqueSet_mono h
#align simple_graph.clique_set_mono' SimpleGraph.cliqueSet_mono'
-/

end CliqueSet

/-! ### Finset of cliques -/

section CliqueFinset

variable (G) [Fintype α] [DecidableEq α] [DecidableRel G.Adj] {n : ℕ} {a b c : α} {s : Finset α}

#print SimpleGraph.cliqueFinset /-
/-- The `n`-cliques in a graph as a finset. -/
def cliqueFinset (n : ℕ) : Finset (Finset α) :=
  univ.filterₓ <| G.IsNClique n
#align simple_graph.clique_finset SimpleGraph.cliqueFinset
-/

#print SimpleGraph.mem_cliqueFinset_iff /-
theorem mem_cliqueFinset_iff : s ∈ G.cliqueFinset n ↔ G.IsNClique n s :=
  mem_filter.trans <| and_iff_right <| mem_univ _
#align simple_graph.mem_clique_finset_iff SimpleGraph.mem_cliqueFinset_iff
-/

#print SimpleGraph.coe_cliqueFinset /-
@[simp]
theorem coe_cliqueFinset (n : ℕ) : (G.cliqueFinset n : Set (Finset α)) = G.cliqueSet n :=
  Set.ext fun _ => mem_cliqueFinset_iff _
#align simple_graph.coe_clique_finset SimpleGraph.coe_cliqueFinset
-/

#print SimpleGraph.cliqueFinset_eq_empty_iff /-
@[simp]
theorem cliqueFinset_eq_empty_iff : G.cliqueFinset n = ∅ ↔ G.CliqueFree n := by
  simp_rw [clique_free, eq_empty_iff_forall_not_mem, mem_clique_finset_iff]
#align simple_graph.clique_finset_eq_empty_iff SimpleGraph.cliqueFinset_eq_empty_iff
-/

alias clique_finset_eq_empty_iff ↔ _ _root_.simple_graph.clique_free.clique_finset
#align simple_graph.clique_free.clique_finset SimpleGraph.CliqueFree.cliqueFinset

attribute [protected] clique_free.clique_finset

variable {G} [DecidableRel H.Adj]

#print SimpleGraph.cliqueFinset_mono /-
@[mono]
theorem cliqueFinset_mono (h : G ≤ H) : G.cliqueFinset n ⊆ H.cliqueFinset n :=
  monotone_filter_right _ fun _ => IsNClique.mono h
#align simple_graph.clique_finset_mono SimpleGraph.cliqueFinset_mono
-/

end CliqueFinset

end SimpleGraph


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.analysis.convex.basic
import Mathlib.linear_algebra.finite_dimensional
import Mathlib.PostPort

universes u

namespace Mathlib

/-!
# Carathéodory's convexity theorem

This file is devoted to proving Carathéodory's convexity theorem:
The convex hull of a set `s` in ℝᵈ is the union of the convex hulls of the (d+1)-tuples in `s`.

## Main results:

* `convex_hull_eq_union`: Carathéodory's convexity theorem

## Implementation details

This theorem was formalized as part of the Sphere Eversion project.

## Tags
convex hull, caratheodory

-/

namespace caratheodory

/--
If `x` is in the convex hull of some finset `t` with strictly more than `findim + 1` elements,
then it is in the union of the convex hulls of the finsets `t.erase y` for `y ∈ t`.
-/
theorem mem_convex_hull_erase {E : Type u} [add_comm_group E] [vector_space ℝ E]
    [finite_dimensional ℝ E] [DecidableEq E] {t : finset E}
    (h : finite_dimensional.findim ℝ E + 1 < finset.card t) {x : E} (m : x ∈ convex_hull ↑t) :
    ∃ (y : ↥↑t), x ∈ convex_hull ↑(finset.erase t ↑y) :=
  sorry

/--
The convex hull of a finset `t` with `findim ℝ E + 1 < t.card` is equal to
the union of the convex hulls of the finsets `t.erase x` for `x ∈ t`.
-/
theorem step {E : Type u} [add_comm_group E] [vector_space ℝ E] [finite_dimensional ℝ E]
    [DecidableEq E] (t : finset E) (h : finite_dimensional.findim ℝ E + 1 < finset.card t) :
    convex_hull ↑t = set.Union fun (x : ↥↑t) => convex_hull ↑(finset.erase t ↑x) :=
  sorry

/--
The convex hull of a finset `t` with `findim ℝ E + 1 < t.card` is contained in
the union of the convex hulls of the finsets `t' ⊆ t` with `t'.card ≤ findim ℝ E + 1`.
-/
theorem shrink' {E : Type u} [add_comm_group E] [vector_space ℝ E] [finite_dimensional ℝ E]
    (t : finset E) (k : ℕ) (h : finset.card t = finite_dimensional.findim ℝ E + 1 + k) :
    convex_hull ↑t ⊆
        set.Union
          fun (t' : finset E) =>
            set.Union
              fun (w : t' ⊆ t) =>
                set.Union
                  fun (b : finset.card t' ≤ finite_dimensional.findim ℝ E + 1) => convex_hull ↑t' :=
  sorry

/--
The convex hull of any finset `t` is contained in
the union of the convex hulls of the finsets `t' ⊆ t` with `t'.card ≤ findim ℝ E + 1`.
-/
theorem shrink {E : Type u} [add_comm_group E] [vector_space ℝ E] [finite_dimensional ℝ E]
    (t : finset E) :
    convex_hull ↑t ⊆
        set.Union
          fun (t' : finset E) =>
            set.Union
              fun (w : t' ⊆ t) =>
                set.Union
                  fun (b : finset.card t' ≤ finite_dimensional.findim ℝ E + 1) => convex_hull ↑t' :=
  sorry

end caratheodory

/--
One inclusion of Carathéodory's convexity theorem.

The convex hull of a set `s` in ℝᵈ is contained in
the union of the convex hulls of the (d+1)-tuples in `s`.
-/
theorem convex_hull_subset_union {E : Type u} [add_comm_group E] [vector_space ℝ E]
    [finite_dimensional ℝ E] (s : set E) :
    convex_hull s ⊆
        set.Union
          fun (t : finset E) =>
            set.Union
              fun (w : ↑t ⊆ s) =>
                set.Union
                  fun (b : finset.card t ≤ finite_dimensional.findim ℝ E + 1) => convex_hull ↑t :=
  sorry

/--
Carathéodory's convexity theorem.

The convex hull of a set `s` in ℝᵈ is the union of the convex hulls of the (d+1)-tuples in `s`.
-/
theorem convex_hull_eq_union {E : Type u} [add_comm_group E] [vector_space ℝ E]
    [finite_dimensional ℝ E] (s : set E) :
    convex_hull s =
        set.Union
          fun (t : finset E) =>
            set.Union
              fun (w : ↑t ⊆ s) =>
                set.Union
                  fun (b : finset.card t ≤ finite_dimensional.findim ℝ E + 1) => convex_hull ↑t :=
  sorry

/--
A more explicit formulation of Carathéodory's convexity theorem,
writing an element of a convex hull as the center of mass
of an explicit `finset` with cardinality at most `dim + 1`.
-/
theorem eq_center_mass_card_le_dim_succ_of_mem_convex_hull {E : Type u} [add_comm_group E]
    [vector_space ℝ E] [finite_dimensional ℝ E] {s : set E} {x : E} (h : x ∈ convex_hull s) :
    ∃ (t : finset E),
        ∃ (w : ↑t ⊆ s),
          ∃ (b : finset.card t ≤ finite_dimensional.findim ℝ E + 1),
            ∃ (f : E → ℝ),
              (∀ (y : E), y ∈ t → 0 ≤ f y) ∧ finset.sum t f = 1 ∧ finset.center_mass t f id = x :=
  sorry

/--
A variation on Carathéodory's convexity theorem,
writing an element of a convex hull as a center of mass
of an explicit `finset` with cardinality at most `dim + 1`,
where all coefficients in the center of mass formula
are strictly positive.

(This is proved using `eq_center_mass_card_le_dim_succ_of_mem_convex_hull`,
and discarding any elements of the set with coefficient zero.)
-/
theorem eq_pos_center_mass_card_le_dim_succ_of_mem_convex_hull {E : Type u} [add_comm_group E]
    [vector_space ℝ E] [finite_dimensional ℝ E] {s : set E} {x : E} (h : x ∈ convex_hull s) :
    ∃ (t : finset E),
        ∃ (w : ↑t ⊆ s),
          ∃ (b : finset.card t ≤ finite_dimensional.findim ℝ E + 1),
            ∃ (f : E → ℝ),
              (∀ (y : E), y ∈ t → 0 < f y) ∧ finset.sum t f = 1 ∧ finset.center_mass t f id = x :=
  sorry

end Mathlib


lemma one_pow (m : mynat) : (1 : mynat) ^ m = 1 :=
begin
induction m with h hd,
rwa pow_zero,
rw pow_succ,
rw hd,
refl,
end


import topology.basic
import data.nat.prime
#check topological_space

open nat

-- clear id*

-- clear h₁ ... hₙ tries to clear each hypothesis hᵢ from the local context.

lemma two_is_prime : prime 2 :=
begin
  unfold prime,
  have h_two_le_two : 2 <= 2, from dec_trivial,
  -- have h0: ∀ (x: Prop), true ∧ x, from begin

  -- end
  trace_simp_set  only [h_two_le_two],
  -- simplification rules for iff
  -- [h_two_le_two] #0, 2 ≤ 2 ↦ true
  simp only [h_two_le_two],
  -- simp only [and.elim_right],
  type_check h_two_le_two, -- 2 <= 2
  trace_simp_set [h_two_le_two],
  trace (2+5), -- 7
  simp,
  introv h_m_mod_2_is_0,
  simp [(∣)] at h_m_mod_2_is_0,
  admit,
end

#print two_is_prime

lemma eq_2 : ∀ (m : ℕ), m = 2 → prime m :=
begin
  intros,
  rw a,
  exact two_is_prime,
end

#print eq_2
-- theorem eq_2 : ∀ (m : ℕ), m = 2 → m.prime :=
-- λ (m : ℕ) (a : m = 2),
--   (id ((eq.refl m.prime).rec a)).mpr two_is_prime


import data.list.join
import data.set.lattice

/- # language -/
/- 这个文件定义了对字母表上的正则语言的定义和操作。注意: 字符串是作为字母表上的列表实现的。-/
open list set

universes v
variables {α β γ : Type*}
/- 一个语言是一个字母表`α`上的串的集合-/
/- derive utilities -/
/- derive complete_boolean_algebra则是因为正则语言可以交并补 -/
/- A Boolean algebra is a bounded distributive lattice with a complement operator `c`
 - such that `x ⊓ c(x) = ⊥` and `x ⊔ x = ⊤`. For convenience, it must also provice a set
 - difference operation '\' statisfying `x \ y = x ⊓ c(y)`
 - [https://en.wikipedia.org/wiki/Complete_Boolean_algebra]
 - [https://zh.wikipedia.org/wiki/%E5%B8%83%E5%B0%94%E4%BB%A3%E6%95%B0]
 -/
@[derive [has_mem (list α), has_singleton (list α), has_insert (list α), complete_boolean_algebra]]
def language (α) := set (list α)

namespace language
variables {l m: language α} {a b x: list α}
local attribute [reducible] language

/- 空语言没有元素 -/
instance : has_zero (language α) := ⟨(∅ : set _)⟩
/- `1: language α` 接受空串的语言 -/
instance : has_one (language α) := ⟨{[]}⟩
instance : inhabited (language α) := ⟨0⟩
/- 可以并 -/
instance : has_add (language α) := ⟨(∪)⟩
/- 可以笛卡尔积 -/
instance : has_mul (language α) := ⟨image2 (++)⟩

lemma zero_def : (0: language α) = (∅ : set _) := rfl
lemma one_def : (1: language α) = {[]} := rfl

lemma add_def (l m : language α) : l + m = l ∪ m := rfl
lemma mul_def (l m : language α) : l * m = image2 (++) l m := rfl

/- 定义克林闭包运算,这里没有采用结构归纳定义,使用了字符串拼接来定义 -/
/- 这个定义的意思是：语言`l`的克林闭包里的每一个元素，都可以由`l`里的-/
/- 任意多个串拼接而成-/
/- 例如`l={0,1}`, `0101 ∈ l*`, `0101=[0,1,0,1].join`-/
def star (l : language α) : language α :=
{x| ∃ S: list (list α), x = S.join ∧ ∀ y∈ S, y ∈ l}
lemma star_def (l: language α) :
  l.star = {x| ∃ S: list (list α), x = S.join ∧ ∀ y∈ S, y ∈ l} := rfl

@[simp] lemma not_mem_zero (x:list α) : x∉ (0:language α) := id
@[simp] lemma mem_one (x:list α) : x∈ (1:language α) ↔ x = [] := by refl
lemma nil_mem_one : [] ∈ (1 : language α) := set.mem_singleton _
@[simp] lemma mem_add (l m: language α) (x : list α) : x∈ l+m ↔ x ∈ l ∨ x ∈ m := iff.rfl
lemma mem_mul : x ∈ l * m ↔ ∃ a b, a ∈ l ∧ b ∈ m ∧ a ++ b = x := mem_image2
lemma append_mem_mul : a ∈ l → b ∈ m → a++b ∈ l*m := mem_image2_of_mem
lemma mem_star : x ∈ l.star ↔ ∃ S : list (list α), x = S.join ∧ ∀ y ∈ S, y∈ l := iff.rfl
lemma join_mem_star {S: list (list α)} (h: ∀ y∈ S, y∈ l) : S.join ∈ l.star :=
⟨S, rfl, h⟩
lemma nil_mem_star (l : language α): [] ∈ l.star := ⟨[], rfl, λ _, false.elim⟩

/- 正则语言的半环结构 -/
instance : semiring (language α) :=
{ add := (+),
  add_assoc := union_assoc,
  zero := 0,
  zero_add := empty_union,
  add_zero := union_empty,
  add_comm := union_comm,
  mul := (*),
  mul_assoc := λ _ _ _, image2_assoc append_assoc,
  zero_mul := λ _, image2_empty_left,
  mul_zero := λ _, image2_empty_right,
  one := 1,
  one_mul := λ l, by simp [mul_def, one_def],
  mul_one := λ l, by simp [mul_def, one_def],
  left_distrib := λ _ _ _, image2_union_right,
  right_distrib := λ _ _ _, image2_union_left}

@[simp] lemma add_self (l : language α) : l + l = l := sup_idem

/- Ring homomorphism -/
def map (f : α → β) : language α →+* language β :=
{ to_fun := image (list.map f),
  map_zero' := image_empty _,
  map_one' := image_singleton,
  map_add' := image_union _,
  map_mul' := λ _ _, image_image2_distrib $ map_append _}
end language


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Bhavik Mehta
-/
import category_theory.limits.preserves.basic

/-!
# Isomorphisms about functors which preserve (co)limits

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

If `G` preserves limits, and `C` and `D` have limits, then for any diagram `F : J ⥤ C` we have a
canonical isomorphism `preserves_limit_iso : G.obj (limit F) ≅ limit (F ⋙ G)`.
We also show that we can commute `is_limit.lift` of a preserved limit with `functor.map_cone`:
`(preserves_limit.preserves t).lift (G.map_cone c₂) = G.map (t.lift c₂)`.

The duals of these are also given. For functors which preserve (co)limits of specific shapes, see
`preserves/shapes.lean`.
-/

universes w' w v₁ v₂ u₁ u₂

noncomputable theory

namespace category_theory

open category limits

variables {C : Type u₁} [category.{v₁} C]
variables {D : Type u₂} [category.{v₂} D]
variables (G : C ⥤ D)
variables {J : Type w} [category.{w'} J]
variables (F : J ⥤ C)

section
variables [preserves_limit F G]

@[simp]
lemma preserves_lift_map_cone (c₁ c₂ : cone F) (t : is_limit c₁) :
  (preserves_limit.preserves t).lift (G.map_cone c₂) = G.map (t.lift c₂) :=
((preserves_limit.preserves t).uniq (G.map_cone c₂) _ (by simp [← G.map_comp])).symm

variables [has_limit F] [has_limit (F ⋙ G)]
/--
If `G` preserves limits, we have an isomorphism from the image of the limit of a functor `F`
to the limit of the functor `F ⋙ G`.
-/
def preserves_limit_iso : G.obj (limit F) ≅ limit (F ⋙ G) :=
(preserves_limit.preserves (limit.is_limit _)).cone_point_unique_up_to_iso (limit.is_limit _)

@[simp, reassoc]
lemma preserves_limits_iso_hom_π (j) :
  (preserves_limit_iso G F).hom ≫ limit.π _ j = G.map (limit.π F j) :=
is_limit.cone_point_unique_up_to_iso_hom_comp _ _ j

@[simp, reassoc]
lemma preserves_limits_iso_inv_π (j) :
  (preserves_limit_iso G F).inv ≫ G.map (limit.π F j) = limit.π _ j :=
is_limit.cone_point_unique_up_to_iso_inv_comp _ _ j

@[simp, reassoc]
lemma lift_comp_preserves_limits_iso_hom (t : cone F) :
  G.map (limit.lift _ t) ≫ (preserves_limit_iso G F).hom = limit.lift (F ⋙ G) (G.map_cone _) :=
by { ext, simp [← G.map_comp] }

variables [preserves_limits_of_shape J G] [has_limits_of_shape J D] [has_limits_of_shape J C]

/-- If `C, D` has all limits of shape `J`, and `G` preserves them, then `preserves_limit_iso` is
functorial wrt `F`. -/
@[simps] def preserves_limit_nat_iso : lim ⋙ G ≅ (whiskering_right J C D).obj G ⋙ lim :=
nat_iso.of_components (λ F, preserves_limit_iso G F)
begin
  intros _ _ f,
  ext,
  dsimp,
  simp only [preserves_limits_iso_hom_π, whisker_right_app, lim_map_π, category.assoc,
    preserves_limits_iso_hom_π_assoc, ← G.map_comp]
end

end

section
variables [preserves_colimit F G]

@[simp]
lemma preserves_desc_map_cocone (c₁ c₂ : cocone F) (t : is_colimit c₁) :
  (preserves_colimit.preserves t).desc (G.map_cocone _) = G.map (t.desc c₂) :=
((preserves_colimit.preserves t).uniq (G.map_cocone _) _ (by simp [← G.map_comp])).symm

variables [has_colimit F] [has_colimit (F ⋙ G)]
/--
If `G` preserves colimits, we have an isomorphism from the image of the colimit of a functor `F`
to the colimit of the functor `F ⋙ G`.
-/
-- TODO: think about swapping the order here
def preserves_colimit_iso : G.obj (colimit F) ≅ colimit (F ⋙ G) :=
(preserves_colimit.preserves (colimit.is_colimit _)).cocone_point_unique_up_to_iso
  (colimit.is_colimit _)

@[simp, reassoc]
lemma ι_preserves_colimits_iso_inv (j : J) :
  colimit.ι _ j ≫ (preserves_colimit_iso G F).inv = G.map (colimit.ι F j) :=
is_colimit.comp_cocone_point_unique_up_to_iso_inv _ (colimit.is_colimit (F ⋙ G)) j

@[simp, reassoc]
lemma ι_preserves_colimits_iso_hom (j : J) :
  G.map (colimit.ι F j) ≫ (preserves_colimit_iso G F).hom = colimit.ι (F ⋙ G) j :=
(preserves_colimit.preserves (colimit.is_colimit _)).comp_cocone_point_unique_up_to_iso_hom _ j

@[simp, reassoc]
lemma preserves_colimits_iso_inv_comp_desc (t : cocone F) :
  (preserves_colimit_iso G F).inv ≫ G.map (colimit.desc _ t) = colimit.desc _ (G.map_cocone t) :=
by { ext, simp [← G.map_comp] }

variables [preserves_colimits_of_shape J G] [has_colimits_of_shape J D] [has_colimits_of_shape J C]

/-- If `C, D` has all colimits of shape `J`, and `G` preserves them, then `preserves_colimit_iso`
is functorial wrt `F`. -/
@[simps] def preserves_colimit_nat_iso : colim ⋙ G ≅ (whiskering_right J C D).obj G ⋙ colim :=
nat_iso.of_components (λ F, preserves_colimit_iso G F)
begin
  intros _ _ f,
  rw [← iso.inv_comp_eq, ← category.assoc, ← iso.eq_comp_inv],
  ext,
  dsimp,
  erw ι_colim_map_assoc,
  simp only [ι_preserves_colimits_iso_inv, whisker_right_app, category.assoc,
    ι_preserves_colimits_iso_inv_assoc, ← G.map_comp],
  erw ι_colim_map
end

end

end category_theory


/-
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
-/
import combinatorics.simple_graph.density
import set_theory.ordinal.basic

/-!
# Graph uniformity and uniform partitions

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

In this file we define uniformity of a pair of vertices in a graph and uniformity of a partition of
vertices of a graph. Both are also known as ε-regularity.

Finsets of vertices `s` and `t` are `ε`-uniform in a graph `G` if their edge density is at most
`ε`-far from the density of any big enough `s'` and `t'` where `s' ⊆ s`, `t' ⊆ t`.
The definition is pretty technical, but it amounts to the edges between `s` and `t` being "random"
The literature contains several definitions which are equivalent up to scaling `ε` by some constant
when the partition is equitable.

A partition `P` of the vertices is `ε`-uniform if the proportion of non `ε`-uniform pairs of parts
is less than `ε`.

## Main declarations

* `simple_graph.is_uniform`: Graph uniformity of a pair of finsets of vertices.
* `simple_graph.nonuniform_witness`: `G.nonuniform_witness ε s t` and `G.nonuniform_witness ε t s`
  together witness the non-uniformity of `s` and `t`.
* `finpartition.non_uniforms`: Non uniform pairs of parts of a partition.
* `finpartition.is_uniform`: Uniformity of a partition.
* `finpartition.nonuniform_witnesses`: For each non-uniform pair of parts of a partition, pick
  witnesses of non-uniformity and dump them all together.
-/

open finset

variables {α 𝕜 : Type*} [linear_ordered_field 𝕜]

/-! ###  Graph uniformity -/

namespace simple_graph
variables (G : simple_graph α) [decidable_rel G.adj] (ε : 𝕜) {s t : finset α} {a b : α}

/-- A pair of finsets of vertices is `ε`-uniform (aka `ε`-regular) iff their edge density is close
to the density of any big enough pair of subsets. Intuitively, the edges between them are
random-like. -/
def is_uniform (s t : finset α) : Prop :=
∀ ⦃s'⦄, s' ⊆ s → ∀ ⦃t'⦄, t' ⊆ t → (s.card : 𝕜) * ε ≤ s'.card → (t.card : 𝕜) * ε ≤ t'.card →
  |(G.edge_density s' t' : 𝕜) - (G.edge_density s t : 𝕜)| < ε

variables {G ε}

lemma is_uniform.mono {ε' : 𝕜} (h : ε ≤ ε') (hε : is_uniform G ε s t) : is_uniform G ε' s t :=
λ s' hs' t' ht' hs ht, by refine (hε hs' ht' (le_trans _ hs) (le_trans _ ht)).trans_le h;
  exact mul_le_mul_of_nonneg_left h (nat.cast_nonneg _)

lemma is_uniform.symm : symmetric (is_uniform G ε) :=
λ s t h t' ht' s' hs' ht hs,
  by { rw [edge_density_comm _ t', edge_density_comm _ t], exact h hs' ht' hs ht }

variables (G)

lemma is_uniform_comm : is_uniform G ε s t ↔ is_uniform G ε t s := ⟨λ h, h.symm, λ h, h.symm⟩

lemma is_uniform_singleton (hε : 0 < ε) : G.is_uniform ε {a} {b} :=
begin
  intros s' hs' t' ht' hs ht,
  rw [card_singleton, nat.cast_one, one_mul] at hs ht,
  obtain rfl | rfl := finset.subset_singleton_iff.1 hs',
  { replace hs : ε ≤ 0 := by simpa using hs,
    exact (hε.not_le hs).elim },
  obtain rfl | rfl := finset.subset_singleton_iff.1 ht',
  { replace ht : ε ≤ 0 := by simpa using ht,
    exact (hε.not_le ht).elim },
  { rwa [sub_self, abs_zero] }
end

lemma not_is_uniform_zero : ¬ G.is_uniform (0 : 𝕜) s t :=
λ h, (abs_nonneg _).not_lt $ h (empty_subset _) (empty_subset _) (by simp) (by simp)

lemma is_uniform_one : G.is_uniform (1 : 𝕜) s t :=
begin
  intros s' hs' t' ht' hs ht,
  rw mul_one at hs ht,
  rw [eq_of_subset_of_card_le hs' (nat.cast_le.1 hs),
    eq_of_subset_of_card_le ht' (nat.cast_le.1 ht), sub_self, abs_zero],
  exact zero_lt_one,
end

variables {G}

lemma not_is_uniform_iff :
  ¬ G.is_uniform ε s t ↔ ∃ s', s' ⊆ s ∧ ∃ t', t' ⊆ t ∧ ↑s.card * ε ≤ s'.card ∧
    ↑t.card * ε ≤ t'.card ∧  ε ≤ |G.edge_density s' t' - G.edge_density s t| :=
by { unfold is_uniform, simp only [not_forall, not_lt, exists_prop] }

open_locale classical
variables (G)

/-- An arbitrary pair of subsets witnessing the non-uniformity of `(s, t)`. If `(s, t)` is uniform,
returns `(s, t)`. Witnesses for `(s, t)` and `(t, s)` don't necessarily match. See
`simple_graph.nonuniform_witness`. -/
noncomputable def nonuniform_witnesses (ε : 𝕜) (s t : finset α) : finset α × finset α :=
if h : ¬ G.is_uniform ε s t
  then ((not_is_uniform_iff.1 h).some, (not_is_uniform_iff.1 h).some_spec.2.some)
  else (s, t)

lemma left_nonuniform_witnesses_subset (h : ¬ G.is_uniform ε s t) :
  (G.nonuniform_witnesses ε s t).1 ⊆ s :=
by { rw [nonuniform_witnesses, dif_pos h], exact (not_is_uniform_iff.1 h).some_spec.1 }

lemma left_nonuniform_witnesses_card (h : ¬ G.is_uniform ε s t) :
  (s.card : 𝕜) * ε ≤ (G.nonuniform_witnesses ε s t).1.card :=
by { rw [nonuniform_witnesses, dif_pos h],
  exact (not_is_uniform_iff.1 h).some_spec.2.some_spec.2.1 }

lemma right_nonuniform_witnesses_subset (h : ¬ G.is_uniform ε s t) :
  (G.nonuniform_witnesses ε s t).2 ⊆ t :=
by { rw [nonuniform_witnesses, dif_pos h], exact (not_is_uniform_iff.1 h).some_spec.2.some_spec.1 }

lemma right_nonuniform_witnesses_card (h : ¬ G.is_uniform ε s t) :
  (t.card : 𝕜) * ε ≤ (G.nonuniform_witnesses ε s t).2.card :=
by { rw [nonuniform_witnesses, dif_pos h],
  exact (not_is_uniform_iff.1 h).some_spec.2.some_spec.2.2.1 }

lemma nonuniform_witnesses_spec (h : ¬ G.is_uniform ε s t) :
  ε ≤ |G.edge_density (G.nonuniform_witnesses ε s t).1 (G.nonuniform_witnesses ε s t).2
    - G.edge_density s t| :=
by { rw [nonuniform_witnesses, dif_pos h],
  exact (not_is_uniform_iff.1 h).some_spec.2.some_spec.2.2.2 }

/-- Arbitrary witness of non-uniformity. `G.nonuniform_witness ε s t` and
`G.nonuniform_witness ε t s` form a pair of subsets witnessing the non-uniformity of `(s, t)`. If
`(s, t)` is uniform, returns `s`. -/
noncomputable def nonuniform_witness (ε : 𝕜) (s t : finset α) : finset α :=
if well_ordering_rel s t then (G.nonuniform_witnesses ε s t).1 else (G.nonuniform_witnesses ε t s).2

lemma nonuniform_witness_subset (h : ¬ G.is_uniform ε s t) : G.nonuniform_witness ε s t ⊆ s :=
begin
  unfold nonuniform_witness,
  split_ifs,
  { exact G.left_nonuniform_witnesses_subset h },
  { exact G.right_nonuniform_witnesses_subset (λ i, h i.symm) }
end

lemma nonuniform_witness_card_le (h : ¬ G.is_uniform ε s t) :
  (s.card : 𝕜) * ε ≤ (G.nonuniform_witness ε s t).card :=
begin
  unfold nonuniform_witness,
  split_ifs,
  { exact G.left_nonuniform_witnesses_card h },
  { exact G.right_nonuniform_witnesses_card (λ i, h i.symm) }
end

lemma nonuniform_witness_spec (h₁ : s ≠ t) (h₂ : ¬ G.is_uniform ε s t) :
  ε ≤ |G.edge_density (G.nonuniform_witness ε s t) (G.nonuniform_witness ε t s)
    - G.edge_density s t| :=
begin
  unfold nonuniform_witness,
  rcases trichotomous_of well_ordering_rel s t with lt | rfl | gt,
  { rw [if_pos lt, if_neg (asymm lt)],
    exact G.nonuniform_witnesses_spec h₂ },
  { cases h₁ rfl },
  { rw [if_neg (asymm gt), if_pos gt, edge_density_comm, edge_density_comm _ s],
    apply G.nonuniform_witnesses_spec (λ i, h₂ i.symm) }
end

end simple_graph

/-! ### Uniform partitions -/

variables [decidable_eq α] {A : finset α} (P : finpartition A) (G : simple_graph α)
  [decidable_rel G.adj] {ε : 𝕜}

namespace finpartition
open_locale classical

/-- The pairs of parts of a partition `P` which are not `ε`-uniform in a graph `G`. Note that we
dismiss the diagonal. We do not care whether `s` is `ε`-uniform with itself. -/
noncomputable def non_uniforms (ε : 𝕜) : finset (finset α × finset α) :=
P.parts.off_diag.filter $ λ uv, ¬G.is_uniform ε uv.1 uv.2

lemma mk_mem_non_uniforms_iff (u v : finset α) (ε : 𝕜) :
  (u, v) ∈ P.non_uniforms G ε ↔ u ∈ P.parts ∧ v ∈ P.parts ∧ u ≠ v ∧ ¬G.is_uniform ε u v :=
by rw [non_uniforms, mem_filter, mem_off_diag, and_assoc, and_assoc]

lemma non_uniforms_mono {ε ε' : 𝕜} (h : ε ≤ ε') : P.non_uniforms G ε' ⊆ P.non_uniforms G ε :=
monotone_filter_right _ $ λ uv, mt $ simple_graph.is_uniform.mono h

lemma non_uniforms_bot (hε : 0 < ε) : (⊥ : finpartition A).non_uniforms G ε = ∅ :=
begin
  rw eq_empty_iff_forall_not_mem,
  rintro ⟨u, v⟩,
  simp only [finpartition.mk_mem_non_uniforms_iff, finpartition.parts_bot, mem_map, not_and,
    not_not, exists_imp_distrib],
  rintro x hx rfl y hy rfl h,
  exact G.is_uniform_singleton hε,
end

/-- A finpartition of a graph's vertex set is `ε`-uniform (aka `ε`-regular) iff the proportion of
its pairs of parts that are not `ε`-uniform is at most `ε`. -/
def is_uniform (ε : 𝕜) : Prop :=
((P.non_uniforms G ε).card : 𝕜) ≤ (P.parts.card * (P.parts.card - 1) : ℕ) * ε

lemma bot_is_uniform (hε : 0 < ε) : (⊥ : finpartition A).is_uniform G ε :=
begin
  rw [finpartition.is_uniform, finpartition.card_bot, non_uniforms_bot _ hε,
    finset.card_empty, nat.cast_zero],
  exact mul_nonneg (nat.cast_nonneg _) hε.le,
end

lemma is_uniform_one : P.is_uniform G (1 : 𝕜) :=
begin
  rw [is_uniform, mul_one, nat.cast_le],
  refine (card_filter_le _ _).trans _,
  rw [off_diag_card, nat.mul_sub_left_distrib, mul_one],
end

variables {P G}

lemma is_uniform.mono {ε ε' : 𝕜} (hP : P.is_uniform G ε) (h : ε ≤ ε') : P.is_uniform G ε' :=
((nat.cast_le.2 $ card_le_of_subset $ P.non_uniforms_mono G h).trans hP).trans $
  mul_le_mul_of_nonneg_left h $ nat.cast_nonneg _

lemma is_uniform_of_empty (hP : P.parts = ∅) : P.is_uniform G ε :=
by simp [is_uniform, hP, non_uniforms]

lemma nonempty_of_not_uniform (h : ¬ P.is_uniform G ε) : P.parts.nonempty :=
nonempty_of_ne_empty $ λ h₁, h $ is_uniform_of_empty h₁

variables (P G ε) (s : finset α)

/-- A choice of witnesses of non-uniformity among the parts of a finpartition. -/
noncomputable def nonuniform_witnesses : finset (finset α) :=
(P.parts.filter $ λ t, s ≠ t ∧ ¬ G.is_uniform ε s t).image (G.nonuniform_witness ε s)

variables {P G ε s} {t : finset α}

lemma nonuniform_witness_mem_nonuniform_witnesses (h : ¬ G.is_uniform ε s t) (ht : t ∈ P.parts)
  (hst : s ≠ t) :
  G.nonuniform_witness ε s t ∈ P.nonuniform_witnesses G ε s :=
mem_image_of_mem _ $ mem_filter.2 ⟨ht, hst, h⟩

end finpartition


import tactic.suggest
import tactic.linarith

namespace surreal

-- TODO: separate set and number
inductive number : Type
| zero : number
| add_left : number → number → number
| add_right : number → number → number

instance : has_union (set number) := ⟨λ (X Y : set number), {n | n ∈ X ∨ n ∈ Y}⟩

def number.left : number → set number
| number.zero := ∅
| (number.add_left n l) := {l} ∪ n.left
| (number.add_right n r) := n.left

def number.right : number → set number
| number.zero := ∅
| (number.add_left n l) := n.right
| (number.add_right n r) := {r} ∪ n.right

def number.day : number → ℕ
| number.zero := 0
| (number.add_left n l) := max (l.day + 1) n.day
| (number.add_right n r) := max (r.day + 1) n.day

def number.size : number → ℕ
| number.zero := 0
| (number.add_left n l) := 1 + l.size + n.size
| (number.add_right n r) := 1 + r.size + n.size

-- TODO: more like the original text
-- Great explanation of well-founded: https://exlean.org/well-founded-recursion/
def number.le : number → number → Prop
| number.zero number.zero := true
| (number.add_left x xl) y :=
    have y.size + xl.size < (x.add_left xl).size + y.size, from begin rw number.size, linarith end,
    have x.size + y.size < (x.add_left xl).size + y.size, from begin rw number.size, linarith end,
  ¬(number.le y xl) ∧ (number.le x y)
| (number.add_right x xr) y :=
    have x.size + y.size < (x.add_right xr).size + y.size, from begin rw number.size, linarith end,
  number.le x y
| x (number.add_left y yl) :=
    have x.size + y.size < x.size + (y.add_left yl).size, from begin rw number.size, linarith end,
  number.le x y
| x (number.add_right y yr) :=
    have yr.size + x.size < x.size + (y.add_right yr).size, from begin rw number.size, linarith end,
    have x.size + y.size < x.size + (y.add_right yr).size, from begin rw number.size, linarith end,
  ¬(number.le yr x) ∧ (number.le x y)
using_well_founded {
  dec_tac := `[assumption],
  rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ s, s.1.size + s.2.size)⟩]}

instance has_le : has_le number := ⟨number.le⟩

def number.surreal : number → Prop
| number.zero := true
| (number.add_left n l) := n.surreal ∧ l.surreal ∧ ∀r ∈ n.right, ¬(l ≥ r)
| (number.add_right n r) := n.surreal ∧ r.surreal ∧ ∀l ∈ n.left, ¬(l ≥ r)

-- lemma left_mem (x y z : number) : x ∈ (y.add_left z).left → x ∈ y.left :=
-- begin
--   intro h,
--   rw [number.left] at h,
--   sorry
-- end

-- theorem member_is_older (x : number) :
--   (∀xl ∈ x.left, (number.day xl) < (number.day x)) ∧
--   (∀xr ∈ x.right, (number.day xr) < (number.day x)) :=
-- begin
--   split,
--   begin
--     intros xl hmem,
--     induction x with hx hxl ihx ihxl hx hxr ihx ihxr,
--     begin
--       rw number.day,
--       apply false.rec,
--       exact hmem,
--     end,
--     begin
--       rw number.day,
--       refine lt_max_iff.mpr _,
--       apply or.intro_right,
--       apply ihx,
--       apply left_mem,
--       exact hmem,
--     end,
--     begin
--       sorry
--     end
--   end,
--   begin
--     sorry
--   end
-- end

-- def le : number → number → Prop
-- | x y := ∀ xl ∈ x.left, ¬(le y xl)
-- using_well_founded
--   { rel_tac := λ _ _,
--     `[exact ⟨_, measure_wf (λ s, s.1.day + s.2.day)⟩] }

-- def mem : number → set → Prop
-- | x set.empty  := false
-- | x (set.add y tail) := x == y ∨ mem x tail

-- instance : has_mem number set := ⟨mem⟩

-- def le : number → number → Prop
-- | (number.mk Xl Xr) (number.mk Yl Yr) := ∀ xl ∈ Xl, ¬(le (number.mk Yl Yr) xl)
-- using_well_founded
--   { rel_tac := λ _ _,
--     `[exact ⟨_, measure_wf (λ t, number.sizeof t.1 + number.sizeof t.2)⟩] }

-- def valid : number → Prop
-- | (number.mk L R) := ∀ l ∈ L, ∀ r ∈ R, ¬(l ≥ r) ∧ (valid l) ∧ (valid r)

-- inductive number : Type
-- | zero : number
-- | left : number → number → number
-- | right : number → number → number

-- def valid : number → Prop
-- | number.zero := true
-- | (number.left n l) := false
-- | (number.right n r) := false

end surreal


import Lean.Meta
open Nat

namespace MWE

structure ProvedSkip(n m: Nat) where
  result : Nat
  lt : m < n → result = m
  ge : n ≤ m → result = m + 1

def provedSkip (n m : Nat) : ProvedSkip n m :=
  if c : m < n then
    ⟨m, fun _ => rfl, fun hyp => False.elim (Nat.lt_irrefl m (Nat.lt_of_lt_of_le c hyp))⟩
  else
    ⟨m + 1, fun hyp => absurd hyp c, fun _ => rfl⟩

def skip: Nat → Nat → Nat :=
  fun n m => (provedSkip n m).result

theorem skip_below_eq(n m : Nat) : m < n → (skip n m = m) :=
  fun hyp => (provedSkip n m).lt hyp

theorem skip_above_eq(n m : Nat) : n ≤ m → (skip n m = m + 1) :=
  fun hyp => (provedSkip n m).ge hyp

theorem skip_not_below_eq(n m : Nat) : Not (m < n) → (skip n m = m + 1) :=
  fun hyp =>
    let lem : n ≤ m :=
      match Nat.lt_or_ge m n with
      | Or.inl lt => absurd lt hyp
      | Or.inr ge => ge
    skip_above_eq n m lem

theorem skip_lt: (k j: Nat) →  skip k j < j + 2 :=
    fun k j =>
      if c : j < k then
        let eqn := skip_below_eq k j c
        by
          rw [eqn]
          apply Nat.le_step
          apply Nat.le_refl
          done
      else
        let eqn := skip_not_below_eq k j c
        by
          rw [eqn]
          apply Nat.le_refl
          done

theorem skip_le_succ {n k j : Nat} : j < n → skip k j < n + 1 :=
   by
    intro hyp
    apply Nat.le_trans (skip_lt k j)
    apply Nat.succ_lt_succ
    exact hyp

def FinSeq (n: Nat) (α : Type) : Type := (k : Nat) → k < n → α

theorem witness_independent{α : Type}{n : Nat}(seq: FinSeq n α) :
    (i : Nat)→ (j : Nat) → (iw : i < n) → (jw : j < n) →
        (i = j) → seq i iw = seq j jw :=
        fun i j iw jw eqn =>
          match j, eqn, jw with
          | .(i), rfl, ijw =>
               rfl
namespace FinSeq
def init {α : Type}{n: Nat}(seq : FinSeq (n + 1) α): FinSeq n α :=
  fun k w =>
      seq k (Nat.le_step w)

def last{α : Type}{n: Nat}(seq : FinSeq (n + 1) α): α :=
  seq n (Nat.le_refl _)

def delete{α : Type}{n: Nat}(k : Nat) (kw : k < (n + 1)) (seq : FinSeq (n + 1) α): FinSeq n α :=
  fun j w =>
    seq (skip k j) (skip_le_succ w)

end FinSeq

inductive Vector (α : Type) : Nat → Type where
  | nil : Vector α zero
  | cons{n: Nat}(head: α) (tail: Vector  α n) : Vector α  (n + 1)

infixr:66 "+:" => Vector.cons

open Vector

def Vector.coords {α : Type}{n : Nat}(v: Vector α n) : FinSeq n α :=
  fun j jw =>
  match n, v, j, jw with
  | .(zero), nil, k, lt => nomatch lt
  | m + 1, cons head tail, zero, lt => head
  | m + 1, cons head tail, j + 1, w =>  tail.coords j (Nat.le_of_succ_le_succ w)

def seqVecAux {α: Type}{n m l: Nat}: (s : n + m = l) →
    (seq1 : FinSeq n α) → (accum : Vector α m) →
       Vector α l:=
    match n with
    | zero => fun s => fun _ => fun seq2 =>
      by
        have ss : l = m := by
          rw [← s]
          apply Nat.zero_add
          done
        have sf : Vector α l = Vector α m := by
          rw [ss]
        exact Eq.mpr sf seq2
        done
    | k + 1 => fun s seq1 seq2 =>
      let ss : k + (m + 1)  = l :=
        by
          rw [← s]
          rw [(Nat.add_comm m 1)]
          rw [(Nat.add_assoc k 1 m)]
          done
      seqVecAux ss (seq1.init) ((seq1.last) +: seq2)

def FinSeq.vec {α : Type}{n: Nat} : FinSeq n α  →  Vector α n :=
    fun seq => seqVecAux (Nat.add_zero n) seq Vector.nil

def Clause(n : Nat) : Type := Vector (Option Bool) n

def Valuation(n: Nat) : Type := Vector Bool n

inductive SatAnswer{dom n: Nat}(clauses : Vector (Clause n) dom) where
  | unsat : SatAnswer clauses
  | sat :  SatAnswer clauses

structure SimpleRestrictionClauses{dom n: Nat}
    (clauses: Vector (Clause (n + 1)) dom) where
  codom : Nat
  restClauses : Vector  (Clause n) codom

def prependRes{dom n: Nat}(branch: Bool)(focus: Nat)(focusLt : focus < n + 1)
    (clauses: Vector (Clause (n + 1)) dom):
        (rd : SimpleRestrictionClauses clauses) →
           (head : Clause (n + 1)) →
        SimpleRestrictionClauses (head +: clauses) :=
        fun rd  head =>
          if c : head.coords focus focusLt = some branch then
            ⟨rd.codom, rd.restClauses⟩
          else
            ⟨rd.codom + 1, (FinSeq.vec (FinSeq.delete focus focusLt head.coords)) +: rd.restClauses⟩

def restClauses{dom n: Nat}(branch: Bool)(focus: Nat)(focusLt : focus < n + 1)
        (clauses: Vector (Clause (n + 1)) dom) :
         SimpleRestrictionClauses clauses :=
            match dom, clauses with
            | 0, _ =>  ⟨0, Vector.nil⟩
            | m + 1, Vector.cons head clauses =>
                prependRes branch focus focusLt clauses
                            (restClauses branch focus focusLt clauses) head

def answerSAT{n dom : Nat}: (clauses : Vector (Clause n) dom) →  SatAnswer clauses :=
      match n with
      | zero =>
           match dom with
            | zero => fun cls => SatAnswer.sat
            | l + 1 => fun _ =>  SatAnswer.unsat
      | m + 1 =>
        fun clauses =>
        let cls := clauses
        let bd := zero_lt_succ m
        let rd  :=
            restClauses false zero bd clauses
        let subCls := rd.restClauses
        let subSol: SatAnswer subCls := answerSAT subCls
        match subSol with
        | SatAnswer.sat   =>
          SatAnswer.sat
        | SatAnswer.unsat  =>
            let rd := restClauses true zero bd cls -- replacing cls by clauses fixes this
            let subCls := rd.restClauses
            let subSol : SatAnswer subCls := answerSAT subCls
            match subSol with
            | SatAnswer.sat   =>
                SatAnswer.sat
            | SatAnswer.unsat   =>
                SatAnswer.unsat

open Lean.Meta
open Lean.Elab.Term

syntax (name:= nrmlform)"whnf!" term : term
@[termElab nrmlform] def normalformImpl : TermElab :=
  fun stx expectedType? =>
  match stx with
  | `(whnf! $s) =>
      do
        let t ← elabTerm s none
        let e ← whnf t
        return e
  | _ => Lean.Elab.throwIllFormedSyntax

def cls1 : Clause 2 := -- ¬P
  (some false) +: none +: Vector.nil

def cls2 : Clause 2 := (some true) +: none +: Vector.nil  -- P

def egStatement := cls1 +: cls2 +: Vector.nil

def egAnswer : SatAnswer egStatement := answerSAT egStatement

def egAnswerNorm : SatAnswer egStatement := whnf! egAnswer

#print egAnswerNorm

end MWE


/-
Copyright (c) 2022 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis, Heather Macbeth

! This file was ported from Lean 3 source module ring_theory.witt_vector.frobenius_fraction_field
! leanprover-community/mathlib commit cead93130da7100f8a9fe22ee210f7636a91168f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.Cast.WithTop
import Mathbin.FieldTheory.IsAlgClosed.Basic
import Mathbin.RingTheory.WittVector.DiscreteValuationRing

/-!
# Solving equations about the Frobenius map on the field of fractions of `𝕎 k`

The goal of this file is to prove `witt_vector.exists_frobenius_solution_fraction_ring`,
which says that for an algebraically closed field `k` of characteristic `p` and `a, b` in the
field of fractions of Witt vectors over `k`,
there is a solution `b` to the equation `φ b * a = p ^ m * b`, where `φ` is the Frobenius map.

Most of this file builds up the equivalent theorem over `𝕎 k` directly,
moving to the field of fractions at the end.
See `witt_vector.frobenius_rotation` and its specification.

The construction proceeds by recursively defining a sequence of coefficients as solutions to a
polynomial equation in `k`. We must define these as generic polynomials using Witt vector API
(`witt_vector.witt_mul`, `witt_polynomial`) to show that they satisfy the desired equation.

Preliminary work is done in the dependency `ring_theory.witt_vector.mul_coeff`
to isolate the `n+1`st coefficients of `x` and `y` in the `n+1`st coefficient of `x*y`.

This construction is described in Dupuis, Lewis, and Macbeth,
[Formalized functional analysis via semilinear maps][dupuis-lewis-macbeth2022].
We approximately follow an approach sketched on MathOverflow:
<https://mathoverflow.net/questions/62468/about-frobenius-of-witt-vectors>

The result is a dependency for the proof of `witt_vector.isocrystal_classification`,
the classification of one-dimensional isocrystals over an algebraically closed field.
-/

noncomputable section

namespace WittVector

variable (p : ℕ) [hp : Fact p.Prime]

-- mathport name: expr𝕎
local notation "𝕎" => WittVector p

namespace RecursionMain

/-!

## The recursive case of the vector coefficients

The first coefficient of our solution vector is easy to define below.
In this section we focus on the recursive case.
The goal is to turn `witt_poly_prod n` into a univariate polynomial
whose variable represents the `n`th coefficient of `x` in `x * a`.

-/

section CommRing

include hp

variable {k : Type _} [CommRing k] [CharP k p]

open Polynomial

/-- The root of this polynomial determines the `n+1`st coefficient of our solution. -/
def succNthDefiningPoly (n : ℕ) (a₁ a₂ : 𝕎 k) (bs : Fin (n + 1) → k) : Polynomial k :=
  X ^ p * C (a₁.coeff 0 ^ p ^ (n + 1)) - X * C (a₂.coeff 0 ^ p ^ (n + 1)) +
    C
      (a₁.coeff (n + 1) * (bs 0 ^ p) ^ p ^ (n + 1) +
            nthRemainder p n (fun v => bs v ^ p) (truncateFun (n + 1) a₁) -
          a₂.coeff (n + 1) * bs 0 ^ p ^ (n + 1) -
        nthRemainder p n bs (truncateFun (n + 1) a₂))
#align witt_vector.recursion_main.succ_nth_defining_poly WittVector.RecursionMain.succNthDefiningPoly

theorem succNthDefiningPoly_degree [IsDomain k] (n : ℕ) (a₁ a₂ : 𝕎 k) (bs : Fin (n + 1) → k)
    (ha₁ : a₁.coeff 0 ≠ 0) (ha₂ : a₂.coeff 0 ≠ 0) : (succNthDefiningPoly p n a₁ a₂ bs).degree = p :=
  by
  have : (X ^ p * C (a₁.coeff 0 ^ p ^ (n + 1))).degree = p :=
    by
    rw [degree_mul, degree_C]
    · simp only [Nat.cast_withBot, add_zero, degree_X, degree_pow, Nat.smul_one_eq_coe]
    · exact pow_ne_zero _ ha₁
  have : (X ^ p * C (a₁.coeff 0 ^ p ^ (n + 1)) - X * C (a₂.coeff 0 ^ p ^ (n + 1))).degree = p :=
    by
    rw [degree_sub_eq_left_of_degree_lt, this]
    rw [this, degree_mul, degree_C, degree_X, add_zero]
    · exact_mod_cast hp.out.one_lt
    · exact pow_ne_zero _ ha₂
  rw [succ_nth_defining_poly, degree_add_eq_left_of_degree_lt, this]
  apply lt_of_le_of_lt degree_C_le
  rw [this]
  exact_mod_cast hp.out.pos
#align witt_vector.recursion_main.succ_nth_defining_poly_degree WittVector.RecursionMain.succNthDefiningPoly_degree

end CommRing

section IsAlgClosed

include hp

variable {k : Type _} [Field k] [CharP k p] [IsAlgClosed k]

theorem root_exists (n : ℕ) (a₁ a₂ : 𝕎 k) (bs : Fin (n + 1) → k) (ha₁ : a₁.coeff 0 ≠ 0)
    (ha₂ : a₂.coeff 0 ≠ 0) : ∃ b : k, (succNthDefiningPoly p n a₁ a₂ bs).IsRoot b :=
  IsAlgClosed.exists_root _ <| by
    simp only [succ_nth_defining_poly_degree p n a₁ a₂ bs ha₁ ha₂, hp.out.ne_zero,
      WithTop.coe_eq_zero, Ne.def, not_false_iff]
#align witt_vector.recursion_main.root_exists WittVector.RecursionMain.root_exists

/-- This is the `n+1`st coefficient of our solution, projected from `root_exists`. -/
def succNthVal (n : ℕ) (a₁ a₂ : 𝕎 k) (bs : Fin (n + 1) → k) (ha₁ : a₁.coeff 0 ≠ 0)
    (ha₂ : a₂.coeff 0 ≠ 0) : k :=
  Classical.choose (root_exists p n a₁ a₂ bs ha₁ ha₂)
#align witt_vector.recursion_main.succ_nth_val WittVector.RecursionMain.succNthVal

theorem succNthVal_spec (n : ℕ) (a₁ a₂ : 𝕎 k) (bs : Fin (n + 1) → k) (ha₁ : a₁.coeff 0 ≠ 0)
    (ha₂ : a₂.coeff 0 ≠ 0) :
    (succNthDefiningPoly p n a₁ a₂ bs).IsRoot (succNthVal p n a₁ a₂ bs ha₁ ha₂) :=
  Classical.choose_spec (root_exists p n a₁ a₂ bs ha₁ ha₂)
#align witt_vector.recursion_main.succ_nth_val_spec WittVector.RecursionMain.succNthVal_spec

theorem succNthVal_spec' (n : ℕ) (a₁ a₂ : 𝕎 k) (bs : Fin (n + 1) → k) (ha₁ : a₁.coeff 0 ≠ 0)
    (ha₂ : a₂.coeff 0 ≠ 0) :
    succNthVal p n a₁ a₂ bs ha₁ ha₂ ^ p * a₁.coeff 0 ^ p ^ (n + 1) +
          a₁.coeff (n + 1) * (bs 0 ^ p) ^ p ^ (n + 1) +
        nthRemainder p n (fun v => bs v ^ p) (truncateFun (n + 1) a₁) =
      succNthVal p n a₁ a₂ bs ha₁ ha₂ * a₂.coeff 0 ^ p ^ (n + 1) +
          a₂.coeff (n + 1) * bs 0 ^ p ^ (n + 1) +
        nthRemainder p n bs (truncateFun (n + 1) a₂) :=
  by
  rw [← sub_eq_zero]
  have := succ_nth_val_spec p n a₁ a₂ bs ha₁ ha₂
  simp only [Polynomial.map_add, Polynomial.eval_X, Polynomial.map_pow, Polynomial.eval_C,
    Polynomial.eval_pow, succ_nth_defining_poly, Polynomial.eval_mul, Polynomial.eval_add,
    Polynomial.eval_sub, Polynomial.map_mul, Polynomial.map_sub, Polynomial.IsRoot.def] at this
  convert this using 1
  ring
#align witt_vector.recursion_main.succ_nth_val_spec' WittVector.RecursionMain.succNthVal_spec'

end IsAlgClosed

end RecursionMain

namespace RecursionBase

include hp

variable {k : Type _} [Field k] [IsAlgClosed k]

theorem solution_pow (a₁ a₂ : 𝕎 k) : ∃ x : k, x ^ (p - 1) = a₂.coeff 0 / a₁.coeff 0 :=
  IsAlgClosed.exists_pow_nat_eq _ <| by linarith [hp.out.one_lt, le_of_lt hp.out.one_lt]
#align witt_vector.recursion_base.solution_pow WittVector.RecursionBase.solution_pow

/-- The base case (0th coefficient) of our solution vector. -/
def solution (a₁ a₂ : 𝕎 k) : k :=
  Classical.choose <| solution_pow p a₁ a₂
#align witt_vector.recursion_base.solution WittVector.RecursionBase.solution

theorem solution_spec (a₁ a₂ : 𝕎 k) : solution p a₁ a₂ ^ (p - 1) = a₂.coeff 0 / a₁.coeff 0 :=
  Classical.choose_spec <| solution_pow p a₁ a₂
#align witt_vector.recursion_base.solution_spec WittVector.RecursionBase.solution_spec

theorem solution_nonzero {a₁ a₂ : 𝕎 k} (ha₁ : a₁.coeff 0 ≠ 0) (ha₂ : a₂.coeff 0 ≠ 0) :
    solution p a₁ a₂ ≠ 0 := by
  intro h
  have := solution_spec p a₁ a₂
  rw [h, zero_pow] at this
  · simpa [ha₁, ha₂] using _root_.div_eq_zero_iff.mp this.symm
  · linarith [hp.out.one_lt, le_of_lt hp.out.one_lt]
#align witt_vector.recursion_base.solution_nonzero WittVector.RecursionBase.solution_nonzero

theorem solution_spec' {a₁ : 𝕎 k} (ha₁ : a₁.coeff 0 ≠ 0) (a₂ : 𝕎 k) :
    solution p a₁ a₂ ^ p * a₁.coeff 0 = solution p a₁ a₂ * a₂.coeff 0 :=
  by
  have := solution_spec p a₁ a₂
  cases' Nat.exists_eq_succ_of_ne_zero hp.out.ne_zero with q hq
  have hq' : q = p - 1 := by simp only [hq, tsub_zero, Nat.succ_sub_succ_eq_sub]
  conv_lhs =>
    congr
    congr
    skip
    rw [hq]
  rw [pow_succ', hq', this]
  field_simp [ha₁, mul_comm]
#align witt_vector.recursion_base.solution_spec' WittVector.RecursionBase.solution_spec'

end RecursionBase

open RecursionMain RecursionBase

section FrobeniusRotation

section IsAlgClosed

include hp

variable {k : Type _} [Field k] [CharP k p] [IsAlgClosed k]

/-- Recursively defines the sequence of coefficients for `witt_vector.frobenius_rotation`.
-/
noncomputable def frobeniusRotationCoeff {a₁ a₂ : 𝕎 k} (ha₁ : a₁.coeff 0 ≠ 0)
    (ha₂ : a₂.coeff 0 ≠ 0) : ℕ → k
  | 0 => solution p a₁ a₂
  | n + 1 => succNthVal p n a₁ a₂ (fun i => frobenius_rotation_coeff i.val) ha₁ ha₂ decreasing_by
  apply Fin.is_lt
#align witt_vector.frobenius_rotation_coeff WittVector.frobeniusRotationCoeff

/-- For nonzero `a₁` and `a₂`, `frobenius_rotation a₁ a₂` is a Witt vector that satisfies the
equation `frobenius (frobenius_rotation a₁ a₂) * a₁ = (frobenius_rotation a₁ a₂) * a₂`.
-/
def frobeniusRotation {a₁ a₂ : 𝕎 k} (ha₁ : a₁.coeff 0 ≠ 0) (ha₂ : a₂.coeff 0 ≠ 0) : 𝕎 k :=
  WittVector.mk p (frobeniusRotationCoeff p ha₁ ha₂)
#align witt_vector.frobenius_rotation WittVector.frobeniusRotation

theorem frobeniusRotation_nonzero {a₁ a₂ : 𝕎 k} (ha₁ : a₁.coeff 0 ≠ 0) (ha₂ : a₂.coeff 0 ≠ 0) :
    frobeniusRotation p ha₁ ha₂ ≠ 0 := by
  intro h
  apply solution_nonzero p ha₁ ha₂
  simpa [← h, frobenius_rotation, frobenius_rotation_coeff] using WittVector.zero_coeff p k 0
#align witt_vector.frobenius_rotation_nonzero WittVector.frobeniusRotation_nonzero

theorem frobenius_frobeniusRotation {a₁ a₂ : 𝕎 k} (ha₁ : a₁.coeff 0 ≠ 0) (ha₂ : a₂.coeff 0 ≠ 0) :
    frobenius (frobeniusRotation p ha₁ ha₂) * a₁ = frobeniusRotation p ha₁ ha₂ * a₂ :=
  by
  ext n
  induction' n with n ih
  · simp only [WittVector.mul_coeff_zero, WittVector.coeff_frobenius_charP, frobenius_rotation,
      frobenius_rotation_coeff]
    apply solution_spec' _ ha₁
  · simp only [nth_remainder_spec, WittVector.coeff_frobenius_charP, frobenius_rotation_coeff,
      frobenius_rotation, [anonymous]]
    have :=
      succ_nth_val_spec' p n a₁ a₂ (fun i : Fin (n + 1) => frobenius_rotation_coeff p ha₁ ha₂ i.val)
        ha₁ ha₂
    simp only [frobenius_rotation_coeff, [anonymous], Fin.val_zero] at this
    convert this using 4
    apply TruncatedWittVector.ext
    intro i
    simp only [[anonymous], WittVector.coeff_truncateFun, WittVector.coeff_frobenius_charP]
    rfl
#align witt_vector.frobenius_frobenius_rotation WittVector.frobenius_frobeniusRotation

-- mathport name: exprφ
local notation "φ" => IsFractionRing.fieldEquivOfRingEquiv (frobeniusEquiv p k)

theorem exists_frobenius_solution_fractionRing_aux (m n : ℕ) (r' q' : 𝕎 k) (hr' : r'.coeff 0 ≠ 0)
    (hq' : q'.coeff 0 ≠ 0) (hq : ↑p ^ n * q' ∈ nonZeroDivisors (𝕎 k)) :
    let b : 𝕎 k := frobeniusRotation p hr' hq'
    IsFractionRing.fieldEquivOfRingEquiv (frobeniusEquiv p k)
          (algebraMap (𝕎 k) (FractionRing (𝕎 k)) b) *
        Localization.mk (↑p ^ m * r') ⟨↑p ^ n * q', hq⟩ =
      ↑p ^ (m - n : ℤ) * algebraMap (𝕎 k) (FractionRing (𝕎 k)) b :=
  by
  intro b
  have key : WittVector.frobenius b * p ^ m * r' * p ^ n = p ^ m * b * (p ^ n * q') :=
    by
    have H := congr_arg (fun x : 𝕎 k => x * p ^ m * p ^ n) (frobenius_frobenius_rotation p hr' hq')
    dsimp at H
    refine' (Eq.trans _ H).trans _ <;> ring
  have hq'' : algebraMap (𝕎 k) (FractionRing (𝕎 k)) q' ≠ 0 :=
    by
    have hq''' : q' ≠ 0 := fun h => hq' (by simp [h])
    simpa only [Ne.def, map_zero] using
      (IsFractionRing.injective (𝕎 k) (FractionRing (𝕎 k))).Ne hq'''
  rw [zpow_sub₀ (fraction_ring.p_nonzero p k)]
  field_simp [fraction_ring.p_nonzero p k]
  simp only [IsFractionRing.fieldEquivOfRingEquiv, IsLocalization.ringEquivOfRingEquiv_eq,
    RingEquiv.coe_ofBijective]
  convert congr_arg (fun x => algebraMap (𝕎 k) (FractionRing (𝕎 k)) x) key using 1
  · simp only [RingHom.map_mul, RingHom.map_pow, map_natCast, frobenius_equiv_apply]
    ring
  · simp only [RingHom.map_mul, RingHom.map_pow, map_natCast]
#align witt_vector.exists_frobenius_solution_fraction_ring_aux WittVector.exists_frobenius_solution_fractionRing_aux

theorem exists_frobenius_solution_fractionRing {a : FractionRing (𝕎 k)} (ha : a ≠ 0) :
    ∃ (b : FractionRing (𝕎 k))(hb : b ≠ 0)(m : ℤ), φ b * a = p ^ m * b :=
  by
  revert ha
  refine' Localization.induction_on a _
  rintro ⟨r, q, hq⟩ hrq
  have hq0 : q ≠ 0 := mem_nonZeroDivisors_iff_ne_zero.1 hq
  have hr0 : r ≠ 0 := fun h => hrq (by simp [h])
  obtain ⟨m, r', hr', rfl⟩ := exists_eq_pow_p_mul r hr0
  obtain ⟨n, q', hq', rfl⟩ := exists_eq_pow_p_mul q hq0
  let b := frobenius_rotation p hr' hq'
  refine' ⟨algebraMap (𝕎 k) _ b, _, m - n, _⟩
  ·
    simpa only [map_zero] using
      (IsFractionRing.injective (WittVector p k) (FractionRing (WittVector p k))).Ne
        (frobenius_rotation_nonzero p hr' hq')
  exact exists_frobenius_solution_fraction_ring_aux p m n r' q' hr' hq' hq
#align witt_vector.exists_frobenius_solution_fraction_ring WittVector.exists_frobenius_solution_fractionRing

end IsAlgClosed

end FrobeniusRotation

end WittVector


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

universes v l u_1

namespace Mathlib

/-!
# The category of commutative rings has all colimits.

This file uses a "pre-automated" approach, just as for `Mon/colimits.lean`.
It is a very uniform approach, that conceivably could be synthesised directly
by a tactic that analyses the shape of `comm_ring` and `ring_hom`.
-/

-- [ROBOT VOICE]:

-- You should pretend for now that this file was automatically generated.

-- It follows the same template as colimits in Mon.

/-
`#print comm_ring` says:

structure comm_ring : Type u → Type u
fields:
comm_ring.zero : Π (α : Type u) [c : comm_ring α], α
comm_ring.one : Π (α : Type u) [c : comm_ring α], α
comm_ring.neg : Π {α : Type u} [c : comm_ring α], α → α
comm_ring.add : Π {α : Type u} [c : comm_ring α], α → α → α
comm_ring.mul : Π {α : Type u} [c : comm_ring α], α → α → α

comm_ring.zero_add : ∀ {α : Type u} [c : comm_ring α] (a : α), 0 + a = a
comm_ring.add_zero : ∀ {α : Type u} [c : comm_ring α] (a : α), a + 0 = a
comm_ring.one_mul : ∀ {α : Type u} [c : comm_ring α] (a : α), 1 * a = a
comm_ring.mul_one : ∀ {α : Type u} [c : comm_ring α] (a : α), a * 1 = a
comm_ring.add_left_neg : ∀ {α : Type u} [c : comm_ring α] (a : α), -a + a = 0
comm_ring.add_comm : ∀ {α : Type u} [c : comm_ring α] (a b : α), a + b = b + a
comm_ring.mul_comm : ∀ {α : Type u} [c : comm_ring α] (a b : α), a * b = b * a
comm_ring.add_assoc : ∀ {α : Type u} [c : comm_ring α] (a b c_1 : α), a + b + c_1 = a + (b + c_1)
comm_ring.mul_assoc : ∀ {α : Type u} [c : comm_ring α] (a b c_1 : α), a * b * c_1 = a * (b * c_1)
comm_ring.left_distrib : ∀ {α : Type u} [c : comm_ring α] (a b c_1 : α), a * (b + c_1) = a * b + a * c_1
comm_ring.right_distrib : ∀ {α : Type u} [c : comm_ring α] (a b c_1 : α), (a + b) * c_1 = a * c_1 + b * c_1
-/

namespace CommRing.colimits

/-!
We build the colimit of a diagram in `CommRing` by constructing the
free commutative ring on the disjoint union of all the commutative rings in the diagram,
then taking the quotient by the commutative ring laws within each commutative ring,
and the identifications given by the morphisms in the diagram.
-/

/--
An inductive type representing all commutative ring expressions (without relations)
on a collection of types indexed by the objects of `J`.
-/
-- There's always `of`

inductive prequotient {J : Type v} [category_theory.small_category J] (F : J ⥤ CommRing) where
| of : (j : J) → ↥(category_theory.functor.obj F j) → prequotient F
| zero : prequotient F
| one : prequotient F
| neg : prequotient F → prequotient F
| add : prequotient F → prequotient F → prequotient F
| mul : prequotient F → prequotient F → prequotient F

-- Then one generator for each operation

protected instance prequotient.inhabited {J : Type v} [category_theory.small_category J]
    (F : J ⥤ CommRing) : Inhabited (prequotient F) :=
  { default := prequotient.zero }

/--
The relation on `prequotient` saying when two expressions are equal
because of the commutative ring laws, or
because one element is mapped to another by a morphism in the diagram.
-/
-- Make it an equivalence relation:

inductive relation {J : Type v} [category_theory.small_category J] (F : J ⥤ CommRing) :
    prequotient F → prequotient F → Prop
    where
| refl : ∀ (x : prequotient F), relation F x x
| symm : ∀ (x y : prequotient F), relation F x y → relation F y x
| trans : ∀ (x y z : prequotient F), relation F x y → relation F y z → relation F x z
| map :
    ∀ (j j' : J) (f : j ⟶ j') (x : ↥(category_theory.functor.obj F j)),
      relation F (prequotient.of j' (coe_fn (category_theory.functor.map F f) x))
        (prequotient.of j x)
| zero : ∀ (j : J), relation F (prequotient.of j 0) prequotient.zero
| one : ∀ (j : J), relation F (prequotient.of j 1) prequotient.one
| neg :
    ∀ (j : J) (x : ↥(category_theory.functor.obj F j)),
      relation F (prequotient.of j (-x)) (prequotient.neg (prequotient.of j x))
| add :
    ∀ (j : J) (x y : ↥(category_theory.functor.obj F j)),
      relation F (prequotient.of j (x + y))
        (prequotient.add (prequotient.of j x) (prequotient.of j y))
| mul :
    ∀ (j : J) (x y : ↥(category_theory.functor.obj F j)),
      relation F (prequotient.of j (x * y))
        (prequotient.mul (prequotient.of j x) (prequotient.of j y))
| neg_1 :
    ∀ (x x' : prequotient F), relation F x x' → relation F (prequotient.neg x) (prequotient.neg x')
| add_1 :
    ∀ (x x' y : prequotient F),
      relation F x x' → relation F (prequotient.add x y) (prequotient.add x' y)
| add_2 :
    ∀ (x y y' : prequotient F),
      relation F y y' → relation F (prequotient.add x y) (prequotient.add x y')
| mul_1 :
    ∀ (x x' y : prequotient F),
      relation F x x' → relation F (prequotient.mul x y) (prequotient.mul x' y)
| mul_2 :
    ∀ (x y y' : prequotient F),
      relation F y y' → relation F (prequotient.mul x y) (prequotient.mul x y')
| zero_add : ∀ (x : prequotient F), relation F (prequotient.add prequotient.zero x) x
| add_zero : ∀ (x : prequotient F), relation F (prequotient.add x prequotient.zero) x
| one_mul : ∀ (x : prequotient F), relation F (prequotient.mul prequotient.one x) x
| mul_one : ∀ (x : prequotient F), relation F (prequotient.mul x prequotient.one) x
| add_left_neg :
    ∀ (x : prequotient F), relation F (prequotient.add (prequotient.neg x) x) prequotient.zero
| add_comm : ∀ (x y : prequotient F), relation F (prequotient.add x y) (prequotient.add y x)
| mul_comm : ∀ (x y : prequotient F), relation F (prequotient.mul x y) (prequotient.mul y x)
| add_assoc :
    ∀ (x y z : prequotient F),
      relation F (prequotient.add (prequotient.add x y) z) (prequotient.add x (prequotient.add y z))
| mul_assoc :
    ∀ (x y z : prequotient F),
      relation F (prequotient.mul (prequotient.mul x y) z) (prequotient.mul x (prequotient.mul y z))
| left_distrib :
    ∀ (x y z : prequotient F),
      relation F (prequotient.mul x (prequotient.add y z))
        (prequotient.add (prequotient.mul x y) (prequotient.mul x z))
| right_distrib :
    ∀ (x y z : prequotient F),
      relation F (prequotient.mul (prequotient.add x y) z)
        (prequotient.add (prequotient.mul x z) (prequotient.mul y z))

-- There's always a `map` relation

-- Then one relation per operation, describing the interaction with `of`

-- Then one relation per argument of each operation

-- And one relation per axiom

/--
The setoid corresponding to commutative expressions modulo monoid relations and identifications.
-/
instance colimit_setoid {J : Type v} [category_theory.small_category J] (F : J ⥤ CommRing) :
    setoid (prequotient F) :=
  setoid.mk (relation F) sorry

/--
The underlying type of the colimit of a diagram in `CommRing`.
-/
def colimit_type {J : Type v} [category_theory.small_category J] (F : J ⥤ CommRing) :=
  quotient (colimit_setoid F)

protected instance colimit_type.comm_ring {J : Type v} [category_theory.small_category J]
    (F : J ⥤ CommRing) : comm_ring (colimit_type F) :=
  comm_ring.mk
    (Quot.lift
      (fun (x : prequotient F) =>
        Quot.lift (fun (y : prequotient F) => Quot.mk setoid.r (prequotient.add x y)) sorry)
      sorry)
    sorry (Quot.mk setoid.r prequotient.zero) sorry sorry
    (Quot.lift (fun (x : prequotient F) => Quot.mk setoid.r (prequotient.neg x)) sorry)
    (ring.sub._default
      (Quot.lift
        (fun (x : prequotient F) =>
          Quot.lift (fun (y : prequotient F) => Quot.mk setoid.r (prequotient.add x y)) sorry)
        sorry)
      sorry (Quot.mk setoid.r prequotient.zero) sorry sorry
      (Quot.lift (fun (x : prequotient F) => Quot.mk setoid.r (prequotient.neg x)) sorry))
    sorry sorry
    (Quot.lift
      (fun (x : prequotient F) =>
        Quot.lift (fun (y : prequotient F) => Quot.mk setoid.r (prequotient.mul x y)) sorry)
      sorry)
    sorry (Quot.mk setoid.r prequotient.one) sorry sorry sorry sorry sorry

@[simp] theorem quot_zero {J : Type v} [category_theory.small_category J] (F : J ⥤ CommRing) :
    Quot.mk setoid.r prequotient.zero = 0 :=
  rfl

@[simp] theorem quot_one {J : Type v} [category_theory.small_category J] (F : J ⥤ CommRing) :
    Quot.mk setoid.r prequotient.one = 1 :=
  rfl

@[simp] theorem quot_neg {J : Type v} [category_theory.small_category J] (F : J ⥤ CommRing)
    (x : prequotient F) : Quot.mk setoid.r (prequotient.neg x) = -Quot.mk setoid.r x :=
  rfl

@[simp] theorem quot_add {J : Type v} [category_theory.small_category J] (F : J ⥤ CommRing)
    (x : prequotient F) (y : prequotient F) :
    Quot.mk setoid.r (prequotient.add x y) = Quot.mk setoid.r x + Quot.mk setoid.r y :=
  rfl

@[simp] theorem quot_mul {J : Type v} [category_theory.small_category J] (F : J ⥤ CommRing)
    (x : prequotient F) (y : prequotient F) :
    Quot.mk setoid.r (prequotient.mul x y) = Quot.mk setoid.r x * Quot.mk setoid.r y :=
  rfl

/-- The bundled commutative ring giving the colimit of a diagram. -/
def colimit {J : Type v} [category_theory.small_category J] (F : J ⥤ CommRing) : CommRing :=
  of (colimit_type F)

/-- The function from a given commutative ring in the diagram to the colimit commutative ring. -/
def cocone_fun {J : Type v} [category_theory.small_category J] (F : J ⥤ CommRing) (j : J)
    (x : ↥(category_theory.functor.obj F j)) : colimit_type F :=
  Quot.mk setoid.r (prequotient.of j x)

/-- The ring homomorphism from a given commutative ring in the diagram to the colimit commutative
ring. -/
def cocone_morphism {J : Type v} [category_theory.small_category J] (F : J ⥤ CommRing) (j : J) :
    category_theory.functor.obj F j ⟶ colimit F :=
  ring_hom.mk (cocone_fun F j) sorry sorry sorry sorry

@[simp] theorem cocone_naturality {J : Type v} [category_theory.small_category J] (F : J ⥤ CommRing)
    {j : J} {j' : J} (f : j ⟶ j') :
    category_theory.functor.map F f ≫ cocone_morphism F j' = cocone_morphism F j :=
  ring_hom.ext fun (x : ↥(category_theory.functor.obj F j)) => quot.sound (relation.map j j' f x)

@[simp] theorem cocone_naturality_components {J : Type v} [category_theory.small_category J]
    (F : J ⥤ CommRing) (j : J) (j' : J) (f : j ⟶ j') (x : ↥(category_theory.functor.obj F j)) :
    coe_fn (cocone_morphism F j') (coe_fn (category_theory.functor.map F f) x) =
        coe_fn (cocone_morphism F j) x :=
  sorry

/-- The cocone over the proposed colimit commutative ring. -/
def colimit_cocone {J : Type v} [category_theory.small_category J] (F : J ⥤ CommRing) :
    category_theory.limits.cocone F :=
  category_theory.limits.cocone.mk (colimit F) (category_theory.nat_trans.mk (cocone_morphism F))

/-- The function from the free commutative ring on the diagram to the cone point of any other
cocone. -/
@[simp] def desc_fun_lift {J : Type v} [category_theory.small_category J] (F : J ⥤ CommRing)
    (s : category_theory.limits.cocone F) : prequotient F → ↥(category_theory.limits.cocone.X s) :=
  sorry

/-- The function from the colimit commutative ring to the cone point of any other cocone. -/
def desc_fun {J : Type v} [category_theory.small_category J] (F : J ⥤ CommRing)
    (s : category_theory.limits.cocone F) : colimit_type F → ↥(category_theory.limits.cocone.X s) :=
  Quot.lift (desc_fun_lift F s) sorry

/-- The ring homomorphism from the colimit commutative ring to the cone point of any other
cocone. -/
def desc_morphism {J : Type v} [category_theory.small_category J] (F : J ⥤ CommRing)
    (s : category_theory.limits.cocone F) : colimit F ⟶ category_theory.limits.cocone.X s :=
  ring_hom.mk (desc_fun F s) sorry sorry sorry sorry

/-- Evidence that the proposed colimit is the colimit. -/
def colimit_is_colimit {J : Type v} [category_theory.small_category J] (F : J ⥤ CommRing) :
    category_theory.limits.is_colimit (colimit_cocone F) :=
  category_theory.limits.is_colimit.mk
    fun (s : category_theory.limits.cocone F) => desc_morphism F s

protected instance has_colimits_CommRing : category_theory.limits.has_colimits CommRing :=
  category_theory.limits.has_colimits.mk
    fun (J : Type u_1) (𝒥 : category_theory.small_category J) =>
      category_theory.limits.has_colimits_of_shape.mk
        fun (F : J ⥤ CommRing) =>
          category_theory.limits.has_colimit.mk
            (category_theory.limits.colimit_cocone.mk (colimit_cocone F) (colimit_is_colimit F))

end Mathlib


/-
Copyright (c) 2021 Frédéric Dupuis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Frédéric Dupuis, Heather Macbeth

! This file was ported from Lean 3 source module algebra.ring.comp_typeclasses
! leanprover-community/mathlib commit 207cfac9fcd06138865b5d04f7091e46d9320432
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Ring.Equiv

/-!
# Propositional typeclasses on several ring homs

This file contains three typeclasses used in the definition of (semi)linear maps:
* `RingHomCompTriple σ₁₂ σ₂₃ σ₁₃`, which expresses the fact that `σ₂₃.comp σ₁₂ = σ₁₃`
* `RingHomInvPair σ₁₂ σ₂₁`, which states that `σ₁₂` and `σ₂₁` are inverses of each other
* `RingHomSurjective σ`, which states that `σ` is surjective
These typeclasses ensure that objects such as `σ₂₃.comp σ₁₂` never end up in the type of a
semilinear map; instead, the typeclass system directly finds the appropriate `RingHom` to use.
A typical use-case is conjugate-linear maps, i.e. when `σ = Complex.conj`; this system ensures that
composing two conjugate-linear maps is a linear map, and not a `conj.comp conj`-linear map.

Instances of these typeclasses mostly involving `RingHom.id` are also provided:
* `RingHomInvPair (RingHom.id R) (RingHom.id R)`
* `[RingHomInvPair σ₁₂ σ₂₁] : RingHomCompTriple σ₁₂ σ₂₁ (RingHom.id R₁)`
* `RingHomCompTriple (RingHom.id R₁) σ₁₂ σ₁₂`
* `RingHomCompTriple σ₁₂ (RingHom.id R₂) σ₁₂`
* `RingHomSurjective (RingHom.id R)`
* `[RingHomInvPair σ₁ σ₂] : RingHomSurjective σ₁`

## Implementation notes

* For the typeclass `RingHomInvPair σ₁₂ σ₂₁`, `σ₂₁` is marked as an `outParam`,
  as it must typically be found via the typeclass inference system.

* Likewise, for `RingHomCompTriple σ₁₂ σ₂₃ σ₁₃`, `σ₁₃` is marked as an `outParam`,
  for the same reason.

## Tags

`RingHomCompTriple`, `RingHomInvPair`, `RingHomSurjective`
-/

variable {R₁ : Type _} {R₂ : Type _} {R₃ : Type _}

variable [Semiring R₁] [Semiring R₂] [Semiring R₃]

/-- Class that expresses the fact that three ring homomorphisms form a composition triple. This is
used to handle composition of semilinear maps. -/
class RingHomCompTriple (σ₁₂ : R₁ →+* R₂) (σ₂₃ : R₂ →+* R₃) (σ₁₃ : outParam (R₁ →+* R₃)) :
  Prop where
  /-- The morphisms form a commutative triangle -/
  comp_eq : σ₂₃.comp σ₁₂ = σ₁₃
#align ring_hom_comp_triple RingHomCompTriple

attribute [simp] RingHomCompTriple.comp_eq

variable {σ₁₂ : R₁ →+* R₂} {σ₂₃ : R₂ →+* R₃} {σ₁₃ : R₁ →+* R₃}

namespace RingHomCompTriple

@[simp]
theorem comp_apply [RingHomCompTriple σ₁₂ σ₂₃ σ₁₃] {x : R₁} : σ₂₃ (σ₁₂ x) = σ₁₃ x :=
  RingHom.congr_fun comp_eq x
#align ring_hom_comp_triple.comp_apply RingHomCompTriple.comp_apply

end RingHomCompTriple

/-- Class that expresses the fact that two ring homomorphisms are inverses of each other. This is
used to handle `symm` for semilinear equivalences. -/
class RingHomInvPair (σ : R₁ →+* R₂) (σ' : outParam (R₂ →+* R₁)) : Prop where
  /-- `σ'` is a left inverse of `σ` -/
  comp_eq : σ'.comp σ = RingHom.id R₁
  /-- `σ'` is a left inverse of `σ'` -/
  comp_eq₂ : σ.comp σ' = RingHom.id R₂
#align ring_hom_inv_pair RingHomInvPair

-- attribute [simp] RingHomInvPair.comp_eq Porting note: `simp` can prove it

-- attribute [simp] RingHomInvPair.comp_eq₂ Porting note: `simp` can prove it

variable {σ : R₁ →+* R₂} {σ' : R₂ →+* R₁}

namespace RingHomInvPair

variable [RingHomInvPair σ σ']

-- @[simp] Porting note: `simp` can prove it
theorem comp_apply_eq {x : R₁} : σ' (σ x) = x := by
  rw [← RingHom.comp_apply, comp_eq]
  simp
#align ring_hom_inv_pair.comp_apply_eq RingHomInvPair.comp_apply_eq

-- @[simp] Porting note: `simp` can prove it
theorem comp_apply_eq₂ {x : R₂} : σ (σ' x) = x := by
  rw [← RingHom.comp_apply, comp_eq₂]
  simp
#align ring_hom_inv_pair.comp_apply_eq₂ RingHomInvPair.comp_apply_eq₂

instance ids : RingHomInvPair (RingHom.id R₁) (RingHom.id R₁) :=
  ⟨rfl, rfl⟩
#align ring_hom_inv_pair.ids RingHomInvPair.ids

instance triples {σ₂₁ : R₂ →+* R₁} [RingHomInvPair σ₁₂ σ₂₁] :
    RingHomCompTriple σ₁₂ σ₂₁ (RingHom.id R₁) :=
  ⟨by simp only [comp_eq]⟩
#align ring_hom_inv_pair.triples RingHomInvPair.triples

instance triples₂ {σ₂₁ : R₂ →+* R₁} [RingHomInvPair σ₁₂ σ₂₁] :
    RingHomCompTriple σ₂₁ σ₁₂ (RingHom.id R₂) :=
  ⟨by simp only [comp_eq₂]⟩
#align ring_hom_inv_pair.triples₂ RingHomInvPair.triples₂

/-- Construct a `RingHomInvPair` from both directions of a ring equiv.

This is not an instance, as for equivalences that are involutions, a better instance
would be `RingHomInvPair e e`. Indeed, this declaration is not currently used in mathlib.

See note [reducible non-instances].
-/
@[reducible]
theorem of_ringEquiv (e : R₁ ≃+* R₂) : RingHomInvPair (↑e : R₁ →+* R₂) ↑e.symm :=
  ⟨e.symm_toRingHom_comp_toRingHom, e.symm.symm_toRingHom_comp_toRingHom⟩
#align ring_hom_inv_pair.of_ring_equiv RingHomInvPair.of_ringEquiv

/--
Swap the direction of a `RingHomInvPair`. This is not an instance as it would loop, and better
instances are often available and may often be preferrable to using this one. Indeed, this
declaration is not currently used in mathlib.

See note [reducible non-instances].
-/
@[reducible]
theorem symm (σ₁₂ : R₁ →+* R₂) (σ₂₁ : R₂ →+* R₁) [RingHomInvPair σ₁₂ σ₂₁] :
    RingHomInvPair σ₂₁ σ₁₂ :=
  ⟨RingHomInvPair.comp_eq₂, RingHomInvPair.comp_eq⟩
#align ring_hom_inv_pair.symm RingHomInvPair.symm

end RingHomInvPair

namespace RingHomCompTriple

instance ids : RingHomCompTriple (RingHom.id R₁) σ₁₂ σ₁₂ :=
  ⟨by
    ext
    simp⟩
#align ring_hom_comp_triple.ids RingHomCompTriple.ids

instance right_ids : RingHomCompTriple σ₁₂ (RingHom.id R₂) σ₁₂ :=
  ⟨by
    ext
    simp⟩
#align ring_hom_comp_triple.right_ids RingHomCompTriple.right_ids

end RingHomCompTriple

/-- Class expressing the fact that a `RingHom` is surjective. This is needed in the context
of semilinear maps, where some lemmas require this. -/
class RingHomSurjective (σ : R₁ →+* R₂) : Prop where
  /-- The ring homomorphism is surjective -/
  is_surjective : Function.Surjective σ
#align ring_hom_surjective RingHomSurjective

theorem RingHom.surjective (σ : R₁ →+* R₂) [t : RingHomSurjective σ] : Function.Surjective σ :=
  t.is_surjective
#align ring_hom.is_surjective RingHom.surjective

namespace RingHomSurjective

-- The linter gives a false positive, since `σ₂` is an out_param
-- @[nolint dangerous_instance] Porting note: this linter is not implemented yet
instance (priority := 100) invPair {σ₁ : R₁ →+* R₂} {σ₂ : R₂ →+* R₁} [RingHomInvPair σ₁ σ₂] :
    RingHomSurjective σ₁ :=
  ⟨fun x => ⟨σ₂ x, RingHomInvPair.comp_apply_eq₂⟩⟩
#align ring_hom_surjective.inv_pair RingHomSurjective.invPair

instance ids : RingHomSurjective (RingHom.id R₁) :=
  ⟨is_surjective⟩
#align ring_hom_surjective.ids RingHomSurjective.ids

/-- This cannot be an instance as there is no way to infer `σ₁₂` and `σ₂₃`. -/
theorem comp [RingHomCompTriple σ₁₂ σ₂₃ σ₁₃] [RingHomSurjective σ₁₂] [RingHomSurjective σ₂₃] :
    RingHomSurjective σ₁₃ :=
  { is_surjective := by
      have := σ₂₃.surjective.comp σ₁₂.surjective
      rwa [← RingHom.coe_comp, RingHomCompTriple.comp_eq] at this }
#align ring_hom_surjective.comp RingHomSurjective.comp

end RingHomSurjective