/-
The direct encoding for the at-most-one function.

Authors: Cayden Codel, Jeremy Avigad, Marijn Heule
Carnegie Mellon University
-/

import cnf.literal
import cnf.assignment
import cnf.clause
import cnf.cnf
import cnf.encoding

import cardinality.amk
import cardinality.distinct

variables {V : Type*} [decidable_eq V] [inhabited V]

open list nat
open amk
open assignment clause literal cnf distinct encoding

namespace direct_amo

def direct_amo' : list (literal V) → cnf V
| []        := []
| (l :: ls) := (ls.map (λ m, [l.flip, m.flip])) ++ (direct_amo' ls)

def direct_amo : enc_fn V := dir_enc direct_amo'

@[simp] theorem direct_amo_nil : direct_amo' ([] : list (literal V)) = [] := rfl
@[simp] theorem direct_amo_singleton (lit : literal V) : direct_amo' [lit] = [] := rfl

@[simp] theorem direct_amo_double (l₁ l₂ : literal V) :
  direct_amo' [l₁, l₂] = [[l₁.flip, l₂.flip]] := rfl

theorem exists_mem_of_length_ge_two :
  ∀ {l : list (literal V)}, length l ≥ 2 → ∃ (c : clause V), c ∈ direct_amo' l
| []   hl := by { rw length at hl, linarith }
| [l₁] hl := by { rw [length, length] at hl, linarith }
| (l₁ :: l₂ :: ls) hl := begin
  use [[l₁.flip, l₂.flip]],
  rw [direct_amo', mem_append], left,
  simp only [map, mem_cons_iff, eq_self_iff_true, true_or]
end

theorem length_eq_two_of_mem {l : list (literal V)} {c : clause V} (hl : length l ≥ 2) :
  c ∈ direct_amo' l → length c = 2 :=
begin
  induction l with l₁ ls ih,
  { rw length at hl, linarith },
  { rw direct_amo',
    simp only [mem_map, mem_append],
    by_cases hls : length ls = 1,
    { rcases exists_of_length_succ ls hls with ⟨l₂, ls, rfl⟩,
      simp [length_eq_zero] at hls,
      simp [hls],
      rintro rfl,
      dec_trivial },
    { rw length at hl,
      have := succ_le_succ_iff.mp hl,
      have : 1 < ls.length, exact (ne.symm hls).le_iff_lt.mp this,
      have : 2 ≤ ls.length, exact succ_le_iff.mpr this,
      rintros (⟨a, ha, rfl⟩ | h),
      { dec_trivial },
      { exact ih this h } } }
end

-- TODO rename, distinct isn't used here
theorem exists_double_flip_eq_of_mem {l : list (literal V)} {c : clause V} (hl : length l ≥ 2) :
  c ∈ direct_amo' l → ∃ (lit₁ lit₂ : literal V), [lit₁.flip, lit₂.flip] = c :=
begin
  intro h,
  rcases exists_cons_cons_of_length_eq_two (length_eq_two_of_mem hl h) with ⟨lit₁, lit₂, rfl⟩,
  use [lit₁.flip, lit₂.flip],
  rw [flip_flip, flip_flip]
end

-- TODO this feels like a very long proof, can probably be shortened
theorem distinct_iff_mem {l : list (literal V)} {lit₁ lit₂ : literal V} :
  distinct lit₁ lit₂ l ↔ [lit₁.flip, lit₂.flip] ∈ direct_amo' l :=
begin
  split,
  { induction l with l₁ ls ih,
    { intro h, exact absurd h (not_distinct_nil _ _) },
    { intro h,
      have hdis := h,
      have hl := length_ge_two_of_distinct h,
      rcases exists_cons_cons_of_length_ge_two hl with ⟨a₁, a₂, L, hL⟩,
      rw ← (tail_eq_of_cons_eq hL) at *,
      rw [direct_amo', mem_append],
      rcases h with ⟨i, j, hi, hj, hij, hil, hjl⟩,
      cases i,
      { rw nth_le at hil,
        left,
        rw [hil, mem_map],
        use [lit₂, mem_tail_of_distinct_cons hdis] },
      { have : distinct lit₁ lit₂ (a₂ :: L),
        { rw length at hi,
          have := succ_le_iff.mpr ((gt_of_gt_of_ge hij (zero_le i.succ))),
          rcases nth_le_of_ge hj this with ⟨h₁, h₂⟩,
          rw length at h₁,
          rw distinct,
          use [i, j - 1, succ_lt_succ_iff.mp hi, succ_lt_succ_iff.mp h₁],
          split,
          { rw ← nat.sub_add_cancel this at hij,
            exact succ_lt_succ_iff.mp hij },
          rw nth_le at hil,
          rw [hjl, nth_le] at h₂,
          exact ⟨hil, h₂.symm⟩ },
        exact or.inr (ih this) } } },
  { induction l with l₁ ls ih,
    { simp only [direct_amo_nil, not_mem_nil, is_empty.forall_iff] },
    { cases ls with l₂ ls,
      { rw direct_amo_singleton, intro h, exact absurd h (not_mem_nil _) },
      cases ls with l₃ ls,
      { rw [direct_amo_double, mem_singleton],
        simp only [eq_self_iff_true, and_true, and_imp],
        intros h₁ h₂,
        rw [flip_inj.mp h₁, flip_inj.mp h₂],
        use [0, 1], simp },
      { intro h, -- TODO this feels very casewise
        rw [direct_amo', mem_append] at h,
        rcases h with (h | h),
        { simp at h,
          rcases h with (⟨h₁, h₂⟩ | ⟨h₁, h₃⟩ | ⟨l₄, hl₄, h₁, hls⟩),
          { rw [flip_inj.mp h₁, flip_inj.mp h₂],
            use [0, 1], simp },
          { rw [flip_inj.mp h₁, flip_inj.mp h₃],
            use [0, 2], simp, linarith }, -- can be done explicitly rather than linarith
          { rw [flip_inj.mp h₁, ← flip_inj.mp hls],
            rcases nth_le_of_mem hl₄ with ⟨n, hn, hln₄⟩,
            use [0, n + 3],
            simp,
            use [succ_lt_succ (succ_lt_succ (succ_lt_succ hn)), hln₄] } },
        { have : (l₂ :: l₃ :: ls).length ≥ 2,
          { rw [length, length], linarith },
          exact distinct_cons_of_distinct l₁ (ih h) } } } }
end

theorem subset_direct_of_sublist {l₁ l₂ : list (literal V)} :
  l₁ <+ l₂ → (direct_amo' l₁) ⊆ (direct_amo' l₂) :=
begin
  induction l₂ with lit₁ ls ih generalizing l₁,
  { rw sublist_nil_iff_eq_nil, rintro rfl, exact subset.refl _ },
  { intros hl₁ c hc,
    cases hl₁,
    { rw [direct_amo', mem_append],
      exact or.inr ((ih hl₁_ᾰ) hc) },
    { rw [direct_amo', mem_append] at hc,
      rcases hc with (hc | hc),
      { rw mem_map at hc,
        rcases hc with ⟨a, hal, hac⟩,
        rw [direct_amo', mem_append, mem_map],
        exact or.inl ⟨a, sublist.subset hl₁_ᾰ hal, hac⟩ },
      { rw [direct_amo', mem_append],
        exact or.inr (ih hl₁_ᾰ hc) } } }
end

theorem eval_tt_iff_forall_distinct_eval_ff {τ : assignment V}
  {l : list (literal V)} : length l ≥ 2 → ((direct_amo' l).eval τ = tt ↔
   (∀ {lit₁ lit₂ : literal V}, (distinct lit₁ lit₂ l) → lit₁.eval τ = ff ∨ lit₂.eval τ = ff)) :=
begin
  intro hl,
  split,
  { intros heval lit₁ lit₂ hdis,
    rw cnf.eval_tt_iff_forall_clause_eval_tt at heval,
    have := heval [lit₁.flip, lit₂.flip] (distinct_iff_mem.mp hdis),
    rw eval_tt_iff_exists_literal_eval_tt at this,
    rcases this with ⟨lit, hmem, hlit⟩,
    simp only [mem_cons_iff, mem_singleton] at hmem,
    rcases hmem with (rfl | rfl),
    { rw eval_flip at hlit,
      exact or.inl (bool.eq_ff_of_bnot_eq_tt hlit) },
    { rw eval_flip at hlit,
      exact or.inr (bool.eq_ff_of_bnot_eq_tt hlit) } },
  { intro h,
    rw cnf.eval_tt_iff_forall_clause_eval_tt,
    intros c hc,
    rcases exists_double_flip_eq_of_mem hl hc with ⟨l₁, l₂, rfl⟩,
    have := h (distinct_iff_mem.mpr hc),
    rw eval_tt_iff_exists_literal_eval_tt,
    rcases h (distinct_iff_mem.mpr hc) with (hff | hff),
    { use l₁.flip,
      simp [eval_flip_of_eval hff] },
    { use l₂.flip,
      simp [eval_flip_of_eval hff] } }
end

theorem eval_tt_iff_forall_distinct_eval_ff_of_eval_tt {τ : assignment V}
  {l : list (literal V)} : length l ≥ 2 → ((direct_amo' l).eval τ = tt ↔
   (∀ {lit₁ lit₂ : literal V}, (distinct lit₁ lit₂ l) → lit₁.eval τ = tt → lit₂.eval τ = ff)) :=
begin
  intro hl,
  split,
  { intros ht lit₁ lit₂ hdis hlit₁,
    rcases (eval_tt_iff_forall_distinct_eval_ff hl).mp ht hdis with (h | h),
    { rw h at hlit₁, contradiction },
    { exact h } },
  { intro hls,
    apply (eval_tt_iff_forall_distinct_eval_ff hl).mpr,
    intros lit₁ lit₂ hdis,
    cases h : (literal.eval τ lit₁),
    { exact or.inl (refl ff) },
    { exact or.inr (hls hdis h) } }
end

theorem eval_ff_iff_forall_distinct_eval_tt {τ : assignment V}
  {l : list (literal V)} (hl : length l ≥ 2) :
  ((direct_amo' l).eval τ = ff ↔
  (∃ {lit₁ lit₂ : literal V}, (distinct lit₁ lit₂ l) ∧ lit₁.eval τ = tt ∧ lit₂.eval τ = tt)) :=
begin
  split,
  { rw cnf.eval_ff_iff_exists_clause_eval_ff,
    rintros ⟨c, hmem, hc⟩,
    rcases exists_double_flip_eq_of_mem hl hmem with ⟨lit₁, lit₂, rfl⟩,
    rw eval_ff_iff_forall_literal_eval_ff at hc,
    use [lit₁, lit₂, distinct_iff_mem.mpr hmem],
    have h₁ : lit₁.flip ∈ [lit₁.flip, lit₂.flip], from mem_cons_self _ _,
    have h₂ : lit₂.flip ∈ [lit₁.flip, lit₂.flip], simp,
    have h₁eval := eval_flip_of_eval (hc lit₁.flip h₁),
    have h₂eval := eval_flip_of_eval (hc lit₂.flip h₂),
    rw flip_flip at h₁eval h₂eval,
    exact ⟨h₁eval, h₂eval⟩ },
  { rintro ⟨lit₁, lit₂, hdis, h₁, h₂⟩,
    rw cnf.eval_ff_iff_exists_clause_eval_ff,
    use [[lit₁.flip, lit₂.flip], distinct_iff_mem.mp hdis],
    rw eval_ff_iff_forall_literal_eval_ff,
    simp [h₁, h₂, eval_flip] }
end

theorem direct_amo_formula_encodes_amo : ∀ (l : list (literal V)),
  formula_encodes (amk 1) (direct_amo' l) l
| []   := by { intro τ, simp [constraint.eval] }
| [l₁] := by { intro τ, simp [constraint.eval], use τ }
| (l₁ :: l₂ :: ls) := begin
  have hl : length (l₁ :: l₂ :: ls) ≥ 2, dec_trivial,
  intro τ, split,
  { intro hamk,
    rw [amo_eval_tt_iff_distinct_eval_ff_of_eval_tt] at hamk,
    use τ, split,
    { rw cnf.eval_tt_iff_forall_clause_eval_tt,
      intros c hc,
      rw eval_tt_iff_exists_literal_eval_tt,
      rcases exists_double_flip_eq_of_mem hl hc with ⟨lit₁, lit₂, rfl⟩,
      cases h : (lit₁.eval τ),
      { use [lit₁.flip, mem_cons_self _ _],
        rw eval_flip,
        simp only [h, bool.bnot_ff] },
      { have : lit₂.flip ∈ [lit₁.flip, lit₂.flip], simp,
        use [lit₂.flip, this],
        exact eval_flip_of_eval (hamk (distinct_iff_mem.mpr hc) h) } },
    { exact agree_on.refl _ _ } },
  { rintros ⟨σ, heval, hsigma⟩,
    rw cnf.eval_tt_iff_forall_clause_eval_tt at heval,
    rw amo_eval_tt_iff_distinct_eval_ff_of_eval_tt,
    intros lit₁ lit₂ hdis h₁,
    have := heval _ (distinct_iff_mem.mp hdis),
    rw eval_tt_iff_exists_literal_eval_tt at this,
    rcases this with ⟨lit, hmem, hlit⟩,
    simp at hmem,
    rcases hmem with (rfl | rfl),
    { have := mem_vars_of_mem (mem_of_distinct_left hdis),
      rw eval_eq_of_agree_on_of_var_mem hsigma this at h₁,
      rw [eval_flip, h₁] at hlit,
      contradiction },
    { have := mem_vars_of_mem (mem_of_distinct_right hdis),
      have h₂ := eval_flip_of_eval hlit,
      rw flip_flip at h₂,
      rw ← eval_eq_of_agree_on_of_var_mem hsigma this at h₂,
      exact h₂ } }
end

lemma amo_map_vars (lit : literal V) (l : list (literal V)) : l ≠ [] →
  cnf.vars (l.map (λ m, [lit.flip, m.flip])) = clause.vars (lit :: l) :=
begin
  induction l with l ls ih,
  { simp },
  { cases ls with l₂ ls,
    { simp [clause.vars, flip_var_eq] },
    { simp [flip_var_eq] at ih,
      simp [cnf.vars, clause.vars, flip_var_eq, ih],
      rw ← finset.union_assoc {l.var} {lit.var} _,
      rw finset.union_comm {l.var} {lit.var},
      rw finset.union_assoc {lit.var} {l.var} _,
      rw ← finset.union_assoc {lit.var} {lit.var} _,
      simp } }
end

theorem direct_amo_is_wb : is_wb (direct_amo : enc_fn V) :=
begin
  intros l g hdis,
  simp [direct_amo, direct_amo', dir_enc],
  split,
  { refl },
  { induction l with lit₁ ls ih,
    { simp },
    { cases ls with lit₂ ls,
      { simp [direct_amo'] },
      { rw direct_amo', simp [cnf.vars, cnf.vars_append],
        apply finset.union_subset,
        { simp [clause.vars, flip_var_eq] },
        { apply finset.union_subset,
          { rw flip_var_eq,
            apply finset.subset_union_of_subset_right,
            rw finset.singleton_subset_iff,
            exact finset.mem_union_left _ (finset.mem_singleton_self _) },
          { apply finset.union_subset,
            { intros v hv,
              rw mem_vars_iff_exists_mem_clause_and_mem at hv,
              simp at hv,
              rcases hv with ⟨lit, hlit, (rfl | rfl)⟩,
              { rw flip_var_eq,
                exact finset.mem_union_left _ (finset.mem_singleton_self _) },
              { rw flip_var_eq,
                exact finset.mem_union_right _ (finset.mem_union_right _ (mem_vars_of_mem hlit)) } },
        { apply finset.subset_union_of_subset_right,
          rw ← clause.vars_cons,
          exact ih (disj_of_disj_cons hdis) } } } } } }
end

theorem direct_amo_encodes_amo : encodes (amk 1) (direct_amo : enc_fn V) :=
⟨λ l _ _, direct_amo_formula_encodes_amo l, direct_amo_is_wb⟩

end direct_amo


import data.polynomial.derivative

open_locale polynomial
open polynomial

lemma iterate_derivative_eq_zero {R} [comm_semiring R] {p : R[X]} {x : ℕ} (hx : p.nat_degree < x) :
  polynomial.derivative^[x] p = 0 :=
begin
  induction h : p.nat_degree using nat.strong_induction_on with _ ih generalizing p x,
  subst h,
  obtain ⟨t, rfl⟩ := nat.exists_eq_succ_of_ne_zero (pos_of_gt hx).ne',
  rw [function.iterate_succ_apply],
  by_cases hp : p.derivative = 0,
  { rw [hp, polynomial.iterate_derivative_zero] },
  have := nat_degree_derivative_lt hp,
  exact ih _ this (this.trans_le $ nat.le_of_lt_succ hx) rfl
end


/-
Copyright © 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Shing Tak Lam

! This file was ported from Lean 3 source module topology.continuous_function.ordered
! leanprover-community/mathlib commit 84dc0bd6619acaea625086d6f53cb35cdd554219
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.Algebra.Order.ProjIcc
import Mathlib.Topology.Algebra.Order.Group
import Mathlib.Topology.ContinuousFunction.Basic

/-!
# Bundled continuous maps into orders, with order-compatible topology

-/

variable {α : Type _} {β : Type _} {γ : Type _}

variable [TopologicalSpace α] [TopologicalSpace β] [TopologicalSpace γ]

namespace ContinuousMap

section

variable [LinearOrderedAddCommGroup β] [OrderTopology β]

/-- The pointwise absolute value of a continuous function as a continuous function. -/
def abs (f : C(α, β)) : C(α, β) where toFun x := |f x|
#align continuous_map.abs ContinuousMap.abs

-- see Note [lower instance priority]
instance (priority := 100) : Abs C(α, β) :=
  ⟨fun f => abs f⟩

@[simp]
theorem abs_apply (f : C(α, β)) (x : α) : (|f|) x = |f x| :=
  rfl
#align continuous_map.abs_apply ContinuousMap.abs_apply

end

/-!
We now set up the partial order and lattice structure (given by pointwise min and max)
on continuous functions.
-/

section Lattice

instance partialOrder [PartialOrder β] : PartialOrder C(α, β) :=
  PartialOrder.lift (fun f => f.toFun) (fun f g _ => by cases f; cases g; congr)
  -- porting note: was `by tidy`, and `by aesop` alone didn't work
#align continuous_map.partial_order ContinuousMap.partialOrder

theorem le_def [PartialOrder β] {f g : C(α, β)} : f ≤ g ↔ ∀ a, f a ≤ g a :=
  Pi.le_def
#align continuous_map.le_def ContinuousMap.le_def

theorem lt_def [PartialOrder β] {f g : C(α, β)} : f < g ↔ (∀ a, f a ≤ g a) ∧ ∃ a, f a < g a :=
  Pi.lt_def
#align continuous_map.lt_def ContinuousMap.lt_def

instance sup [LinearOrder β] [OrderClosedTopology β] : Sup C(α, β)
    where sup f g := { toFun := fun a => max (f a) (g a) }
#align continuous_map.has_sup ContinuousMap.sup

@[simp, norm_cast]
theorem sup_coe [LinearOrder β] [OrderClosedTopology β] (f g : C(α, β)) :
    ((f ⊔ g : C(α, β)) : α → β) = (f ⊔ g : α → β) :=
  rfl
#align continuous_map.sup_coe ContinuousMap.sup_coe

@[simp]
theorem sup_apply [LinearOrder β] [OrderClosedTopology β] (f g : C(α, β)) (a : α) :
    (f ⊔ g) a = max (f a) (g a) :=
  rfl
#align continuous_map.sup_apply ContinuousMap.sup_apply

instance semilatticeSup [LinearOrder β] [OrderClosedTopology β] : SemilatticeSup C(α, β) :=
  { ContinuousMap.partialOrder,
    ContinuousMap.sup with
    le_sup_left := fun f g => le_def.mpr (by simp [le_refl])
    le_sup_right := fun f g => le_def.mpr (by simp [le_refl])
    sup_le := fun f₁ f₂ g w₁ w₂ => le_def.mpr fun a => by simp [le_def.mp w₁ a, le_def.mp w₂ a] }

instance inf [LinearOrder β] [OrderClosedTopology β] : Inf C(α, β)
    where inf f g := { toFun := fun a => min (f a) (g a) }
#align continuous_map.has_inf ContinuousMap.inf

@[simp, norm_cast]
theorem inf_coe [LinearOrder β] [OrderClosedTopology β] (f g : C(α, β)) :
    ((f ⊓ g : C(α, β)) : α → β) = (f ⊓ g : α → β) :=
  rfl
#align continuous_map.inf_coe ContinuousMap.inf_coe

@[simp]
theorem inf_apply [LinearOrder β] [OrderClosedTopology β] (f g : C(α, β)) (a : α) :
    (f ⊓ g) a = min (f a) (g a) :=
  rfl
#align continuous_map.inf_apply ContinuousMap.inf_apply

instance semilatticeInf [LinearOrder β] [OrderClosedTopology β] : SemilatticeInf C(α, β) :=
  { ContinuousMap.partialOrder,
    ContinuousMap.inf with
    inf_le_left := fun f g => le_def.mpr (by simp [le_refl])
    inf_le_right := fun f g => le_def.mpr (by simp [le_refl])
    le_inf := fun f₁ f₂ g w₁ w₂ => le_def.mpr fun a => by simp [le_def.mp w₁ a, le_def.mp w₂ a] }

instance [LinearOrder β] [OrderClosedTopology β] : Lattice C(α, β) :=
  { ContinuousMap.semilatticeInf, ContinuousMap.semilatticeSup with }

-- TODO transfer this lattice structure to `BoundedContinuousFunction`
section Sup'

variable [LinearOrder γ] [OrderClosedTopology γ]

theorem sup'_apply {ι : Type _} {s : Finset ι} (H : s.Nonempty) (f : ι → C(β, γ)) (b : β) :
    s.sup' H f b = s.sup' H fun a => f a b :=
  Finset.comp_sup'_eq_sup'_comp H (fun f : C(β, γ) => f b) fun _ _ => rfl
#align continuous_map.sup'_apply ContinuousMap.sup'_apply

@[simp, norm_cast]
theorem sup'_coe {ι : Type _} {s : Finset ι} (H : s.Nonempty) (f : ι → C(β, γ)) :
    ((s.sup' H f : C(β, γ)) : β → γ) = s.sup' H fun a => (f a : β → γ) := by
  ext
  simp [sup'_apply]
#align continuous_map.sup'_coe ContinuousMap.sup'_coe

end Sup'

section Inf'

variable [LinearOrder γ] [OrderClosedTopology γ]

theorem inf'_apply {ι : Type _} {s : Finset ι} (H : s.Nonempty) (f : ι → C(β, γ)) (b : β) :
    s.inf' H f b = s.inf' H fun a => f a b :=
  @sup'_apply _ γᵒᵈ _ _ _ _ _ _ H f b
#align continuous_map.inf'_apply ContinuousMap.inf'_apply

@[simp, norm_cast]
theorem inf'_coe {ι : Type _} {s : Finset ι} (H : s.Nonempty) (f : ι → C(β, γ)) :
    ((s.inf' H f : C(β, γ)) : β → γ) = s.inf' H fun a => (f a : β → γ) :=
  @sup'_coe _ γᵒᵈ _ _ _ _ _ _ H f
#align continuous_map.inf'_coe ContinuousMap.inf'_coe

end Inf'

end Lattice

section Extend

variable [LinearOrder α] [OrderTopology α] {a b : α} (h : a ≤ b)

/-- Extend a continuous function `f : C(set.Icc a b, β)` to a function `f : C(α, β)`.  -/
def IccExtend (f : C(Set.Icc a b, β)) : C(α, β) where
  toFun := Set.IccExtend h f
#align continuous_map.Icc_extend ContinuousMap.IccExtend

@[simp]
theorem coe_IccExtend (f : C(Set.Icc a b, β)) :
    ((IccExtend h f : C(α, β)) : α → β) = Set.IccExtend h f :=
  rfl
#align continuous_map.coe_Icc_extend ContinuousMap.coe_IccExtend

end Extend

end ContinuousMap


namespace Nat
  theorem add_equations: ∀{a b c d: Nat}, a = b → c = d → a + c = b + d := by
    intro a b c d ab cd
    rw [ab, cd]

  theorem add_to_equation_right: ∀{a b c: Nat}, a = b → a + c = b + c := by
    intro a b c ab
    exact add_equations ab rfl

  theorem succ_equation : ∀{a b: Nat}, Nat.succ a = Nat.succ b → a = b := by
    intro a b
    apply Eq.mp -- (a + 1 = b + 1) = a + b
    apply Nat.succ.injEq -- this was already here?

  inductive A : Nat -> Type
    | ooo: (n: Nat) → A n

  theorem subtract_to_equation_right: ∀{a b c: Nat}, a + c = b + c → a = b := by
    intro a b c acbc
    induction c with
    | zero =>
      repeat rw [Nat.add_zero] at acbc
      exact acbc
    | succ pc inner =>
      /-
        a + S pc = b + S pc -- comm
        S pc + a = S pc + b -- addition definition
        S (pc + a) = S (pc + b) -- injective constructor
        pc + a = pc + b
      -/
      rw [Nat.add_comm a (Nat.succ pc), Nat.add_comm b (Nat.succ pc)] at acbc
      simp [Nat.succ_add, Nat.add_comm] at acbc
      exact (inner acbc)

  theorem subtract_to_equation_left: ∀{a b c: Nat}, c + a = c + b → a = b := by
    intro a b c cacb
    rw [Nat.add_comm c a, Nat.add_comm c b] at cacb
    exact (subtract_to_equation_right cacb)

  theorem add_equation_both_sides_right: ∀{a b c: Nat}, (a = b) ↔ (a + c = b + c) := by
    intro a b c
    apply Iff.intro
    . exact add_to_equation_right
    . exact subtract_to_equation_right

  theorem multiply_equation_left: ∀{a b c: Nat}, (a = b) → (c * a = c * b) := by
    intro a b c ab
    rw [ab]

  theorem double.addition_is_multiplication (x: Nat): 2 * x = x + x := by
    induction x with
    | zero => simp
    | succ px ic =>
      simp [<-Nat.add_one, Nat.left_distrib, ic, Nat.add_left_comm, Nat.add_assoc]
end Nat


/-
Copyright (c) 2022 Dhruv Bhatia. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Dhruv Bhatia, Eric Wieser

! This file was ported from Lean 3 source module tactic.polyrith
! leanprover-community/mathlib commit 5fc18b5e34affac9a4020b228bea6d1c67519415
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.LinearCombination
import Mathbin.Data.Buffer.Parser.Numeral
import Mathbin.Data.Json

/-!

# polyrith Tactic

In this file, the `polyrith` tactic is created.  This tactic, which
works over `field`s, attempts to prove a multivariate polynomial target over said
field by using multivariable polynomial hypotheses/proof terms over the same field.
Used as is, the tactic makes use of those hypotheses in the local context that are
over the same field as the target. However, the user can also specifiy which hypotheses
from the local context to use, along with proof terms that might not already be in the
local context. Note: since this tactic uses SageMath via an API call done in Python,
it can only be used with a working internet connection, and with a local installation of Python.

## Implementation Notes

The tactic `linear_combination` is often used to prove such goals by allowing the user to
specify a coefficient for each hypothesis. If the target polynomial can be written as a
linear combination of the hypotheses with the chosen coefficients, then the `linear_combination`
tactic succeeds. In other words, `linear_combination` is a certificate checker, and it is left
to the user to find a collection of good coefficients. The `polyrith` tactic automates this
process using the theory of Groebner bases.

Polyrith does this by first parsing the relevant hypotheses into a form that Python can understand.
It then calls a Python file that uses the SageMath API to compute the coefficients. These
coefficients are then sent back to Lean, which parses them into pexprs. The information is then
given to the `linear_combination` tactic, which completes the process by checking the certificate.

`polyrith` calls an external python script `scripts/polyrith_sage.py`. Because this is not a Lean
file, changes to this script may not be noticed during Lean compilation if you have already
generated olean files. If you are modifying this python script, you likely know what you're doing;
remember to force recompilation of any files that call `polyrith`.

## TODO

* Give Sage more information about the specific ring being used for the coefficients. For now,
  we always use ℚ (or `QQ` in Sage).
* Handle `•` terms.
* Support local Sage installations.

## References

* See the book [*Ideals, Varieties, and Algorithms*][coxlittleOshea1997] by David Cox, John Little,
  and Donal O'Shea for the background theory on Groebner bases
* This code was heavily inspired by the code for the tactic `linarith`, which was written by
  Robert Lewis, who advised me on this project as part of a Computer Science independant study
  at Brown University.

-/

open Tactic Native

namespace Polyrith

/-! # Poly Datatype -/

/-- A datatype representing the semantics of multivariable polynomials.
Each `poly` can be converted into a string.
-/
inductive Poly
  | const : ℚ → poly
  | var : ℕ → poly
  | add : poly → poly → poly
  | sub : poly → poly → poly
  | mul : poly → poly → poly
  | pow : poly → ℕ → poly
  | neg : poly → poly
  deriving DecidableEq
#align polyrith.poly Polyrith.Poly

/-- This converts a poly object into a string representing it. The string
maintains the semantic structure of the poly object.

The output of this function must be valid Python syntax, and it assumes the variables `varN` from
`scripts/polyrith.py.`
-/
unsafe def poly.mk_string : Poly → String
  | poly.const z => toString z
  | poly.var n => "var" ++ toString n
  | poly.add p q => "(" ++ poly.mk_string p ++ " + " ++ poly.mk_string q ++ ")"
  | poly.sub p q => "(" ++ poly.mk_string p ++ " - " ++ poly.mk_string q ++ ")"
  | poly.mul p q => "(" ++ poly.mk_string p ++ " * " ++ poly.mk_string q ++ ")"
  | poly.pow p n => toString <| f!"({(poly.mk_string p)} ^ {n})"
  | poly.neg p => "-" ++ poly.mk_string p
#align polyrith.poly.mk_string polyrith.poly.mk_string

unsafe instance : Add Poly :=
  ⟨Poly.add⟩

unsafe instance : Sub Poly :=
  ⟨Poly.sub⟩

unsafe instance : Mul Poly :=
  ⟨Poly.mul⟩

unsafe instance : Pow Poly ℕ :=
  ⟨Poly.pow⟩

unsafe instance : Neg Poly :=
  ⟨Poly.neg⟩

unsafe instance : Repr Poly :=
  ⟨poly.mk_string⟩

unsafe instance : has_to_format Poly :=
  ⟨to_fmt ∘ poly.mk_string⟩

unsafe instance : Inhabited Poly :=
  ⟨Poly.const 0⟩

/-!
# Parsing algorithms

The following section contains code that can convert an `expr` of type `Prop` into a `poly` object
(provided that it is an equality)
-/

/-- `(vars, p) ← poly_form_of_atom red vars e` is the atomic case for `poly_form_of_expr`.
If `e` appears with index `k` in `vars`, it returns the singleton sum `p = poly.var k`.
Otherwise it updates `vars`, adding `e` with index `n`, and returns the singleton `p = poly.var n`.
-/
unsafe def poly_form_of_atom (red : Transparency) (vars : List expr) (e : expr) :
    tactic (List expr × Poly) := do
  let index_of_e ←
    vars.foldlIdxM
        (fun n last e' =>
          match last with
          | none => tactic.try_core <| tactic.is_def_eq e e' red >> return n
          | some k => return k)
        none
  return
      (match index_of_e with
      | some k => (vars, poly.var k)
      | none => (vars e, poly.var vars))
#align polyrith.poly_form_of_atom polyrith.poly_form_of_atom

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      `poly_form_of_expr red map e` computes the polynomial form of `e`.

      `map` is a lookup map from atomic expressions to variable numbers.
      If a new atomic expression is encountered, it is added to the map with a new number.
      It matches atomic expressions up to reducibility given by `red`.

      Because it matches up to definitional equality, this function must be in the `tactic` monad,
      and forces some functions that call it into `tactic` as well.
      -/
    unsafe
  def
    poly_form_of_expr
    ( red : Transparency ) : List expr → expr → tactic ( List expr × Poly )
    |
        m , q( $ ( e1 ) * $ ( e2 ) )
        =>
        do
          let ( m' , comp1 ) ← poly_form_of_expr m e1
            let ( m' , comp2 ) ← poly_form_of_expr m' e2
            return ( m' , comp1 * comp2 )
      |
        m , q( $ ( e1 ) + $ ( e2 ) )
        =>
        do
          let ( m' , comp1 ) ← poly_form_of_expr m e1
            let ( m' , comp2 ) ← poly_form_of_expr m' e2
            return ( m' , comp1 + comp2 )
      |
        m , q( $ ( e1 ) - $ ( e2 ) )
        =>
        do
          let ( m' , comp1 ) ← poly_form_of_expr m e1
            let ( m' , comp2 ) ← poly_form_of_expr m' e2
            return ( m' , comp1 - comp2 )
      | m , q( - $ ( e ) ) => do let ( m' , comp ) ← poly_form_of_expr m e return ( m' , - comp )
      |
        m , p @ q( @ Pow.pow _ ℕ _ $ ( e ) $ ( n ) )
        =>
        match
          n . toNat
          with
          | some k => do let ( m' , comp ) ← poly_form_of_expr m e return ( m' , comp ^ k )
            | none => poly_form_of_atom red m p
      |
        m , e
        =>
        match
          e . to_rat
          with
          | some z => return ⟨ m , Poly.const z ⟩ | none => poly_form_of_atom red m e
#align polyrith.poly_form_of_expr polyrith.poly_form_of_expr

/-!
# Un-Parsing algorithms

The following section contains code that can convert an a `poly` object into a `pexpr`.
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `n -/
-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      This can convert a `poly` into a `pexpr` that would evaluate to a polynomial.
      To do so, it uses a list `m` of expressions, the atomic expressions that appear in the `poly`.
      The index of an expression in this list corresponds to its `poly.var` argument: that is,
      if `e` is the `k`th element of `m`, then it is represented as `poly.var k`.

      `poly` objects only contain coefficients from `ℚ`. However, the `poly` object might
      be referring to a polynomial over some other field. As such, the resulting `pexpr` contains
      no typing information.
      -/
    unsafe
  def
    poly.to_pexpr
    : List expr → Poly → tactic pexpr
    | _ , poly.const z => return z . to_pexpr
      |
        m , poly.var n
        =>
        do
          let some e ← return <| m . get? n | throwError "unknown variable poly.var { ← n }"
            return ` `( $ ( e ) )
      |
        m , poly.add p q
        =>
        do
          let p_pexpr ← poly.to_pexpr m p
            let q_pexpr ← poly.to_pexpr m q
            return ` `( $ ( p_pexpr ) + $ ( q_pexpr ) )
      |
        m , poly.sub p q
        =>
        do
          let p_pexpr ← poly.to_pexpr m p
            let q_pexpr ← poly.to_pexpr m q
            if
              p_pexpr = ` `( 0 )
              then
              return ` `( - $ ( q_pexpr ) )
              else
              return ` `( $ ( p_pexpr ) - $ ( q_pexpr ) )
      |
        m , poly.mul p q
        =>
        do
          let p_pexpr ← poly.to_pexpr m p
            let q_pexpr ← poly.to_pexpr m q
            return ` `( $ ( p_pexpr ) * $ ( q_pexpr ) )
      |
        m , poly.pow p n
        =>
        do let p_pexpr ← poly.to_pexpr m p return ` `( $ ( p_pexpr ) ^ n $ ( n.to_pexpr ) )
      | m , poly.neg p => do let p_pexpr ← poly.to_pexpr m p return ` `( - $ ( p_pexpr ) )
#align polyrith.poly.to_pexpr polyrith.poly.to_pexpr

/-!
# Parsing SageMath output into a poly

The following section contains code that can convert a string of appropriate format into
a `poly` object. This is used later on to convert the coefficients given by Sage into
`poly` objects.
-/

open Parser

/-- A parser object that parses `string`s of the form `"poly.var n"`
to the appropriate `poly` object representing a variable.
Here, `n` is a natural number
-/
unsafe def var_parser : Parser Poly := do
  str "poly.var " >> poly.var <$> Parser.nat
#align polyrith.var_parser polyrith.var_parser

/-- A parser object that parses `string`s of the form `"poly.const r"`
to the appropriate `poly` object representing a rational coefficient.
Here, `r` is a rational number
-/
unsafe def const_fraction_parser : Parser Poly :=
  str "poly.const " >> Poly.const <$> Parser.rat
#align polyrith.const_fraction_parser polyrith.const_fraction_parser

/-- A parser object that parses `string`s of the form `"poly.add p q"`
to the appropriate `poly` object representing the sum of two `poly`s.
Here, `p` and `q` are themselves string forms of `poly`s.
-/
unsafe def add_parser (cont : Parser Poly) : Parser Poly :=
  str "poly.add " >> Poly.add <$> cont <*> (ch ' ' >> cont)
#align polyrith.add_parser polyrith.add_parser

/-- A parser object that parses `string`s of the form `"poly.sub p q"`
to the appropriate `poly` object representing the subtraction of two `poly`s.
Here, `p` and `q` are themselves string forms of `poly`s.
-/
unsafe def sub_parser (cont : Parser Poly) : Parser Poly :=
  str "poly.sub " >> Poly.sub <$> cont <*> (ch ' ' >> cont)
#align polyrith.sub_parser polyrith.sub_parser

/-- A parser object that parses `string`s of the form `"poly.mul p q"`
to the appropriate `poly` object representing the product of two `poly`s.
Here, `p` and `q` are themselves string forms of `poly`s.
-/
unsafe def mul_parser (cont : Parser Poly) : Parser Poly :=
  str "poly.mul " >> Poly.mul <$> cont <*> (ch ' ' >> cont)
#align polyrith.mul_parser polyrith.mul_parser

/-- A parser object that parses `string`s of the form `"poly.pow p n"`
to the appropriate `poly` object representing a `poly` raised to the
power of a natural number. Here, `p` is the string form of a `poly`
and `n` is a natural number.
-/
unsafe def pow_parser (cont : Parser Poly) : Parser Poly :=
  str "poly.pow " >> Poly.pow <$> cont <*> (ch ' ' >> Nat)
#align polyrith.pow_parser polyrith.pow_parser

/-- A parser object that parses `string`s of the form `"poly.neg p"`
to the appropriate `poly` object representing the negation of a `poly`.
Here, `p` is the string form of a `poly`.
-/
unsafe def neg_parser (cont : Parser Poly) : Parser Poly :=
  str "poly.neg " >> Poly.neg <$> cont
#align polyrith.neg_parser polyrith.neg_parser

/-- A parser for `poly` that uses an s-essresion style formats such as
`(poly.add (poly.var 0) (poly.const 1)`. -/
unsafe def poly_parser : Parser Poly :=
  ch '(' *>
      (var_parser <|>
        const_fraction_parser <|>
          add_parser poly_parser <|>
            sub_parser poly_parser <|>
              mul_parser poly_parser <|> pow_parser poly_parser <|> neg_parser poly_parser) <*
    ch ')'
#align polyrith.poly_parser polyrith.poly_parser

unsafe instance : non_null_json_serializable Poly
    where
  to_json p := json.null
  -- we don't actually need this, but the typeclass asks for it
  of_json j := do
    let s ← of_json String j
    match poly_parser s with
      | Sum.inl s =>
        exceptional.fail
          f! "unable to parse polynomial from.

            {s}"
      | Sum.inr p => pure p

/-- A schema for success messages from the python script -/
structure SageJsonSuccess where
  success : { b : Bool // b = true }
  trace : Option String := none
  data : Option (List Poly) := none
  deriving non_null_json_serializable, Inhabited
#align polyrith.sage_json_success Polyrith.SageJsonSuccess

/-- A schema for failure messages from the python script -/
structure SageJsonFailure where
  success : { b : Bool // b = false }
  errorName : String
  errorValue : String
  deriving non_null_json_serializable, Inhabited
#align polyrith.sage_json_failure Polyrith.SageJsonFailure

/-- Parse the json output from `scripts/polyrith.py` into either an error message, a list of `poly`
objects, or `none` if only trace output was requested. -/
unsafe def convert_sage_output (j : json) : tactic (Option (List Poly)) := do
  let r : Sum SageJsonSuccess SageJsonFailure ←
    decorate_ex "internal json error: "
        (-- try the error format first, so that if both fail we get the message from the success parser
            Sum.inr <$>
            of_json SageJsonFailure j <|>
          Sum.inl <$> of_json SageJsonSuccess j)
  match r with
    | Sum.inr f => throwError "polyrith failed to retrieve a solution from Sage! {(← f)}: {← f}"
    | Sum.inl s => do
      s trace
      pure s
#align polyrith.convert_sage_output polyrith.convert_sage_output

/-!
# Parsing context into poly

The following section contains code that collects hypotheses of the appropriate type
from the context (and from the list of hypotheses and proof terms specified by the user)
and converts them into `poly` objects.
-/

-- failed to format: unknown constant 'term.pseudo.antiquot'
/-- Convert an expression of the form `lhs = rhs` into the form `lhs - rhs` -/ unsafe
  def
    equality_to_left_side
    : expr → tactic expr
    | q( $ ( lhs ) = $ ( rhs ) ) => to_expr ` `( $ ( lhs ) - $ ( rhs ) )
      | e => fail "expression is not an equality"
#align polyrith.equality_to_left_side polyrith.equality_to_left_side

/-- `(vars, poly, typ) ← parse_target_to_poly` interprets the current target (an equality over
some field) into a `poly`. The result is a list of the atomic expressions in the target,
the `poly` itself, and an `expr` representing the type of the field. -/
unsafe def parse_target_to_poly : tactic (List expr × Poly × expr) := do
  let e@q(@Eq $(R) _ _) ← target
  let left_side ← equality_to_left_side e
  let (m, p) ← poly_form_of_expr Transparency.reducible [] left_side
  return (m, p, R)
#align polyrith.parse_target_to_poly polyrith.parse_target_to_poly

/-- Filter `l` to the elements which are equalities of type `expt`. -/
unsafe def get_equalities_of_type (expt : expr) (l : List expr) : tactic (List expr) :=
  l.filterM fun h_eq =>
    succeeds do
      let q(@Eq $(R) _ _) ← infer_type h_eq
      unify expt R
#align polyrith.get_equalities_of_type polyrith.get_equalities_of_type

/-- The purpose of this tactic is to collect all the hypotheses
and proof terms (specified by the user) that are equalities
of the same type as the target. It takes in an `expr` representing
the type, a list of expressions representing the atoms
(typically this starts as only containing
information about the target), a `bool` representing whether the
user used the key word "only", and a `list pexpr` of all the
hypotheses and proof terms selected by the user.

If the key word "only" is used, it collects together only those
hypotheses/proof terms selected by the user. If not, they are
combined with hypotheses from the local context. We throw out
those hypotheses that are not equalities of the given type,
and then modify each equality such that everything has been
moved to the left of the "=" sign.

The tactic returns the names of these hypotheses (as `expr`s),
a list of atoms updated with information from all these hypotheses,
and a list of these hypotheses converted into `poly` objects.
-/
unsafe def parse_ctx_to_polys (expt : expr) (m : List expr) (only_on : Bool) (hyps : List pexpr) :
    tactic (List expr × List expr × List Poly) := do
  let hyps ← hyps.mapM i_to_expr
  let hyps ← if only_on then return hyps else (· ++ hyps) <$> local_context
  let eq_names ← get_equalities_of_type expt hyps
  let eqs ← eq_names.mapM infer_type
  let eqs_to_left ← eqs.mapM equality_to_left_side
  let-- convert the expressions to polynomials, tracking the variables in `m`
    (m, poly_list)
    ←
    eqs_to_left.foldlM
        (fun (s : _ × List Poly) new_exp => do
          let (m, poly_list) := s
          let (m', new_poly) ← poly_form_of_expr Transparency.reducible m new_exp
          return (m', poly_list ++ [new_poly]))
        (m, [])
  return (eq_names, m, poly_list)
#align polyrith.parse_ctx_to_polys polyrith.parse_ctx_to_polys

/-!
# Connecting with Python

The following section contains code that allows lean to communicate with a python script.
-/

/-- This tactic calls python from the command line with the args in `arg_list`.
The output printed to the console is returned as a `string`.
It assumes that `python3` is available on the path.
-/
unsafe def sage_output (arg_list : List String := []) : tactic json := do
  let path ← get_mathlib_dir
  let args := [Path ++ "../scripts/polyrith_sage.py"] ++ arg_list
  let s ←
    unsafe_run_io <|
        Io.cmd
          { cmd := "python3"
            args }
  let some j ← pure (json.parse s) |
    throwError "Invalid json: {← s}"
  pure j
#align polyrith.sage_output polyrith.sage_output

/-- Adds parentheses around additions and subtractions, for printing at
precedence 65.
-/
unsafe def add_parens : expr → tactic format
  | e@q(_ + _) => f!"({← e})"
  | e@q(_ - _) => f!"({← e})"
  | e => f!"{← e}"
#align polyrith.add_parens polyrith.add_parens

/-- Given a pair of `expr`s, where one represents the hypothesis/proof term,
and the other representes the coefficient attached to it, this tactic
creates a string combining the two in the appropriate format for
`linear_combination`.

The boolean value returned is `tt` if the format needs to be negated
to accurately reflect the input expressions.
The negation is not applied in the format output by this function,
because it may appear as a negation (if this is the first component)
or a subtraction.
-/
unsafe def component_to_lc_format : expr × expr → tactic (Bool × format)
  | (ex, q(@One.one _ _)) => Prod.mk false <$> f!"{← ex}"
  | (ex, q(@One.one _ _ / $(cf))) => do
    let f ← add_parens cf
    Prod.mk ff <$> f!"{(← ex)} / {← f}"
  | (ex, q(-$(cf))) => do
    let (neg, fmt) ← component_to_lc_format (ex, cf)
    return (!neg, fmt)
  | (ex, cf) => do
    let f ← add_parens cf
    Prod.mk ff <$> f!"{(← f)} * {← ex}"
#align polyrith.component_to_lc_format polyrith.component_to_lc_format

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
private unsafe def intersperse_ops_aux : List (Bool × format) → format
  | [] => ""
  | (ff, fmt)::t => " +" ++ format.soft_break ++ fmt ++ intersperse_ops_aux t
  | (tt, fmt)::t => " -" ++ format.soft_break ++ fmt ++ intersperse_ops_aux t
#align polyrith.intersperse_ops_aux polyrith.intersperse_ops_aux

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- Given a `list (bool × format)`, this function uses `+` and `-` to conjoin the
`format`s in the list. A `format` is negated if its corresponding `bool` is `tt`.
-/
unsafe def intersperse_ops : List (Bool × format) → format
  | [] => ""
  | (ff, fmt)::t => fmt ++ intersperse_ops_aux t
  | (tt, fmt)::t => "-" ++ fmt ++ intersperse_ops_aux t
#align polyrith.intersperse_ops polyrith.intersperse_ops

/-- This tactic repeats the process above for a `list` of pairs of `expr`s.-/
unsafe def components_to_lc_format (components : List (expr × expr)) : tactic format :=
  intersperse_ops <$> components.mapM component_to_lc_format
#align polyrith.components_to_lc_format polyrith.components_to_lc_format

/-!
# Connecting with Python

The following section contains code that allows lean to communicate with a python script.
-/

initialize
  registerTraceClass.1 `polyrith

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- The first half of `tactic.polyrith` produces a list of arguments to be sent to Sage.
-/
unsafe def create_args (only_on : Bool) (hyps : List pexpr) :
    tactic (List expr × List expr × expr × List String) := do
  let (m, p, R) ← parse_target_to_poly
  let (eq_names, m, polys) ← parse_ctx_to_polys R m only_on hyps
  let args := [toString R, toString m.length, (polys.map poly.mk_string).toString, p.mk_string]
  return <| (eq_names, m, R, toString (is_trace_enabled_for `polyrith)::args)
#align polyrith.create_args polyrith.create_args

/-- The second half of `tactic.polyrith` processes the output from Sage into
a call to `linear_combination`.
-/
unsafe def process_output (eq_names : List expr) (m : List expr) (R : expr) (sage_out : json) :
    tactic format :=
  focus1 do
    let some coeffs_as_poly ← convert_sage_output sage_out |
      throwError"internal error: No output available"
    let coeffs_as_pexpr ← coeffs_as_poly.mapM (poly.to_pexpr m)
    let eq_names_pexpr := eq_names.map to_pexpr
    let coeffs_as_expr ← coeffs_as_pexpr.mapM fun e => to_expr ``(($(e) : $(R)))
    linear_combo.linear_combination eq_names_pexpr coeffs_as_pexpr
    let components :=
      (eq_names.zip coeffs_as_expr).filterₓ fun pr => not <| pr.2.is_app_of `has_zero.zero
    let expr_string ← components_to_lc_format components
    let lc_fmt : format := "linear_combination " ++ format.nest 2 (format.group expr_string)
    done <|>
        throwError "polyrith found the following certificate, but it failed to close the goal:
          {← lc_fmt}"
    return <| "linear_combination " ++ format.nest 2 (format.group expr_string)
#align polyrith.process_output polyrith.process_output

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/-- Tactic for the special case when no hypotheses are available. -/
unsafe def no_hypotheses_case : tactic (Option format) :=
  (do
      sorry
      return <| some "ring") <|>
    fail "polyrith did not find any relevant hypotheses and the goal is not provable by ring"
#align polyrith.no_hypotheses_case polyrith.no_hypotheses_case

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/-- Tactic for the special case when there are no variables. -/
unsafe def no_variables_case : tactic (Option format) :=
  (do
      sorry
      return <| some "ring") <|>
    fail "polyrith did not find any variables and the goal is not provable by ring"
#align polyrith.no_variables_case polyrith.no_variables_case

/-- This is the main body of the `polyrith` tactic. It takes in the following inputs:
* `(only_on : bool)` - This represents whether the user used the key word "only"
* `(hyps : list pexpr)` - the hypotheses/proof terms selecteed by the user

First, the tactic converts the target into a `poly`, and finds out what type it
is an equality of. (It also fills up a list of `expr`s with its atoms). Then, it
collects all the relevant hypotheses/proof terms from the context, and from those
selected by the user, taking into account whether `only_on` is true. (The list of atoms is
updated accordingly as well).

This information is used to create a list of args that get used in a call to
the appropriate python file that executes a grobner basis computation. The
output of this computation is a `string` representing the certificate. This
string is parsed into a list of `poly` objects that are then converted into
`pexpr`s (using the updated list of atoms).

the names of the hypotheses, along with the corresponding coefficients are
given to `linear_combination`. If that tactic succeeds, the user is prompted
to replace the call to `polyrith` with the appropriate call to
`linear_combination`.

This returns `none` if this was a "dry run" attempt that does not actually invoke sage.
-/
unsafe def _root_.tactic.polyrith (only_on : Bool) (hyps : List pexpr) : tactic (Option format) :=
  do
  sleep 10
  let-- otherwise can lead to weird errors when actively editing code with polyrith calls
    (eq_names, m, R, args)
    ← create_args only_on hyps
  if eq_names = 0 then no_hypotheses_case
    else
      if m = 0 then no_variables_case
      else do
        let sage_out ← sage_output args
        if is_trace_enabled_for `polyrith then do
            convert_sage_output sage_out
            return none
          else some <$> process_output eq_names m R sage_out
#align tactic.polyrith tactic.polyrith

/-! # Interactivity -/

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
/-- Attempts to prove polynomial equality goals through polynomial arithmetic
on the hypotheses (and additional proof terms if the user specifies them).
It proves the goal by generating an appropriate call to the tactic
`linear_combination`. If this call succeeds, the call to `linear_combination`
is suggested to the user.

* `polyrith` will use all relevant hypotheses in the local context.
* `polyrith [t1, t2, t3]` will add proof terms t1, t2, t3 to the local context.
* `polyrith only [h1, h2, h3, t1, t2, t3]` will use only local hypotheses
  `h1`, `h2`, `h3`, and proofs `t1`, `t2`, `t3`. It will ignore the rest of the local context.

Notes:
* This tactic only works with a working internet connection, since it calls Sage
  using the SageCell web API at <https://sagecell.sagemath.org/>.
  Many thanks to the Sage team and organization for allowing this use.
* This tactic assumes that the user has `python3` installed and available on the path.
  (Test by opening a terminal and executing `python3 --version`.)
  It also assumes that the `requests` library is installed: `python3 -m pip install requests`.

Examples:

```lean
example (x y : ℚ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
  x*y = -2*y + 1 :=
by polyrith
-- Try this: linear_combination h1 - 2 * h2

example (x y z w : ℚ) (hzw : z = w) : x*z + 2*y*z = x*w + 2*y*w :=
by polyrith
-- Try this: linear_combination (2 * y + x) * hzw

constant scary : ∀ a b : ℚ, a + b = 0

example (a b c d : ℚ) (h : a + b = 0) (h2: b + c = 0) : a + b + c + d = 0 :=
by polyrith only [scary c d, h]
-- Try this: linear_combination scary c d + h
```
-/
unsafe def _root_.tactic.interactive.polyrith (restr : parse (tk "only")?)
    (hyps : parse pexpr_list ?) : tactic Unit := do
  let some f ← tactic.polyrith restr.isSome (hyps.getD []) |
    skip
  ← do
      dbg_trace "Try this: {← f}"
#align tactic.interactive.polyrith tactic.interactive.polyrith

add_tactic_doc
  { Name := "polyrith"
    category := DocCategory.tactic
    declNames := [`tactic.interactive.polyrith]
    tags := ["arithmetic", "finishing", "decision procedure"] }

end Polyrith


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

! This file was ported from Lean 3 source module algebra.order.rearrangement
! leanprover-community/mathlib commit b3f25363ae62cb169e72cd6b8b1ac97bacf21ca7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.BigOperators.Basic
import Mathbin.Algebra.Order.Module
import Mathbin.Data.Prod.Lex
import Mathbin.GroupTheory.Perm.Support
import Mathbin.Order.Monotone.Monovary
import Mathbin.Tactic.Abel

/-!
# Rearrangement inequality

This file proves the rearrangement inequality and deduces the conditions for equality and strict
inequality.

The rearrangement inequality tells you that for two functions `f g : ι → α`, the sum
`∑ i, f i * g (σ i)` is maximized over all `σ : perm ι` when `g ∘ σ` monovaries with `f` and
minimized when `g ∘ σ` antivaries with `f`.

The inequality also tells you that `∑ i, f i * g (σ i) = ∑ i, f i * g i` if and only if `g ∘ σ`
monovaries with `f` when `g` monovaries with `f`. The above equality also holds if and only if
`g ∘ σ` antivaries with `f` when `g` antivaries with `f`.

From the above two statements, we deduce that the inequality is strict if and only if `g ∘ σ` does
not monovary with `f` when `g` monovaries with `f`. Analogously, the inequality is strict if and
only if `g ∘ σ` does not antivary with `f` when `g` antivaries with `f`.

## Implementation notes

In fact, we don't need much compatibility between the addition and multiplication of `α`, so we can
actually decouple them by replacing multiplication with scalar multiplication and making `f` and `g`
land in different types.
As a bonus, this makes the dual statement trivial. The multiplication versions are provided for
convenience.

The case for `monotone`/`antitone` pairs of functions over a `linear_order` is not deduced in this
file because it is easily deducible from the `monovary` API.
-/

open Equiv Equiv.Perm Finset Function OrderDual

open BigOperators

variable {ι α β : Type _}

/-! ### Scalar multiplication versions -/

section Smul

variable [LinearOrderedRing α] [LinearOrderedAddCommGroup β] [Module α β] [OrderedSMul α β]
  {s : Finset ι} {σ : Perm ι} {f : ι → α} {g : ι → β}

/-- **Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g` is maximized when
`f` and `g` monovary together. Stated by permuting the entries of `g`. -/
theorem MonovaryOn.sum_smul_comp_perm_le_sum_smul (hfg : MonovaryOn f g s)
    (hσ : { x | σ x ≠ x } ⊆ s) : (∑ i in s, f i • g (σ i)) ≤ ∑ i in s, f i • g i := by
  classical
    revert hσ σ hfg
    apply Finset.induction_on_max_value (fun i => toLex (g i, f i)) s
    · simp only [le_rfl, Finset.sum_empty, imp_true_iff]
    intro a s has hamax hind σ hfg hσ
    set τ : perm ι := σ.trans (swap a (σ a)) with hτ
    have hτs : { x | τ x ≠ x } ⊆ s := by
      intro x hx
      simp only [Ne.def, Set.mem_setOf_eq, Equiv.coe_trans, Equiv.swap_comp_apply] at hx
      split_ifs  at hx with h₁ h₂ h₃
      · obtain rfl | hax := eq_or_ne x a
        · contradiction
        · exact mem_of_mem_insert_of_ne (hσ fun h => hax <| h.symm.trans h₁) hax
      · exact (hx <| σ.injective h₂.symm).elim
      · exact mem_of_mem_insert_of_ne (hσ hx) (ne_of_apply_ne _ h₂)
    specialize hind (hfg.subset <| subset_insert _ _) hτs
    simp_rw [sum_insert has]
    refine' le_trans _ (add_le_add_left hind _)
    obtain hσa | hσa := eq_or_ne a (σ a)
    · rw [hτ, ← hσa, swap_self, trans_refl]
    have h1s : σ⁻¹ a ∈ s := by
      rw [Ne.def, ← inv_eq_iff_eq] at hσa
      refine' mem_of_mem_insert_of_ne (hσ fun h => hσa _) hσa
      rwa [apply_inv_self, eq_comm] at h
    simp only [← s.sum_erase_add _ h1s, add_comm]
    rw [← add_assoc, ← add_assoc]
    simp only [hτ, swap_apply_left, Function.comp_apply, Equiv.coe_trans, apply_inv_self]
    refine' add_le_add (smul_add_smul_le_smul_add_smul' _ _) (sum_congr rfl fun x hx => _).le
    · specialize hamax (σ⁻¹ a) h1s
      rw [Prod.Lex.le_iff] at hamax
      cases hamax
      · exact hfg (mem_insert_of_mem h1s) (mem_insert_self _ _) hamax
      · exact hamax.2
    · specialize hamax (σ a) (mem_of_mem_insert_of_ne (hσ <| σ.injective.ne hσa.symm) hσa.symm)
      rw [Prod.Lex.le_iff] at hamax
      cases hamax
      · exact hamax.le
      · exact hamax.1.le
    · rw [mem_erase, Ne.def, eq_inv_iff_eq] at hx
      rw [swap_apply_of_ne_of_ne hx.1 (σ.injective.ne _)]
      rintro rfl
      exact has hx.2
#align monovary_on.sum_smul_comp_perm_le_sum_smul MonovaryOn.sum_smul_comp_perm_le_sum_smul

/-- **Equality case of Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g`,
which monovary together, is unchanged by a permutation if and only if `f` and `g ∘ σ` monovary
together. Stated by permuting the entries of `g`. -/
theorem MonovaryOn.sum_smul_comp_perm_eq_sum_smul_iff (hfg : MonovaryOn f g s)
    (hσ : { x | σ x ≠ x } ⊆ s) :
    ((∑ i in s, f i • g (σ i)) = ∑ i in s, f i • g i) ↔ MonovaryOn f (g ∘ σ) s := by
  classical
    refine' ⟨not_imp_not.1 fun h => _, fun h => (hfg.sum_smul_comp_perm_le_sum_smul hσ).antisymm _⟩
    · rw [MonovaryOn] at h
      push_neg  at h
      obtain ⟨x, hx, y, hy, hgxy, hfxy⟩ := h
      set τ : perm ι := (swap x y).trans σ
      have hτs : { x | τ x ≠ x } ⊆ s :=
        by
        refine' (set_support_mul_subset σ <| swap x y).trans (Set.union_subset hσ fun z hz => _)
        obtain ⟨_, rfl | rfl⟩ := swap_apply_ne_self_iff.1 hz <;> assumption
      refine' ((hfg.sum_smul_comp_perm_le_sum_smul hτs).trans_lt' _).Ne
      obtain rfl | hxy := eq_or_ne x y
      · cases lt_irrefl _ hfxy
      simp only [← s.sum_erase_add _ hx, ← (s.erase x).sum_erase_add _ (mem_erase.2 ⟨hxy.symm, hy⟩),
        add_assoc, Equiv.coe_trans, Function.comp_apply, swap_apply_right, swap_apply_left]
      refine'
        add_lt_add_of_le_of_lt (Finset.sum_congr rfl fun z hz => _).le
          (smul_add_smul_lt_smul_add_smul hfxy hgxy)
      simp_rw [mem_erase] at hz
      rw [swap_apply_of_ne_of_ne hz.2.1 hz.1]
    · convert h.sum_smul_comp_perm_le_sum_smul ((set_support_inv_eq _).Subset.trans hσ) using 1
      simp_rw [Function.comp_apply, apply_inv_self]
#align monovary_on.sum_smul_comp_perm_eq_sum_smul_iff MonovaryOn.sum_smul_comp_perm_eq_sum_smul_iff

/-- **Strict inequality case of Rearrangement Inequality**: Pointwise scalar multiplication of
`f` and `g`, which monovary together, is strictly decreased by a permutation if and only if
`f` and `g ∘ σ` do not monovary together. Stated by permuting the entries of `g`. -/
theorem MonovaryOn.sum_smul_comp_perm_lt_sum_smul_iff (hfg : MonovaryOn f g s)
    (hσ : { x | σ x ≠ x } ⊆ s) :
    ((∑ i in s, f i • g (σ i)) < ∑ i in s, f i • g i) ↔ ¬MonovaryOn f (g ∘ σ) s := by
  simp [← hfg.sum_smul_comp_perm_eq_sum_smul_iff hσ, lt_iff_le_and_ne,
    hfg.sum_smul_comp_perm_le_sum_smul hσ]
#align monovary_on.sum_smul_comp_perm_lt_sum_smul_iff MonovaryOn.sum_smul_comp_perm_lt_sum_smul_iff

/-- **Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g` is maximized when
`f` and `g` monovary together. Stated by permuting the entries of `f`. -/
theorem MonovaryOn.sum_comp_perm_smul_le_sum_smul (hfg : MonovaryOn f g s)
    (hσ : { x | σ x ≠ x } ⊆ s) : (∑ i in s, f (σ i) • g i) ≤ ∑ i in s, f i • g i :=
  by
  convert hfg.sum_smul_comp_perm_le_sum_smul
      (show { x | σ⁻¹ x ≠ x } ⊆ s by simp only [set_support_inv_eq, hσ]) using
    1
  exact σ.sum_comp' s (fun i j => f i • g j) hσ
#align monovary_on.sum_comp_perm_smul_le_sum_smul MonovaryOn.sum_comp_perm_smul_le_sum_smul

/-- **Equality case of Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g`,
which monovary together, is unchanged by a permutation if and only if `f ∘ σ` and `g` monovary
together. Stated by permuting the entries of `f`. -/
theorem MonovaryOn.sum_comp_perm_smul_eq_sum_smul_iff (hfg : MonovaryOn f g s)
    (hσ : { x | σ x ≠ x } ⊆ s) :
    ((∑ i in s, f (σ i) • g i) = ∑ i in s, f i • g i) ↔ MonovaryOn (f ∘ σ) g s :=
  by
  have hσinv : { x | σ⁻¹ x ≠ x } ⊆ s := (set_support_inv_eq _).Subset.trans hσ
  refine'
    (Iff.trans _ <| hfg.sum_smul_comp_perm_eq_sum_smul_iff hσinv).trans ⟨fun h => _, fun h => _⟩
  · simpa only [σ.sum_comp' s (fun i j => f i • g j) hσ]
  · convert h.comp_right σ
    · rw [comp.assoc, inv_def, symm_comp_self, comp.right_id]
    · rw [σ.eq_preimage_iff_image_eq, Set.image_perm hσ]
  · convert h.comp_right σ.symm
    · rw [comp.assoc, self_comp_symm, comp.right_id]
    · rw [σ.symm.eq_preimage_iff_image_eq]
      exact Set.image_perm hσinv
#align monovary_on.sum_comp_perm_smul_eq_sum_smul_iff MonovaryOn.sum_comp_perm_smul_eq_sum_smul_iff

/-- **Strict inequality case of Rearrangement Inequality**: Pointwise scalar multiplication of
`f` and `g`, which monovary together, is strictly decreased by a permutation if and only if
`f ∘ σ` and `g` do not monovary together. Stated by permuting the entries of `f`. -/
theorem MonovaryOn.sum_comp_perm_smul_lt_sum_smul_iff (hfg : MonovaryOn f g s)
    (hσ : { x | σ x ≠ x } ⊆ s) :
    ((∑ i in s, f (σ i) • g i) < ∑ i in s, f i • g i) ↔ ¬MonovaryOn (f ∘ σ) g s := by
  simp [← hfg.sum_comp_perm_smul_eq_sum_smul_iff hσ, lt_iff_le_and_ne,
    hfg.sum_comp_perm_smul_le_sum_smul hσ]
#align monovary_on.sum_comp_perm_smul_lt_sum_smul_iff MonovaryOn.sum_comp_perm_smul_lt_sum_smul_iff

/-- **Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g` is minimized when
`f` and `g` antivary together. Stated by permuting the entries of `g`. -/
theorem AntivaryOn.sum_smul_le_sum_smul_comp_perm (hfg : AntivaryOn f g s)
    (hσ : { x | σ x ≠ x } ⊆ s) : (∑ i in s, f i • g i) ≤ ∑ i in s, f i • g (σ i) :=
  hfg.dual_right.sum_smul_comp_perm_le_sum_smul hσ
#align antivary_on.sum_smul_le_sum_smul_comp_perm AntivaryOn.sum_smul_le_sum_smul_comp_perm

/-- **Equality case of the Rearrangement Inequality**: Pointwise scalar multiplication of `f` and
`g`, which antivary together, is unchanged by a permutation if and only if `f` and `g ∘ σ` antivary
together. Stated by permuting the entries of `g`. -/
theorem AntivaryOn.sum_smul_eq_sum_smul_comp_perm_iff (hfg : AntivaryOn f g s)
    (hσ : { x | σ x ≠ x } ⊆ s) :
    ((∑ i in s, f i • g (σ i)) = ∑ i in s, f i • g i) ↔ AntivaryOn f (g ∘ σ) s :=
  (hfg.dual_right.sum_smul_comp_perm_eq_sum_smul_iff hσ).trans monovaryOn_toDual_right
#align antivary_on.sum_smul_eq_sum_smul_comp_perm_iff AntivaryOn.sum_smul_eq_sum_smul_comp_perm_iff

/-- **Strict inequality case of the Rearrangement Inequality**: Pointwise scalar multiplication of
`f` and `g`, which antivary together, is strictly decreased by a permutation if and only if
`f` and `g ∘ σ` do not antivary together. Stated by permuting the entries of `g`. -/
theorem AntivaryOn.sum_smul_lt_sum_smul_comp_perm_iff (hfg : AntivaryOn f g s)
    (hσ : { x | σ x ≠ x } ⊆ s) :
    ((∑ i in s, f i • g i) < ∑ i in s, f i • g (σ i)) ↔ ¬AntivaryOn f (g ∘ σ) s := by
  simp [← hfg.sum_smul_eq_sum_smul_comp_perm_iff hσ, lt_iff_le_and_ne, eq_comm,
    hfg.sum_smul_le_sum_smul_comp_perm hσ]
#align antivary_on.sum_smul_lt_sum_smul_comp_perm_iff AntivaryOn.sum_smul_lt_sum_smul_comp_perm_iff

/-- **Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g` is minimized when
`f` and `g` antivary together. Stated by permuting the entries of `f`. -/
theorem AntivaryOn.sum_smul_le_sum_comp_perm_smul (hfg : AntivaryOn f g s)
    (hσ : { x | σ x ≠ x } ⊆ s) : (∑ i in s, f i • g i) ≤ ∑ i in s, f (σ i) • g i :=
  hfg.dual_right.sum_comp_perm_smul_le_sum_smul hσ
#align antivary_on.sum_smul_le_sum_comp_perm_smul AntivaryOn.sum_smul_le_sum_comp_perm_smul

/-- **Equality case of the Rearrangement Inequality**: Pointwise scalar multiplication of `f` and
`g`, which antivary together, is unchanged by a permutation if and only if `f ∘ σ` and `g` antivary
together. Stated by permuting the entries of `f`. -/
theorem AntivaryOn.sum_smul_eq_sum_comp_perm_smul_iff (hfg : AntivaryOn f g s)
    (hσ : { x | σ x ≠ x } ⊆ s) :
    ((∑ i in s, f (σ i) • g i) = ∑ i in s, f i • g i) ↔ AntivaryOn (f ∘ σ) g s :=
  (hfg.dual_right.sum_comp_perm_smul_eq_sum_smul_iff hσ).trans monovaryOn_toDual_right
#align antivary_on.sum_smul_eq_sum_comp_perm_smul_iff AntivaryOn.sum_smul_eq_sum_comp_perm_smul_iff

/-- **Strict inequality case of the Rearrangement Inequality**: Pointwise scalar multiplication of
`f` and `g`, which antivary together, is strictly decreased by a permutation if and only if
`f ∘ σ` and `g` do not antivary together. Stated by permuting the entries of `f`. -/
theorem AntivaryOn.sum_smul_lt_sum_comp_perm_smul_iff (hfg : AntivaryOn f g s)
    (hσ : { x | σ x ≠ x } ⊆ s) :
    ((∑ i in s, f i • g i) < ∑ i in s, f (σ i) • g i) ↔ ¬AntivaryOn (f ∘ σ) g s := by
  simp [← hfg.sum_smul_eq_sum_comp_perm_smul_iff hσ, eq_comm, lt_iff_le_and_ne,
    hfg.sum_smul_le_sum_comp_perm_smul hσ]
#align antivary_on.sum_smul_lt_sum_comp_perm_smul_iff AntivaryOn.sum_smul_lt_sum_comp_perm_smul_iff

variable [Fintype ι]

/-- **Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g` is maximized when
`f` and `g` monovary together. Stated by permuting the entries of `g`. -/
theorem Monovary.sum_smul_comp_perm_le_sum_smul (hfg : Monovary f g) :
    (∑ i, f i • g (σ i)) ≤ ∑ i, f i • g i :=
  (hfg.MonovaryOn _).sum_smul_comp_perm_le_sum_smul fun i _ => mem_univ _
#align monovary.sum_smul_comp_perm_le_sum_smul Monovary.sum_smul_comp_perm_le_sum_smul

/-- **Equality case of Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g`,
which monovary together, is unchanged by a permutation if and only if `f` and `g ∘ σ` monovary
together. Stated by permuting the entries of `g`. -/
theorem Monovary.sum_smul_comp_perm_eq_sum_smul_iff (hfg : Monovary f g) :
    ((∑ i, f i • g (σ i)) = ∑ i, f i • g i) ↔ Monovary f (g ∘ σ) := by
  simp [(hfg.monovary_on _).sum_smul_comp_perm_eq_sum_smul_iff fun i _ => mem_univ _]
#align monovary.sum_smul_comp_perm_eq_sum_smul_iff Monovary.sum_smul_comp_perm_eq_sum_smul_iff

/-- **Strict inequality case of Rearrangement Inequality**: Pointwise scalar multiplication of
`f` and `g`, which monovary together, is strictly decreased by a permutation if and only if
`f` and `g ∘ σ` do not monovary together. Stated by permuting the entries of `g`. -/
theorem Monovary.sum_smul_comp_perm_lt_sum_smul_iff (hfg : Monovary f g) :
    ((∑ i, f i • g (σ i)) < ∑ i, f i • g i) ↔ ¬Monovary f (g ∘ σ) := by
  simp [(hfg.monovary_on _).sum_smul_comp_perm_lt_sum_smul_iff fun i _ => mem_univ _]
#align monovary.sum_smul_comp_perm_lt_sum_smul_iff Monovary.sum_smul_comp_perm_lt_sum_smul_iff

/-- **Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g` is maximized when
`f` and `g` monovary together. Stated by permuting the entries of `f`. -/
theorem Monovary.sum_comp_perm_smul_le_sum_smul (hfg : Monovary f g) :
    (∑ i, f (σ i) • g i) ≤ ∑ i, f i • g i :=
  (hfg.MonovaryOn _).sum_comp_perm_smul_le_sum_smul fun i _ => mem_univ _
#align monovary.sum_comp_perm_smul_le_sum_smul Monovary.sum_comp_perm_smul_le_sum_smul

/-- **Equality case of Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g`,
which monovary together, is unchanged by a permutation if and only if `f ∘ σ` and `g` monovary
together. Stated by permuting the entries of `g`. -/
theorem Monovary.sum_comp_perm_smul_eq_sum_smul_iff (hfg : Monovary f g) :
    ((∑ i, f (σ i) • g i) = ∑ i, f i • g i) ↔ Monovary (f ∘ σ) g := by
  simp [(hfg.monovary_on _).sum_comp_perm_smul_eq_sum_smul_iff fun i _ => mem_univ _]
#align monovary.sum_comp_perm_smul_eq_sum_smul_iff Monovary.sum_comp_perm_smul_eq_sum_smul_iff

/-- **Strict inequality case of Rearrangement Inequality**: Pointwise scalar multiplication of
`f` and `g`, which monovary together, is strictly decreased by a permutation if and only if
`f` and `g ∘ σ` do not monovary together. Stated by permuting the entries of `g`. -/
theorem Monovary.sum_comp_perm_smul_lt_sum_smul_iff (hfg : Monovary f g) :
    ((∑ i, f (σ i) • g i) < ∑ i, f i • g i) ↔ ¬Monovary (f ∘ σ) g := by
  simp [(hfg.monovary_on _).sum_comp_perm_smul_lt_sum_smul_iff fun i _ => mem_univ _]
#align monovary.sum_comp_perm_smul_lt_sum_smul_iff Monovary.sum_comp_perm_smul_lt_sum_smul_iff

/-- **Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g` is minimized when
`f` and `g` antivary together. Stated by permuting the entries of `g`. -/
theorem Antivary.sum_smul_le_sum_smul_comp_perm (hfg : Antivary f g) :
    (∑ i, f i • g i) ≤ ∑ i, f i • g (σ i) :=
  (hfg.AntivaryOn _).sum_smul_le_sum_smul_comp_perm fun i _ => mem_univ _
#align antivary.sum_smul_le_sum_smul_comp_perm Antivary.sum_smul_le_sum_smul_comp_perm

/-- **Equality case of the Rearrangement Inequality**: Pointwise scalar multiplication of `f` and
`g`, which antivary together, is unchanged by a permutation if and only if `f` and `g ∘ σ` antivary
together. Stated by permuting the entries of `g`. -/
theorem Antivary.sum_smul_eq_sum_smul_comp_perm_iff (hfg : Antivary f g) :
    ((∑ i, f i • g (σ i)) = ∑ i, f i • g i) ↔ Antivary f (g ∘ σ) := by
  simp [(hfg.antivary_on _).sum_smul_eq_sum_smul_comp_perm_iff fun i _ => mem_univ _]
#align antivary.sum_smul_eq_sum_smul_comp_perm_iff Antivary.sum_smul_eq_sum_smul_comp_perm_iff

/-- **Strict inequality case of the Rearrangement Inequality**: Pointwise scalar multiplication of
`f` and `g`, which antivary together, is strictly decreased by a permutation if and only if
`f` and `g ∘ σ` do not antivary together. Stated by permuting the entries of `g`. -/
theorem Antivary.sum_smul_lt_sum_smul_comp_perm_iff (hfg : Antivary f g) :
    ((∑ i, f i • g i) < ∑ i, f i • g (σ i)) ↔ ¬Antivary f (g ∘ σ) := by
  simp [(hfg.antivary_on _).sum_smul_lt_sum_smul_comp_perm_iff fun i _ => mem_univ _]
#align antivary.sum_smul_lt_sum_smul_comp_perm_iff Antivary.sum_smul_lt_sum_smul_comp_perm_iff

/-- **Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g` is minimized when
`f` and `g` antivary together. Stated by permuting the entries of `f`. -/
theorem Antivary.sum_smul_le_sum_comp_perm_smul (hfg : Antivary f g) :
    (∑ i, f i • g i) ≤ ∑ i, f (σ i) • g i :=
  (hfg.AntivaryOn _).sum_smul_le_sum_comp_perm_smul fun i _ => mem_univ _
#align antivary.sum_smul_le_sum_comp_perm_smul Antivary.sum_smul_le_sum_comp_perm_smul

/-- **Equality case of the Rearrangement Inequality**: Pointwise scalar multiplication of `f` and
`g`, which antivary together, is unchanged by a permutation if and only if `f ∘ σ` and `g` antivary
together. Stated by permuting the entries of `f`. -/
theorem Antivary.sum_smul_eq_sum_comp_perm_smul_iff (hfg : Antivary f g) :
    ((∑ i, f (σ i) • g i) = ∑ i, f i • g i) ↔ Antivary (f ∘ σ) g := by
  simp [(hfg.antivary_on _).sum_smul_eq_sum_comp_perm_smul_iff fun i _ => mem_univ _]
#align antivary.sum_smul_eq_sum_comp_perm_smul_iff Antivary.sum_smul_eq_sum_comp_perm_smul_iff

/-- **Strict inequality case of the Rearrangement Inequality**: Pointwise scalar multiplication of
`f` and `g`, which antivary together, is strictly decreased by a permutation if and only if
`f ∘ σ` and `g` do not antivary together. Stated by permuting the entries of `f`. -/
theorem Antivary.sum_smul_lt_sum_comp_perm_smul_iff (hfg : Antivary f g) :
    ((∑ i, f i • g i) < ∑ i, f (σ i) • g i) ↔ ¬Antivary (f ∘ σ) g := by
  simp [(hfg.antivary_on _).sum_smul_lt_sum_comp_perm_smul_iff fun i _ => mem_univ _]
#align antivary.sum_smul_lt_sum_comp_perm_smul_iff Antivary.sum_smul_lt_sum_comp_perm_smul_iff

end Smul

/-!
### Multiplication versions

Special cases of the above when scalar multiplication is actually multiplication.
-/

section Mul

variable [LinearOrderedRing α] {s : Finset ι} {σ : Perm ι} {f g : ι → α}

/-- **Rearrangement Inequality**: Pointwise multiplication of `f` and `g` is maximized when `f` and
`g` monovary together. Stated by permuting the entries of `g`. -/
theorem MonovaryOn.sum_mul_comp_perm_le_sum_mul (hfg : MonovaryOn f g s)
    (hσ : { x | σ x ≠ x } ⊆ s) : (∑ i in s, f i * g (σ i)) ≤ ∑ i in s, f i * g i :=
  hfg.sum_smul_comp_perm_le_sum_smul hσ
#align monovary_on.sum_mul_comp_perm_le_sum_mul MonovaryOn.sum_mul_comp_perm_le_sum_mul

/-- **Equality case of Rearrangement Inequality**: Pointwise multiplication of `f` and `g`,
which monovary together, is unchanged by a permutation if and only if `f` and `g ∘ σ` monovary
together. Stated by permuting the entries of `g`. -/
theorem MonovaryOn.sum_mul_comp_perm_eq_sum_mul_iff (hfg : MonovaryOn f g s)
    (hσ : { x | σ x ≠ x } ⊆ s) :
    ((∑ i in s, f i * g (σ i)) = ∑ i in s, f i * g i) ↔ MonovaryOn f (g ∘ σ) s :=
  hfg.sum_smul_comp_perm_eq_sum_smul_iff hσ
#align monovary_on.sum_mul_comp_perm_eq_sum_mul_iff MonovaryOn.sum_mul_comp_perm_eq_sum_mul_iff

/-- **Strict inequality case of Rearrangement Inequality**: Pointwise scalar multiplication of
`f` and `g`, which monovary together, is strictly decreased by a permutation if and only if
`f` and `g ∘ σ` do not monovary together. Stated by permuting the entries of `g`. -/
theorem MonovaryOn.sum_mul_comp_perm_lt_sum_mul_iff (hfg : MonovaryOn f g s)
    (hσ : { x | σ x ≠ x } ⊆ s) :
    ((∑ i in s, f i • g (σ i)) < ∑ i in s, f i • g i) ↔ ¬MonovaryOn f (g ∘ σ) s :=
  hfg.sum_smul_comp_perm_lt_sum_smul_iff hσ
#align monovary_on.sum_mul_comp_perm_lt_sum_mul_iff MonovaryOn.sum_mul_comp_perm_lt_sum_mul_iff

/-- **Rearrangement Inequality**: Pointwise multiplication of `f` and `g` is maximized when `f` and
`g` monovary together. Stated by permuting the entries of `f`. -/
theorem MonovaryOn.sum_comp_perm_mul_le_sum_mul (hfg : MonovaryOn f g s)
    (hσ : { x | σ x ≠ x } ⊆ s) : (∑ i in s, f (σ i) * g i) ≤ ∑ i in s, f i * g i :=
  hfg.sum_comp_perm_smul_le_sum_smul hσ
#align monovary_on.sum_comp_perm_mul_le_sum_mul MonovaryOn.sum_comp_perm_mul_le_sum_mul

/-- **Equality case of Rearrangement Inequality**: Pointwise multiplication of `f` and `g`,
which monovary together, is unchanged by a permutation if and only if `f ∘ σ` and `g` monovary
together. Stated by permuting the entries of `f`. -/
theorem MonovaryOn.sum_comp_perm_mul_eq_sum_mul_iff (hfg : MonovaryOn f g s)
    (hσ : { x | σ x ≠ x } ⊆ s) :
    ((∑ i in s, f (σ i) * g i) = ∑ i in s, f i * g i) ↔ MonovaryOn (f ∘ σ) g s :=
  hfg.sum_comp_perm_smul_eq_sum_smul_iff hσ
#align monovary_on.sum_comp_perm_mul_eq_sum_mul_iff MonovaryOn.sum_comp_perm_mul_eq_sum_mul_iff

/-- **Strict inequality case of Rearrangement Inequality**: Pointwise multiplication of
`f` and `g`, which monovary together, is strictly decreased by a permutation if and only if
`f ∘ σ` and `g` do not monovary together. Stated by permuting the entries of `f`. -/
theorem MonovaryOn.sum_comp_perm_mul_lt_sum_mul_iff (hfg : MonovaryOn f g s)
    (hσ : { x | σ x ≠ x } ⊆ s) :
    ((∑ i in s, f (σ i) * g i) < ∑ i in s, f i * g i) ↔ ¬MonovaryOn (f ∘ σ) g s :=
  hfg.sum_comp_perm_smul_lt_sum_smul_iff hσ
#align monovary_on.sum_comp_perm_mul_lt_sum_mul_iff MonovaryOn.sum_comp_perm_mul_lt_sum_mul_iff

/-- **Rearrangement Inequality**: Pointwise multiplication of `f` and `g` is minimized when `f` and
`g` antivary together. Stated by permuting the entries of `g`. -/
theorem AntivaryOn.sum_mul_le_sum_mul_comp_perm (hfg : AntivaryOn f g s)
    (hσ : { x | σ x ≠ x } ⊆ s) : (∑ i in s, f i * g i) ≤ ∑ i in s, f i * g (σ i) :=
  hfg.sum_smul_le_sum_smul_comp_perm hσ
#align antivary_on.sum_mul_le_sum_mul_comp_perm AntivaryOn.sum_mul_le_sum_mul_comp_perm

/-- **Equality case of the Rearrangement Inequality**: Pointwise multiplication of `f` and `g`,
which antivary together, is unchanged by a permutation if and only if `f` and `g ∘ σ` antivary
together. Stated by permuting the entries of `g`. -/
theorem AntivaryOn.sum_mul_eq_sum_mul_comp_perm_iff (hfg : AntivaryOn f g s)
    (hσ : { x | σ x ≠ x } ⊆ s) :
    ((∑ i in s, f i * g (σ i)) = ∑ i in s, f i * g i) ↔ AntivaryOn f (g ∘ σ) s :=
  hfg.sum_smul_eq_sum_smul_comp_perm_iff hσ
#align antivary_on.sum_mul_eq_sum_mul_comp_perm_iff AntivaryOn.sum_mul_eq_sum_mul_comp_perm_iff

/-- **Strict inequality case of the Rearrangement Inequality**: Pointwise multiplication of
`f` and `g`, which antivary together, is strictly decreased by a permutation if and only if
`f` and `g ∘ σ` do not antivary together. Stated by permuting the entries of `g`. -/
theorem AntivaryOn.sum_mul_lt_sum_mul_comp_perm_iff (hfg : AntivaryOn f g s)
    (hσ : { x | σ x ≠ x } ⊆ s) :
    ((∑ i in s, f i * g i) < ∑ i in s, f i * g (σ i)) ↔ ¬AntivaryOn f (g ∘ σ) s :=
  hfg.sum_smul_lt_sum_smul_comp_perm_iff hσ
#align antivary_on.sum_mul_lt_sum_mul_comp_perm_iff AntivaryOn.sum_mul_lt_sum_mul_comp_perm_iff

/-- **Rearrangement Inequality**: Pointwise multiplication of `f` and `g` is minimized when `f` and
`g` antivary together. Stated by permuting the entries of `f`. -/
theorem AntivaryOn.sum_mul_le_sum_comp_perm_mul (hfg : AntivaryOn f g s)
    (hσ : { x | σ x ≠ x } ⊆ s) : (∑ i in s, f i * g i) ≤ ∑ i in s, f (σ i) * g i :=
  hfg.sum_smul_le_sum_comp_perm_smul hσ
#align antivary_on.sum_mul_le_sum_comp_perm_mul AntivaryOn.sum_mul_le_sum_comp_perm_mul

/-- **Equality case of the Rearrangement Inequality**: Pointwise multiplication of `f` and `g`,
which antivary together, is unchanged by a permutation if and only if `f ∘ σ` and `g` antivary
together. Stated by permuting the entries of `f`. -/
theorem AntivaryOn.sum_mul_eq_sum_comp_perm_mul_iff (hfg : AntivaryOn f g s)
    (hσ : { x | σ x ≠ x } ⊆ s) :
    ((∑ i in s, f (σ i) * g i) = ∑ i in s, f i * g i) ↔ AntivaryOn (f ∘ σ) g s :=
  hfg.sum_smul_eq_sum_comp_perm_smul_iff hσ
#align antivary_on.sum_mul_eq_sum_comp_perm_mul_iff AntivaryOn.sum_mul_eq_sum_comp_perm_mul_iff

/-- **Strict inequality case of the Rearrangement Inequality**: Pointwise multiplication of
`f` and `g`, which antivary together, is strictly decreased by a permutation if and only if
`f ∘ σ` and `g` do not antivary together. Stated by permuting the entries of `f`. -/
theorem AntivaryOn.sum_mul_lt_sum_comp_perm_mul_iff (hfg : AntivaryOn f g s)
    (hσ : { x | σ x ≠ x } ⊆ s) :
    ((∑ i in s, f i * g i) < ∑ i in s, f (σ i) * g i) ↔ ¬AntivaryOn (f ∘ σ) g s :=
  hfg.sum_smul_lt_sum_comp_perm_smul_iff hσ
#align antivary_on.sum_mul_lt_sum_comp_perm_mul_iff AntivaryOn.sum_mul_lt_sum_comp_perm_mul_iff

variable [Fintype ι]

/-- **Rearrangement Inequality**: Pointwise multiplication of `f` and `g` is maximized when `f` and
`g` monovary together. Stated by permuting the entries of `g`. -/
theorem Monovary.sum_mul_comp_perm_le_sum_mul (hfg : Monovary f g) :
    (∑ i, f i * g (σ i)) ≤ ∑ i, f i * g i :=
  hfg.sum_smul_comp_perm_le_sum_smul
#align monovary.sum_mul_comp_perm_le_sum_mul Monovary.sum_mul_comp_perm_le_sum_mul

/-- **Equality case of Rearrangement Inequality**: Pointwise multiplication of `f` and `g`,
which monovary together, is unchanged by a permutation if and only if `f` and `g ∘ σ` monovary
together. Stated by permuting the entries of `g`. -/
theorem Monovary.sum_mul_comp_perm_eq_sum_mul_iff (hfg : Monovary f g) :
    ((∑ i, f i * g (σ i)) = ∑ i, f i * g i) ↔ Monovary f (g ∘ σ) :=
  hfg.sum_smul_comp_perm_eq_sum_smul_iff
#align monovary.sum_mul_comp_perm_eq_sum_mul_iff Monovary.sum_mul_comp_perm_eq_sum_mul_iff

/-- **Strict inequality case of Rearrangement Inequality**: Pointwise multiplication of
`f` and `g`, which monovary together, is strictly decreased by a permutation if and only if
`f` and `g ∘ σ` do not monovary together. Stated by permuting the entries of `g`. -/
theorem Monovary.sum_mul_comp_perm_lt_sum_mul_iff (hfg : Monovary f g) :
    ((∑ i, f i * g (σ i)) < ∑ i, f i * g i) ↔ ¬Monovary f (g ∘ σ) :=
  hfg.sum_smul_comp_perm_lt_sum_smul_iff
#align monovary.sum_mul_comp_perm_lt_sum_mul_iff Monovary.sum_mul_comp_perm_lt_sum_mul_iff

/-- **Rearrangement Inequality**: Pointwise multiplication of `f` and `g` is maximized when `f` and
`g` monovary together. Stated by permuting the entries of `f`. -/
theorem Monovary.sum_comp_perm_mul_le_sum_mul (hfg : Monovary f g) :
    (∑ i, f (σ i) * g i) ≤ ∑ i, f i * g i :=
  hfg.sum_comp_perm_smul_le_sum_smul
#align monovary.sum_comp_perm_mul_le_sum_mul Monovary.sum_comp_perm_mul_le_sum_mul

/-- **Equality case of Rearrangement Inequality**: Pointwise multiplication of `f` and `g`,
which monovary together, is unchanged by a permutation if and only if `f ∘ σ` and `g` monovary
together. Stated by permuting the entries of `g`. -/
theorem Monovary.sum_comp_perm_mul_eq_sum_mul_iff (hfg : Monovary f g) :
    ((∑ i, f (σ i) * g i) = ∑ i, f i * g i) ↔ Monovary (f ∘ σ) g :=
  hfg.sum_comp_perm_smul_eq_sum_smul_iff
#align monovary.sum_comp_perm_mul_eq_sum_mul_iff Monovary.sum_comp_perm_mul_eq_sum_mul_iff

/-- **Strict inequality case of Rearrangement Inequality**: Pointwise multiplication of
`f` and `g`, which monovary together, is strictly decreased by a permutation if and only if
`f` and `g ∘ σ` do not monovary together. Stated by permuting the entries of `g`. -/
theorem Monovary.sum_comp_perm_mul_lt_sum_mul_iff (hfg : Monovary f g) :
    ((∑ i, f (σ i) * g i) < ∑ i, f i * g i) ↔ ¬Monovary (f ∘ σ) g :=
  hfg.sum_comp_perm_smul_lt_sum_smul_iff
#align monovary.sum_comp_perm_mul_lt_sum_mul_iff Monovary.sum_comp_perm_mul_lt_sum_mul_iff

/-- **Rearrangement Inequality**: Pointwise multiplication of `f` and `g` is minimized when `f` and
`g` antivary together. Stated by permuting the entries of `g`. -/
theorem Antivary.sum_mul_le_sum_mul_comp_perm (hfg : Antivary f g) :
    (∑ i, f i * g i) ≤ ∑ i, f i * g (σ i) :=
  hfg.sum_smul_le_sum_smul_comp_perm
#align antivary.sum_mul_le_sum_mul_comp_perm Antivary.sum_mul_le_sum_mul_comp_perm

/-- **Equality case of the Rearrangement Inequality**: Pointwise multiplication of `f` and `g`,
which antivary together, is unchanged by a permutation if and only if `f` and `g ∘ σ` antivary
together. Stated by permuting the entries of `g`. -/
theorem Antivary.sum_mul_eq_sum_mul_comp_perm_iff (hfg : Antivary f g) :
    ((∑ i, f i * g (σ i)) = ∑ i, f i * g i) ↔ Antivary f (g ∘ σ) :=
  hfg.sum_smul_eq_sum_smul_comp_perm_iff
#align antivary.sum_mul_eq_sum_mul_comp_perm_iff Antivary.sum_mul_eq_sum_mul_comp_perm_iff

/-- **Strict inequality case of the Rearrangement Inequality**: Pointwise multiplication of
`f` and `g`, which antivary together, is strictly decreased by a permutation if and only if
`f` and `g ∘ σ` do not antivary together. Stated by permuting the entries of `g`. -/
theorem Antivary.sum_mul_lt_sum_mul_comp_perm_iff (hfg : Antivary f g) :
    ((∑ i, f i • g i) < ∑ i, f i • g (σ i)) ↔ ¬Antivary f (g ∘ σ) :=
  hfg.sum_smul_lt_sum_smul_comp_perm_iff
#align antivary.sum_mul_lt_sum_mul_comp_perm_iff Antivary.sum_mul_lt_sum_mul_comp_perm_iff

/-- **Rearrangement Inequality**: Pointwise multiplication of `f` and `g` is minimized when `f` and
`g` antivary together. Stated by permuting the entries of `f`. -/
theorem Antivary.sum_mul_le_sum_comp_perm_mul (hfg : Antivary f g) :
    (∑ i, f i * g i) ≤ ∑ i, f (σ i) * g i :=
  hfg.sum_smul_le_sum_comp_perm_smul
#align antivary.sum_mul_le_sum_comp_perm_mul Antivary.sum_mul_le_sum_comp_perm_mul

/-- **Equality case of the Rearrangement Inequality**: Pointwise multiplication of `f` and `g`,
which antivary together, is unchanged by a permutation if and only if `f ∘ σ` and `g` antivary
together. Stated by permuting the entries of `f`. -/
theorem Antivary.sum_mul_eq_sum_comp_perm_mul_iff (hfg : Antivary f g) :
    ((∑ i, f (σ i) * g i) = ∑ i, f i * g i) ↔ Antivary (f ∘ σ) g :=
  hfg.sum_smul_eq_sum_comp_perm_smul_iff
#align antivary.sum_mul_eq_sum_comp_perm_mul_iff Antivary.sum_mul_eq_sum_comp_perm_mul_iff

/-- **Strict inequality case of the Rearrangement Inequality**: Pointwise multiplication of
`f` and `g`, which antivary together, is strictly decreased by a permutation if and only if
`f ∘ σ` and `g` do not antivary together. Stated by permuting the entries of `f`. -/
theorem Antivary.sum_mul_lt_sum_comp_perm_mul_iff (hfg : Antivary f g) :
    ((∑ i, f i * g i) < ∑ i, f (σ i) * g i) ↔ ¬Antivary (f ∘ σ) g :=
  hfg.sum_smul_lt_sum_comp_perm_smul_iff
#align antivary.sum_mul_lt_sum_comp_perm_mul_iff Antivary.sum_mul_lt_sum_comp_perm_mul_iff

end Mul


import data.fintype.basic data.set.finite

/-! # IMO 2017 A3 -/

namespace IMOSL
namespace IMO2017A3

open function set

/-- Final solution, monoid version (the claim) -/
theorem final_solution_monoid {M : Type*} [monoid M] [fintype M]
  {x : M} (h : ∀ y : M, x * y * x = y * x * y → y = x) :
  ∃ m : ℕ, 1 < m ∧ x ^ m = x :=
begin

  ---- get some `k > n` such that `x ^ k = x ^ n`
  obtain ⟨n, k, h0, h1⟩ : ∃ n k : ℕ, n < k ∧ x ^ n = x ^ k :=
  begin
    have h0 := not_injective_infinite_finite (λ n : ℕ, x ^ n),
    simp_rw [injective, not_forall] at h0,
    rcases h0 with ⟨n, k, h0, h1⟩,
    rw [← ne.def, ne_iff_lt_or_gt, gt_iff_lt] at h1,
    wlog h1 : n < k := h1 using [n k, k n],
    exact ⟨n, k, h1, h0⟩
  end,

  ---- Now write `k = n + t` and get rid of the case `n = 0`
  rcases n.eq_zero_or_pos with rfl | h2,
  refine ⟨k + 1, nat.succ_lt_succ h0, by rw [pow_succ, ← h1, pow_zero, mul_one]⟩,
  rw lt_iff_exists_add at h0,
  rcases h0 with ⟨t, h0, rfl⟩,

  ---- Choose `m = nt + 1` and prove the equality
  refine ⟨n * t + 1, nat.succ_lt_succ (mul_pos h2 h0), h _ _⟩; clear h2,
  rw [pow_succ, ← mul_assoc (_ * x), ← pow_succ, ← pow_succ,
      ← pow_succ', ← pow_succ', ← pow_succ', ← pow_add],
  change n * t + 1 + 1 + 1 with n * t + 3,
  replace h0 : n ≤ n * t + 3 := le_trans (nat.le_mul_of_pos_right h0) le_self_add,
  generalize_hyp : n * t + 3 = d at h0 ⊢,
  generalize_hyp : n = k,

  ---- More generally, we have `x ^ d = x ^ (d + kt)` for all `d ≥ n` and `k ≥ 0` by induction
  revert k; suffices : x ^ d = x ^ (d + t),
  { intros k; induction k with k k_ih,
    rw [zero_mul, add_zero],
    rw [nat.succ_eq_one_add, one_add_mul, ← add_assoc, pow_add, ← this, ← pow_add, ← k_ih] },
  revert h0 d; apply nat.le_induction,
  exact h1,
  rintros d - h0,
  rw [add_right_comm, pow_succ, pow_succ, ← h0]
end

/-- Final solution -/
theorem final_solution {S : Type*} [fintype S] [decidable_eq S]
  {f : function.End S} (h : ∀ g : S → S, f * g * f = g * f * g → g = f) :
  range (f^[2]) = range f :=
begin
  refine subset.antisymm (range_comp_subset_range f f) _,
  rcases final_solution_monoid h with ⟨m, h1, h0⟩,
  rw [← nat.succ_le_iff, le_iff_exists_add] at h1,
  rcases h1 with ⟨c, rfl⟩,
  nth_rewrite 0 ← h0; clear h0,
  rw [pow_add, pow_succ, pow_one, iterate_succ, iterate_one],
  exact range_comp_subset_range _ (f ∘ f)
end

end IMO2017A3
end IMOSL


import matrix_representation
import action_refondation
import matrix_representation_refondation
set_option trace.simplify.rewrite true
open is_basis linear_map character
--set_option trace.simplify true
universes u v  w w'
open general classical_basis
variables (G : Type u) [group G]
          (R : Type v) [comm_ring R]
          (X : Type w)[fintype X][decidable_eq X]
          [mul_action G X]

open finite_action
open fintype
@[simp]theorem valvl  (g : G) : mat (Perm  R X) g  = λ x y,  if   g • y = x  then 1 else 0 :=
begin
    apply matrix.ext,intros i j,
    unfold mat,  unfold to_matrix,unfold to_matrixₗ, dsimp, --- faire mieux
    erw ← finite_action.Perm_ext,
    erw action_on_basis_apply,
end
lemma Grall (g : G) : (λ i : X, mat (Perm R X) g i i) = (λ i : X, if  g • i = i then  1 else 0 ) := begin
    funext,rw valvl,
end
@[simp]theorem χ_value_eq_fixed_point (g : G ): χ (Perm R X) g = card ({x : X | g • x = x}  : set X):=
begin
    unfold χ,simp,exact rfl,
end
namespace Regular
def Cayley_action (G : Type u) [group G] : mul_action G G := { smul := λ g r, g * r,
  one_smul := begin intros, dsimp, rw one_mul, end,
  mul_smul := begin  intros, dsimp, rw mul_assoc,end }
def Regular_representation (G : Type u) [group G][fintype G][decidable_eq G](R :Type v)[comm_ring R] :
group_representation G R (G → R) := @Perm G R G _ _(Cayley_action G)
variables [fintype G][decidable_eq G]
#check Regular_representation G ℤ
lemma terere (X : Type u)[fintype X][decidable_eq X]  : (fintype.card ({x : X | true })) =  (fintype.card X)   := begin
    -- I don't understand why i'm always dealing with this kind of thing ???
       exact fintype.card_congr (  equiv.set.univ X),

end
#check (Cayley_action G).smul
theorem hhh (g : G):  ((χ (Regular_representation G ℤ ) g) ) = if g = 1 then ( (card G)   ) else (0  ) :=
begin
    erw χ_value_eq_fixed_point,
    split_ifs,rw h,simp, apply fintype.card_congr, exact equiv.set.univ G,
    simp,refine le_bot_iff.mp _,intro,
        intro hyp,
        simp at hyp, have r  : g * a = a,
            exact hyp,
        have rr : g = 1,
            exact mul_left_eq_self.mp (congr_arg (has_mul.mul g) (congr_arg (has_mul.mul g) hyp)),
            trivial,
end
end Regular


import geometry.manifold.partition_of_unity
import topology.metric_space.emetric_paracompact

import to_mathlib.topology.nhds_set

open set filter
open_locale manifold topology

lemma exists_cont_diff_zero_one {E : Type*} [normed_add_comm_group E]
  [normed_space ℝ E] [finite_dimensional ℝ E] {s t : set E} (hs : is_closed s)
  (ht : is_closed t) (hd : disjoint s t) :
  ∃ f : E → ℝ, cont_diff ℝ ⊤ f ∧ eq_on f 0 s ∧ eq_on f 1 t ∧
    ∀ x, f x ∈ Icc (0 : ℝ) 1 :=
let ⟨f, hfs, hft, hf01⟩ := exists_smooth_zero_one_of_closed 𝓘(ℝ, E) hs ht hd
in ⟨f, f.smooth.cont_diff, hfs, hft, hf01⟩

lemma exists_cont_diff_zero_one_nhds {E : Type*} [normed_add_comm_group E]
  [normed_space ℝ E] [finite_dimensional ℝ E] {s t : set E} (hs : is_closed s)
  (ht : is_closed t) (hd : disjoint s t) :
  ∃ f : E → ℝ, cont_diff ℝ ⊤ f ∧ (∀ᶠ x in 𝓝ˢ s, f x = 0) ∧ (∀ᶠ x in 𝓝ˢ t, f x = 1) ∧
    ∀ x, f x ∈ Icc (0 : ℝ) 1 :=
begin
  rcases normal_exists_closure_subset hs ht.is_open_compl
    (subset_compl_iff_disjoint_left.mpr hd.symm) with ⟨u, u_op, hsu, hut⟩,
  have hcu : is_closed (closure u) := is_closed_closure,
  rcases normal_exists_closure_subset ht hcu.is_open_compl (subset_compl_comm.mp hut) with
    ⟨v, v_op, htv, hvu⟩,
  have hcv : is_closed (closure v) := is_closed_closure,
  rcases exists_cont_diff_zero_one hcu hcv (subset_compl_iff_disjoint_left.mp hvu) with
    ⟨f, hfsmooth, hfu, hfv, hf⟩,
  refine ⟨f, hfsmooth, _, _, hf⟩,
  apply eventually_of_mem (mem_of_superset (u_op.mem_nhds_set.mpr hsu) subset_closure) hfu,
  apply eventually_of_mem (mem_of_superset (v_op.mem_nhds_set.mpr htv) subset_closure) hfv
end

lemma exists_cont_diff_one_nhds_of_interior {E : Type*} [normed_add_comm_group E]
  [normed_space ℝ E] [finite_dimensional ℝ E] {s t : set E} (hs : is_closed s)
  (hd : s ⊆ interior t) :
  ∃ f : E → ℝ, cont_diff ℝ ⊤ f ∧ (∀ᶠ x in 𝓝ˢ s, f x = 1) ∧ (∀ x ∉ t, f x = 0) ∧
    ∀ x, f x ∈ Icc (0 : ℝ) 1 :=
begin
  have : is_closed (interior t)ᶜ,
  exact is_open_interior.is_closed_compl,

  rcases exists_cont_diff_zero_one_nhds this hs _ with ⟨f, hfsmooth, h0, h1, hf⟩,
  { refine ⟨f, hfsmooth, h1, _, hf⟩,
    intros x hx,
    exact h0.on_set _ (λ hx', hx $ interior_subset hx') },
  rwa [← subset_compl_iff_disjoint_left, compl_compl]
end


import mynat.definition
import mynat.add
import world2.level1

namespace mynat

lemma add_assoc (a b c : mynat) : (a + b) + c = a + (b + c) :=
begin [nat_num_game]
    induction c with d hd,
    {
        rw add_zero,
        rw add_zero,
        refl,
    },
    {
        rw add_succ,
        rw add_succ,
        rw add_succ,
        rw hd,
        refl,
    }
end

end mynat


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import data.set.finite
import data.countable.basic
import logic.equiv.list

/-!
# Countable sets

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

open function set encodable

open classical (hiding some)
open_locale classical
universes u v w x
variables {α : Type u} {β : Type v} {γ : Type w} {ι : Sort x}

namespace set

/-- A set is countable if there exists an encoding of the set into the natural numbers.
An encoding is an injection with a partial inverse, which can be viewed as a
constructive analogue of countability. (For the most part, theorems about
`countable` will be classical and `encodable` will be constructive.)
-/
protected def countable (s : set α) : Prop := nonempty (encodable s)

@[simp] lemma countable_coe_iff {s : set α} : countable s ↔ s.countable :=
encodable.nonempty_encodable.symm

/-- Prove `set.countable` from a `countable` instance on the subtype. -/
lemma to_countable (s : set α) [countable s] : s.countable := countable_coe_iff.mp ‹_›

/-- Restate `set.countable` as a `countable` instance. -/
alias countable_coe_iff ↔ _root_.countable.to_set countable.to_subtype

protected lemma countable_iff_exists_injective {s : set α} :
  s.countable ↔ ∃ f : s → ℕ, injective f :=
countable_coe_iff.symm.trans (countable_iff_exists_injective s)

/-- A set `s : set α` is countable if and only if there exists a function `α → ℕ` injective
on `s`. -/
lemma countable_iff_exists_inj_on {s : set α} :
  s.countable ↔ ∃ f : α → ℕ, inj_on f s :=
set.countable_iff_exists_injective.trans exists_inj_on_iff_injective.symm

/-- Convert `set.countable s` to `encodable s` (noncomputable). -/
protected def countable.to_encodable {s : set α} : s.countable → encodable s :=
classical.choice

section enumerate

/-- Noncomputably enumerate elements in a set. The `default` value is used to extend the domain to
all of `ℕ`. -/

def enumerate_countable {s : set α} (h : s.countable) (default : α) : ℕ → α :=
assume n, match @encodable.decode s h.to_encodable n with
        | (some y) := y
        | (none)   := default
        end

lemma subset_range_enumerate {s : set α} (h : s.countable) (default : α) :
   s ⊆ range (enumerate_countable h default) :=
assume x hx,
⟨@encodable.encode s h.to_encodable ⟨x, hx⟩,
by simp [enumerate_countable, encodable.encodek]⟩

end enumerate

lemma countable.mono {s₁ s₂ : set α} (h : s₁ ⊆ s₂) : s₂.countable → s₁.countable
| ⟨H⟩ := ⟨@of_inj _ _ H _ (embedding_of_subset _ _ h).2⟩

lemma countable_range [countable ι] (f : ι → β) : (range f).countable :=
surjective_onto_range.countable.to_set

lemma countable_iff_exists_subset_range [nonempty α] {s : set α} :
  s.countable ↔ ∃ f : ℕ → α, s ⊆ range f :=
⟨λ h, by { inhabit α, exact ⟨enumerate_countable h default, subset_range_enumerate _ _⟩ },
  λ ⟨f, hsf⟩, (countable_range f).mono hsf⟩

/--
A non-empty set is countable iff there exists a surjection from the
natural numbers onto the subtype induced by the set.
-/
protected lemma countable_iff_exists_surjective {s : set α} (hs : s.nonempty) :
  s.countable ↔ ∃ f : ℕ → s, surjective f :=
countable_coe_iff.symm.trans $ @countable_iff_exists_surjective s hs.to_subtype

alias set.countable_iff_exists_surjective ↔ countable.exists_surjective _

lemma countable_univ [countable α] : (univ : set α).countable := to_countable univ

/-- If `s : set α` is a nonempty countable set, then there exists a map
`f : ℕ → α` such that `s = range f`. -/
lemma countable.exists_eq_range {s : set α} (hc : s.countable) (hs : s.nonempty) :
  ∃ f : ℕ → α, s = range f :=
begin
  rcases hc.exists_surjective hs with ⟨f, hf⟩,
  refine ⟨coe ∘ f, _⟩,
  rw [hf.range_comp, subtype.range_coe]
end

@[simp]

@[simp] lemma countable_singleton (a : α) : ({a} : set α).countable :=
⟨of_equiv _ (equiv.set.singleton a)⟩

lemma countable.image {s : set α} (hs : s.countable) (f : α → β) : (f '' s).countable :=
by { rw [image_eq_range], haveI := hs.to_subtype, apply countable_range }

lemma maps_to.countable_of_inj_on {s : set α} {t : set β} {f : α → β}
  (hf : maps_to f s t) (hf' : inj_on f s) (ht : t.countable) :
  s.countable :=
have injective (hf.restrict f s t), from (inj_on_iff_injective.1 hf').cod_restrict _,
⟨@encodable.of_inj _ _ ht.to_encodable _ this⟩

lemma countable.preimage_of_inj_on {s : set β} (hs : s.countable) {f : α → β}
  (hf : inj_on f (f ⁻¹' s)) : (f ⁻¹' s).countable :=
(maps_to_preimage f s).countable_of_inj_on hf hs

protected lemma countable.preimage {s : set β} (hs : s.countable) {f : α → β} (hf : injective f) :
  (f ⁻¹' s).countable :=
hs.preimage_of_inj_on (hf.inj_on _)

lemma exists_seq_supr_eq_top_iff_countable [complete_lattice α] {p : α → Prop} (h : ∃ x, p x) :
  (∃ s : ℕ → α, (∀ n, p (s n)) ∧ (⨆ n, s n) = ⊤) ↔
    ∃ S : set α, S.countable ∧ (∀ s ∈ S, p s) ∧ Sup S = ⊤ :=
begin
  split,
  { rintro ⟨s, hps, hs⟩,
    refine ⟨range s, countable_range s, forall_range_iff.2 hps, _⟩, rwa Sup_range },
  { rintro ⟨S, hSc, hps, hS⟩,
    rcases eq_empty_or_nonempty S with rfl|hne,
    { rw [Sup_empty] at hS, haveI := subsingleton_of_bot_eq_top hS,
      rcases h with ⟨x, hx⟩, exact ⟨λ n, x, λ n, hx, subsingleton.elim _ _⟩ },
    { rcases (set.countable_iff_exists_surjective hne).1 hSc with ⟨s, hs⟩,
      refine ⟨λ n, s n, λ n, hps _ (s n).coe_prop, _⟩,
      rwa [hs.supr_comp, ← Sup_eq_supr'] } }
end

lemma exists_seq_cover_iff_countable {p : set α → Prop} (h : ∃ s, p s) :
  (∃ s : ℕ → set α, (∀ n, p (s n)) ∧ (⋃ n, s n) = univ) ↔
    ∃ S : set (set α), S.countable ∧ (∀ s ∈ S, p s) ∧ ⋃₀ S = univ :=
exists_seq_supr_eq_top_iff_countable h

lemma countable_of_injective_of_countable_image {s : set α} {f : α → β}
  (hf : inj_on f s) (hs : (f '' s).countable) : s.countable :=
let ⟨g, hg⟩ := countable_iff_exists_inj_on.1 hs in
countable_iff_exists_inj_on.2 ⟨g ∘ f, hg.comp hf (maps_to_image _ _)⟩

lemma countable_Union {t : ι → set α} [countable ι] (ht : ∀ i, (t i).countable) :
  (⋃ i, t i).countable :=
by { haveI := λ a, (ht a).to_subtype, rw Union_eq_range_psigma, apply countable_range }

@[simp] lemma countable_Union_iff [countable ι] {t : ι → set α} :
  (⋃ i, t i).countable ↔ ∀ i, (t i).countable :=
⟨λ h i, h.mono $ subset_Union _ _, countable_Union⟩

lemma countable.bUnion_iff {s : set α} {t : Π a ∈ s, set β} (hs : s.countable) :
  (⋃ a ∈ s, t a ‹_›).countable ↔ ∀ a ∈ s, (t a ‹_›).countable :=
by { haveI := hs.to_subtype, rw [bUnion_eq_Union, countable_Union_iff, set_coe.forall'] }

lemma countable.sUnion_iff {s : set (set α)} (hs : s.countable) :
  (⋃₀ s).countable ↔ ∀ a ∈ s, (a : _).countable :=
by rw [sUnion_eq_bUnion, hs.bUnion_iff]

alias countable.bUnion_iff ↔ _ countable.bUnion
alias countable.sUnion_iff ↔ _ countable.sUnion

@[simp] lemma countable_union {s t : set α} : (s ∪ t).countable ↔ s.countable ∧ t.countable :=
by simp [union_eq_Union, and.comm]

lemma countable.union {s t : set α} (hs : s.countable) (ht : t.countable) :
  (s ∪ t).countable :=
countable_union.2 ⟨hs, ht⟩

@[simp] lemma countable_insert {s : set α} {a : α} : (insert a s).countable ↔ s.countable :=
by simp only [insert_eq, countable_union, countable_singleton, true_and]

lemma countable.insert {s : set α} (a : α) (h : s.countable) : (insert a s).countable :=
countable_insert.2 h

lemma finite.countable {s : set α} : s.finite → s.countable
| ⟨h⟩ := trunc.nonempty (by exactI fintype.trunc_encodable s)

@[nontriviality] lemma countable.of_subsingleton [subsingleton α] (s : set α) :
  s.countable :=
(finite.of_subsingleton s).countable

lemma subsingleton.countable {s : set α} (hs : s.subsingleton) : s.countable :=
hs.finite.countable

lemma countable_is_top (α : Type*) [partial_order α] : {x : α | is_top x}.countable :=
(finite_is_top α).countable

lemma countable_is_bot (α : Type*) [partial_order α] : {x : α | is_bot x}.countable :=
(finite_is_bot α).countable

/-- The set of finite subsets of a countable set is countable. -/
lemma countable_set_of_finite_subset {s : set α} : s.countable →
  {t | set.finite t ∧ t ⊆ s}.countable | ⟨h⟩ :=
begin
  resetI,
  refine countable.mono _ (countable_range
    (λ t : finset s, {a | ∃ h:a ∈ s, subtype.mk a h ∈ t})),
  rintro t ⟨⟨ht⟩, ts⟩, resetI,
  refine ⟨finset.univ.map (embedding_of_subset _ _ ts), set.ext $ λ a, _⟩,
  simpa using @ts a
end

lemma countable_univ_pi {π : α → Type*} [finite α] {s : Π a, set (π a)}
  (hs : ∀ a, (s a).countable) : (pi univ s).countable :=
begin
  haveI := λ a, (hs a).to_subtype,
  exact (countable.of_equiv _ (equiv.set.univ_pi s).symm).to_set
end

lemma countable_pi {π : α → Type*} [finite α] {s : Πa, set (π a)} (hs : ∀a, (s a).countable) :
  {f : Πa, π a | ∀a, f a ∈ s a}.countable :=
by simpa only [← mem_univ_pi] using countable_univ_pi hs

protected lemma countable.prod {s : set α} {t : set β} (hs : s.countable) (ht : t.countable) :
  set.countable (s ×ˢ t) :=
begin
  haveI : countable s := hs.to_subtype,
  haveI : countable t := ht.to_subtype,
  exact (countable.of_equiv _ $ (equiv.set.prod _ _).symm).to_set
end

lemma countable.image2 {s : set α} {t : set β} (hs : s.countable) (ht : t.countable)
  (f : α → β → γ) : (image2 f s t).countable :=
by { rw ← image_prod, exact (hs.prod ht).image _ }

end set

lemma finset.countable_to_set (s : finset α) : set.countable (↑s : set α) :=
s.finite_to_set.countable