/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import analysis.special_functions.integrals
import analysis.calculus.fderiv_measurable

/-!
# Non integrable functions

In this file we prove that the derivative of a function that tends to infinity is not interval
integrable, see `interval_integral.not_integrable_has_deriv_at_of_tendsto_norm_at_top_filter` and
`interval_integral.not_integrable_has_deriv_at_of_tendsto_norm_at_top_punctured`.  Then we apply the
latter lemma to prove that the function `λ x, x⁻¹` is integrable on `a..b` if and only if `a = b` or
`0 ∉ [a, b]`.

## Main results

* `not_interval_integrable_of_tendsto_norm_at_top_of_deriv_is_O_punctured`: if `f` tends to infinity
  along `𝓝[≠] c` and `f' = O(g)` along the same filter, then `g` is not interval integrable on any
  nontrivial integral `a..b`, `c ∈ [a, b]`.

* `not_interval_integrable_of_tendsto_norm_at_top_of_deriv_is_O_filter`: a version of
  `not_interval_integrable_of_tendsto_norm_at_top_of_deriv_is_O_punctured` that works for one-sided
  neighborhoods;

* `not_interval_integrable_of_sub_inv_is_O_punctured`: if `1 / (x - c) = O(f)` as `x → c`, `x ≠ c`,
  then `f` is not interval integrable on any nontrivial interval `a..b`, `c ∈ [a, b]`;

* `interval_integrable_sub_inv_iff`, `interval_integrable_inv_iff`: integrability conditions for
  `(x - c)⁻¹` and `x⁻¹`.

## Tags

integrable function
-/

open_locale measure_theory topology interval nnreal ennreal
open measure_theory topological_space set filter asymptotics interval_integral

variables {E F : Type*} [normed_add_comm_group E] [normed_space ℝ E] [second_countable_topology E]
[complete_space E] [normed_add_comm_group F]

/-- If `f` is eventually differentiable along a nontrivial filter `l : filter ℝ` that is generated
by convex sets, the norm of `f` tends to infinity along `l`, and `f' = O(g)` along `l`, where `f'`
is the derivative of `f`, then `g` is not integrable on any interval `a..b` such that
`[a, b] ∈ l`. -/
lemma not_interval_integrable_of_tendsto_norm_at_top_of_deriv_is_O_filter {f : ℝ → E} {g : ℝ → F}
  {a b : ℝ} (l : filter ℝ) [ne_bot l] [tendsto_Ixx_class Icc l l] (hl : [a, b] ∈ l)
  (hd : ∀ᶠ x in l, differentiable_at ℝ f x) (hf : tendsto (λ x, ‖f x‖) l at_top)
  (hfg : deriv f =O[l] g) :
  ¬interval_integrable g volume a b :=
begin
  intro hgi,
  obtain ⟨C, hC₀, s, hsl, hsub, hfd, hg⟩ : ∃ (C : ℝ) (hC₀ : 0 ≤ C) (s ∈ l),
    (∀ (x ∈ s) (y ∈ s), [x, y] ⊆ [a, b]) ∧
    (∀ (x ∈ s) (y ∈ s) (z ∈ [x, y]), differentiable_at ℝ f z) ∧
    (∀ (x ∈ s) (y ∈ s) (z ∈ [x, y]), ‖deriv f z‖ ≤ C * ‖g z‖),
  { rcases hfg.exists_nonneg with ⟨C, C₀, hC⟩,
    have h : ∀ᶠ x : ℝ × ℝ in l.prod l, ∀ y ∈ [x.1, x.2], (differentiable_at ℝ f y ∧
      ‖deriv f y‖ ≤ C * ‖g y‖) ∧ y ∈ [a, b],
      from (tendsto_fst.uIcc tendsto_snd).eventually ((hd.and hC.bound).and hl).small_sets,
    rcases mem_prod_self_iff.1 h with ⟨s, hsl, hs⟩,
    simp only [prod_subset_iff, mem_set_of_eq] at hs,
    exact ⟨C, C₀, s, hsl, λ x hx y hy z hz, (hs x hx y hy z hz).2,
      λ x hx y hy z hz, (hs x hx y hy z hz).1.1, λ x hx y hy z hz, (hs x hx y hy z hz).1.2⟩ },
  replace hgi : interval_integrable (λ x, C * ‖g x‖) volume a b, by convert hgi.norm.smul C,
  obtain ⟨c, hc, d, hd, hlt⟩ : ∃ (c ∈ s) (d ∈ s), ‖f c‖ + ∫ y in Ι a b, C * ‖g y‖ < ‖f d‖,
  { rcases filter.nonempty_of_mem hsl with ⟨c, hc⟩,
    have : ∀ᶠ x in l, ‖f c‖ + ∫ y in Ι a b, C * ‖g y‖ < ‖f x‖,
      from hf.eventually (eventually_gt_at_top _),
    exact ⟨c, hc, (this.and hsl).exists.imp (λ d hd, ⟨hd.2, hd.1⟩)⟩ },
  specialize hsub c hc d hd, specialize hfd c hc d hd,
  replace hg : ∀ x ∈ Ι c d, ‖deriv f x‖ ≤ C * ‖g x‖, from λ z hz, hg c hc d hd z ⟨hz.1.le, hz.2⟩,
  have hg_ae : ∀ᵐ x ∂(volume.restrict (Ι c d)), ‖deriv f x‖ ≤ C * ‖g x‖,
    from (ae_restrict_mem measurable_set_uIoc).mono hg,
  have hsub' : Ι c d ⊆ Ι a b,
    from uIoc_subset_uIoc_of_uIcc_subset_uIcc hsub,
  have hfi : interval_integrable (deriv f) volume c d,
    from (hgi.mono_set hsub).mono_fun' (ae_strongly_measurable_deriv _ _) hg_ae,
  refine hlt.not_le (sub_le_iff_le_add'.1 _),
  calc ‖f d‖ - ‖f c‖ ≤ ‖f d - f c‖ : norm_sub_norm_le _ _
  ... = ‖∫ x in c..d, deriv f x‖ : congr_arg _ (integral_deriv_eq_sub hfd hfi).symm
  ... = ‖∫ x in Ι c d, deriv f x‖ : norm_integral_eq_norm_integral_Ioc _
  ... ≤ ∫ x in Ι c d, ‖deriv f x‖ : norm_integral_le_integral_norm _
  ... ≤ ∫ x in Ι c d, C * ‖g x‖ :
    set_integral_mono_on hfi.norm.def (hgi.def.mono_set hsub') measurable_set_uIoc hg
  ... ≤ ∫ x in Ι a b, C * ‖g x‖ :
    set_integral_mono_set hgi.def (ae_of_all _ $ λ x, mul_nonneg hC₀ (norm_nonneg _))
      hsub'.eventually_le
end

/-- If `a ≠ b`, `c ∈ [a, b]`, `f` is differentiable in the neighborhood of `c` within
`[a, b] \ {c}`, `‖f x‖ → ∞` as `x → c` within `[a, b] \ {c}`, and `f' = O(g)` along
`𝓝[[a, b] \ {c}] c`, where `f'` is the derivative of `f`, then `g` is not interval integrable on
`a..b`. -/
lemma not_interval_integrable_of_tendsto_norm_at_top_of_deriv_is_O_within_diff_singleton
  {f : ℝ → E} {g : ℝ → F} {a b c : ℝ} (hne : a ≠ b) (hc : c ∈ [a, b])
  (h_deriv : ∀ᶠ x in 𝓝[[a, b] \ {c}] c, differentiable_at ℝ f x)
  (h_infty : tendsto (λ x, ‖f x‖) (𝓝[[a, b] \ {c}] c) at_top)
  (hg : deriv f =O[𝓝[[a, b] \ {c}] c] g) :
  ¬interval_integrable g volume a b :=
begin
  obtain ⟨l, hl, hl', hle, hmem⟩ : ∃ l : filter ℝ, tendsto_Ixx_class Icc l l ∧ l.ne_bot ∧
    l ≤ 𝓝 c ∧ [a, b] \ {c} ∈ l,
  { cases (min_lt_max.2 hne).lt_or_lt c with hlt hlt,
    { refine ⟨𝓝[<] c, infer_instance, infer_instance, inf_le_left, _⟩,
      rw ← Iic_diff_right,
      exact diff_mem_nhds_within_diff (Icc_mem_nhds_within_Iic ⟨hlt, hc.2⟩) _ },
    { refine ⟨𝓝[>] c, infer_instance, infer_instance, inf_le_left, _⟩,
      rw ← Ici_diff_left,
      exact diff_mem_nhds_within_diff (Icc_mem_nhds_within_Ici ⟨hc.1, hlt⟩) _ } },
  resetI,
  have : l ≤ 𝓝[[a, b] \ {c}] c, from le_inf hle (le_principal_iff.2 hmem),
  exact not_interval_integrable_of_tendsto_norm_at_top_of_deriv_is_O_filter l
    (mem_of_superset hmem (diff_subset _ _))
    (h_deriv.filter_mono this) (h_infty.mono_left this) (hg.mono this),
end

/-- If `f` is differentiable in a punctured neighborhood of `c`, `‖f x‖ → ∞` as `x → c` (more
formally, along the filter `𝓝[≠] c`), and `f' = O(g)` along `𝓝[≠] c`, where `f'` is the derivative
of `f`, then `g` is not interval integrable on any nontrivial interval `a..b` such that
`c ∈ [a, b]`. -/
lemma not_interval_integrable_of_tendsto_norm_at_top_of_deriv_is_O_punctured {f : ℝ → E} {g : ℝ → F}
  {a b c : ℝ} (h_deriv : ∀ᶠ x in 𝓝[≠] c, differentiable_at ℝ f x)
  (h_infty : tendsto (λ x, ‖f x‖) (𝓝[≠] c) at_top) (hg : deriv f =O[𝓝[≠] c] g)
  (hne : a ≠ b) (hc : c ∈ [a, b]) :
  ¬interval_integrable g volume a b :=
have 𝓝[[a, b] \ {c}] c ≤ 𝓝[≠] c, from nhds_within_mono _ (inter_subset_right _ _),
not_interval_integrable_of_tendsto_norm_at_top_of_deriv_is_O_within_diff_singleton hne hc
  (h_deriv.filter_mono this) (h_infty.mono_left this) (hg.mono this)

/-- If `f` grows in the punctured neighborhood of `c : ℝ` at least as fast as `1 / (x - c)`,
then it is not interval integrable on any nontrivial interval `a..b`, `c ∈ [a, b]`. -/
lemma not_interval_integrable_of_sub_inv_is_O_punctured {f : ℝ → F} {a b c : ℝ}
  (hf : (λ x, (x - c)⁻¹) =O[𝓝[≠] c] f) (hne : a ≠ b) (hc : c ∈ [a, b]) :
  ¬interval_integrable f volume a b :=
begin
  have A : ∀ᶠ x in 𝓝[≠] c, has_deriv_at (λ x, real.log (x - c)) (x - c)⁻¹ x,
  { filter_upwards [self_mem_nhds_within] with x hx,
    simpa using ((has_deriv_at_id x).sub_const c).log (sub_ne_zero.2 hx) },
  have B : tendsto (λ x, ‖real.log (x - c)‖) (𝓝[≠] c) at_top,
  { refine tendsto_abs_at_bot_at_top.comp (real.tendsto_log_nhds_within_zero.comp _),
    rw ← sub_self c,
    exact ((has_deriv_at_id c).sub_const c).tendsto_punctured_nhds one_ne_zero },
  exact not_interval_integrable_of_tendsto_norm_at_top_of_deriv_is_O_punctured
    (A.mono (λ x hx, hx.differentiable_at)) B
    (hf.congr' (A.mono $ λ x hx, hx.deriv.symm) eventually_eq.rfl) hne hc
end

/-- The function `λ x, (x - c)⁻¹` is integrable on `a..b` if and only if `a = b` or `c ∉ [a, b]`. -/
@[simp] lemma interval_integrable_sub_inv_iff {a b c : ℝ} :
  interval_integrable (λ x, (x - c)⁻¹) volume a b ↔ a = b ∨ c ∉ [a, b] :=
begin
  split,
  { refine λ h, or_iff_not_imp_left.2 (λ hne hc, _),
    exact not_interval_integrable_of_sub_inv_is_O_punctured (is_O_refl _ _) hne hc h },
  { rintro (rfl|h₀),
    exacts [interval_integrable.refl,
      interval_integrable_inv (λ x hx, sub_ne_zero.2 $ ne_of_mem_of_not_mem hx h₀)
        (continuous_on_id.sub continuous_on_const)] }
end

/-- The function `λ x, x⁻¹` is integrable on `a..b` if and only if `a = b` or `0 ∉ [a, b]`. -/
@[simp] lemma interval_integrable_inv_iff {a b : ℝ} :
  interval_integrable (λ x, x⁻¹) volume a b ↔ a = b ∨ (0 : ℝ) ∉ [a, b] :=
by simp only [← interval_integrable_sub_inv_iff, sub_zero]


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Scott Morrison, Mario Carneiro
-/
import category_theory.concrete_category.bundled_hom
import topology.continuous_function.basic

/-!
# Category instance for topological spaces

We introduce the bundled category `Top` of topological spaces together with the functors `discrete`
and `trivial` from the category of types to `Top` which equip a type with the corresponding
discrete, resp. trivial, topology. For a proof that these functors are left, resp. right adjoint
to the forgetful functor, see `topology.category.Top.adjunctions`.
-/

open category_theory
open topological_space

universe u

/-- The category of topological spaces and continuous maps. -/
def Top : Type (u+1) := bundled topological_space

namespace Top

instance bundled_hom : bundled_hom @continuous_map :=
⟨@continuous_map.to_fun, @continuous_map.id, @continuous_map.comp, @continuous_map.coe_inj⟩

attribute [derive [large_category, concrete_category]] Top

instance : has_coe_to_sort Top Type* := bundled.has_coe_to_sort

instance topological_space_unbundled (x : Top) : topological_space x := x.str

@[simp] lemma id_app (X : Top.{u}) (x : X) :
  (𝟙 X : X → X) x = x := rfl

@[simp] lemma comp_app {X Y Z : Top.{u}} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) :
  (f ≫ g : X → Z) x = g (f x) := rfl

/-- Construct a bundled `Top` from the underlying type and the typeclass. -/
def of (X : Type u) [topological_space X] : Top := ⟨X⟩

instance (X : Top) : topological_space X := X.str

@[simp] lemma coe_of (X : Type u) [topological_space X] : (of X : Type u) = X := rfl

instance : inhabited Top := ⟨Top.of empty⟩

/-- The discrete topology on any type. -/
def discrete : Type u ⥤ Top.{u} :=
{ obj := λ X, ⟨X, ⊥⟩,
  map := λ X Y f, { to_fun := f, continuous_to_fun := continuous_bot } }

/-- The trivial topology on any type. -/
def trivial : Type u ⥤ Top.{u} :=
{ obj := λ X, ⟨X, ⊤⟩,
  map := λ X Y f, { to_fun := f, continuous_to_fun := continuous_top } }

/-- Any homeomorphisms induces an isomorphism in `Top`. -/
@[simps] def iso_of_homeo {X Y : Top.{u}} (f : X ≃ₜ Y) : X ≅ Y :=
{ hom := ⟨f⟩,
  inv := ⟨f.symm⟩ }

/-- Any isomorphism in `Top` induces a homeomorphism. -/
@[simps] def homeo_of_iso {X Y : Top.{u}} (f : X ≅ Y) : X ≃ₜ Y :=
{ to_fun := f.hom,
  inv_fun := f.inv,
  left_inv := λ x, by simp,
  right_inv := λ x, by simp,
  continuous_to_fun := f.hom.continuous,
  continuous_inv_fun := f.inv.continuous }

@[simp] lemma of_iso_of_homeo {X Y : Top.{u}} (f : X ≃ₜ Y) : homeo_of_iso (iso_of_homeo f) = f :=
by { ext, refl }

@[simp] lemma of_homeo_of_iso {X Y : Top.{u}} (f : X ≅ Y) : iso_of_homeo (homeo_of_iso f) = f :=
by { ext, refl }

end Top


import tactic.default .tactic
universes u v w

namespace two_three

variables (α : Type u) (β : Type v) {γ : Type w}

inductive tree
| leaf (k : α) (v : β)
| node2 (t₀ : tree) (x : α) (t₁ : tree)
| node3 (t₀ : tree) (x : α) (t₁ : tree) (y : α) (t₂ : tree)

open tree nat

variables {α β}

def first : tree α β → α
| (tree.leaf x _) := x
| (tree.node2 t₀ x _) := first t₀
| (tree.node3 t₀ x _ _ _) := first t₀

def last : tree α β → α
| (tree.leaf x _) := x
| (tree.node2 _ x t₁) := last t₁
| (tree.node3 t₀ x _ _ t₂) := last t₂

section defs
variables [has_le α] [has_lt α]

open tree nat

inductive below : option α → α → Prop
| nil {x} : below none x
| eq {x} : below (some x) x

inductive above : α → option α → Prop
| nil {x} : above x none
| le {x y} : x < y → above x (some y)

inductive sorted' : tree α β → Prop
| leaf {k v} : sorted' (tree.leaf k v)
| node2 {x t₀ t₁} :
  last t₀ < x →
  x = first t₁ →
  sorted' t₀ →
  sorted' t₁ →
  sorted' (tree.node2 t₀ x t₁)
| node3 {x y t₀ t₁ t₂} :
  last t₀ < x →
  x = first t₁ →
  last t₁ < y →
  y = first t₂ →
  sorted' t₀ →
  sorted' t₁ →
  sorted' t₂ →
  sorted' (tree.node3 t₀ x t₁ y t₂)

inductive with_height : ℕ → tree α β → Prop
| leaf {k v} : with_height 0 (tree.leaf k v)
| node2 {n x t₀ t₁} :
  with_height n t₀ →
  with_height n t₁ →
  with_height (succ n) (tree.node2 t₀ x t₁)
| node3 {n x y t₀ t₁ t₂} :
  with_height n t₀ →
  with_height n t₁ →
  with_height n t₂ →
  with_height (succ n) (tree.node3 t₀ x t₁ y t₂)

end defs

local attribute [simp] first last

variables [linear_order α]

lemma first_le_last_of_sorted {t : tree α β} (h : sorted' t) :
  first t ≤ last t :=
begin
  induction h; subst_vars; dsimp [first, last],
  { refl },
  repeat { solve_by_elim [le_of_lt] <|> transitivity },
end

lemma eq_of_below {x : option α} {y : α} (h : below x y) : x.get_or_else y = y :=
by cases h; refl

lemma above_of_above_of_le {x y : α} {k}
  (h : x ≤ y) (h' : above y k) : above x k :=
by cases h'; constructor; solve_by_elim [lt_of_le_of_lt]

@[interactive]
meta def interactive.saturate : tactic unit := do
tactic.interactive.casesm (some ()) [``(above _ (some _)), ``(below (some _) _)],
tactic.find_all_hyps ``(sorted' _) $ λ h, do
{ n ← tactic.get_unused_name `h,
  tactic.mk_app ``first_le_last_of_sorted [h] >>= tactic.note n none,
  tactic.skip },
tactic.find_all_hyps ``(below _ _) $ λ h, do
{ n ← tactic.get_unused_name `h,
  tactic.mk_app ``eq_of_below [h] >>= tactic.note n none,
  tactic.skip },
tactic.find_all_hyps ``(¬ _ < _) $ λ h, do
{ tactic.mk_app ``le_of_not_gt [h] >>= tactic.note h.local_pp_name none,
  tactic.clear h,
  tactic.skip }

@[interactive]
meta def interactive.above : tactic unit := do
tactic.find_hyp ``(above _ _) $ λ h, do
  tactic.refine ``(above_of_above_of_le _ %%h),
  tactic.interactive.chain_trans

end two_three


/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.padics.padic_integers
import Mathlib.topology.metric_space.cau_seq_filter
import Mathlib.analysis.specific_limits
import Mathlib.data.polynomial.identities
import Mathlib.topology.algebra.polynomial
import Mathlib.PostPort

namespace Mathlib

/-!
# Hensel's lemma on ℤ_p

This file proves Hensel's lemma on ℤ_p, roughly following Keith Conrad's writeup:
<http://www.math.uconn.edu/~kconrad/blurbs/gradnumthy/hensel.pdf>

Hensel's lemma gives a simple condition for the existence of a root of a polynomial.

The proof and motivation are described in the paper
[R. Y. Lewis, *A formal proof of Hensel's lemma over the p-adic integers*][lewis2019].

## References

* <http://www.math.uconn.edu/~kconrad/blurbs/gradnumthy/hensel.pdf>
* [R. Y. Lewis, *A formal proof of Hensel's lemma over the p-adic integers*][lewis2019]
* <https://en.wikipedia.org/wiki/Hensel%27s_lemma>

## Tags

p-adic, p adic, padic, p-adic integer
-/

-- We begin with some general lemmas that are used below in the computation.

theorem padic_polynomial_dist {p : ℕ} [fact (nat.prime p)] (F : polynomial (padic_int p))
    (x : padic_int p) (y : padic_int p) :
    norm (polynomial.eval x F - polynomial.eval y F) ≤ norm (x - y) :=
  sorry

theorem limit_zero_of_norm_tendsto_zero {p : ℕ} [fact (nat.prime p)]
    {ncs : cau_seq (padic_int p) norm} {F : polynomial (padic_int p)}
    (hnorm :
      filter.tendsto (fun (i : ℕ) => norm (polynomial.eval (coe_fn ncs i) F)) filter.at_top
        (nhds 0)) :
    polynomial.eval (cau_seq.lim ncs) F = 0 :=
  tendsto_nhds_unique (comp_tendsto_lim ncs) (tendsto_zero_of_norm_tendsto_zero hnorm)

/-- `T` is an auxiliary value that is used to control the behavior of the polynomial `F`. -/
/-- We will construct a sequence of elements of ℤ_p satisfying successive values of `ih`. -/
/-- Given `z : ℤ_[p]` satisfying `ih n z`, construct `z' : ℤ_[p]` satisfying `ih (n+1) z'`. We need
the hypothesis `ih n z`, since otherwise `z'` is not necessarily an integer. -/
-- why doesn't "noncomputable theory" stick here?

theorem hensels_lemma {p : ℕ} [fact (nat.prime p)] {F : polynomial (padic_int p)} {a : padic_int p}
    (hnorm :
      norm (polynomial.eval a F) <
        norm (polynomial.eval a (coe_fn polynomial.derivative F)) ^ bit0 1) :
    ∃ (z : padic_int p),
        polynomial.eval z F = 0 ∧
          norm (z - a) < norm (polynomial.eval a (coe_fn polynomial.derivative F)) ∧
            norm (polynomial.eval z (coe_fn polynomial.derivative F)) =
                norm (polynomial.eval a (coe_fn polynomial.derivative F)) ∧
              ∀ (z' : padic_int p),
                polynomial.eval z' F = 0 →
                  norm (z' - a) < norm (polynomial.eval a (coe_fn polynomial.derivative F)) →
                    z' = z :=
  sorry

end Mathlib


import data.num.lemmas
import lists
import data.nat.digits

namespace nat

lemma size_eq_log_bits_len {n : ℕ} (hn : n ≠ 0) : n.size = log 2 n + 1 :=
by rw [← size_eq_bits_len, ← digits_len _ _ rfl.le (pos_iff_ne_zero.mpr hn), digits_two_eq_bits, list.length_map]

lemma add_size_le (m n : ℕ) : (m + n).size ≤ (max m.size n.size) + 1 :=
by { rw [nat.size_le, pow_succ, two_mul], apply add_lt_add; simp [← size_le], }

end nat

namespace pos_num
def to_trailing_bits : pos_num → list bool
| 1 := []
| (bit0 xs) := ff :: xs.to_trailing_bits
| (bit1 xs) := tt :: xs.to_trailing_bits

/-- Equivalence between `pos_num` and `list bool` with lsb at the head and msb omitted -/
def equiv_list_bool : pos_num ≃ list bool :=
{ to_fun := to_trailing_bits,
  inv_fun := λ l, l.foldr (λ b n, (cond b bit1 bit0) n) 1,
  left_inv := λ n, by induction n; simpa [to_trailing_bits],
  right_inv := λ l, by { induction l with hd, { refl, }, cases hd; simpa [to_trailing_bits], } }

@[simp] lemma one_eq_one : one = 1 := rfl
@[simp] lemma equiv_list_bool_one : equiv_list_bool 1 = [] := rfl
@[simp] lemma equiv_list_bool_bit0 (n : pos_num) :
  equiv_list_bool (bit0 n) = ff :: equiv_list_bool n := rfl
@[simp] lemma equiv_list_bool_bit1 (n : pos_num) :
  equiv_list_bool (bit1 n) = tt :: equiv_list_bool n := rfl
@[simp] lemma equiv_list_bool_symm_nil : equiv_list_bool.symm [] = 1 := rfl
@[simp] lemma equiv_list_bool_symm_cons_tt (l : list bool) :
  equiv_list_bool.symm (tt :: l) = bit1 (equiv_list_bool.symm l) := rfl
@[simp] lemma equiv_list_bool_symm_cons_ff (l : list bool) :
  equiv_list_bool.symm (ff :: l) = bit0 (equiv_list_bool.symm l) := rfl
@[simp] lemma equiv_list_bool_len_zero_iff (n : pos_num) : (equiv_list_bool n).length = 0 ↔ n = 1 :=
by simp [list.length_eq_zero, equiv.apply_eq_iff_eq_symm_apply]

@[simp] lemma succ_inj_iff {x y : pos_num} : x.succ = y.succ ↔ x = y :=
by { split, { intro h, apply_fun (λ (n : pos_num), (n : ℕ)) at h, simpa using h, }, { rintro rfl, refl, } }

end pos_num

section
variables {α β γ : Type*} [polycodable α] [polycodable β] [polycodable γ]

open pos_num
open ptree.pencodable (encode decode)

local attribute [instance] unary_nat_encode

@[reducible] def bit_encode_size : ℕ := 5
@[reducible] def bit0_encode : ptree := ptree.node ptree.non_nil ptree.nil
@[reducible] def bit1_encode : ptree := ptree.node ptree.nil ptree.non_nil

lemma bit0_ne_bit1 : bit0_encode ≠ bit1_encode := dec_trivial
@[simp] lemma bit0_encode_sizeof : bit0_encode.sizeof = bit_encode_size := by simp
@[simp] lemma bit1_encode_sizeof : bit1_encode.sizeof = bit_encode_size := by simp

attribute [irreducible] bit_encode_size bit0_encode bit1_encode

@[simp] lemma cond_eq {α} (c : bool) (a b : α) (h : a ≠ b) : cond c a b = a ↔ c :=
by cases c; simp [h.symm]

instance : polycodable pos_num :=
polycodable.mk'
(λ n : pos_num, n.equiv_list_bool.map (λ b, cond b bit1_encode bit0_encode))
(λ l : list ptree, equiv_list_bool.symm (l.map (λ x, (x = bit1_encode : bool))))
(λ n, by simp [function.comp, bit0_ne_bit1.symm])
(by { simp [function.comp], polyfun, })

lemma polycodable.pos_num_encode (n : pos_num) :
  encode n = encode (n.equiv_list_bool.map (λ b, cond b bit1_encode bit0_encode)) := rfl

lemma polytime_fun.pos_num_encode : polytime_fun (λ n : pos_num, n.equiv_list_bool.map (λ b, cond b bit1_encode bit0_encode)) :=
polytime_fun.id

lemma polytime_fun.pos_num_decode : polytime_fun (λ l : list ptree, equiv_list_bool.symm (l.map (λ l, (l = bit1_encode : bool)))) :=
polycodable.mk_decode' _ _ _ _

@[polyfun]
lemma polytime_fun.pos_num_equiv_list_bool : polytime_fun equiv_list_bool :=
begin
  have := (_ : polytime_fun (λ l : list ptree, l.map (λ x, (x = bit1_encode : bool)))).comp polytime_fun.pos_num_encode,
  simpa [function.comp, bit0_ne_bit1.symm], polyfun,
end

@[polyfun]
lemma polytime_fun.pos_num_equiv_list_bool_symm : polytime_fun equiv_list_bool.symm :=
begin
  have := polytime_fun.pos_num_decode.comp (_ : polytime_fun (λ l : list bool, l.map (λ b, cond b bit1_encode bit0_encode))),
  simpa [function.comp, bit0_ne_bit1.symm], polyfun,
end

lemma pos_num.succ_list_bool (n : pos_num) :
  equiv_list_bool n.succ = (equiv_list_bool n).tails.foldr (λ (l : list bool) (ih : list bool), if l.head' = some ff then tt :: l.tail else ff :: ih) [] :=
begin
  induction n with tl ih tl ih,
  { refl, }, { simp [pos_num.succ, ih], }, { simp [pos_num.succ, ih], }
end

@[polyfun]
lemma polytime_fun.pos_num_bit0 : polytime_fun pos_num.bit0 :=
by { convert_to polytime_fun (λ n, equiv_list_bool.symm (ff :: equiv_list_bool n)), { ext n, simp, }, polyfun, }

@[polyfun]
lemma polytime_fun.pos_num_bit1 : polytime_fun pos_num.bit1 :=
by { convert_to polytime_fun (λ n, equiv_list_bool.symm (tt :: equiv_list_bool n)), { ext n, simp, }, polyfun, }

@[simp] lemma encode_pos_num_one : (encode (1 : pos_num)).sizeof = 1 :=
by simp [polycodable.pos_num_encode]

@[simp] lemma encode_pos_num_bit0 (n : pos_num) : (encode n.bit0).sizeof = (encode n).sizeof + bit_encode_size + 1 :=
by { simp [polycodable.pos_num_encode], ac_refl, }

@[simp] lemma encode_pos_num_bit1 (n : pos_num) : (encode n.bit1).sizeof = (encode n).sizeof + bit_encode_size + 1 :=
by { simp [polycodable.pos_num_encode], ac_refl, }

attribute [simp] pos_num.nat_size

lemma encode_pos_num_sizeof_eq_size (n : pos_num) : ((encode n).sizeof : ℤ) =  n.nat_size * (bit_encode_size + 1) - bit_encode_size :=
by { induction n; simp [*]; ring, }

lemma succ_size_le (n : pos_num) : n.succ.nat_size ≤ n.nat_size + 1 :=
by { induction n, { simp [pos_num.succ], }, { simpa [pos_num.succ, nat.succ_eq_add_one], }, { simp [pos_num.succ], } }

lemma le_of_size_le {n : pos_num} {N : ℕ} (h : n.nat_size ≤ N) :
  ((encode n).sizeof : ℤ) ≤ N * (bit_encode_size + 1) - bit_encode_size :=
by { rw encode_pos_num_sizeof_eq_size, simpa, }

lemma polysize_fun_safe_pos_num_succ (α : Type*) [ptree.pencodable α] : polysize_fun_safe (λ (_ : α) (n : pos_num), n.succ) :=
⟨bit_encode_size + 1,
λ x y, by { zify, refine (le_of_size_le (succ_size_le _)).trans (le_of_eq _), simp [encode_pos_num_sizeof_eq_size], ring, }⟩

lemma add_size_le (m n : pos_num) : (m + n).nat_size ≤ max m.nat_size n.nat_size + 1 :=
by simpa [pos_num.nat_size_to_nat] using nat.add_size_le m n

lemma add_size_le' (m n : pos_num) : (m + n).nat_size ≤ m.nat_size + n.nat_size + 1 :=
by { refine (add_size_le _ _).trans _, simp, }

lemma polysize_fun_safe_pos_num_add : polysize_fun_safe pos_num.add :=
⟨polynomial.monomial 1 1 + 2*bit_encode_size + 1,
λ m n, by { zify, refine (le_of_size_le (add_size_le' _ _)).trans (le_of_eq _), simp [encode_pos_num_sizeof_eq_size], ring_nf, }⟩

lemma polysize_fun_bit0 (α : Type*) [ptree.pencodable α] : polysize_fun_safe (λ (_ : α), pos_num.bit0) :=
⟨bit_encode_size + 1, λ x y, by { simp [encode_pos_num_sizeof_eq_size], ring_nf, }⟩

lemma polysize_fun_bit1 (α : Type*) [ptree.pencodable α] : polysize_fun_safe (λ (_ : α), pos_num.bit1) :=
⟨bit_encode_size + 1, λ x y, by { simp [encode_pos_num_sizeof_eq_size], ring_nf, }⟩

@[polyfun]
lemma polytime_fun.pos_num_succ : polytime_fun pos_num.succ :=
begin
  convert_to polytime_fun (λ n : pos_num, equiv_list_bool.symm n.succ.equiv_list_bool), { simp, },
  simp_rw pos_num.succ_list_bool, polyfun,
  apply polysize_fun_safe.ite, { simp, apply polysize_of_polytime_fun, polyfun, }, exact polysize_fun_safe.cons.comp (polysize_uniform_of_fin_range _) polysize_fun_safe.id,
end

-- Separated out for performance reasons
@[reducible]
private def add'_foldr (bs : bool × bool) (ih : pos_num) : pos_num :=
cond bs.1 (cond bs.2 ih.succ.bit0 ih.bit1) (cond bs.2 ih.bit1 ih.bit0)

private lemma add'_foldr_polytime : polytime_fun₂ add'_foldr :=
by polyfun

local attribute [polyfun] add'_foldr_polytime
private lemma add'_foldr_polysize : polysize_fun_safe add'_foldr :=
begin
  repeat { apply polysize_fun_safe.cond, },
  { apply polysize_fun_safe.comp' (polysize_fun_bit0 _) (polysize_fun_safe_pos_num_succ _), },
  any_goals { apply polysize_fun_bit1, }, apply polysize_fun_bit0,
end

@[reducible]
private def add'_init (m n : pos_num) :=
(if (equiv_list_bool m).length ≤ (equiv_list_bool n).length then
  (equiv_list_bool.symm ((equiv_list_bool n).drop (equiv_list_bool m).length)).succ
else
  (equiv_list_bool.symm ((equiv_list_bool m).drop (equiv_list_bool n).length)).succ)

private lemma add'_init_polytime : polytime_fun₂ add'_init := by polyfun
local attribute [polyfun] add'_init_polytime

private def add' (m n : pos_num) : pos_num :=
((equiv_list_bool m).zip (equiv_list_bool n))
  .foldr add'_foldr (add'_init m n)

@[simp] private lemma add'_case0 (m : pos_num) : add' 1 m = m.succ := by simp [add', add'_init]
@[simp] private lemma add'_case1 (n : pos_num) : add' n 1 = n.succ := by simpa [add', add'_init] using eq.symm
@[simp] private lemma add'_case2 (m n : pos_num) : add' m.bit0 n.bit0 = (add' m n).bit0 := by simp [add', add'_foldr, add'_init]
@[simp] private lemma add'_case3 (m n : pos_num) : add' m.bit1 n.bit1 = (add' m n).succ.bit0 := by simp [add', add'_init, add'_foldr]
@[simp] private lemma add'_case4 (m n : pos_num) : add' m.bit0 n.bit1 = (add' m n).bit1 := by simp [add', add'_init, add'_foldr]
@[simp] private lemma add'_case5 (m n : pos_num) : add' m.bit1 n.bit0 = (add' m n).bit1 := by simp [add', add'_init, add'_foldr]

lemma add_eq_add (m n : pos_num) : m.add n = m + n := rfl

lemma pos_num_add_eq : ∀ (m n : pos_num),
  (m.add n) = add' m n
| 1 m := by simp [one_add, add_eq_add]
| n 1 := by simp [add_one, add_eq_add]
| (pos_num.bit0 a) (pos_num.bit0 b) := by simpa [pos_num.add] using pos_num_add_eq a b
| (pos_num.bit1 a) (pos_num.bit1 b) := by simpa [pos_num.add] using pos_num_add_eq a b
| (pos_num.bit1 a) (pos_num.bit0 b) := by simpa [pos_num.add] using pos_num_add_eq a b
| (pos_num.bit0 a) (pos_num.bit1 b) := by simpa [pos_num.add] using pos_num_add_eq a b

local attribute [semireducible] add'_foldr
local attribute [semireducible] add'_init

example {P : Prop} (a : P) : P ↔ true := (iff_true _).mpr a

private lemma polytime_fun.pos_num_add' : polytime_fun₂ add' :=
begin
  change polytime_fun₂ (λ _ _, _), polyfun, apply add'_foldr_polysize.comp,
  { simp, apply polysize_of_polytime_fun, polyfun, }, { apply polysize_fun_safe.id, }
end

@[polyfun]
lemma polytime_fun.pos_num_add : polytime_fun₂ pos_num.add :=
by { change polytime_fun₂ (λ _ _, _), simp_rw pos_num_add_eq, exact polytime_fun.pos_num_add', }

@[polyfun]
lemma polytime_fun.pos_num_add' : polytime_fun₂ ((+) : pos_num → pos_num → pos_num) :=
polytime_fun.pos_num_add

lemma polytime_fun.pos_num_mul : polytime_fun₂ pos_num.mul :=
begin
  convert_to polytime_fun₂ (λ (a b : pos_num), (equiv_list_bool b).foldr (λ (b : bool) (acc : pos_num), cond b (a + acc.bit0) acc.bit0) a),
  { ext a b, induction b; simp [pos_num.mul, *, add_comm], },
  polyfun, apply polysize_fun_safe.cond, { apply polysize_fun_safe_pos_num_add.comp, { simp, apply polysize_of_polytime_fun, polyfun, }, { exact polysize_fun_bit0 _, } },
  exact polysize_fun_bit0 _,
end

end

universe u
def pos_num.crec {α} {motive : Type u} (base : α → motive) (pre₁ pre₂ : pos_num → α → α)
  (post₁ post₂ : motive → pos_num → α → motive) : pos_num → α → motive
| 1 x := base x
| N@(pos_num.bit0 n) x := post₁ (pos_num.crec n (pre₁ N x)) N x
| N@(pos_num.bit1 n) x := post₂ (pos_num.crec n (pre₂ N x)) N x

#check pos_num.cases_on
example {n₁ n₂} : pos_num.add n₁ n₂ = pos_num.crec (λ b, pos_num.succ b)
  sorry --(λ b, @pos_num.cases_on (λ _, pos_num) b _ _ _)
  sorry --(λ b, b.cases_on _ _ _)
  (λ ih n₁ n₂, _)
  _ n₁ n₂  :=
begin
  delta pos_num.add,
end


/-
Copyright (c) 2022 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.preadditive.functor_category
import category_theory.linear.basic

/-!
# Linear structure on functor categories

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

If `C` and `D` are categories and `D` is `R`-linear,
then `C ⥤ D` is also `R`-linear.

-/

open_locale big_operators

namespace category_theory
open category_theory.limits linear

variables {R : Type*} [semiring R]
variables {C D : Type*} [category C] [category D] [preadditive D] [linear R D]

instance functor_category_linear : linear R (C ⥤ D) :=
{ hom_module := λ F G,
  { smul := λ r α,
    { app := λ X, r • α.app X,
      naturality' := by { intros, rw [comp_smul, smul_comp, α.naturality] } },
    one_smul := by { intros, ext, apply one_smul },
    zero_smul := by { intros, ext, apply zero_smul },
    smul_zero := by { intros, ext, apply smul_zero },
    add_smul := by { intros, ext, apply add_smul },
    smul_add := by { intros, ext, apply smul_add },
    mul_smul := by { intros, ext, apply mul_smul } },
  smul_comp' := by { intros, ext, apply smul_comp },
  comp_smul' := by { intros, ext, apply comp_smul } }

namespace nat_trans

variables {F G : C ⥤ D}

/-- Application of a natural transformation at a fixed object,
as group homomorphism -/
@[simps] def app_linear_map (X : C) : (F ⟶ G) →ₗ[R] (F.obj X ⟶ G.obj X) :=
{ to_fun := λ α, α.app X,
  map_add' := λ _ _, rfl,
  map_smul' := λ _ _, rfl, }

@[simp] lemma app_smul (X : C) (r : R) (α : F ⟶ G) : (r • α).app X = r • α.app X := rfl

end nat_trans

end category_theory


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.group_theory.perm.sign
import Mathlib.PostPort

universes u_2 u_1

namespace Mathlib

/-!
# Cyclic permutations

## Main definitions

In the following, `f : equiv.perm β`.

* `equiv.perm.is_cycle`: `f.is_cycle` when two nonfixed points of `β`
  are related by repeated application of `f`.
* `equiv.perm.same_cycle`: `f.same_cycle x y` when `x` and `y` are in the same cycle of `f`.

The following two definitions require that `β` is a `fintype`:

* `equiv.perm.cycle_of`: `f.cycle_of x` is the cycle of `f` that `x` belongs to.
* `equiv.perm.cycle_factors`: `f.cycle_factors` is a list of disjoint cyclic permutations that
  multiply to `f`.

-/

namespace equiv.perm

/-!
### `is_cycle`
-/

/-- A permutation is a cycle when any two nonfixed points of the permutation are related by repeated
  application of the permutation. -/
def is_cycle {β : Type u_2} (f : perm β) :=
  ∃ (x : β), coe_fn f x ≠ x ∧ ∀ (y : β), coe_fn f y ≠ y → ∃ (i : ℤ), coe_fn (f ^ i) x = y

theorem is_cycle.swap {α : Type u_1} [DecidableEq α] {x : α} {y : α} (hxy : x ≠ y) :
    is_cycle (swap x y) :=
  sorry

theorem is_cycle.inv {β : Type u_2} {f : perm β} (hf : is_cycle f) : is_cycle (f⁻¹) := sorry

theorem is_cycle.exists_gpow_eq {β : Type u_2} {f : perm β} (hf : is_cycle f) {x : β} {y : β}
    (hx : coe_fn f x ≠ x) (hy : coe_fn f y ≠ y) : ∃ (i : ℤ), coe_fn (f ^ i) x = y :=
  sorry

theorem is_cycle.exists_pow_eq {β : Type u_2} [fintype β] {f : perm β} (hf : is_cycle f) {x : β}
    {y : β} (hx : coe_fn f x ≠ x) (hy : coe_fn f y ≠ y) : ∃ (i : ℕ), coe_fn (f ^ i) x = y :=
  sorry

theorem is_cycle_swap_mul_aux₁ {α : Type u_1} [DecidableEq α] (n : ℕ) {b : α} {x : α} {f : perm α}
    (hb : coe_fn (swap x (coe_fn f x) * f) b ≠ b) (h : coe_fn (f ^ n) (coe_fn f x) = b) :
    ∃ (i : ℤ), coe_fn ((swap x (coe_fn f x) * f) ^ i) (coe_fn f x) = b :=
  sorry

theorem is_cycle_swap_mul_aux₂ {α : Type u_1} [DecidableEq α] (n : ℤ) {b : α} {x : α} {f : perm α}
    (hb : coe_fn (swap x (coe_fn f x) * f) b ≠ b) (h : coe_fn (f ^ n) (coe_fn f x) = b) :
    ∃ (i : ℤ), coe_fn ((swap x (coe_fn f x) * f) ^ i) (coe_fn f x) = b :=
  sorry

theorem is_cycle.eq_swap_of_apply_apply_eq_self {α : Type u_1} [DecidableEq α] {f : perm α}
    (hf : is_cycle f) {x : α} (hfx : coe_fn f x ≠ x) (hffx : coe_fn f (coe_fn f x) = x) :
    f = swap x (coe_fn f x) :=
  sorry

theorem is_cycle.swap_mul {α : Type u_1} [DecidableEq α] {f : perm α} (hf : is_cycle f) {x : α}
    (hx : coe_fn f x ≠ x) (hffx : coe_fn f (coe_fn f x) ≠ x) : is_cycle (swap x (coe_fn f x) * f) :=
  sorry

theorem is_cycle.sign {α : Type u_1} [DecidableEq α] [fintype α] {f : perm α} (hf : is_cycle f) :
    coe_fn sign f = -(-1) ^ finset.card (support f) :=
  sorry

/-!
### `same_cycle`
-/

/-- The equivalence relation indicating that two points are in the same cycle of a permutation. -/
def same_cycle {β : Type u_2} (f : perm β) (x : β) (y : β) := ∃ (i : ℤ), coe_fn (f ^ i) x = y

theorem same_cycle.refl {β : Type u_2} (f : perm β) (x : β) : same_cycle f x x := Exists.intro 0 rfl

theorem same_cycle.symm {β : Type u_2} (f : perm β) {x : β} {y : β} :
    same_cycle f x y → same_cycle f y x :=
  sorry

theorem same_cycle.trans {β : Type u_2} (f : perm β) {x : β} {y : β} {z : β} :
    same_cycle f x y → same_cycle f y z → same_cycle f x z :=
  sorry

theorem same_cycle.apply_eq_self_iff {β : Type u_2} {f : perm β} {x : β} {y : β} :
    same_cycle f x y → (coe_fn f x = x ↔ coe_fn f y = y) :=
  sorry

theorem is_cycle.same_cycle {β : Type u_2} {f : perm β} (hf : is_cycle f) {x : β} {y : β}
    (hx : coe_fn f x ≠ x) (hy : coe_fn f y ≠ y) : same_cycle f x y :=
  is_cycle.exists_gpow_eq hf hx hy

protected instance same_cycle.decidable_rel {α : Type u_1} [DecidableEq α] [fintype α]
    (f : perm α) : DecidableRel (same_cycle f) :=
  fun (x y : α) =>
    decidable_of_iff (∃ (n : ℕ), ∃ (H : n ∈ list.range (order_of f)), coe_fn (f ^ n) x = y) sorry

theorem same_cycle_apply {β : Type u_2} {f : perm β} {x : β} {y : β} :
    same_cycle f x (coe_fn f y) ↔ same_cycle f x y :=
  sorry

theorem same_cycle_cycle {β : Type u_2} {f : perm β} {x : β} (hx : coe_fn f x ≠ x) :
    is_cycle f ↔ ∀ {y : β}, same_cycle f x y ↔ coe_fn f y ≠ y :=
  sorry

theorem same_cycle_inv {β : Type u_2} (f : perm β) {x : β} {y : β} :
    same_cycle (f⁻¹) x y ↔ same_cycle f x y :=
  sorry

theorem same_cycle_inv_apply {β : Type u_2} {f : perm β} {x : β} {y : β} :
    same_cycle f x (coe_fn (f⁻¹) y) ↔ same_cycle f x y :=
  sorry

/-!
### `cycle_of`
-/

/-- `f.cycle_of x` is the cycle of the permutation `f` to which `x` belongs. -/
def cycle_of {α : Type u_1} [DecidableEq α] [fintype α] (f : perm α) (x : α) : perm α :=
  coe_fn of_subtype (subtype_perm f sorry)

theorem cycle_of_apply {α : Type u_1} [DecidableEq α] [fintype α] (f : perm α) (x : α) (y : α) :
    coe_fn (cycle_of f x) y = ite (same_cycle f x y) (coe_fn f y) y :=
  rfl

theorem cycle_of_inv {α : Type u_1} [DecidableEq α] [fintype α] (f : perm α) (x : α) :
    cycle_of f x⁻¹ = cycle_of (f⁻¹) x :=
  sorry

@[simp] theorem cycle_of_pow_apply_self {α : Type u_1} [DecidableEq α] [fintype α] (f : perm α)
    (x : α) (n : ℕ) : coe_fn (cycle_of f x ^ n) x = coe_fn (f ^ n) x :=
  sorry

@[simp] theorem cycle_of_gpow_apply_self {α : Type u_1} [DecidableEq α] [fintype α] (f : perm α)
    (x : α) (n : ℤ) : coe_fn (cycle_of f x ^ n) x = coe_fn (f ^ n) x :=
  sorry

theorem same_cycle.cycle_of_apply {α : Type u_1} [DecidableEq α] [fintype α] {f : perm α} {x : α}
    {y : α} (h : same_cycle f x y) : coe_fn (cycle_of f x) y = coe_fn f y :=
  dif_pos h

theorem cycle_of_apply_of_not_same_cycle {α : Type u_1} [DecidableEq α] [fintype α] {f : perm α}
    {x : α} {y : α} (h : ¬same_cycle f x y) : coe_fn (cycle_of f x) y = y :=
  dif_neg h

@[simp] theorem cycle_of_apply_self {α : Type u_1} [DecidableEq α] [fintype α] (f : perm α)
    (x : α) : coe_fn (cycle_of f x) x = coe_fn f x :=
  same_cycle.cycle_of_apply (same_cycle.refl f x)

theorem is_cycle.cycle_of_eq {α : Type u_1} [DecidableEq α] [fintype α] {f : perm α}
    (hf : is_cycle f) {x : α} (hx : coe_fn f x ≠ x) : cycle_of f x = f :=
  sorry

theorem cycle_of_one {α : Type u_1} [DecidableEq α] [fintype α] (x : α) : cycle_of 1 x = 1 := sorry

theorem is_cycle_cycle_of {α : Type u_1} [DecidableEq α] [fintype α] (f : perm α) {x : α}
    (hx : coe_fn f x ≠ x) : is_cycle (cycle_of f x) :=
  sorry

/-!
### `cycle_factors`
-/

/-- Given a list `l : list α` and a permutation `f : perm α` whose nonfixed points are all in `l`,
  recursively factors `f` into cycles. -/
def cycle_factors_aux {α : Type u_1} [DecidableEq α] [fintype α] (l : List α) (f : perm α) :
    (∀ {x : α}, coe_fn f x ≠ x → x ∈ l) →
        Subtype
          fun (l : List (perm α)) =>
            list.prod l = f ∧ (∀ (g : perm α), g ∈ l → is_cycle g) ∧ list.pairwise disjoint l :=
  sorry

/-- Factors a permutation `f` into a list of disjoint cyclic permutations that multiply to `f`. -/
def cycle_factors {α : Type u_1} [DecidableEq α] [fintype α] [linear_order α] (f : perm α) :
    Subtype
        fun (l : List (perm α)) =>
          list.prod l = f ∧ (∀ (g : perm α), g ∈ l → is_cycle g) ∧ list.pairwise disjoint l :=
  cycle_factors_aux (finset.sort LessEq finset.univ) f sorry

/-!
### Fixed points
-/

theorem one_lt_nonfixed_point_card_of_ne_one {α : Type u_1} [DecidableEq α] [fintype α] {σ : perm α}
    (h : σ ≠ 1) : 1 < finset.card (finset.filter (fun (x : α) => coe_fn σ x ≠ x) finset.univ) :=
  sorry

theorem fixed_point_card_lt_of_ne_one {α : Type u_1} [DecidableEq α] [fintype α] {σ : perm α}
    (h : σ ≠ 1) :
    finset.card (finset.filter (fun (x : α) => coe_fn σ x = x) finset.univ) < fintype.card α - 1 :=
  sorry

end Mathlib


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

universes u_1

namespace Mathlib

/-!

# Relating `ℤ_[p]` to `zmod (p ^ n)`

In this file we establish connections between the `p`-adic integers $\mathbb{Z}_p$
and the integers modulo powers of `p`, $\mathbb{Z}/p^n\mathbb{Z}$.

## Main declarations

We show that $\mathbb{Z}_p$ has a ring hom to $\mathbb{Z}/p^n\mathbb{Z}$ for each `n`.
The case for `n = 1` is handled separately, since it is used in the general construction
and we may want to use it without the `^1` getting in the way.
* `padic_int.to_zmod`: ring hom to `zmod p`
* `padic_int.to_zmod_pow`: ring hom to `zmod (p^n)`
* `padic_int.ker_to_zmod` / `padic_int.ker_to_zmod_pow`: the kernels of these maps are the ideals
  generated by `p^n`

We also establish the universal property of $\mathbb{Z}_p$ as a projective limit.
Given a family of compatible ring homs $f_k : R \to \mathbb{Z}/p^n\mathbb{Z}$,
there is a unique limit $R \to \mathbb{Z}_p$.
* `padic_int.lift`: the limit function
* `padic_int.lift_spec` / `padic_int.lift_unique`: the universal property

## Implementation notes

The ring hom constructions go through an auxiliary constructor `padic_int.to_zmod_hom`,
which removes some boilerplate code.

-/

namespace padic_int

/-! ### Ring homomorphisms to `zmod p` and `zmod (p ^ n)` -/

/--
`mod_part p r` is an integer that satisfies
`∥(r - mod_part p r : ℚ_[p])∥ < 1` when `∥(r : ℚ_[p])∥ ≤ 1`,
see `padic_int.norm_sub_mod_part`.
It is the unique non-negative integer that is `< p` with this property.

(Note that this definition assumes `r : ℚ`.
See `padic_int.zmod_repr` for a version that takes values in `ℕ`
and works for arbitrary `x : ℤ_[p]`.) -/
def mod_part (p : ℕ) (r : ℚ) : ℤ :=
  rat.num r * nat.gcd_a (rat.denom r) p % ↑p

theorem mod_part_lt_p {p : ℕ} [hp_prime : fact (nat.prime p)] (r : ℚ) : mod_part p r < ↑p := sorry

theorem mod_part_nonneg {p : ℕ} [hp_prime : fact (nat.prime p)] (r : ℚ) : 0 ≤ mod_part p r := sorry

theorem is_unit_denom {p : ℕ} [hp_prime : fact (nat.prime p)] (r : ℚ) (h : norm ↑r ≤ 1) : is_unit ↑(rat.denom r) := sorry

theorem norm_sub_mod_part_aux {p : ℕ} [hp_prime : fact (nat.prime p)] (r : ℚ) (h : norm ↑r ≤ 1) : ↑p ∣ rat.num r - rat.num r * nat.gcd_a (rat.denom r) p % ↑p * ↑(rat.denom r) := sorry

theorem norm_sub_mod_part {p : ℕ} [hp_prime : fact (nat.prime p)] (r : ℚ) (h : norm ↑r ≤ 1) : norm ({ val := ↑r, property := h } - ↑(mod_part p r)) < 1 := sorry

theorem exists_mem_range_of_norm_rat_le_one {p : ℕ} [hp_prime : fact (nat.prime p)] (r : ℚ) (h : norm ↑r ≤ 1) : ∃ (n : ℤ), 0 ≤ n ∧ n < ↑p ∧ norm ({ val := ↑r, property := h } - ↑n) < 1 :=
  Exists.intro (mod_part p r)
    { left := mod_part_nonneg r, right := { left := mod_part_lt_p r, right := norm_sub_mod_part r h } }

theorem zmod_congr_of_sub_mem_span_aux {p : ℕ} [hp_prime : fact (nat.prime p)] (n : ℕ) (x : padic_int p) (a : ℤ) (b : ℤ) (ha : x - ↑a ∈ ideal.span (singleton (↑p ^ n))) (hb : x - ↑b ∈ ideal.span (singleton (↑p ^ n))) : ↑a = ↑b := sorry

theorem zmod_congr_of_sub_mem_span {p : ℕ} [hp_prime : fact (nat.prime p)] (n : ℕ) (x : padic_int p) (a : ℕ) (b : ℕ) (ha : x - ↑a ∈ ideal.span (singleton (↑p ^ n))) (hb : x - ↑b ∈ ideal.span (singleton (↑p ^ n))) : ↑a = ↑b :=
  zmod_congr_of_sub_mem_span_aux n x (↑a) (↑b) ha hb

theorem zmod_congr_of_sub_mem_max_ideal {p : ℕ} [hp_prime : fact (nat.prime p)] (x : padic_int p) (m : ℕ) (n : ℕ) (hm : x - ↑m ∈ local_ring.maximal_ideal (padic_int p)) (hn : x - ↑n ∈ local_ring.maximal_ideal (padic_int p)) : ↑m = ↑n := sorry

theorem exists_mem_range {p : ℕ} [hp_prime : fact (nat.prime p)] (x : padic_int p) : ∃ (n : ℕ), n < p ∧ x - ↑n ∈ local_ring.maximal_ideal (padic_int p) := sorry

/--
`zmod_repr x` is the unique natural number smaller than `p`
satisfying `∥(x - zmod_repr x : ℤ_[p])∥ < 1`.
-/
def zmod_repr {p : ℕ} [hp_prime : fact (nat.prime p)] (x : padic_int p) : ℕ :=
  classical.some (exists_mem_range x)

theorem zmod_repr_spec {p : ℕ} [hp_prime : fact (nat.prime p)] (x : padic_int p) : zmod_repr x < p ∧ x - ↑(zmod_repr x) ∈ local_ring.maximal_ideal (padic_int p) :=
  classical.some_spec (exists_mem_range x)

theorem zmod_repr_lt_p {p : ℕ} [hp_prime : fact (nat.prime p)] (x : padic_int p) : zmod_repr x < p :=
  and.left (zmod_repr_spec x)

theorem sub_zmod_repr_mem {p : ℕ} [hp_prime : fact (nat.prime p)] (x : padic_int p) : x - ↑(zmod_repr x) ∈ local_ring.maximal_ideal (padic_int p) :=
  and.right (zmod_repr_spec x)

/--
`to_zmod_hom` is an auxiliary constructor for creating ring homs from `ℤ_[p]` to `zmod v`.
-/
def to_zmod_hom {p : ℕ} [hp_prime : fact (nat.prime p)] (v : ℕ) (f : padic_int p → ℕ) (f_spec : ∀ (x : padic_int p), x - ↑(f x) ∈ ideal.span (singleton ↑v)) (f_congr : ∀ (x : padic_int p) (a b : ℕ), x - ↑a ∈ ideal.span (singleton ↑v) → x - ↑b ∈ ideal.span (singleton ↑v) → ↑a = ↑b) : padic_int p →+* zmod v :=
  ring_hom.mk (fun (x : padic_int p) => ↑(f x)) sorry sorry sorry sorry

/--
`to_zmod` is a ring hom from `ℤ_[p]` to `zmod p`,
with the equality `to_zmod x = (zmod_repr x : zmod p)`.
-/
def to_zmod {p : ℕ} [hp_prime : fact (nat.prime p)] : padic_int p →+* zmod p :=
  to_zmod_hom p zmod_repr sorry sorry

/--
`z - (to_zmod z : ℤ_[p])` is contained in the maximal ideal of `ℤ_[p]`, for every `z : ℤ_[p]`.

The coercion from `zmod p` to `ℤ_[p]` is `zmod.has_coe_t`,
which coerces `zmod p` into artibrary rings.
This is unfortunate, but a consequence of the fact that we allow `zmod p`
to coerce to rings of arbitrary characteristic, instead of only rings of characteristic `p`.
This coercion is only a ring homomorphism if it coerces into a ring whose characteristic divides
`p`. While this is not the case here we can still make use of the coercion.
-/
theorem to_zmod_spec {p : ℕ} [hp_prime : fact (nat.prime p)] (z : padic_int p) : z - ↑(coe_fn to_zmod z) ∈ local_ring.maximal_ideal (padic_int p) := sorry

theorem ker_to_zmod {p : ℕ} [hp_prime : fact (nat.prime p)] : ring_hom.ker to_zmod = local_ring.maximal_ideal (padic_int p) := sorry

/-- `appr n x` gives a value `v : ℕ` such that `x` and `↑v : ℤ_p` are congruent mod `p^n`.
See `appr_spec`. -/
def appr {p : ℕ} [hp_prime : fact (nat.prime p)] : padic_int p → ℕ → ℕ :=
  sorry

theorem appr_lt {p : ℕ} [hp_prime : fact (nat.prime p)] (x : padic_int p) (n : ℕ) : appr x n < p ^ n := sorry

theorem appr_mono {p : ℕ} [hp_prime : fact (nat.prime p)] (x : padic_int p) : monotone (appr x) := sorry

theorem dvd_appr_sub_appr {p : ℕ} [hp_prime : fact (nat.prime p)] (x : padic_int p) (m : ℕ) (n : ℕ) (h : m ≤ n) : p ^ m ∣ appr x n - appr x m := sorry

theorem appr_spec {p : ℕ} [hp_prime : fact (nat.prime p)] (n : ℕ) (x : padic_int p) : x - ↑(appr x n) ∈ ideal.span (singleton (↑p ^ n)) := sorry

/-- A ring hom from `ℤ_[p]` to `zmod (p^n)`, with underlying function `padic_int.appr n`. -/
def to_zmod_pow {p : ℕ} [hp_prime : fact (nat.prime p)] (n : ℕ) : padic_int p →+* zmod (p ^ n) :=
  to_zmod_hom (p ^ n) (fun (x : padic_int p) => appr x n) sorry sorry

theorem ker_to_zmod_pow {p : ℕ} [hp_prime : fact (nat.prime p)] (n : ℕ) : ring_hom.ker (to_zmod_pow n) = ideal.span (singleton (↑p ^ n)) := sorry

@[simp] theorem zmod_cast_comp_to_zmod_pow {p : ℕ} [hp_prime : fact (nat.prime p)] (m : ℕ) (n : ℕ) (h : m ≤ n) : ring_hom.comp (zmod.cast_hom (pow_dvd_pow p h) (zmod (p ^ m))) (to_zmod_pow n) = to_zmod_pow m := sorry

@[simp] theorem cast_to_zmod_pow {p : ℕ} [hp_prime : fact (nat.prime p)] (m : ℕ) (n : ℕ) (h : m ≤ n) (x : padic_int p) : ↑(coe_fn (to_zmod_pow n) x) = coe_fn (to_zmod_pow m) x := sorry

theorem dense_range_nat_cast {p : ℕ} [hp_prime : fact (nat.prime p)] : dense_range nat.cast := sorry

theorem dense_range_int_cast {p : ℕ} [hp_prime : fact (nat.prime p)] : dense_range int.cast := sorry

/-! ### Universal property as projective limit -/

/--
Given a family of ring homs `f : Π n : ℕ, R →+* zmod (p ^ n)`,
`nth_hom f r` is an integer-valued sequence
whose `n`th value is the unique integer `k` such that `0 ≤ k < p ^ n`
and `f n r = (k : zmod (p ^ n))`.
-/
def nth_hom {p : ℕ} {R : Type u_1} [comm_ring R] (f : (k : ℕ) → R →+* zmod (p ^ k)) (r : R) : ℕ → ℤ :=
  fun (n : ℕ) => ↑(zmod.val (coe_fn (f n) r))

@[simp] theorem nth_hom_zero {p : ℕ} {R : Type u_1} [comm_ring R] (f : (k : ℕ) → R →+* zmod (p ^ k)) : nth_hom f 0 = 0 := sorry

theorem pow_dvd_nth_hom_sub {p : ℕ} [hp_prime : fact (nat.prime p)] {R : Type u_1} [comm_ring R] {f : (k : ℕ) → R →+* zmod (p ^ k)} (f_compat : ∀ (k1 k2 : ℕ) (hk : k1 ≤ k2), ring_hom.comp (zmod.cast_hom (pow_dvd_pow p hk) (zmod (p ^ k1))) (f k2) = f k1) (r : R) (i : ℕ) (j : ℕ) (h : i ≤ j) : ↑p ^ i ∣ nth_hom f r j - nth_hom f r i := sorry

theorem is_cau_seq_nth_hom {p : ℕ} [hp_prime : fact (nat.prime p)] {R : Type u_1} [comm_ring R] {f : (k : ℕ) → R →+* zmod (p ^ k)} (f_compat : ∀ (k1 k2 : ℕ) (hk : k1 ≤ k2), ring_hom.comp (zmod.cast_hom (pow_dvd_pow p hk) (zmod (p ^ k1))) (f k2) = f k1) (r : R) : is_cau_seq (padic_norm p) fun (n : ℕ) => ↑(nth_hom f r n) := sorry

/--
`nth_hom_seq f_compat r` bundles `padic_int.nth_hom f r`
as a Cauchy sequence of rationals with respect to the `p`-adic norm.
The `n`th value of the sequence is `((f n r).val : ℚ)`.
-/
def nth_hom_seq {p : ℕ} [hp_prime : fact (nat.prime p)] {R : Type u_1} [comm_ring R] {f : (k : ℕ) → R →+* zmod (p ^ k)} (f_compat : ∀ (k1 k2 : ℕ) (hk : k1 ≤ k2), ring_hom.comp (zmod.cast_hom (pow_dvd_pow p hk) (zmod (p ^ k1))) (f k2) = f k1) (r : R) : padic_seq p :=
  { val := fun (n : ℕ) => ↑(nth_hom f r n), property := is_cau_seq_nth_hom f_compat r }

theorem nth_hom_seq_one {p : ℕ} [hp_prime : fact (nat.prime p)] {R : Type u_1} [comm_ring R] {f : (k : ℕ) → R →+* zmod (p ^ k)} (f_compat : ∀ (k1 k2 : ℕ) (hk : k1 ≤ k2), ring_hom.comp (zmod.cast_hom (pow_dvd_pow p hk) (zmod (p ^ k1))) (f k2) = f k1) : nth_hom_seq f_compat 1 ≈ 1 := sorry

theorem nth_hom_seq_add {p : ℕ} [hp_prime : fact (nat.prime p)] {R : Type u_1} [comm_ring R] {f : (k : ℕ) → R →+* zmod (p ^ k)} (f_compat : ∀ (k1 k2 : ℕ) (hk : k1 ≤ k2), ring_hom.comp (zmod.cast_hom (pow_dvd_pow p hk) (zmod (p ^ k1))) (f k2) = f k1) (r : R) (s : R) : nth_hom_seq f_compat (r + s) ≈ nth_hom_seq f_compat r + nth_hom_seq f_compat s := sorry

theorem nth_hom_seq_mul {p : ℕ} [hp_prime : fact (nat.prime p)] {R : Type u_1} [comm_ring R] {f : (k : ℕ) → R →+* zmod (p ^ k)} (f_compat : ∀ (k1 k2 : ℕ) (hk : k1 ≤ k2), ring_hom.comp (zmod.cast_hom (pow_dvd_pow p hk) (zmod (p ^ k1))) (f k2) = f k1) (r : R) (s : R) : nth_hom_seq f_compat (r * s) ≈ nth_hom_seq f_compat r * nth_hom_seq f_compat s := sorry

/--
`lim_nth_hom f_compat r` is the limit of a sequence `f` of compatible ring homs `R →+* zmod (p^k)`.
This is itself a ring hom: see `padic_int.lift`.
-/
def lim_nth_hom {p : ℕ} [hp_prime : fact (nat.prime p)] {R : Type u_1} [comm_ring R] {f : (k : ℕ) → R →+* zmod (p ^ k)} (f_compat : ∀ (k1 k2 : ℕ) (hk : k1 ≤ k2), ring_hom.comp (zmod.cast_hom (pow_dvd_pow p hk) (zmod (p ^ k1))) (f k2) = f k1) (r : R) : padic_int p :=
  of_int_seq (nth_hom f r) (is_cau_seq_nth_hom f_compat r)

theorem lim_nth_hom_spec {p : ℕ} [hp_prime : fact (nat.prime p)] {R : Type u_1} [comm_ring R] {f : (k : ℕ) → R →+* zmod (p ^ k)} (f_compat : ∀ (k1 k2 : ℕ) (hk : k1 ≤ k2), ring_hom.comp (zmod.cast_hom (pow_dvd_pow p hk) (zmod (p ^ k1))) (f k2) = f k1) (r : R) (ε : ℝ) : 0 < ε → ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → norm (lim_nth_hom f_compat r - ↑(nth_hom f r n)) < ε := sorry

theorem lim_nth_hom_zero {p : ℕ} [hp_prime : fact (nat.prime p)] {R : Type u_1} [comm_ring R] {f : (k : ℕ) → R →+* zmod (p ^ k)} (f_compat : ∀ (k1 k2 : ℕ) (hk : k1 ≤ k2), ring_hom.comp (zmod.cast_hom (pow_dvd_pow p hk) (zmod (p ^ k1))) (f k2) = f k1) : lim_nth_hom f_compat 0 = 0 := sorry

theorem lim_nth_hom_one {p : ℕ} [hp_prime : fact (nat.prime p)] {R : Type u_1} [comm_ring R] {f : (k : ℕ) → R →+* zmod (p ^ k)} (f_compat : ∀ (k1 k2 : ℕ) (hk : k1 ≤ k2), ring_hom.comp (zmod.cast_hom (pow_dvd_pow p hk) (zmod (p ^ k1))) (f k2) = f k1) : lim_nth_hom f_compat 1 = 1 :=
  subtype.ext (quot.sound (nth_hom_seq_one f_compat))

theorem lim_nth_hom_add {p : ℕ} [hp_prime : fact (nat.prime p)] {R : Type u_1} [comm_ring R] {f : (k : ℕ) → R →+* zmod (p ^ k)} (f_compat : ∀ (k1 k2 : ℕ) (hk : k1 ≤ k2), ring_hom.comp (zmod.cast_hom (pow_dvd_pow p hk) (zmod (p ^ k1))) (f k2) = f k1) (r : R) (s : R) : lim_nth_hom f_compat (r + s) = lim_nth_hom f_compat r + lim_nth_hom f_compat s :=
  subtype.ext (quot.sound (nth_hom_seq_add f_compat r s))

theorem lim_nth_hom_mul {p : ℕ} [hp_prime : fact (nat.prime p)] {R : Type u_1} [comm_ring R] {f : (k : ℕ) → R →+* zmod (p ^ k)} (f_compat : ∀ (k1 k2 : ℕ) (hk : k1 ≤ k2), ring_hom.comp (zmod.cast_hom (pow_dvd_pow p hk) (zmod (p ^ k1))) (f k2) = f k1) (r : R) (s : R) : lim_nth_hom f_compat (r * s) = lim_nth_hom f_compat r * lim_nth_hom f_compat s :=
  subtype.ext (quot.sound (nth_hom_seq_mul f_compat r s))

-- TODO: generalize this to arbitrary complete discrete valuation rings

/--
`lift f_compat` is the limit of a sequence `f` of compatible ring homs `R →+* zmod (p^k)`,
with the equality `lift f_compat r = padic_int.lim_nth_hom f_compat r`.
-/
def lift {p : ℕ} [hp_prime : fact (nat.prime p)] {R : Type u_1} [comm_ring R] {f : (k : ℕ) → R →+* zmod (p ^ k)} (f_compat : ∀ (k1 k2 : ℕ) (hk : k1 ≤ k2), ring_hom.comp (zmod.cast_hom (pow_dvd_pow p hk) (zmod (p ^ k1))) (f k2) = f k1) : R →+* padic_int p :=
  ring_hom.mk (lim_nth_hom f_compat) sorry sorry sorry sorry

theorem lift_sub_val_mem_span {p : ℕ} [hp_prime : fact (nat.prime p)] {R : Type u_1} [comm_ring R] {f : (k : ℕ) → R →+* zmod (p ^ k)} (f_compat : ∀ (k1 k2 : ℕ) (hk : k1 ≤ k2), ring_hom.comp (zmod.cast_hom (pow_dvd_pow p hk) (zmod (p ^ k1))) (f k2) = f k1) (r : R) (n : ℕ) : coe_fn (lift f_compat) r - ↑(zmod.val (coe_fn (f n) r)) ∈ ideal.span (singleton (↑p ^ n)) := sorry

/--
One part of the universal property of `ℤ_[p]` as a projective limit.
See also `padic_int.lift_unique`.
-/
theorem lift_spec {p : ℕ} [hp_prime : fact (nat.prime p)] {R : Type u_1} [comm_ring R] {f : (k : ℕ) → R →+* zmod (p ^ k)} (f_compat : ∀ (k1 k2 : ℕ) (hk : k1 ≤ k2), ring_hom.comp (zmod.cast_hom (pow_dvd_pow p hk) (zmod (p ^ k1))) (f k2) = f k1) (n : ℕ) : ring_hom.comp (to_zmod_pow n) (lift f_compat) = f n := sorry

/--
One part of the universal property of `ℤ_[p]` as a projective limit.
See also `padic_int.lift_spec`.
-/
theorem lift_unique {p : ℕ} [hp_prime : fact (nat.prime p)] {R : Type u_1} [comm_ring R] {f : (k : ℕ) → R →+* zmod (p ^ k)} (f_compat : ∀ (k1 k2 : ℕ) (hk : k1 ≤ k2), ring_hom.comp (zmod.cast_hom (pow_dvd_pow p hk) (zmod (p ^ k1))) (f k2) = f k1) (g : R →+* padic_int p) (hg : ∀ (n : ℕ), ring_hom.comp (to_zmod_pow n) g = f n) : lift f_compat = g := sorry

@[simp] theorem lift_self {p : ℕ} [hp_prime : fact (nat.prime p)] (z : padic_int p) : coe_fn (lift zmod_cast_comp_to_zmod_pow) z = z := sorry

theorem ext_of_to_zmod_pow {p : ℕ} [hp_prime : fact (nat.prime p)] {x : padic_int p} {y : padic_int p} : (∀ (n : ℕ), coe_fn (to_zmod_pow n) x = coe_fn (to_zmod_pow n) y) ↔ x = y := sorry

theorem to_zmod_pow_eq_iff_ext {p : ℕ} [hp_prime : fact (nat.prime p)] {R : Type u_1} [comm_ring R] {g : R →+* padic_int p} {g' : R →+* padic_int p} : (∀ (n : ℕ), ring_hom.comp (to_zmod_pow n) g = ring_hom.comp (to_zmod_pow n) g') ↔ g = g' := sorry


/-
Copyright © 2018 François G. Dorais. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import tup

universes u v
variables {σ : Type u} (sig : σ → ℕ) (α : Type v)
include sig

inductive term : Type (u+1)
| var {} : ℕ → term
| app (s : σ) : term ^ (sig s) → term

structure eqn : Type (u+1) := (fst snd : term sig)

infix ≡ := eqn.mk

structure alg : Type (max u v) :=
(app : Π (s : σ), α ^ (sig s) → α)

definition term_alg : alg sig (term sig) :=
{ app := term.app
}

definition eqn_alg : alg sig (eqn sig) :=
{ app := λ s es, term.app s (tup.map eqn.fst es) ≡ term.app s (tup.map eqn.snd es)
}

variables {sig} {α} (a : alg sig α)

definition eval (val : ℕ → α) : term sig → α
| (term.var n) := val n
| (term.app s ts) := alg.app a s (λ i, eval (ts i))

@[simp]
lemma eval_var (val : ℕ → α) {n : ℕ} :
eval a val (term.var n) = val n := rfl

@[simp]
lemma eval_app (val : ℕ → α) (s : σ) {ts : term sig ^ (sig s)} :
eval a val (term.app s ts) = alg.app a s (tup.map (eval a val) ts) := rfl

definition sat (e : eqn sig) : Prop :=
∀ val : ℕ → α, eval a val e.fst = eval a val e.snd

infix ` ⊧ `:20 := sat


import algebra.order.positive.field algebra.module.submodule.basic

/-! # IMO 2018 A5 -/

namespace IMOSL
namespace IMO2018A5

variables {F V : Type*} [linear_ordered_field F] [add_comm_group V] [module F V]

def good (f : {x : F // 0 < x} → V) :=
  ∀ x y : {x : F // 0 < x}, (x + x⁻¹ : F) • f y = f (x * y) + f (x⁻¹ * y)

private def good_space (F V : Type*) [linear_ordered_field F] [add_comm_group V] [module F V] :
  submodule F ({x : F // 0 < x} → V) :=
{ carrier := set_of good,
  add_mem' := λ f g h h0 x y,
    by simp_rw [pi.add_apply, smul_add]; rw [h x y, h0 x y, add_add_add_comm],
  zero_mem' := λ x y, by simp_rw pi.zero_apply; rw [smul_zero, zero_add],
  smul_mem' := λ c f h x y, by simp_rw [pi.smul_apply, smul_comm _ c, h x, ← smul_add] }

private lemma smul_vec_is_good (v : V) :
  good (λ x : {x : F // 0 < x}, (x : F) • v) :=
  λ x y, by simp_rw [positive.coe_mul, positive.coe_inv, ← smul_smul, ← add_smul]

private lemma inv_smul_vec_is_good (v : V) :
  good (λ x : {x : F // 0 < x}, (x⁻¹ : F) • v) :=
  λ x y, by simp_rw [positive.coe_mul, mul_inv, positive.coe_inv, inv_inv, ← smul_smul];
    rw [← add_smul, add_comm (x : F)]

private lemma smul_add_inv_smul_is_good (v1 v2 : V) :
  good (λ x : {x : F // 0 < x}, (x : F) • v1 + (x⁻¹ : F) • v2) :=
  (good_space F V).add_mem (smul_vec_is_good v1) (inv_smul_vec_is_good v2)

private lemma exists_smul_add_inv_smul_two_eq {a b : {x : F // 0 < x}} (h : a ≠ b) (v1 v2 : V) :
 ∃ w1 w2 : V, (a : F) • w1 + (a : F)⁻¹ • w2 = v1 ∧ (b : F) • w1 + (b : F)⁻¹ • w2 = v2 :=
begin
  set S := {x : F // 0 < x},
  let c : F := a * b⁻¹ - b * a⁻¹,
  rsuffices ⟨h0, h1⟩ : c ≠ 0 ∧ ∃ w1 w2 : V,
    (a : F) • w1 + (a : F)⁻¹ • w2 = c • v1 ∧ (b : F) • w1 + (b : F)⁻¹ • w2 = c • v2,
  { rcases h1 with ⟨w1, w2, h1, h2⟩,
    refine ⟨c⁻¹ • w1, c⁻¹ • w2, _, _⟩;
      simp_rw [smul_smul, mul_comm _ c⁻¹, ← smul_smul];
      rwa [← smul_add, inv_smul_eq_iff₀ h0] },
  dsimp only [c]; clear c; split,

  ---- `ab⁻¹ ≠ ba⁻¹`
  { simp_rw [← positive.coe_inv, ← positive.coe_mul],
    rw [ne.def, sub_eq_zero, set_coe.ext_iff, ← mul_inv_eq_one, mul_inv_rev, inv_inv, ← sq],
    revert h; rw [ne.def, ← mul_inv_eq_one, not_imp_not],
    exact (pow_eq_one_iff two_ne_zero).mp },

  ---- `f` good with `f(a) = (ab⁻¹ - ba⁻¹) v₁` and `f(b) = (ab⁻¹ - ba⁻¹) v₂`
  { refine ⟨(b : F)⁻¹ • v1 - (a : F)⁻¹ • v2, (a : F) • v2 - (b : F) • v1, _⟩,
    replace h : (a : F) ≠ 0 := ne_of_gt a.2,
    generalize_hyp : (a : F) = x at h ⊢,
    have h0 : (b : F) ≠ 0 := ne_of_gt b.2,
    generalize_hyp : (b : F) = y at h0 ⊢,
    clear a b S; simp_rw [smul_sub, smul_smul]; split,
    rw [mul_inv_cancel h, inv_mul_cancel h, sub_add_sub_cancel, ← sub_smul, mul_comm y],
    rw [mul_inv_cancel h0, inv_mul_cancel h0, sub_add_sub_cancel', ← sub_smul, mul_comm x] }
end

private lemma good_two_eq_zero {f : {x : F // 0 < x} → V} (h : good f)
  {a b : {x : F // 0 < x}} (h0 : a ≠ b) (h1 : f a = 0) (h2 : f b = 0) :
  f = 0 :=
begin
  have h3 : ∀ u : {x : F // 0 < x}, f u = 0 → ∀ x : {x : F // 0 < x}, f (u ^ 2 * x) = -f x⁻¹ :=
    λ u h3 x, by replace h := h (u * x) u; rwa [h3, smul_zero, mul_inv_rev,
      inv_mul_cancel_right, mul_right_comm, ← sq, eq_comm, add_eq_zero_iff_eq_neg] at h,
  replace h3 : ∀ x : {x : F // 0 < x}, f ((a * b⁻¹) ^ 2 * x) = f x :=
    λ x, by rw [mul_pow, mul_assoc, h3 a h1, ← h3 b h2, inv_pow, mul_inv_cancel_left],
  rw [ne.def, ← mul_inv_eq_one] at h0,
  replace h0 : (a * b⁻¹) ^ 2 ≠ 1 := λ h4, h0 ((pow_eq_one_iff two_ne_zero).mp h4),
  clear h1 h2; generalize_hyp : (a * b⁻¹) ^ 2 = c at h0 h3,

  funext x; replace h := h c (c * x),
  rw [h3 (c * x), h3, inv_mul_cancel_left, ← sub_eq_zero,
      ← two_smul F, ← sub_smul, smul_eq_zero, sub_eq_zero] at h,
  revert h; clear h3; refine (or_iff_right (λ h3, _)).mp,
  apply_fun has_mul.mul (c : F) at h3,
  have h1 : 0 < (c : F) := c.2,
  rw [mul_add, mul_inv_cancel (ne_of_gt h1), mul_two, ← eq_sub_iff_add_eq,
      add_sub_assoc, ← sub_eq_iff_eq_add', ← mul_sub_one, mul_left_eq_self₀,
      sub_eq_zero, or_self, ← positive.coe_one, subtype.coe_inj] at h3,
  exact h0 h3
end

/-- Final solution -/
theorem final_solution {F V : Type*} [linear_ordered_field F] [add_comm_group V] [module F V] :
  ∀ f : {x : F // 0 < x} → V, good f ↔ ∃ v1 v2 : V, f = λ x, (x : F) • v1 + (x⁻¹ : F) • v2 :=
begin
  intros f; symmetry; refine ⟨λ h, _, λ h, _⟩,
  rcases h with ⟨v1, v2, rfl⟩,
  exact smul_add_inv_smul_is_good v1 v2,
  obtain ⟨a, b, h0⟩ : ∃ a b : {x : F // 0 < x}, a ≠ b :=
    ⟨⟨2, two_pos⟩, ⟨1, one_pos⟩, ne_of_gt (by rw subtype.mk_lt_mk; exact one_lt_two)⟩,
  obtain ⟨v1, v2, h1, h2⟩ := exists_smul_add_inv_smul_two_eq h0 (f a) (f b),
  rw [eq_comm, ← sub_eq_zero] at h1 h2,
  refine ⟨v1, v2, sub_eq_zero.mp (good_two_eq_zero _ h0 h1 h2)⟩,
  exact (good_space F V).sub_mem h (smul_add_inv_smul_is_good v1 v2)
end

end IMO2018A5
end IMOSL


import data.real.basic analysis.special_functions.trigonometric
import measure_theory.interval_integral
import analysis.special_functions.pow

open_locale real
noncomputable theory
open interval_integral

example : ∫ (x : ℝ) in 0..1, x = 1/2 :=
begin
  have : deriv (λ x : ℝ, x^2/2) = λ x, x,
  { ext x,
    simp, field_simp, ring },
  simp only [← this],
  rw integral_deriv_eq_sub,
  { norm_num },
  { simp },
  { rw this,
    exact continuous_id.continuous_on }
end

example (r : ℝ) : deriv (λ x : ℝ, (real.sqrt (r^2 - x^2))) = λ x, (-x/real.sqrt (r^2 - x^2)) :=
begin
  ext,
  rw deriv_sqrt,
  {
    simp only [differentiable_at_const, mul_one, zero_sub, deriv_sub, differentiable_at_id', deriv_pow'', nat.cast_bit0, deriv_id'',
  deriv_const', pow_one, differentiable_at.pow, nat.cast_one, mul_zero],
    sorry
  },
  {
    sorry
  },
  {

  }
end

example (r : ℝ) (x : ℝ) : 4 * ∫ x in (0: ℝ)..r, (real.sqrt (r^2 - x^2)) = π*r^2 :=
begin
  have : deriv (λ x : ℝ, (real.sqrt (r^2 - x^2))) = λ x, (-x/real.sqrt (r^2 - x^2)),
  { ext, sorry

  },
  sorry
end


import data.nat.prime
import tactic.linarith

/-! # LoVe Preface

## Proof Assistants

Proof assistants (also called interactive theorem provers)

* check and help develop formal proofs;
* can be used to prove big theorems, not only logic puzzles;
* can be tedious to use;
* are highly addictive (think video games).

A selection of proof assistants, classified by logical foundations:

* set theory: Isabelle/ZF, Metamath, Mizar;
* simple type theory: HOL4, HOL Light, Isabelle/HOL;
* **dependent type theory**: Agda, Coq, **Lean**, Matita, PVS.

## Success Stories

Mathematics:

* the four-color theorem (in Coq);
* the odd-order theorem (in Coq);
* the Kepler conjecture (in HOL Light and Isabelle/HOL).

Computer science:

* hardware
* operating systems
* programming language theory
* compilers
* security

## Lean

Lean is a proof assistant developed primarily by Leonardo de Moura (Microsoft
Research) since 2012.

Its mathematical library, `mathlib`, is developed by a user community.

We use community version 3.20.0. We use its basic libraries, `mathlib`, and
`LoVelib`. Lean is a research project.

Strengths:

* highly expressive logic based on a dependent type theory called the
  **calculus of inductive constructions**;
* extended with classical axioms and quotient types;
* metaprogramming framework;
* modern user interface;
* documentation;
* open source;
* wonderful user community.

## This Course

### Web Site

    https://cs.brown.edu/courses/cs1951x/

### Repository (Demos, Exercises, Homework)

    https://github.com/BrownCS1951x/fpv2021

The file you are currently looking at is a demo.
For each chapter of the Hitchhiker's Guide, there will be approximately
one demo, one exercise sheet, and one homework.

* Demos will be covered in class. These are "lecture notes."
  We'll post skeletons of the demos before class, and completed demos after class.

* Exercises are ungraded practice problems for you to use to learn.
  Sometimes we'll cover exercise problems in class. Occasionally we may run
  class like a lab, giving you time to work on exercise problems with us around.

* Homeworks are for you to do on your own, and submit via Gradescope.

### The Hitchhiker's Guide to Logical Verification

    https://cs.brown.edu/courses/cs1951x/static_files/main.pdf

The lecture notes consist of a preface and 13 chapters. They cover the same
material as the corresponding lectures but with more details. Sometimes there
will not be enough time to cover everything in class, so reading the lecture
notes will be necessary.

Download this version, not others that you might find online!

## Our Goal

We want you to

* master fundamental theory and techniques in interactive theorem proving;
* familiarize yourselves with some application areas;
* develop some practical skills you can apply on a larger project (as a hobby,
  for an MSc or PhD, or in industry);
* feel ready to move to another proof assistant and apply what you have learned;
* understand the domain well enough to start reading scientific papers.

This course is neither a pure logical foundations course nor a Lean tutorial.
Lean is our vehicle, not an end in itself.

-/

open nat
open_locale nat

theorem infinitude_of_primes : ∀ N, ∃ p ≥ N, prime p :=
sorry


/-
Copyright (c) 2022 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers
-/
import data.sign
import topology.order.basic

/-!
# Topology on `sign_type`

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

This file gives `sign_type` the discrete topology, and proves continuity results for `sign` in
an `order_topology`.

-/

instance : topological_space sign_type := ⊥
instance : discrete_topology sign_type := ⟨rfl⟩

variables {α : Type*} [has_zero α] [topological_space α]

section partial_order

variables [partial_order α] [decidable_rel ((<) : α → α → Prop)] [order_topology α]

lemma continuous_at_sign_of_pos {a : α} (h : 0 < a) : continuous_at sign a :=
begin
  refine (continuous_at_const : continuous_at (λ x, (1 : sign_type)) a).congr _,
  rw [filter.eventually_eq, eventually_nhds_iff],
  exact ⟨{x | 0 < x}, λ x hx, (sign_pos hx).symm, is_open_lt' 0, h⟩
end

lemma continuous_at_sign_of_neg {a : α} (h : a < 0) : continuous_at sign a :=
begin
  refine (continuous_at_const : continuous_at (λ x, (-1 : sign_type)) a).congr _,
  rw [filter.eventually_eq, eventually_nhds_iff],
  exact ⟨{x | x < 0}, λ x hx, (sign_neg hx).symm, is_open_gt' 0, h⟩
end

end partial_order

section linear_order

variables [linear_order α] [order_topology α]

lemma continuous_at_sign_of_ne_zero {a : α} (h : a ≠ 0) : continuous_at sign a :=
begin
  rcases h.lt_or_lt with h_neg|h_pos,
  { exact continuous_at_sign_of_neg h_neg },
  { exact continuous_at_sign_of_pos h_pos }
end

end linear_order


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Patrick Massot
-/
import algebra.module.basic
import algebra.regular.smul
import algebra.ring.pi
import group_theory.group_action.pi

/-!
# Pi instances for modules

This file defines instances for module and related structures on Pi Types
-/

universes u v w
variable {I : Type u}     -- The indexing type
variable {f : I → Type v} -- The family of types already equipped with instances
variables (x y : Π i, f i) (i : I)

namespace pi

lemma _root_.is_smul_regular.pi {α : Type*} [Π i, has_smul α $ f i] {k : α}
  (hk : Π i, is_smul_regular (f i) k) : is_smul_regular (Π i, f i) k :=
λ _ _ h, funext $ λ i, hk i (congr_fun h i : _)

instance smul_with_zero (α) [has_zero α]
  [Π i, has_zero (f i)] [Π i, smul_with_zero α (f i)] :
  smul_with_zero α (Π i, f i) :=
{ smul_zero := λ _, funext $ λ _, smul_zero' (f _) _,
  zero_smul := λ _, funext $ λ _, zero_smul _ _,
  ..pi.has_smul }

instance smul_with_zero' {g : I → Type*} [Π i, has_zero (g i)]
  [Π i, has_zero (f i)] [Π i, smul_with_zero (g i) (f i)] :
  smul_with_zero (Π i, g i) (Π i, f i) :=
{ smul_zero := λ _, funext $ λ _, smul_zero' (f _) _,
  zero_smul := λ _, funext $ λ _, zero_smul _ _,
  ..pi.has_smul' }

instance mul_action_with_zero (α) [monoid_with_zero α]
  [Π i, has_zero (f i)] [Π i, mul_action_with_zero α (f i)] :
  mul_action_with_zero α (Π i, f i) :=
{ ..pi.mul_action _,
  ..pi.smul_with_zero _ }

instance mul_action_with_zero' {g : I → Type*} [Π i, monoid_with_zero (g i)]
  [Π i, has_zero (f i)] [Π i, mul_action_with_zero (g i) (f i)] :
  mul_action_with_zero (Π i, g i) (Π i, f i) :=
{ ..pi.mul_action',
  ..pi.smul_with_zero' }

variables (I f)

instance module (α) {r : semiring α} {m : ∀ i, add_comm_monoid $ f i}
  [∀ i, module α $ f i] :
  @module α (Π i : I, f i) r (@pi.add_comm_monoid I f m) :=
{ add_smul := λ c f g, funext $ λ i, add_smul _ _ _,
  zero_smul := λ f, funext $ λ i, zero_smul α _,
  ..pi.distrib_mul_action _ }

/- Extra instance to short-circuit type class resolution.
For unknown reasons, this is necessary for certain inference problems. E.g., for this to succeed:
```lean
example (β X : Type*) [normed_group β] [normed_space ℝ β] : module ℝ (X → β) := by apply_instance
```
See: https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/Typeclass.20resolution.20under.20binders/near/281296989
-/
/-- A special case of `pi.module` for non-dependent types. Lean struggles to elaborate
definitions elsewhere in the library without this. -/
instance _root_.function.module (α β : Type*) [semiring α] [add_comm_monoid β] [module α β] :
  module α (I → β) :=
pi.module _ _ _

variables {I f}

instance module' {g : I → Type*} {r : Π i, semiring (f i)} {m : Π i, add_comm_monoid (g i)}
  [Π i, module (f i) (g i)] :
  module (Π i, f i) (Π i, g i) :=
{ add_smul := by { intros, ext1, apply add_smul },
  zero_smul := by { intros, ext1, apply zero_smul } }

instance (α) {r : semiring α} {m : Π i, add_comm_monoid $ f i}
  [Π i, module α $ f i] [∀ i, no_zero_smul_divisors α $ f i] :
  no_zero_smul_divisors α (Π i : I, f i) :=
⟨λ c x h, or_iff_not_imp_left.mpr (λ hc, funext
  (λ i, (smul_eq_zero.mp (congr_fun h i)).resolve_left hc))⟩

end pi


/-
Copyright (c) 2020 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis
Ported by: Scott Morrison
-/
import Std.Tactic.Simpa
import Std.Tactic.Lint.Basic
import Mathlib.Algebra.Order.Ring.Defs
import Mathlib.Algebra.Order.Monoid.Lemmas
import Mathlib.Init.Data.Int.Order
import Mathlib.Algebra.Order.ZeroLEOne
import Mathlib.Algebra.GroupPower.Order

/-!
# Lemmas for `linarith`.

Those in the `Linarith` namespace should stay here.

Those outside the `Linarith` namespace may be deleted as they are ported to mathlib4.
-/

namespace Linarith

theorem lt_irrefl {α : Type u} [Preorder α] {a : α} : ¬a < a := _root_.lt_irrefl a

theorem eq_of_eq_of_eq {α} [OrderedSemiring α] {a b : α} (ha : a = 0) (hb : b = 0) : a + b = 0 := by
  simp [*]

theorem lt_of_eq_of_lt {α} [OrderedSemiring α] {a b : α} (ha : a = 0) (hb : b < 0) : a + b < 0 := by
  simp [*]

theorem le_of_le_of_eq {α} [OrderedSemiring α] {a b : α} (ha : a ≤ 0) (hb : b = 0) : a + b ≤ 0 := by
  simp [*]

theorem lt_of_lt_of_eq {α} [OrderedSemiring α] {a b : α} (ha : a < 0) (hb : b = 0) : a + b < 0 := by
  simp [*]

theorem mul_neg {α} [StrictOrderedRing α] {a b : α} (ha : a < 0) (hb : 0 < b) : b * a < 0 :=
  have : (-b)*a > 0 := mul_pos_of_neg_of_neg (neg_neg_of_pos hb) ha
  neg_of_neg_pos (by simpa)

theorem mul_nonpos {α} [OrderedRing α] {a b : α} (ha : a ≤ 0) (hb : 0 < b) : b * a ≤ 0 :=
  have : (-b)*a ≥ 0 := mul_nonneg_of_nonpos_of_nonpos (le_of_lt (neg_neg_of_pos hb)) ha
  by simpa

-- used alongside `mul_neg` and `mul_nonpos`, so has the same argument pattern for uniformity
@[nolint unusedArguments]
theorem mul_eq {α} [OrderedSemiring α] {a b : α} (ha : a = 0) (_ : 0 < b) : b * a = 0 := by
  simp [*]

lemma eq_of_not_lt_of_not_gt {α} [LinearOrder α] (a b : α) (h1 : ¬ a < b) (h2 : ¬ b < a) : a = b :=
le_antisymm (le_of_not_gt h2) (le_of_not_gt h1)

-- used in the `nlinarith` normalization steps. The `_` argument is for uniformity.
@[nolint unusedArguments]
lemma mul_zero_eq {α} {R : α → α → Prop} [Semiring α] {a b : α} (_ : R a 0) (h : b = 0) :
  a * b = 0 :=
by simp [h]

-- used in the `nlinarith` normalization steps. The `_` argument is for uniformity.
@[nolint unusedArguments]
lemma zero_mul_eq {α} {R : α → α → Prop} [Semiring α] {a b : α} (h : a = 0) (_ : R b 0) :
  a * b = 0 :=
by simp [h]

end Linarith

section
open Function
-- These lemmas can be removed when their originals are ported.

theorem lt_zero_of_zero_gt [Zero α] [LT α] {a : α} (h : 0 > a) : a < 0 := h

theorem le_zero_of_zero_ge [Zero α] [LE α] {a : α} (h : 0 ≥ a) : a ≤ 0 := h


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.multiset.dedup
import data.list.min_max

/-!
# The fold operation for a commutative associative operation over a multiset.
-/

namespace multiset
variables {α β : Type*}

/-! ### fold -/
section fold
variables (op : α → α → α) [hc : is_commutative α op] [ha : is_associative α op]
local notation a * b := op a b
include hc ha

/-- `fold op b s` folds a commutative associative operation `op` over
  the multiset `s`. -/
def fold : α → multiset α → α := foldr op (left_comm _ hc.comm ha.assoc)

theorem fold_eq_foldr (b : α) (s : multiset α) :
  fold op b s = foldr op (left_comm _ hc.comm ha.assoc) b s := rfl

@[simp] theorem coe_fold_r (b : α) (l : list α) : fold op b l = l.foldr op b := rfl

theorem coe_fold_l (b : α) (l : list α) : fold op b l = l.foldl op b :=
(coe_foldr_swap op _ b l).trans $ by simp [hc.comm]

theorem fold_eq_foldl (b : α) (s : multiset α) :
  fold op b s = foldl op (right_comm _ hc.comm ha.assoc) b s :=
quot.induction_on s $ λ l, coe_fold_l _ _ _

@[simp] theorem fold_zero (b : α) : (0 : multiset α).fold op b = b := rfl

@[simp] theorem fold_cons_left : ∀ (b a : α) (s : multiset α),
  (a ::ₘ s).fold op b = a * s.fold op b := foldr_cons _ _

theorem fold_cons_right (b a : α) (s : multiset α) : (a ::ₘ s).fold op b = s.fold op b * a :=
by simp [hc.comm]

theorem fold_cons'_right (b a : α) (s : multiset α) : (a ::ₘ s).fold op b = s.fold op (b * a) :=
by rw [fold_eq_foldl, foldl_cons, ← fold_eq_foldl]

theorem fold_cons'_left (b a : α) (s : multiset α) : (a ::ₘ s).fold op b = s.fold op (a * b) :=
by rw [fold_cons'_right, hc.comm]

theorem fold_add (b₁ b₂ : α) (s₁ s₂ : multiset α) :
  (s₁ + s₂).fold op (b₁ * b₂) = s₁.fold op b₁ * s₂.fold op b₂ :=
multiset.induction_on s₂
  (by rw [add_zero, fold_zero, ← fold_cons'_right, ← fold_cons_right op])
  (by simp {contextual := tt}; cc)

theorem fold_singleton (b a : α) : ({a} : multiset α).fold op b = a * b := foldr_singleton _ _ _ _

theorem fold_distrib {f g : β → α} (u₁ u₂ : α) (s : multiset β) :
  (s.map (λx, f x * g x)).fold op (u₁ * u₂) = (s.map f).fold op u₁ * (s.map g).fold op u₂ :=
multiset.induction_on s (by simp) (by simp {contextual := tt}; cc)

theorem fold_hom {op' : β → β → β} [is_commutative β op'] [is_associative β op']
  {m : α → β} (hm : ∀x y, m (op x y) = op' (m x) (m y)) (b : α) (s : multiset α) :
  (s.map m).fold op' (m b) = m (s.fold op b) :=
multiset.induction_on s (by simp) (by simp [hm] {contextual := tt})

theorem fold_union_inter [decidable_eq α] (s₁ s₂ : multiset α) (b₁ b₂ : α) :
  (s₁ ∪ s₂).fold op b₁ * (s₁ ∩ s₂).fold op b₂ = s₁.fold op b₁ * s₂.fold op b₂ :=
by rw [← fold_add op, union_add_inter, fold_add op]

@[simp] theorem fold_dedup_idem [decidable_eq α] [hi : is_idempotent α op] (s : multiset α)
  (b : α) :
  (dedup s).fold op b = s.fold op b :=
multiset.induction_on s (by simp) $ λ a s IH, begin
  by_cases a ∈ s; simp [IH, h],
  show fold op b s = op a (fold op b s),
  rw [← cons_erase h, fold_cons_left, ← ha.assoc, hi.idempotent],
end

end fold

section order

lemma max_le_of_forall_le {α : Type*} [canonically_linear_ordered_add_monoid α]
  (l : multiset α) (n : α) (h : ∀ (x ∈ l), x ≤ n) :
  l.fold max ⊥ ≤ n :=
begin
  induction l using quotient.induction_on,
  simpa using list.max_le_of_forall_le _ _ h
end

lemma max_nat_le_of_forall_le (l : multiset ℕ) (n : ℕ) (h : ∀ (x ∈ l), x ≤ n) :
  l.fold max 0 ≤ n :=
max_le_of_forall_le l n h

end order

open nat

theorem le_smul_dedup [decidable_eq α] (s : multiset α) :
  ∃ n : ℕ, s ≤ n • dedup s :=
⟨(s.map (λ a, count a s)).fold max 0, le_iff_count.2 $ λ a, begin
  rw count_nsmul, by_cases a ∈ s,
  { refine le_trans _ (nat.mul_le_mul_left _ $ count_pos.2 $ mem_dedup.2 h),
    have : count a s ≤ fold max 0 (map (λ a, count a s) (a ::ₘ erase s a));
    [simp [le_max_left], simpa [cons_erase h]] },
  { simp [count_eq_zero.2 h, nat.zero_le] }
end⟩

end multiset


import algebra.field
import gtm106.weierstrass_equation.linear_change_of_variable
import gtm106.weierstrass_equation.intersection_with_line.basic
import tactic

def linear_change_of_variable.change_intersection_with_line
{K : Type*} [field K] (cov : linear_change_of_variable K)
(L : weierstrass_equation.intersection_with_line K)
: weierstrass_equation.intersection_with_line K
:= ⟨ cov.change_curve L.E, (L.A - cov.s) / cov.u, (L.B + L.A * cov.r - cov.t) / cov.u ^ 3 ⟩

def linear_change_of_variable.change_x
{K : Type*} [field K] (cov : linear_change_of_variable K)
(x : K) : K
:= x / cov.u ^ 2 - cov.r / cov.u ^ 2

namespace weierstrass_equation

namespace intersection_with_line

def from_point_lcov {K : Type*} [field K]
(E : weierstrass_equation K)
(P : affine_plane_point K)
(A : K) (cov : linear_change_of_variable K)
: from_point (cov.change_curve E) (cov.change_affine_point P) ((A - cov.s) / cov.u)
= cov.change_intersection_with_line (from_point E P A) :=
begin
  simp [from_point, linear_change_of_variable.change_intersection_with_line,
    linear_change_of_variable.change_affine_point],
  field_simp,
  ring,
end

lemma point_lcov {K : Type*} [field K]
(L : intersection_with_line K) (cov : linear_change_of_variable K)
(x : K)
: (cov.change_intersection_with_line L).point (cov.change_x x)
= cov.change_affine_point (L.point x) :=
begin
  simp only [linear_change_of_variable.change_intersection_with_line,
    linear_change_of_variable.change_affine_point,
    linear_change_of_variable.change_x,
    point],
  split, { refl, },
  field_simp,
  ring,
end

@[simp]
lemma a_lcov {K : Type*} [field K]
(L : intersection_with_line K) (cov : linear_change_of_variable K)
: (cov.change_intersection_with_line L).a
= (L.a + 3 * cov.r) / cov.u ^ 2 :=
begin
  simp only [linear_change_of_variable.change_intersection_with_line,
    linear_change_of_variable.change_curve,
    a],
  field_simp,
  ring,
end

@[simp]
lemma b_lcov {K : Type*} [field K]
(L : intersection_with_line K) (cov : linear_change_of_variable K)
: (cov.change_intersection_with_line L).b
= (L.b + 2 * L.a * cov.r + 3 * cov.r ^ 2) / cov.u ^ 4 :=
begin
  unfold b,
  simp only [linear_change_of_variable.change_intersection_with_line,
    linear_change_of_variable.change_curve,
    a],
  field_simp,
  ring,
end

@[simp]
lemma c_lcov {K : Type*} [field K]
(L : intersection_with_line K) (cov : linear_change_of_variable K)
: (cov.change_intersection_with_line L).c
= (L.c + L.b * cov.r + L.a * cov.r ^ 2 + cov.r ^ 3) / cov.u ^ 6 :=
begin
  unfold c,
  simp only [linear_change_of_variable.change_intersection_with_line,
    linear_change_of_variable.change_curve,
    b, a],
  field_simp,
  ring,
end

@[simp]
lemma disc_lcov {K : Type*} [field K]
(L : intersection_with_line K) (cov : linear_change_of_variable K)
: (cov.change_intersection_with_line L).poly.disc
= L.poly.disc / cov.u ^ 12
:=
begin
  simp only [poly, a_lcov, b_lcov, c_lcov,
    monic_cubic_poly.disc],
  field_simp [cov.hu, pow_succ],
  ring,
end

@[simp]
lemma eval_at_lcov {K : Type*} [field K]
(L : intersection_with_line K) (cov : linear_change_of_variable K)
(x : K)
: (cov.change_intersection_with_line L).poly.eval_at (cov.change_x x)
= L.poly.eval_at x / cov.u ^ 6 :=
begin
  simp only [poly, monic_cubic_poly.eval_at,
    a_lcov, b_lcov, c_lcov, linear_change_of_variable.change_x],
  field_simp [cov.hu, pow_succ],
  ring,
end

@[simp]
lemma eval_dx_at_lcov {K : Type*} [field K]
(L : intersection_with_line K) (cov : linear_change_of_variable K)
(x : K)
: (cov.change_intersection_with_line L).poly.eval_dx_at (cov.change_x x)
= L.poly.eval_dx_at x / cov.u ^ 4 :=
begin
  simp only [poly, monic_cubic_poly.eval_dx_at,
    a_lcov, b_lcov, c_lcov, linear_change_of_variable.change_x],
  field_simp [cov.hu, pow_succ],
  ring,
end

lemma is_on_lcov {K : Type*} [field K]
(L : intersection_with_line K) (cov : linear_change_of_variable K)
(x : K)
: (cov.change_intersection_with_line L).poly.is_root (cov.change_x x)
↔ L.poly.is_root x :=
begin
  unfold monic_cubic_poly.is_root,
  simp,
end

lemma is_on_2_lcov {K : Type*} [field K]
(L : intersection_with_line K) (cov : linear_change_of_variable K)
(x : K)
: (cov.change_intersection_with_line L).poly.is_multiple_root (cov.change_x x)
↔ L.poly.is_multiple_root x :=
begin
  unfold monic_cubic_poly.is_multiple_root,
  simp,
end

end intersection_with_line

end weierstrass_equation