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

import field_theory.finite.basic
import field_theory.mv_polynomial
import data.mv_polynomial.expand
import linear_algebra.basic
import linear_algebra.finite_dimensional

/-!
## Polynomials over finite fields
-/

namespace mv_polynomial
variables {σ : Type*}

/-- A polynomial over the integers is divisible by `n : ℕ`
if and only if it is zero over `zmod n`. -/
lemma C_dvd_iff_zmod (n : ℕ) (φ : mv_polynomial σ ℤ) :
  C (n:ℤ) ∣ φ ↔ map (int.cast_ring_hom (zmod n)) φ = 0 :=
C_dvd_iff_map_hom_eq_zero _ _ (char_p.int_cast_eq_zero_iff (zmod n) n) _

section frobenius

variables {p : ℕ} [fact p.prime]

lemma frobenius_zmod (f : mv_polynomial σ (zmod p)) :
  frobenius _ p f = expand p f :=
begin
  apply induction_on f,
  { intro a, rw [expand_C, frobenius_def, ← C_pow, zmod.pow_card], },
  { simp only [alg_hom.map_add, ring_hom.map_add], intros _ _ hf hg, rw [hf, hg] },
  { simp only [expand_X, ring_hom.map_mul, alg_hom.map_mul],
    intros _ _ hf, rw [hf, frobenius_def], },
end

end frobenius

end mv_polynomial

namespace mv_polynomial

noncomputable theory
open_locale big_operators classical
open set linear_map submodule

variables {K : Type*} {σ : Type*}
variables [field K] [fintype K] [fintype σ]

def indicator (a : σ → K) : mv_polynomial σ K :=
∏ n, (1 - (X n - C (a n))^(fintype.card K - 1))

lemma eval_indicator_apply_eq_one (a : σ → K) :
  eval a (indicator a) = 1 :=
have 0 < fintype.card K - 1,
begin
  rw [← finite_field.card_units, fintype.card_pos_iff],
  exact ⟨1⟩
end,
by simp only [indicator, (finset.univ.prod_hom (eval a)).symm, ring_hom.map_sub,
    is_ring_hom.map_one (eval a), is_monoid_hom.map_pow (eval a), eval_X, eval_C,
    sub_self, zero_pow this, sub_zero, finset.prod_const_one]

lemma eval_indicator_apply_eq_zero (a b : σ → K) (h : a ≠ b) :
  eval a (indicator b) = 0 :=
have ∃i, a i ≠ b i, by rwa [(≠), function.funext_iff, not_forall] at h,
begin
  rcases this with ⟨i, hi⟩,
  simp only [indicator, (finset.univ.prod_hom (eval a)).symm, ring_hom.map_sub,
    is_ring_hom.map_one (eval a), is_monoid_hom.map_pow (eval a), eval_X, eval_C,
    sub_self, finset.prod_eq_zero_iff],
  refine ⟨i, finset.mem_univ _, _⟩,
  rw [finite_field.pow_card_sub_one_eq_one, sub_self],
  rwa [(≠), sub_eq_zero],
end

lemma degrees_indicator (c : σ → K) :
  degrees (indicator c) ≤ ∑ s : σ, (fintype.card K - 1) • {s} :=
begin
  rw [indicator],
  refine le_trans (degrees_prod _ _) (finset.sum_le_sum $ assume s hs, _),
  refine le_trans (degrees_sub _ _) _,
  rw [degrees_one, ← bot_eq_zero, bot_sup_eq],
  refine le_trans (degrees_pow _ _) (nsmul_le_nsmul_of_le_right _ _),
  refine le_trans (degrees_sub _ _) _,
  rw [degrees_C, ← bot_eq_zero, sup_bot_eq],
  exact degrees_X' _
end

lemma indicator_mem_restrict_degree (c : σ → K) :
  indicator c ∈ restrict_degree σ K (fintype.card K - 1) :=
begin
  rw [mem_restrict_degree_iff_sup, indicator],
  assume n,
  refine le_trans (multiset.count_le_of_le _ $ degrees_indicator _) (le_of_eq _),
  rw [← finset.univ.sum_hom (multiset.count n)],
  simp only [is_add_monoid_hom.map_nsmul (multiset.count n), multiset.singleton_eq_singleton,
    nsmul_eq_mul, nat.cast_id],
  transitivity,
  refine finset.sum_eq_single n _ _,
  { assume b hb ne, rw [multiset.count_cons_of_ne ne.symm, multiset.count_zero, mul_zero] },
  { assume h, exact (h $ finset.mem_univ _).elim },
  { rw [multiset.count_cons_self, multiset.count_zero, mul_one] }
end

section
variables (K σ)
def evalₗ : mv_polynomial σ K →ₗ[K] (σ → K) → K :=
⟨ λp e, eval e p,
  assume p q, (by { ext x, rw ring_hom.map_add, refl, }),
  assume a p, funext $ assume e, by rw [smul_eq_C_mul, ring_hom.map_mul, eval_C]; refl ⟩
end

lemma evalₗ_apply (p : mv_polynomial σ K) (e : σ → K) : evalₗ K σ p e = eval e p :=
rfl

lemma map_restrict_dom_evalₗ : (restrict_degree σ K (fintype.card K - 1)).map (evalₗ K σ) = ⊤ :=
begin
  refine top_unique (set_like.le_def.2 $ assume e _, mem_map.2 _),
  refine ⟨∑ n : σ → K, e n • indicator n, _, _⟩,
  { exact sum_mem _ (assume c _, smul_mem _ _ (indicator_mem_restrict_degree _)) },
  { ext n,
    simp only [linear_map.map_sum, @finset.sum_apply (σ → K) (λ_, K) _ _ _ _ _,
      pi.smul_apply, linear_map.map_smul],
    simp only [evalₗ_apply],
    transitivity,
    refine finset.sum_eq_single n _ _,
    { assume b _ h,
      rw [eval_indicator_apply_eq_zero _ _ h.symm, smul_zero] },
    { assume h, exact (h $ finset.mem_univ n).elim },
    { rw [eval_indicator_apply_eq_one, smul_eq_mul, mul_one] } }
end
end mv_polynomial

namespace mv_polynomial

open_locale classical
open linear_map submodule

universe u
variables (σ : Type u) (K : Type u) [fintype σ] [field K] [fintype K]

@[derive [add_comm_group, module K, inhabited]]
def R : Type u := restrict_degree σ K (fintype.card K - 1)

noncomputable instance decidable_restrict_degree (m : ℕ) :
  decidable_pred (λn, n ∈ {n : σ →₀ ℕ | ∀i, n i ≤ m }) :=
by simp only [set.mem_set_of_eq]; apply_instance

lemma dim_R : module.rank K (R σ K) = fintype.card (σ → K) :=
calc module.rank K (R σ K) =
  module.rank K (↥{s : σ →₀ ℕ | ∀ (n : σ), s n ≤ fintype.card K - 1} →₀ K) :
    linear_equiv.dim_eq
      (finsupp.supported_equiv_finsupp {s : σ →₀ ℕ | ∀n:σ, s n ≤ fintype.card K - 1 })
  ... = cardinal.mk {s : σ →₀ ℕ | ∀ (n : σ), s n ≤ fintype.card K - 1} :
    by rw [finsupp.dim_eq, dim_of_field, mul_one]
  ... = cardinal.mk {s : σ → ℕ | ∀ (n : σ), s n < fintype.card K } :
  begin
    refine quotient.sound ⟨equiv.subtype_equiv finsupp.equiv_fun_on_fintype $ assume f, _⟩,
    refine forall_congr (assume n, nat.le_sub_right_iff_add_le _),
    exact fintype.card_pos_iff.2 ⟨0⟩
  end
  ... = cardinal.mk (σ → {n // n < fintype.card K}) :
    quotient.sound ⟨@equiv.subtype_pi_equiv_pi σ (λ_, ℕ) (λs n, n < fintype.card K)⟩
  ... = cardinal.mk (σ → fin (fintype.card K)) :
    quotient.sound ⟨equiv.arrow_congr (equiv.refl σ) (equiv.fin_equiv_subtype _).symm⟩
  ... = cardinal.mk (σ → K) :
    quotient.sound ⟨equiv.arrow_congr (equiv.refl σ) (fintype.equiv_fin K).symm⟩
  ... = fintype.card (σ → K) : cardinal.fintype_card _

instance : finite_dimensional K (R σ K) :=
finite_dimensional.finite_dimensional_iff_dim_lt_omega.mpr
  (by simpa only [dim_R] using cardinal.nat_lt_omega (fintype.card (σ → K)))

lemma finrank_R : finite_dimensional.finrank K (R σ K) = fintype.card (σ → K) :=
finite_dimensional.finrank_eq_of_dim_eq (dim_R σ K)

def evalᵢ : R σ K →ₗ[K] (σ → K) → K :=
((evalₗ K σ).comp (restrict_degree σ K (fintype.card K - 1)).subtype)

lemma range_evalᵢ : (evalᵢ σ K).range = ⊤ :=
begin
  rw [evalᵢ, linear_map.range_comp, range_subtype],
  exact map_restrict_dom_evalₗ
end

lemma ker_evalₗ : (evalᵢ σ K).ker = ⊥ :=
begin
  refine (ker_eq_bot_iff_range_eq_top_of_finrank_eq_finrank _).mpr (range_evalᵢ _ _),
  rw [finite_dimensional.finrank_fintype_fun_eq_card, finrank_R]
end

lemma eq_zero_of_eval_eq_zero (p : mv_polynomial σ K)
  (h : ∀v:σ → K, eval v p = 0) (hp : p ∈ restrict_degree σ K (fintype.card K - 1)) :
  p = 0 :=
let p' : R σ K := ⟨p, hp⟩ in
have p' ∈ (evalᵢ σ K).ker := by { rw [mem_ker], ext v, exact h v },
show p'.1 = (0 : R σ K).1,
begin
  rw [ker_evalₗ, mem_bot] at this,
  rw [this]
end

end mv_polynomial


import order.lattice dynamics.fixed_points.basic
import dynamics.fixed_points.basic
import order.hom.order

constant α : Type

theorem knaster_tarski [lat : complete_lattice α] (f : α →o α) (a : α)  :
  (a = Sup {a : α | a ≤ (f a)}) → (f a = a) :=
  begin
    intro h,
    have mf := f.monotone,
    let P := {a : α | a ≤ (f a)},
    have hua : ∀ u ∈ P, u ≤ a := by {
      intros u hu,
      rw h,
      exact le_Sup hu,
    },
    have hufu : ∀ u ∈ P, u ≤ f u := by {
      simp,
    },
    have hfufa : ∀ u ∈ P, f u ≤ f a := by {
      intros u hu,
      apply mf,
      exact hua u hu,
    },
    have ha : a ∈ {a : α | a ≤ (f a)} := by
    {
      begin
        simp,
        by_contra,
        sorry,
      end
    },
    have pfa : f a ≤ f (f a) := by {
      apply mf,
      exact ha,
    },
    have hfaa : f a ≤ a := by {
      exact hua (f a) pfa,
    },
    exact ge_antisymm ha hfaa,
  end

theorem shroeder_bernstein (X Y : set α) (f g : α → α) : ∃ A, A ⊆ X ∧ g(Y \ f A)) = X 𝔸 :=
begin

end

theorem test (p : (nat → Prop)) : (∀ a, p a) → ∃ a, p a :=
  begin
    intro h,
    fapply exists.intro 0,
    exact h 0,
  end


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

! This file was ported from Lean 3 source module dynamics.periodic_pts
! leanprover-community/mathlib commit f7fc89d5d5ff1db2d1242c7bb0e9062ce47ef47c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Hom.Iterate
import Mathlib.Data.List.Cycle
import Mathlib.Data.PNat.Basic
import Mathlib.Data.Nat.Prime
import Mathlib.Dynamics.FixedPoints.Basic
import Mathlib.GroupTheory.GroupAction.Group
import Mathlib.Tactic.NthRewrite

/-!
# Periodic points

A point `x : α` is a periodic point of `f : α → α` of period `n` if `f^[n] x = x`.

## Main definitions

* `IsPeriodicPt f n x` : `x` is a periodic point of `f` of period `n`, i.e. `f^[n] x = x`.
  We do not require `n > 0` in the definition.
* `ptsOfPeriod f n` : the set `{x | IsPeriodicPt f n x}`. Note that `n` is not required to
  be the minimal period of `x`.
* `periodicPts f` : the set of all periodic points of `f`.
* `minimalPeriod f x` : the minimal period of a point `x` under an endomorphism `f` or zero
  if `x` is not a periodic point of `f`.
* `orbit f x`: the cycle `[x, f x, f (f x), ...]` for a periodic point.

## Main statements

We provide “dot syntax”-style operations on terms of the form `h : IsPeriodicPt f n x` including
arithmetic operations on `n` and `h.map (hg : SemiconjBy g f f')`. We also prove that `f`
is bijective on each set `ptsOfPeriod f n` and on `periodicPts f`. Finally, we prove that `x`
is a periodic point of `f` of period `n` if and only if `minimalPeriod f x | n`.

## References

* https://en.wikipedia.org/wiki/Periodic_point

-/

open Set

namespace Function

variable {α : Type _} {β : Type _} {f fa : α → α} {fb : β → β} {x y : α} {m n : ℕ}

/-- A point `x` is a periodic point of `f : α → α` of period `n` if `f^[n] x = x`.
Note that we do not require `0 < n` in this definition. Many theorems about periodic points
need this assumption. -/
def IsPeriodicPt (f : α → α) (n : ℕ) (x : α) :=
  IsFixedPt (f^[n]) x
#align function.is_periodic_pt Function.IsPeriodicPt

/-- A fixed point of `f` is a periodic point of `f` of any prescribed period. -/
theorem IsFixedPt.isPeriodicPt (hf : IsFixedPt f x) (n : ℕ) : IsPeriodicPt f n x :=
  hf.iterate n
#align function.is_fixed_pt.is_periodic_pt Function.IsFixedPt.isPeriodicPt

/-- For the identity map, all points are periodic. -/
theorem is_periodic_id (n : ℕ) (x : α) : IsPeriodicPt id n x :=
  (isFixedPt_id x).isPeriodicPt n
#align function.is_periodic_id Function.is_periodic_id

/-- Any point is a periodic point of period `0`. -/
theorem isPeriodicPt_zero (f : α → α) (x : α) : IsPeriodicPt f 0 x :=
  isFixedPt_id x
#align function.is_periodic_pt_zero Function.isPeriodicPt_zero

namespace IsPeriodicPt

instance [DecidableEq α] {f : α → α} {n : ℕ} {x : α} : Decidable (IsPeriodicPt f n x) :=
  IsFixedPt.decidable

protected theorem isFixedPt (hf : IsPeriodicPt f n x) : IsFixedPt (f^[n]) x :=
  hf
#align function.is_periodic_pt.is_fixed_pt Function.IsPeriodicPt.isFixedPt

protected theorem map (hx : IsPeriodicPt fa n x) {g : α → β} (hg : Semiconj g fa fb) :
    IsPeriodicPt fb n (g x) :=
  IsFixedPt.map hx (hg.iterate_right n)
#align function.is_periodic_pt.map Function.IsPeriodicPt.map

theorem apply_iterate (hx : IsPeriodicPt f n x) (m : ℕ) : IsPeriodicPt f n ((f^[m]) x) :=
  hx.map <| Commute.iterate_self f m
#align function.is_periodic_pt.apply_iterate Function.IsPeriodicPt.apply_iterate

protected theorem apply (hx : IsPeriodicPt f n x) : IsPeriodicPt f n (f x) :=
  hx.apply_iterate 1
#align function.is_periodic_pt.apply Function.IsPeriodicPt.apply

protected theorem add (hn : IsPeriodicPt f n x) (hm : IsPeriodicPt f m x) :
    IsPeriodicPt f (n + m) x := by
  rw [IsPeriodicPt, iterate_add]
  exact hn.comp hm
#align function.is_periodic_pt.add Function.IsPeriodicPt.add

theorem left_of_add (hn : IsPeriodicPt f (n + m) x) (hm : IsPeriodicPt f m x) :
    IsPeriodicPt f n x := by
  rw [IsPeriodicPt, iterate_add] at hn
  exact hn.left_of_comp hm
#align function.is_periodic_pt.left_of_add Function.IsPeriodicPt.left_of_add

theorem right_of_add (hn : IsPeriodicPt f (n + m) x) (hm : IsPeriodicPt f n x) :
    IsPeriodicPt f m x := by
  rw [add_comm] at hn
  exact hn.left_of_add hm
#align function.is_periodic_pt.right_of_add Function.IsPeriodicPt.right_of_add

protected theorem sub (hm : IsPeriodicPt f m x) (hn : IsPeriodicPt f n x) :
    IsPeriodicPt f (m - n) x := by
  cases' le_total n m with h h
  · refine' left_of_add _ hn
    rwa [tsub_add_cancel_of_le h]
  · rw [tsub_eq_zero_iff_le.mpr h]
    apply isPeriodicPt_zero
#align function.is_periodic_pt.sub Function.IsPeriodicPt.sub

protected theorem mul_const (hm : IsPeriodicPt f m x) (n : ℕ) : IsPeriodicPt f (m * n) x := by
  simp only [IsPeriodicPt, iterate_mul, hm.isFixedPt.iterate n]
#align function.is_periodic_pt.mul_const Function.IsPeriodicPt.mul_const

protected theorem const_mul (hm : IsPeriodicPt f m x) (n : ℕ) : IsPeriodicPt f (n * m) x := by
  simp only [mul_comm n, hm.mul_const n]
#align function.is_periodic_pt.const_mul Function.IsPeriodicPt.const_mul

theorem trans_dvd (hm : IsPeriodicPt f m x) {n : ℕ} (hn : m ∣ n) : IsPeriodicPt f n x :=
  let ⟨k, hk⟩ := hn
  hk.symm ▸ hm.mul_const k
#align function.is_periodic_pt.trans_dvd Function.IsPeriodicPt.trans_dvd

protected theorem iterate (hf : IsPeriodicPt f n x) (m : ℕ) : IsPeriodicPt (f^[m]) n x := by
  rw [IsPeriodicPt, ← iterate_mul, mul_comm, iterate_mul]
  exact hf.isFixedPt.iterate m
#align function.is_periodic_pt.iterate Function.IsPeriodicPt.iterate

theorem comp {g : α → α} (hco : Commute f g) (hf : IsPeriodicPt f n x) (hg : IsPeriodicPt g n x) :
    IsPeriodicPt (f ∘ g) n x := by
  rw [IsPeriodicPt, hco.comp_iterate]
  exact IsFixedPt.comp hf hg
#align function.is_periodic_pt.comp Function.IsPeriodicPt.comp

theorem comp_lcm {g : α → α} (hco : Commute f g) (hf : IsPeriodicPt f m x)
    (hg : IsPeriodicPt g n x) : IsPeriodicPt (f ∘ g) (Nat.lcm m n) x :=
  (hf.trans_dvd <| Nat.dvd_lcm_left _ _).comp hco (hg.trans_dvd <| Nat.dvd_lcm_right _ _)
#align function.is_periodic_pt.comp_lcm Function.IsPeriodicPt.comp_lcm

theorem left_of_comp {g : α → α} (hco : Commute f g) (hfg : IsPeriodicPt (f ∘ g) n x)
    (hg : IsPeriodicPt g n x) : IsPeriodicPt f n x := by
  rw [IsPeriodicPt, hco.comp_iterate] at hfg
  exact hfg.left_of_comp hg
#align function.is_periodic_pt.left_of_comp Function.IsPeriodicPt.left_of_comp

theorem iterate_mod_apply (h : IsPeriodicPt f n x) (m : ℕ) : (f^[m % n]) x = (f^[m]) x := by
  conv_rhs => rw [← Nat.mod_add_div m n, iterate_add_apply, (h.mul_const _).eq]
#align function.is_periodic_pt.iterate_mod_apply Function.IsPeriodicPt.iterate_mod_apply

protected theorem mod (hm : IsPeriodicPt f m x) (hn : IsPeriodicPt f n x) :
    IsPeriodicPt f (m % n) x :=
  (hn.iterate_mod_apply m).trans hm
#align function.is_periodic_pt.mod Function.IsPeriodicPt.mod

protected theorem gcd (hm : IsPeriodicPt f m x) (hn : IsPeriodicPt f n x) :
    IsPeriodicPt f (m.gcd n) x := by
  revert hm hn
  refine' Nat.gcd.induction m n (fun n _ hn => _) fun m n _ ih hm hn => _
  · rwa [Nat.gcd_zero_left]
  · rw [Nat.gcd_rec]
    exact ih (hn.mod hm) hm
#align function.is_periodic_pt.gcd Function.IsPeriodicPt.gcd

/-- If `f` sends two periodic points `x` and `y` of the same positive period to the same point,
then `x = y`. For a similar statement about points of different periods see `eq_of_apply_eq`. -/
theorem eq_of_apply_eq_same (hx : IsPeriodicPt f n x) (hy : IsPeriodicPt f n y) (hn : 0 < n)
    (h : f x = f y) : x = y := by
  rw [← hx.eq, ← hy.eq, ← iterate_pred_comp_of_pos f hn, comp_apply, comp_apply, h]
#align function.is_periodic_pt.eq_of_apply_eq_same Function.IsPeriodicPt.eq_of_apply_eq_same

/-- If `f` sends two periodic points `x` and `y` of positive periods to the same point,
then `x = y`. -/
theorem eq_of_apply_eq (hx : IsPeriodicPt f m x) (hy : IsPeriodicPt f n y) (hm : 0 < m) (hn : 0 < n)
    (h : f x = f y) : x = y :=
  (hx.mul_const n).eq_of_apply_eq_same (hy.const_mul m) (mul_pos hm hn) h
#align function.is_periodic_pt.eq_of_apply_eq Function.IsPeriodicPt.eq_of_apply_eq

end IsPeriodicPt

/-- The set of periodic points of a given (possibly non-minimal) period. -/
def ptsOfPeriod (f : α → α) (n : ℕ) : Set α :=
  { x : α | IsPeriodicPt f n x }
#align function.pts_of_period Function.ptsOfPeriod

@[simp]
theorem mem_ptsOfPeriod : x ∈ ptsOfPeriod f n ↔ IsPeriodicPt f n x :=
  Iff.rfl
#align function.mem_pts_of_period Function.mem_ptsOfPeriod

theorem Semiconj.mapsTo_ptsOfPeriod {g : α → β} (h : Semiconj g fa fb) (n : ℕ) :
    MapsTo g (ptsOfPeriod fa n) (ptsOfPeriod fb n) :=
  (h.iterate_right n).mapsTo_fixedPoints
#align function.semiconj.maps_to_pts_of_period Function.Semiconj.mapsTo_ptsOfPeriod

theorem bijOn_ptsOfPeriod (f : α → α) {n : ℕ} (hn : 0 < n) :
    BijOn f (ptsOfPeriod f n) (ptsOfPeriod f n) :=
  ⟨(Commute.refl f).mapsTo_ptsOfPeriod n, fun x hx y hy hxy => hx.eq_of_apply_eq_same hy hn hxy,
    fun x hx =>
    ⟨(f^[n.pred]) x, hx.apply_iterate _, by
      rw [← comp_apply (f := f), comp_iterate_pred_of_pos f hn, hx.eq]⟩⟩
#align function.bij_on_pts_of_period Function.bijOn_ptsOfPeriod

theorem directed_ptsOfPeriod_pNat (f : α → α) : Directed (· ⊆ ·) fun n : ℕ+ => ptsOfPeriod f n :=
  fun m n => ⟨m * n, fun _ hx => hx.mul_const n, fun _ hx => hx.const_mul m⟩
#align function.directed_pts_of_period_pnat Function.directed_ptsOfPeriod_pNat

/-- The set of periodic points of a map `f : α → α`. -/
def periodicPts (f : α → α) : Set α :=
  { x : α | ∃ n > 0, IsPeriodicPt f n x }
#align function.periodic_pts Function.periodicPts

theorem mk_mem_periodicPts (hn : 0 < n) (hx : IsPeriodicPt f n x) : x ∈ periodicPts f :=
  ⟨n, hn, hx⟩
#align function.mk_mem_periodic_pts Function.mk_mem_periodicPts

theorem mem_periodicPts : x ∈ periodicPts f ↔ ∃ n > 0, IsPeriodicPt f n x :=
  Iff.rfl
#align function.mem_periodic_pts Function.mem_periodicPts

theorem isPeriodicPt_of_mem_periodicPts_of_isPeriodicPt_iterate (hx : x ∈ periodicPts f)
    (hm : IsPeriodicPt f m ((f^[n]) x)) : IsPeriodicPt f m x := by
  rcases hx with ⟨r, hr, hr'⟩
  suffices n ≤ (n / r + 1) * r by
    -- porting note: convert used to unfold IsPeriodicPt
    change _ = _
    convert (hm.apply_iterate ((n / r + 1) * r - n)).eq <;>
      rw [← iterate_add_apply, Nat.sub_add_cancel this, iterate_mul, (hr'.iterate _).eq]
  rw [add_mul, one_mul]
  exact (Nat.lt_div_mul_add hr).le
#align function.is_periodic_pt_of_mem_periodic_pts_of_is_periodic_pt_iterate Function.isPeriodicPt_of_mem_periodicPts_of_isPeriodicPt_iterate

variable (f)

theorem bUnion_ptsOfPeriod : (⋃ n > 0, ptsOfPeriod f n) = periodicPts f :=
  Set.ext fun x => by simp [mem_periodicPts]
#align function.bUnion_pts_of_period Function.bUnion_ptsOfPeriod

theorem unionᵢ_pNat_ptsOfPeriod : (⋃ n : ℕ+, ptsOfPeriod f n) = periodicPts f :=
  supᵢ_subtype.trans <| bUnion_ptsOfPeriod f
#align function.Union_pnat_pts_of_period Function.unionᵢ_pNat_ptsOfPeriod

theorem bijOn_periodicPts : BijOn f (periodicPts f) (periodicPts f) :=
  unionᵢ_pNat_ptsOfPeriod f ▸
    bijOn_unionᵢ_of_directed (directed_ptsOfPeriod_pNat f) fun i => bijOn_ptsOfPeriod f i.pos
#align function.bij_on_periodic_pts Function.bijOn_periodicPts

variable {f}

theorem Semiconj.mapsTo_periodicPts {g : α → β} (h : Semiconj g fa fb) :
    MapsTo g (periodicPts fa) (periodicPts fb) := fun _ ⟨n, hn, hx⟩ => ⟨n, hn, hx.map h⟩
#align function.semiconj.maps_to_periodic_pts Function.Semiconj.mapsTo_periodicPts

open Classical

noncomputable section

/-- Minimal period of a point `x` under an endomorphism `f`. If `x` is not a periodic point of `f`,
then `minimalPeriod f x = 0`. -/
def minimalPeriod (f : α → α) (x : α) :=
  if h : x ∈ periodicPts f then Nat.find h else 0
#align function.minimal_period Function.minimalPeriod

theorem isPeriodicPt_minimalPeriod (f : α → α) (x : α) : IsPeriodicPt f (minimalPeriod f x) x := by
  delta minimalPeriod
  split_ifs with hx
  · exact (Nat.find_spec hx).2
  · exact isPeriodicPt_zero f x
#align function.is_periodic_pt_minimal_period Function.isPeriodicPt_minimalPeriod

@[simp]
theorem iterate_minimalPeriod : (f^[minimalPeriod f x]) x = x :=
  isPeriodicPt_minimalPeriod f x
#align function.iterate_minimal_period Function.iterate_minimalPeriod

@[simp]

@[simp]
theorem iterate_mod_minimalPeriod_eq : (f^[n % minimalPeriod f x]) x = (f^[n]) x :=
  (isPeriodicPt_minimalPeriod f x).iterate_mod_apply n
#align function.iterate_mod_minimal_period_eq Function.iterate_mod_minimalPeriod_eq

theorem minimalPeriod_pos_of_mem_periodicPts (hx : x ∈ periodicPts f) : 0 < minimalPeriod f x := by
  simp only [minimalPeriod, dif_pos hx, (Nat.find_spec hx).1.lt]
#align function.minimal_period_pos_of_mem_periodic_pts Function.minimalPeriod_pos_of_mem_periodicPts

theorem minimalPeriod_eq_zero_of_nmem_periodicPts (hx : x ∉ periodicPts f) :
    minimalPeriod f x = 0 := by simp only [minimalPeriod, dif_neg hx]
#align function.minimal_period_eq_zero_of_nmem_periodic_pts Function.minimalPeriod_eq_zero_of_nmem_periodicPts

theorem IsPeriodicPt.minimalPeriod_pos (hn : 0 < n) (hx : IsPeriodicPt f n x) :
    0 < minimalPeriod f x :=
  minimalPeriod_pos_of_mem_periodicPts <| mk_mem_periodicPts hn hx
#align function.is_periodic_pt.minimal_period_pos Function.IsPeriodicPt.minimalPeriod_pos

theorem minimalPeriod_pos_iff_mem_periodicPts : 0 < minimalPeriod f x ↔ x ∈ periodicPts f :=
  ⟨not_imp_not.1 fun h => by simp only [minimalPeriod, dif_neg h, lt_irrefl 0, not_false_iff],
    minimalPeriod_pos_of_mem_periodicPts⟩
#align function.minimal_period_pos_iff_mem_periodic_pts Function.minimalPeriod_pos_iff_mem_periodicPts

theorem minimalPeriod_eq_zero_iff_nmem_periodicPts : minimalPeriod f x = 0 ↔ x ∉ periodicPts f := by
  rw [← minimalPeriod_pos_iff_mem_periodicPts, not_lt, nonpos_iff_eq_zero]
#align function.minimal_period_eq_zero_iff_nmem_periodic_pts Function.minimalPeriod_eq_zero_iff_nmem_periodicPts

theorem IsPeriodicPt.minimalPeriod_le (hn : 0 < n) (hx : IsPeriodicPt f n x) :
    minimalPeriod f x ≤ n := by
  rw [minimalPeriod, dif_pos (mk_mem_periodicPts hn hx)]
  exact Nat.find_min' (mk_mem_periodicPts hn hx) ⟨hn, hx⟩
#align function.is_periodic_pt.minimal_period_le Function.IsPeriodicPt.minimalPeriod_le

theorem minimalPeriod_apply_iterate (hx : x ∈ periodicPts f) (n : ℕ) :
    minimalPeriod f ((f^[n]) x) = minimalPeriod f x := by
  apply
    (IsPeriodicPt.minimalPeriod_le (minimalPeriod_pos_of_mem_periodicPts hx) _).antisymm
      ((isPeriodicPt_of_mem_periodicPts_of_isPeriodicPt_iterate hx
            (isPeriodicPt_minimalPeriod f _)).minimalPeriod_le
        (minimalPeriod_pos_of_mem_periodicPts _))
  · exact (isPeriodicPt_minimalPeriod f x).apply_iterate n
  · rcases hx with ⟨m, hm, hx⟩
    exact ⟨m, hm, hx.apply_iterate n⟩
#align function.minimal_period_apply_iterate Function.minimalPeriod_apply_iterate

theorem minimalPeriod_apply (hx : x ∈ periodicPts f) : minimalPeriod f (f x) = minimalPeriod f x :=
  minimalPeriod_apply_iterate hx 1
#align function.minimal_period_apply Function.minimalPeriod_apply

theorem le_of_lt_minimalPeriod_of_iterate_eq {m n : ℕ} (hm : m < minimalPeriod f x)
    (hmn : (f^[m]) x = (f^[n]) x) : m ≤ n := by
  by_contra' hmn'
  rw [← Nat.add_sub_of_le hmn'.le, add_comm, iterate_add_apply] at hmn
  exact
    ((IsPeriodicPt.minimalPeriod_le (tsub_pos_of_lt hmn')
              (isPeriodicPt_of_mem_periodicPts_of_isPeriodicPt_iterate
                (minimalPeriod_pos_iff_mem_periodicPts.1 ((zero_le m).trans_lt hm)) hmn)).trans
          (Nat.sub_le m n)).not_lt
      hm
#align function.le_of_lt_minimal_period_of_iterate_eq Function.le_of_lt_minimalPeriod_of_iterate_eq

theorem eq_of_lt_minimalPeriod_of_iterate_eq {m n : ℕ} (hm : m < minimalPeriod f x)
    (hn : n < minimalPeriod f x) (hmn : (f^[m]) x = (f^[n]) x) : m = n :=
  (le_of_lt_minimalPeriod_of_iterate_eq hm hmn).antisymm
    (le_of_lt_minimalPeriod_of_iterate_eq hn hmn.symm)
#align function.eq_of_lt_minimal_period_of_iterate_eq Function.eq_of_lt_minimalPeriod_of_iterate_eq

theorem eq_iff_lt_minimalPeriod_of_iterate_eq {m n : ℕ} (hm : m < minimalPeriod f x)
    (hn : n < minimalPeriod f x) : (f^[m]) x = (f^[n]) x ↔ m = n :=
  ⟨eq_of_lt_minimalPeriod_of_iterate_eq hm hn, congr_arg (Nat.iterate f · x)⟩
#align function.eq_iff_lt_minimal_period_of_iterate_eq Function.eq_iff_lt_minimalPeriod_of_iterate_eq

theorem minimalPeriod_id : minimalPeriod id x = 1 :=
  ((is_periodic_id _ _).minimalPeriod_le Nat.one_pos).antisymm
    (Nat.succ_le_of_lt ((is_periodic_id _ _).minimalPeriod_pos Nat.one_pos))
#align function.minimal_period_id Function.minimalPeriod_id

theorem is_fixed_point_iff_minimalPeriod_eq_one : minimalPeriod f x = 1 ↔ IsFixedPt f x := by
  refine' ⟨fun h => _, fun h => _⟩
  · rw [← iterate_one f]
    refine' Function.IsPeriodicPt.isFixedPt _
    rw [← h]
    exact isPeriodicPt_minimalPeriod f x
  · exact
      ((h.isPeriodicPt 1).minimalPeriod_le Nat.one_pos).antisymm
        (Nat.succ_le_of_lt ((h.isPeriodicPt 1).minimalPeriod_pos Nat.one_pos))
#align function.is_fixed_point_iff_minimal_period_eq_one Function.is_fixed_point_iff_minimalPeriod_eq_one

theorem IsPeriodicPt.eq_zero_of_lt_minimalPeriod (hx : IsPeriodicPt f n x)
    (hn : n < minimalPeriod f x) : n = 0 :=
  Eq.symm <|
    (eq_or_lt_of_le <| n.zero_le).resolve_right fun hn0 => not_lt.2 (hx.minimalPeriod_le hn0) hn
#align function.is_periodic_pt.eq_zero_of_lt_minimal_period Function.IsPeriodicPt.eq_zero_of_lt_minimalPeriod

theorem not_isPeriodicPt_of_pos_of_lt_minimalPeriod :
    ∀ {n : ℕ} (_ : n ≠ 0) (_ : n < minimalPeriod f x), ¬IsPeriodicPt f n x
  | 0, n0, _ => (n0 rfl).elim
  | _ + 1, _, hn => fun hp => Nat.succ_ne_zero _ (hp.eq_zero_of_lt_minimalPeriod hn)
#align function.not_is_periodic_pt_of_pos_of_lt_minimal_period Function.not_isPeriodicPt_of_pos_of_lt_minimalPeriod

theorem IsPeriodicPt.minimalPeriod_dvd (hx : IsPeriodicPt f n x) : minimalPeriod f x ∣ n :=
  (eq_or_lt_of_le <| n.zero_le).elim (fun hn0 => hn0 ▸ dvd_zero _) fun hn0 =>
    -- Porting note: `Nat.dvd_iff_mod_eq_zero` gained explicit arguments
    (Nat.dvd_iff_mod_eq_zero _ _).2 <|
      (hx.mod <| isPeriodicPt_minimalPeriod f x).eq_zero_of_lt_minimalPeriod <|
        Nat.mod_lt _ <| hx.minimalPeriod_pos hn0
#align function.is_periodic_pt.minimal_period_dvd Function.IsPeriodicPt.minimalPeriod_dvd

theorem isPeriodicPt_iff_minimalPeriod_dvd : IsPeriodicPt f n x ↔ minimalPeriod f x ∣ n :=
  ⟨IsPeriodicPt.minimalPeriod_dvd, fun h => (isPeriodicPt_minimalPeriod f x).trans_dvd h⟩
#align function.is_periodic_pt_iff_minimal_period_dvd Function.isPeriodicPt_iff_minimalPeriod_dvd

open Nat

theorem minimalPeriod_eq_minimalPeriod_iff {g : β → β} {y : β} :
    minimalPeriod f x = minimalPeriod g y ↔ ∀ n, IsPeriodicPt f n x ↔ IsPeriodicPt g n y := by
  simp_rw [isPeriodicPt_iff_minimalPeriod_dvd, dvd_right_iff_eq]
#align function.minimal_period_eq_minimal_period_iff Function.minimalPeriod_eq_minimalPeriod_iff

theorem minimalPeriod_eq_prime {p : ℕ} [hp : Fact p.Prime] (hper : IsPeriodicPt f p x)
    (hfix : ¬IsFixedPt f x) : minimalPeriod f x = p :=
  (hp.out.eq_one_or_self_of_dvd _ hper.minimalPeriod_dvd).resolve_left
    (mt is_fixed_point_iff_minimalPeriod_eq_one.1 hfix)
#align function.minimal_period_eq_prime Function.minimalPeriod_eq_prime

theorem minimalPeriod_eq_prime_pow {p k : ℕ} [hp : Fact p.Prime] (hk : ¬IsPeriodicPt f (p ^ k) x)
    (hk1 : IsPeriodicPt f (p ^ (k + 1)) x) : minimalPeriod f x = p ^ (k + 1) := by
  apply Nat.eq_prime_pow_of_dvd_least_prime_pow hp.out <;>
    rwa [← isPeriodicPt_iff_minimalPeriod_dvd]
#align function.minimal_period_eq_prime_pow Function.minimalPeriod_eq_prime_pow

theorem Commute.minimalPeriod_of_comp_dvd_lcm {g : α → α} (h : Function.Commute f g) :
    minimalPeriod (f ∘ g) x ∣ Nat.lcm (minimalPeriod f x) (minimalPeriod g x) := by
  rw [← isPeriodicPt_iff_minimalPeriod_dvd]
  exact (isPeriodicPt_minimalPeriod f x).comp_lcm h (isPeriodicPt_minimalPeriod g x)
#align function.commute.minimal_period_of_comp_dvd_lcm Function.Commute.minimalPeriod_of_comp_dvd_lcm

theorem Commute.minimalPeriod_of_comp_dvd_mul {g : α → α} (h : Function.Commute f g) :
    minimalPeriod (f ∘ g) x ∣ minimalPeriod f x * minimalPeriod g x :=
  dvd_trans h.minimalPeriod_of_comp_dvd_lcm (lcm_dvd_mul _ _)
#align function.commute.minimal_period_of_comp_dvd_mul Function.Commute.minimalPeriod_of_comp_dvd_mul

theorem Commute.minimalPeriod_of_comp_eq_mul_of_coprime {g : α → α} (h : Function.Commute f g)
    (hco : coprime (minimalPeriod f x) (minimalPeriod g x)) :
    minimalPeriod (f ∘ g) x = minimalPeriod f x * minimalPeriod g x := by
  apply dvd_antisymm h.minimalPeriod_of_comp_dvd_mul
  suffices :
    ∀ {f g : α → α},
      Commute f g →
        coprime (minimalPeriod f x) (minimalPeriod g x) →
          minimalPeriod f x ∣ minimalPeriod (f ∘ g) x
  · exact hco.mul_dvd_of_dvd_of_dvd (this h hco) (h.comp_eq.symm ▸ this h.symm hco.symm)
  intro f g h hco
  refine' hco.dvd_of_dvd_mul_left (IsPeriodicPt.left_of_comp h _ _).minimalPeriod_dvd
  · exact (isPeriodicPt_minimalPeriod _ _).const_mul _
  · exact (isPeriodicPt_minimalPeriod _ _).mul_const _
#align function.commute.minimal_period_of_comp_eq_mul_of_coprime Function.Commute.minimalPeriod_of_comp_eq_mul_of_coprime

private theorem minimalPeriod_iterate_eq_div_gcd_aux (h : 0 < gcd (minimalPeriod f x) n) :
    minimalPeriod (f^[n]) x = minimalPeriod f x / Nat.gcd (minimalPeriod f x) n := by
  apply Nat.dvd_antisymm
  · apply IsPeriodicPt.minimalPeriod_dvd
    rw [IsPeriodicPt, IsFixedPt, ← iterate_mul, ← Nat.mul_div_assoc _ (gcd_dvd_left _ _),
      mul_comm, Nat.mul_div_assoc _ (gcd_dvd_right _ _), mul_comm, iterate_mul]
    exact (isPeriodicPt_minimalPeriod f x).iterate _
  · apply coprime.dvd_of_dvd_mul_right (coprime_div_gcd_div_gcd h)
    apply Nat.dvd_of_mul_dvd_mul_right h
    rw [Nat.div_mul_cancel (gcd_dvd_left _ _), mul_assoc, Nat.div_mul_cancel (gcd_dvd_right _ _),
      mul_comm]
    apply IsPeriodicPt.minimalPeriod_dvd
    rw [IsPeriodicPt, IsFixedPt, iterate_mul]
    exact isPeriodicPt_minimalPeriod _ _

theorem minimalPeriod_iterate_eq_div_gcd (h : n ≠ 0) :
    minimalPeriod (f^[n]) x = minimalPeriod f x / Nat.gcd (minimalPeriod f x) n :=
  minimalPeriod_iterate_eq_div_gcd_aux <| gcd_pos_of_pos_right _ (Nat.pos_of_ne_zero h)
#align function.minimal_period_iterate_eq_div_gcd Function.minimalPeriod_iterate_eq_div_gcd

theorem minimalPeriod_iterate_eq_div_gcd' (h : x ∈ periodicPts f) :
    minimalPeriod (f^[n]) x = minimalPeriod f x / Nat.gcd (minimalPeriod f x) n :=
  minimalPeriod_iterate_eq_div_gcd_aux <|
    gcd_pos_of_pos_left n (minimalPeriod_pos_iff_mem_periodicPts.mpr h)
#align function.minimal_period_iterate_eq_div_gcd' Function.minimalPeriod_iterate_eq_div_gcd'

/-- The orbit of a periodic point `x` of `f` is the cycle `[x, f x, f (f x), ...]`. Its length is
the minimal period of `x`.

If `x` is not a periodic point, then this is the empty (aka nil) cycle. -/
def periodicOrbit (f : α → α) (x : α) : Cycle α :=
  (List.range (minimalPeriod f x)).map fun n => (f^[n]) x
#align function.periodic_orbit Function.periodicOrbit

/-- The definition of a periodic orbit, in terms of `List.map`. -/
theorem periodicOrbit_def (f : α → α) (x : α) :
    periodicOrbit f x = (List.range (minimalPeriod f x)).map fun n => (f^[n]) x :=
  rfl
#align function.periodic_orbit_def Function.periodicOrbit_def

/-- The definition of a periodic orbit, in terms of `Cycle.map`. -/
theorem periodicOrbit_eq_cycle_map (f : α → α) (x : α) :
    periodicOrbit f x = (List.range (minimalPeriod f x) : Cycle ℕ).map fun n => (f^[n]) x :=
  rfl
#align function.periodic_orbit_eq_cycle_map Function.periodicOrbit_eq_cycle_map

@[simp]
theorem periodicOrbit_length : (periodicOrbit f x).length = minimalPeriod f x := by
  rw [periodicOrbit, Cycle.length_coe, List.length_map, List.length_range]
#align function.periodic_orbit_length Function.periodicOrbit_length

@[simp]
theorem periodicOrbit_eq_nil_iff_not_periodic_pt :
    periodicOrbit f x = Cycle.nil ↔ x ∉ periodicPts f := by
  simp [periodicOrbit]
  exact minimalPeriod_eq_zero_iff_nmem_periodicPts
#align function.periodic_orbit_eq_nil_iff_not_periodic_pt Function.periodicOrbit_eq_nil_iff_not_periodic_pt

theorem periodicOrbit_eq_nil_of_not_periodic_pt (h : x ∉ periodicPts f) :
    periodicOrbit f x = Cycle.nil :=
  periodicOrbit_eq_nil_iff_not_periodic_pt.2 h
#align function.periodic_orbit_eq_nil_of_not_periodic_pt Function.periodicOrbit_eq_nil_of_not_periodic_pt

@[simp]
theorem mem_periodicOrbit_iff (hx : x ∈ periodicPts f) :
    y ∈ periodicOrbit f x ↔ ∃ n, (f^[n]) x = y := by
  simp only [periodicOrbit, Cycle.mem_coe_iff, List.mem_map, List.mem_range]
  use fun ⟨a, _, ha'⟩ => ⟨a, ha'⟩
  rintro ⟨n, rfl⟩
  use n % minimalPeriod f x, mod_lt _ (minimalPeriod_pos_of_mem_periodicPts hx)
  rw [iterate_mod_minimalPeriod_eq]
#align function.mem_periodic_orbit_iff Function.mem_periodicOrbit_iff

@[simp]
theorem iterate_mem_periodicOrbit (hx : x ∈ periodicPts f) (n : ℕ) :
    (f^[n]) x ∈ periodicOrbit f x :=
  (mem_periodicOrbit_iff hx).2 ⟨n, rfl⟩
#align function.iterate_mem_periodic_orbit Function.iterate_mem_periodicOrbit

@[simp]
theorem self_mem_periodicOrbit (hx : x ∈ periodicPts f) : x ∈ periodicOrbit f x :=
  iterate_mem_periodicOrbit hx 0
#align function.self_mem_periodic_orbit Function.self_mem_periodicOrbit

theorem nodup_periodicOrbit : (periodicOrbit f x).Nodup := by
  rw [periodicOrbit, Cycle.nodup_coe_iff, List.nodup_map_iff_inj_on (List.nodup_range _)]
  intro m hm n hn hmn
  rw [List.mem_range] at hm hn
  rwa [eq_iff_lt_minimalPeriod_of_iterate_eq hm hn] at hmn
#align function.nodup_periodic_orbit Function.nodup_periodicOrbit

set_option linter.deprecated false in
theorem periodicOrbit_apply_iterate_eq (hx : x ∈ periodicPts f) (n : ℕ) :
    periodicOrbit f ((f^[n]) x) = periodicOrbit f x :=
  Eq.symm <|
    Cycle.coe_eq_coe.2 <|
      ⟨n, by
        apply List.ext_nthLe _ fun m _ _ => _
        · simp [minimalPeriod_apply_iterate hx]
        · simp [List.nthLe_rotate, iterate_add_apply]⟩
#align function.periodic_orbit_apply_iterate_eq Function.periodicOrbit_apply_iterate_eq

theorem periodicOrbit_apply_eq (hx : x ∈ periodicPts f) :
    periodicOrbit f (f x) = periodicOrbit f x :=
  periodicOrbit_apply_iterate_eq hx 1
#align function.periodic_orbit_apply_eq Function.periodicOrbit_apply_eq

theorem periodicOrbit_chain (r : α → α → Prop) {f : α → α} {x : α} :
    (periodicOrbit f x).Chain r ↔ ∀ n < minimalPeriod f x, r ((f^[n]) x) ((f^[n + 1]) x) := by
  by_cases hx : x ∈ periodicPts f
  · have hx' := minimalPeriod_pos_of_mem_periodicPts hx
    have hM := Nat.sub_add_cancel (succ_le_iff.2 hx')
    rw [periodicOrbit, ← Cycle.map_coe, Cycle.chain_map, ← hM, Cycle.chain_range_succ]
    refine' ⟨_, fun H => ⟨_, fun m hm => H _ (hm.trans (Nat.lt_succ_self _))⟩⟩
    · rintro ⟨hr, H⟩ n hn
      cases' eq_or_lt_of_le (lt_succ_iff.1 hn) with hM' hM'
      · rwa [hM', hM, iterate_minimalPeriod]
      · exact H _ hM'
    · rw [iterate_zero_apply]
      nth_rw 3 [← @iterate_minimalPeriod α f x]
      nth_rw 2 [← hM]
      exact H _ (Nat.lt_succ_self _)
  · rw [periodicOrbit_eq_nil_of_not_periodic_pt hx, minimalPeriod_eq_zero_of_nmem_periodicPts hx]
    simp
#align function.periodic_orbit_chain Function.periodicOrbit_chain

theorem periodicOrbit_chain' (r : α → α → Prop) {f : α → α} {x : α} (hx : x ∈ periodicPts f) :
    (periodicOrbit f x).Chain r ↔ ∀ n, r ((f^[n]) x) ((f^[n + 1]) x) := by
  rw [periodicOrbit_chain r]
  refine' ⟨fun H n => _, fun H n _ => H n⟩
  rw [iterate_succ_apply, ← iterate_mod_minimalPeriod_eq, ← iterate_mod_minimalPeriod_eq (n := n),
    ← iterate_succ_apply, minimalPeriod_apply hx]
  exact H _ (mod_lt _ (minimalPeriod_pos_of_mem_periodicPts hx))
#align function.periodic_orbit_chain' Function.periodicOrbit_chain'

end -- noncomputable

end Function

namespace MulAction

open Function

variable {α β : Type _} [Group α] [MulAction α β] {a : α} {b : β}

@[to_additive]
theorem pow_smul_eq_iff_minimalPeriod_dvd {n : ℕ} :
    a ^ n • b = b ↔ Function.minimalPeriod ((· • ·) a) b ∣ n := by
  rw [← isPeriodicPt_iff_minimalPeriod_dvd, IsPeriodicPt, IsFixedPt, smul_iterate]
#align mul_action.pow_smul_eq_iff_minimal_period_dvd MulAction.pow_smul_eq_iff_minimalPeriod_dvd
#align add_action.nsmul_vadd_eq_iff_minimal_period_dvd AddAction.nsmul_vadd_eq_iff_minimalPeriod_dvd

@[to_additive]
theorem zpow_smul_eq_iff_minimalPeriod_dvd {n : ℤ} :
    a ^ n • b = b ↔ (Function.minimalPeriod ((· • ·) a) b : ℤ) ∣ n := by
  cases n
  · rw [Int.ofNat_eq_coe, zpow_ofNat, Int.coe_nat_dvd, pow_smul_eq_iff_minimalPeriod_dvd]
  · rw [Int.negSucc_coe, zpow_neg, zpow_ofNat, inv_smul_eq_iff, eq_comm, dvd_neg, Int.coe_nat_dvd,
      pow_smul_eq_iff_minimalPeriod_dvd]
#align mul_action.zpow_smul_eq_iff_minimal_period_dvd MulAction.zpow_smul_eq_iff_minimalPeriod_dvd
#align add_action.zsmul_vadd_eq_iff_minimal_period_dvd AddAction.zsmul_vadd_eq_iff_minimalPeriod_dvd

variable (a b)

@[to_additive (attr := simp)]
theorem pow_smul_mod_minimalPeriod (n : ℕ) :
    a ^ (n % Function.minimalPeriod ((· • ·) a) b) • b = a ^ n • b := by
  conv_rhs =>
    rw [← Nat.mod_add_div n (minimalPeriod ((· • ·) a) b), pow_add, mul_smul,
      pow_smul_eq_iff_minimalPeriod_dvd.mpr (dvd_mul_right _ _)]
#align mul_action.pow_smul_mod_minimal_period MulAction.pow_smul_mod_minimalPeriod
#align add_action.nsmul_vadd_mod_minimal_period AddAction.nsmul_vadd_mod_minimalPeriod

@[to_additive (attr := simp)]
theorem zpow_smul_mod_minimalPeriod (n : ℤ) :
    a ^ (n % (Function.minimalPeriod ((· • ·) a) b : ℤ)) • b = a ^ n • b := by
  conv_rhs =>
    rw [← Int.emod_add_ediv n (minimalPeriod ((a • ·)) b), zpow_add, mul_smul,
      zpow_smul_eq_iff_minimalPeriod_dvd.mpr (dvd_mul_right _ _)]
#align mul_action.zpow_smul_mod_minimal_period MulAction.zpow_smul_mod_minimalPeriod
#align add_action.zsmul_vadd_mod_minimal_period AddAction.zsmul_vadd_mod_minimalPeriod

end MulAction


/-
Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import data.set.basic
import data.bool

/-!
# Booleans and set operations

This file contains two trivial lemmas about `bool`, `set.univ`, and `set.range`.
-/

open set

namespace bool

@[simp] lemma univ_eq : (univ : set bool) = {ff, tt} :=
(eq_univ_of_forall bool.dichotomy).symm

@[simp] lemma range_eq {α : Type*} (f : bool → α) : range f = {f ff, f tt} :=
by rw [← image_univ, univ_eq, image_pair]

end bool


import cautomaton utils data.list.perm

open utils

namespace hpp

section hpp

inductive cellT | X | N | W | E | S
                | NW | NE | NS | WS | WE | ES
                | NWE | NWS | NES | WES | NWSE

inductive cardinal | CN | CW | CE | CS

open cellT cardinal

def cellT_str : cellT → string
	| N    := "↑"
	| W    := "←"
	| E    := "→"
	| S    := "↓"
  | NW   := "↖"
  | NE   := "↗"
  | NS   := "↕"
  | WS   := "↙"
  | WE   := "↔"
  | ES   := "↙"
  | NWE  := "⊥"
  | NWS  := "⊣"
  | NES  := "⊢"
  | WES  := "⊤"
  | NWSE := "+"
  | X    := " "

def num_particles : cellT → ℕ
| N    := 1
| W    := 1
| E    := 1
| S    := 1
| NW   := 2
| NE   := 2
| NS   := 2
| WS   := 2
| WE   := 2
| ES   := 2
| NWE  := 3
| NWS  := 3
| NES  := 3
| WES  := 3
| NWSE := 4
| X    := 0

instance cellT_to_str : has_to_string cellT := ⟨cellT_str⟩

instance cellT_repr : has_repr cellT := ⟨cellT_str⟩

instance cellT_deceq : decidable_eq cellT :=
	λl r, by cases l; cases r; try {exact is_true rfl}; apply is_false; trivial

attribute [reducible]
def hpp := cautomaton cellT

def has_cardinal : cellT → cardinal → bool
  | N CN := tt
  | N _  := ff
  | W CW := tt
  | W _  := ff
  | E CE := tt
  | E _  := ff
  | S CS := tt
  | S _  := ff
  | NW CN := tt
  | NW CW := tt
  | NW _  := ff
  | NE CN := tt
  | NE CE := tt
  | NE _  := ff
  | NS CW := tt
  | NS CE := tt
  | NS _  := ff
  | WS CW := tt
  | WS CS := tt
  | WS _  := ff
  | WE CS := tt
  | WE CN := tt
  | WE _  := ff
  | ES CE := tt
  | ES CS := tt
  | ES _  := ff
  | NWE CN := tt
  | NWE CW := tt
  | NWE CE := tt
  | NWE _  := ff
  | NWS CN := tt
  | NWS CW := tt
  | NWS CS := tt
  | NWS _  := ff
  | NES CN := tt
  | NES CE := tt
  | NES CS := tt
  | NES _  := ff
  | WES CW := tt
  | WES CE := tt
  | WES CS := tt
  | WES _  := ff
  | NWSE _ := tt
  | X _ := ff

def collision : cellT → cellT
  | NS := WE
  | WE := NS
  | x  := x

def translation' : bool → bool → bool → bool → cellT
  | tt tt tt tt := NWSE
  | tt tt tt ff := WES
  | tt tt ff tt := NES
  | tt tt ff ff := ES
  | tt ff tt tt := NWS
  | tt ff tt ff := WS
  | tt ff ff tt := NS
  | tt ff ff ff := S
  | ff tt tt tt := NWE
  | ff tt tt ff := WE
  | ff tt ff tt := NE
  | ff tt ff ff := E
  | ff ff tt tt := NW
  | ff ff tt ff := W
  | ff ff ff tt := N
  | ff ff ff ff := X

def translation (neigh : list cellT) : cellT :=
  let north := list.nth neigh 0 in
  let west  := list.nth neigh 1 in
  let east  := list.nth neigh 2 in
  let south := list.nth neigh 3 in
  match north with
    | none     := X
    | (some n) :=
  match west with
    | none     := X
    | (some w) :=
  match east with
    | none     := X
    | (some e) :=
  match south with
    | none     := X
    | (some s) :=
      translation' (has_cardinal n CS)
                   (has_cardinal w CE)
                   (has_cardinal e CW)
                   (has_cardinal s CN)
  end end end end

lemma translation_eq_translation' {neigh : list cellT}
  (h : list.length neigh = 4) :
  translation neigh =
    let n := list.nth_le neigh 0 $ by simp [h]; exact dec_trivial in
    let w := list.nth_le neigh 1 $ by simp [h]; exact dec_trivial in
    let e := list.nth_le neigh 2 $ by simp [h]; exact dec_trivial in
    let s := list.nth_le neigh 3 $ by simp [h]; exact dec_trivial in
      translation' (has_cardinal n CS)
                   (has_cardinal w CE)
                   (has_cardinal e CW)
                   (has_cardinal s CN) :=
begin
  cases neigh with x₁ xs₁, cases h,
  cases xs₁ with x₂ xs₂, cases h,
  cases xs₂ with x₃ xs₃, cases h,
  cases xs₃ with x₄ xs₄, cases h,
  cases xs₄ with x₅ xs₅, swap 2, cases h,
  unfold translation, simp,
  delta translation, simp
end

def mk_hpp (g : vec_grid₀ cellT) : hpp :=
  ⟨g, X, cautomatons.neumann, sum.inl cautomatons.ext_one, (λ_ neigh, translation neigh)⟩

def hpp_g :=
  vec_grid₀.mk
    ⟨11, 11, dec_trivial,
    ⟨[X, X, X, X, X, X, X, X, X, X, X,
      X, X, X, X, X, X, X, X, X, X, X,
      X, X, X, X, X, X, X, X, X, X, X,
      X, X, X, X, X, WE, X, X, X, S, X,
      E, X, X, X, E, X, W, X, X, N, N,
      X, X, X, X, X, N, X, X, X, X, X,
      X, X, X, X, X, X, X, X, X, X, X,
      X, X, X, X, X, X, X, X, X, X, X,
      X, X, X, X, X, X, X, X, X, X, X,
      X, X, X, X, X, X, X, X, X, X, X,
      X, X, X, X, X, X, X, X, X, X, X], rfl⟩⟩
    ⟨0, 0⟩

def simple := mk_hpp hpp_g

#eval step_n simple 8

def hpp_g' :=
  vec_grid₀.mk
    ⟨11, 11, dec_trivial,
    ⟨[X, X, X, X, X, X, X, X, X, X, X,
      X, X, X, X, X, X, X, X, X, X, X,
      X, X, X, X, X, X, X, X, X, X, X,
      X, X, X, X, X, X, X, X, X, X, X,
      X, X, X, X, X, X, X, X, X, X, X,
      X, X, X, X, X, X, X, X, X, X, X,
      X, X, X, X, X, X, X, X, X, X, X,
      X, X, X, X, X, X, X, X, X, X, X,
      X, X, X, X, X, X, X, X, X, X, X,
      X, X, X, X, X, X, X, X, X, X, X,
      X, X, X, X, X, X, X, X, X, X, X], rfl⟩⟩
    ⟨0, 0⟩

def test_simple := mk_hpp hpp_g'

def count_particles (a : hpp) : ℕ :=
  list.sum ℘(num_particles <$> a.g)

def count_particles' (a : hpp) : ℕ :=
  count a N + count a W + count a S + count a E +
  2 * count a NW + 2 * count a NE + 2 * count a NS + 2 * count a WS +
  2 * count a WE + 2 * count a ES + 3 * count a NWE + 3 * count a NWS +
  3 * count a NES + 3 * count a WES + 4 * count a NWSE

def option_coerce : option cellT → cellT
  | option.none := X
  | (option.some c) := c

instance : has_coe (option cellT) cellT := ⟨option_coerce⟩

set_option pp.binder_types false

open list

lemma count_particles_split_dir {g} (a : hpp) (h : a = mk_hpp g) :
  count_particles' a = count_particles a :=
begin
  subst h, simp [mk_hpp],
  simp [count_particles, count_particles', _root_.count, count_grid],
  rw ← map_generate_map_v₀,
  repeat { rw generate_eq_data },
  rcases g with ⟨⟨r, c, h, ⟨data, hdata⟩⟩, o⟩,
  simp, clear hdata,
  induction data with hd tl ih,
    {simp [list.count]},
    {
      by_cases eq₁ : hd = E; simp [eq₁],
        {
          rw @count_cons_self _ _ E,
          repeat { rw @count_cons_of_ne _ _ _ E _ tl }; try { trivial },
          unfold num_particles, rw ← ih, rw nat.succ_add,
          rw nat.one_add
        },
        {
      by_cases eq₂ : hd = N,
        {
          subst eq₂,
          rw @count_cons_self _ _ N,
          repeat { rw @count_cons_of_ne _ _ _ N _ tl }; try { trivial },
          unfold num_particles, rw ← ih, rw nat.succ_add,
          rw nat.one_add
        },
        {
      by_cases eq₃ : hd = S,
        {
          subst eq₃,
          rw @count_cons_self _ _ S,
          repeat { rw @count_cons_of_ne _ _ _ S _ tl }; try { trivial },
          unfold num_particles, rw ← ih, rw nat.succ_add,
          rw nat.one_add, ring
        },
        {
      by_cases eq₄ : hd = W,
        {
          subst eq₄,
          rw @count_cons_self _ _ W,
          repeat { rw @count_cons_of_ne _ _ _ W _ tl }; try { trivial },
          unfold num_particles, rw ← ih, rw nat.succ_add,
          rw nat.one_add, ring
        },
        {
      by_cases eq₅ : hd = ES,
        {
          subst eq₅, unfold num_particles,
          rw @count_cons_self _ _ ES, repeat { rw ← nat.one_add },
          repeat { rw @count_cons_of_ne _ _ _ ES _ tl }; try { trivial },
          rw ← ih, ring
        },
        {
      by_cases eq₆ : hd = NE,
        {
          subst eq₆, unfold num_particles,
          rw @count_cons_self _ _ NE, repeat { rw ← nat.one_add },
          repeat { rw @count_cons_of_ne _ _ _ NE _ tl }; try { trivial },
          rw ← ih, ring
        },
        {
      by_cases eq₇ : hd = NS,
        {
          subst eq₇, unfold num_particles,
          rw @count_cons_self _ _ NS, repeat { rw ← nat.one_add },
          repeat { rw @count_cons_of_ne _ _ _ NS _ tl }; try { trivial },
          rw ← ih, ring
        },
        {
      by_cases eq₈ : hd = NW,
        {
          subst eq₈, unfold num_particles,
          rw @count_cons_self _ _ NW, repeat { rw ← nat.one_add },
          repeat { rw @count_cons_of_ne _ _ _ NW _ tl }; try { trivial },
          rw ← ih, ring
        },
        {
      by_cases eq₉ : hd = WE,
        {
          subst eq₉, unfold num_particles,
          rw @count_cons_self _ _ WE, repeat { rw ← nat.one_add },
          repeat { rw @count_cons_of_ne _ _ _ WE _ tl }; try { trivial },
          rw ← ih, ring
        },
        {
      by_cases eq₁₀ : hd = NES,
        {
          subst eq₁₀, unfold num_particles,
          rw @count_cons_self _ _ NES, repeat { rw ← nat.one_add },
          repeat { rw @count_cons_of_ne _ _ _ NES _ tl }; try { trivial },
          rw ← ih, ring
        },
        {
      by_cases eq₁₁ : hd = NWE,
        {
          subst eq₁₁, unfold num_particles,
          rw @count_cons_self _ _ NWE, repeat { rw ← nat.one_add },
          repeat { rw @count_cons_of_ne _ _ _ NWE _ tl }; try { trivial },
          rw ← ih, ring
        },
        {
      by_cases eq₁₂ : hd = NWS,
        {
          subst eq₁₂, unfold num_particles,
          rw @count_cons_self _ _ NWS, repeat { rw ← nat.one_add },
          repeat { rw @count_cons_of_ne _ _ _ NWS _ tl }; try { trivial },
          rw ← ih, ring
        },
        {
      by_cases eq₁₃ : hd = WES,
        {
          subst eq₁₃, unfold num_particles,
          rw @count_cons_self _ _ WES, repeat { rw ← nat.one_add },
          repeat { rw @count_cons_of_ne _ _ _ WES _ tl }; try { trivial },
          rw ← ih, ring
        },
        {
      by_cases eq₁₄ : hd = NWSE,
        {
          subst eq₁₄, unfold num_particles,
          rw @count_cons_self _ _ NWSE, repeat { rw ← nat.one_add },
          repeat { rw @count_cons_of_ne _ _ _ NWSE _ tl }; try { trivial },
          rw ← ih, ring
        },
        {
      by_cases eq₁₅ : hd = WS,
        {
          subst eq₁₅, unfold num_particles,
          rw @count_cons_self _ _ WS, repeat { rw ← nat.one_add },
          repeat { rw @count_cons_of_ne _ _ _ WS _ tl }; try { trivial },
          rw ← ih, ring
        },
        {
          have : hd = X, { cases hd; try { trivial } }, subst this,
          repeat { rw @count_cons_of_ne _ _ _ X _ tl }; try { trivial },
          unfold num_particles,
          rw zero_add, rw ← ih,
        }}}}}}}}}}}}}}}
    }
end

theorem canonical_pres_count {g} (a : hpp) (h : a = mk_hpp g) :
  count_particles a = count_particles (make_canonical a) :=
begin
  rw ← count_particles_split_dir _ h,
  rw ← count_particles_split_dir,
  have h₁ : a.empty = X, by finish,
  unfold count_particles',
  repeat { rw ← count_nonempty_make_canonical },
  all_goals { try { rw h₁; trivial } },
  swap 2, exact (make_canonical a).g, simp [mk_hpp],
  simp [make_canonical], subst h, simp [mk_hpp]
end

lemma next_gen_ext_one_gbl_y {a : hpp}
  (h : a.bound = sum.inl cautomatons.ext_one) :
  (grid.bl (ext_aut a).g).y = (grid.bl a.g).y - 1 :=
begin
  simp [ext_aut, h, grid.bl],
  unfold_coes,
  simp [vec_grid₀_of_fgrid₀_o, cautomatons.bl_ext_one, grid_bounds, grid.bl]
end

lemma next_gen_ext_one_gbl_x {a : hpp}
  (h : a.bound = sum.inl cautomatons.ext_one) :
  (grid.bl (ext_aut a).g).x = (grid.bl a.g).x - 1 :=
begin
  simp [ext_aut, h, grid.bl],
  unfold_coes,
  simp [vec_grid₀_of_fgrid₀_o, cautomatons.bl_ext_one, grid_bounds, grid.bl]
end

lemma next_gen_ext_one_gtr_y {a : hpp}
  (h : a.bound = sum.inl cautomatons.ext_one) :
  (gtr ((ext_aut a).g)).y = (gtr a.g).y + 1 :=
begin
  simp [ext_aut, h, expand_gtr, grid.bl],
  unfold_coes,
  simp [vec_grid₀_of_fgrid₀_o, vec_grid₀_of_fgrid₀, relative_grid.rows],
  simp [cautomatons.bl_ext_one, cautomatons.rows_of_box_ext_one,
  rows_of_box, cautomatons.tr_ext_one, grid_bounds, grid.bl, expand_gtr,
  relative_grid.rows],
  rw int.nat_abs_of_nonneg,
  ring, simp
end

end hpp

end hpp