/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.set.intervals.basic
import Mathlib.data.set.lattice
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Intervals in `pi`-space

In this we prove various simple lemmas about intervals in `Π i, α i`. Closed intervals (`Ici x`,
`Iic x`, `Icc x y`) are equal to products of their projections to `α i`, while (semi-)open intervals
usually include the corresponding products as proper subsets.
-/

namespace set

@[simp] theorem pi_univ_Ici {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → preorder (α i)]
    (x : (i : ι) → α i) : (pi univ fun (i : ι) => Ici (x i)) = Ici x :=
  sorry

@[simp] theorem pi_univ_Iic {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → preorder (α i)]
    (x : (i : ι) → α i) : (pi univ fun (i : ι) => Iic (x i)) = Iic x :=
  sorry

@[simp] theorem pi_univ_Icc {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → preorder (α i)]
    (x : (i : ι) → α i) (y : (i : ι) → α i) : (pi univ fun (i : ι) => Icc (x i) (y i)) = Icc x y :=
  sorry

theorem pi_univ_Ioi_subset {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → preorder (α i)]
    (x : (i : ι) → α i) [Nonempty ι] : (pi univ fun (i : ι) => Ioi (x i)) ⊆ Ioi x :=
  sorry

theorem pi_univ_Iio_subset {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → preorder (α i)]
    (x : (i : ι) → α i) [Nonempty ι] : (pi univ fun (i : ι) => Iio (x i)) ⊆ Iio x :=
  pi_univ_Ioi_subset x

theorem pi_univ_Ioo_subset {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → preorder (α i)]
    (x : (i : ι) → α i) (y : (i : ι) → α i) [Nonempty ι] :
    (pi univ fun (i : ι) => Ioo (x i) (y i)) ⊆ Ioo x y :=
  fun (x_1 : (i : ι) → α i) (hx : x_1 ∈ pi univ fun (i : ι) => Ioo (x i) (y i)) =>
    { left :=
        pi_univ_Ioi_subset (fun (i : ι) => x i) fun (i : ι) (hi : i ∈ univ) => and.left (hx i hi),
      right :=
        pi_univ_Iio_subset (fun (i : ι) => y i) fun (i : ι) (hi : i ∈ univ) => and.right (hx i hi) }

theorem pi_univ_Ioc_subset {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → preorder (α i)]
    (x : (i : ι) → α i) (y : (i : ι) → α i) [Nonempty ι] :
    (pi univ fun (i : ι) => Ioc (x i) (y i)) ⊆ Ioc x y :=
  fun (x_1 : (i : ι) → α i) (hx : x_1 ∈ pi univ fun (i : ι) => Ioc (x i) (y i)) =>
    { left :=
        pi_univ_Ioi_subset (fun (i : ι) => x i) fun (i : ι) (hi : i ∈ univ) => and.left (hx i hi),
      right := fun (i : ι) => and.right (hx i trivial) }

theorem pi_univ_Ico_subset {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → preorder (α i)]
    (x : (i : ι) → α i) (y : (i : ι) → α i) [Nonempty ι] :
    (pi univ fun (i : ι) => Ico (x i) (y i)) ⊆ Ico x y :=
  fun (x_1 : (i : ι) → α i) (hx : x_1 ∈ pi univ fun (i : ι) => Ico (x i) (y i)) =>
    { left := fun (i : ι) => and.left (hx i trivial),
      right :=
        pi_univ_Iio_subset (fun (i : ι) => y i) fun (i : ι) (hi : i ∈ univ) => and.right (hx i hi) }

theorem pi_univ_Ioc_update_left {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → preorder (α i)]
    [DecidableEq ι] {x : (i : ι) → α i} {y : (i : ι) → α i} {i₀ : ι} {m : α i₀} (hm : x i₀ ≤ m) :
    (pi univ fun (i : ι) => Ioc (function.update x i₀ m i) (y i)) =
        (set_of fun (z : (i : ι) → α i) => m < z i₀) ∩ pi univ fun (i : ι) => Ioc (x i) (y i) :=
  sorry

theorem pi_univ_Ioc_update_right {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → preorder (α i)]
    [DecidableEq ι] {x : (i : ι) → α i} {y : (i : ι) → α i} {i₀ : ι} {m : α i₀} (hm : m ≤ y i₀) :
    (pi univ fun (i : ι) => Ioc (x i) (function.update y i₀ m i)) =
        (set_of fun (z : (i : ι) → α i) => z i₀ ≤ m) ∩ pi univ fun (i : ι) => Ioc (x i) (y i) :=
  sorry

theorem disjoint_pi_univ_Ioc_update_left_right {ι : Type u_1} {α : ι → Type u_2}
    [(i : ι) → preorder (α i)] [DecidableEq ι] {x : (i : ι) → α i} {y : (i : ι) → α i} {i₀ : ι}
    {m : α i₀} :
    disjoint (pi univ fun (i : ι) => Ioc (x i) (function.update y i₀ m i))
        (pi univ fun (i : ι) => Ioc (function.update x i₀ m i) (y i)) :=
  sorry

theorem pi_univ_Ioc_update_union {ι : Type u_1} {α : ι → Type u_2} [DecidableEq ι]
    [(i : ι) → linear_order (α i)] (x : (i : ι) → α i) (y : (i : ι) → α i) (i₀ : ι) (m : α i₀)
    (hm : m ∈ Icc (x i₀) (y i₀)) :
    ((pi univ fun (i : ι) => Ioc (x i) (function.update y i₀ m i)) ∪
          pi univ fun (i : ι) => Ioc (function.update x i₀ m i) (y i)) =
        pi univ fun (i : ι) => Ioc (x i) (y i) :=
  sorry

/-- If `x`, `y`, `x'`, and `y'` are functions `Π i : ι, α i`, then
the set difference between the box `[x, y]` and the product of the open intervals `(x' i, y' i)`
is covered by the union of the following boxes: for each `i : ι`, we take
`[x, update y i (x' i)]` and `[update x i (y' i), y]`.

E.g., if `x' = x` and `y' = y`, then this lemma states that the difference between a closed box
`[x, y]` and the corresponding open box `{z | ∀ i, x i < z i < y i}` is covered by the union
of the faces of `[x, y]`. -/
theorem Icc_diff_pi_univ_Ioo_subset {ι : Type u_1} {α : ι → Type u_2} [DecidableEq ι]
    [(i : ι) → linear_order (α i)] (x : (i : ι) → α i) (y : (i : ι) → α i) (x' : (i : ι) → α i)
    (y' : (i : ι) → α i) :
    (Icc x y \ pi univ fun (i : ι) => Ioo (x' i) (y' i)) ⊆
        (Union fun (i : ι) => Icc x (function.update y i (x' i))) ∪
          Union fun (i : ι) => Icc (function.update x i (y' i)) y :=
  sorry

/-- If `x`, `y`, `z` are functions `Π i : ι, α i`, then
the set difference between the box `[x, z]` and the product of the intervals `(y i, z i]`
is covered by the union of the boxes `[x, update z i (y i)]`.

E.g., if `x = y`, then this lemma states that the difference between a closed box
`[x, y]` and the product of half-open intervals `{z | ∀ i, x i < z i ≤ y i}` is covered by the union
of the faces of `[x, y]` adjacent to `x`. -/
theorem Icc_diff_pi_univ_Ioc_subset {ι : Type u_1} {α : ι → Type u_2} [DecidableEq ι]
    [(i : ι) → linear_order (α i)] (x : (i : ι) → α i) (y : (i : ι) → α i) (z : (i : ι) → α i) :
    (Icc x z \ pi univ fun (i : ι) => Ioc (y i) (z i)) ⊆
        Union fun (i : ι) => Icc x (function.update z i (y i)) :=
  sorry

end Mathlib


import category_theory.abelian.homology
import algebra.homology.homotopy
import for_mathlib.homological_complex_op

open category_theory
open category_theory.limits

namespace homotopy

universes v u
variables {M : Type*} {c : complex_shape M}
  (A : Type u) [category.{v} A] [abelian A]

variables (C₁ C₂ : homological_complex A c) (f₁ f₂ : C₁ ⟶ C₂)

lemma kernel_ι_comp_comp_cokernel_π_of_homotopy (h : homotopy f₁ f₂) (i : M) :
  kernel.ι (C₁.d_from i) ≫ f₁.f i ≫ cokernel.π (C₂.d_to i) =
  kernel.ι _ ≫ f₂.f i ≫ cokernel.π _ :=
begin
  have := h.comm i,
  apply_fun (λ e, kernel.ι (C₁.d_from i) ≫ e ≫ cokernel.π (C₂.d_to i)) at this,
  simpa using this,
end

def homotopy_unop_functor_right_op_map_unop_of_homotopy
  (C₁ C₂ : homological_complex Aᵒᵖ c) (f₁ f₂ : C₁ ⟶ C₂) (h : homotopy f₁ f₂) :
  homotopy
    (homological_complex.unop_functor.right_op.map f₁).unop
    (homological_complex.unop_functor.right_op.map f₂).unop :=
{ hom := λ i j, (h.hom _ _).unop,
  zero' := λ i j hh, begin
    let z := _, change _ = z, rw ← z.unop_op,
    congr' 1,
    exact h.zero _ _ hh,
  end,
  comm := begin
    intros i,
    dsimp,
    rw h.comm i,
    simp only [unop_add, unop_comp, add_left_inj],
    rw add_comm, refl,
  end }

end homotopy


open bool
constant true_is_false : tt = ff

example : false := begin
    have n: tt = ff, from true_is_false,
    have m: tt ≠ ff, begin
        cases n
    end,
    contradiction
end

#print axioms


import parlang.defs

namespace parlang
namespace thread_state
variables {n : ℕ} {σ : Type} {ι : Type} {τ : ι → Type} [decidable_eq ι]

lemma store_accesses {ts : thread_state σ τ} {i} : i ∉ accesses ts → i ∉ stores ts := begin
  unfold accesses,
  rw [set.mem_union, not_or_distrib],
  intros h,
  cases h,
  trivial,
end

lemma loads_accesses {ts : thread_state σ τ} {i} : i ∉ accesses ts → i ∉ loads ts := begin
  unfold accesses,
  rw [set.mem_union, not_or_distrib],
  intro h,
  cases h,
  trivial,
end

@[simp]
lemma compute_id : @thread_state.compute σ _ τ _ id = id := begin
  funext ts,
  cases ts,
  simp [thread_state.compute],
end

#print store._match_1

lemma store_intro (f : σ → (Σi:ι, τ i)) (t : thread_state σ τ) : store f t = { shared := t.shared.update (f t.tlocal).1 (f t.tlocal).2,
  stores := insert (f t.tlocal).1 t.stores,
  .. t} := begin
  sorry,
end

/-- TODO: rename to store_compute_comm -/
lemma thread_state_map {f : thread_state σ τ → thread_state σ τ} {g h} : f ∘ thread_state.store g ∘ thread_state.compute h = f ∘ thread_state.compute h ∘ thread_state.store (λ s, g (h s)) := begin
  funext,
  simp,
  unfold compute,
  cases x,
  rw store_intro,
  rw store_intro,
end

/-- TODO: rename to store_compute_comm' -/
lemma thread_state_map' {g : σ → Σ (i : ι), τ i} {h} : thread_state.store g ∘ thread_state.compute h = thread_state.compute h ∘ thread_state.store (λ s, g (h s)) := begin
  funext,
  simp,
  unfold compute,
  cases x,
  rw store_intro,
  rw store_intro,
end

end thread_state
end parlang


structure X :=
  ( x : nat )

definition S ( a : X ) : X := { x := a.x }

definition f ( a : X ) ( n : nat ) : nat := 1

lemma foo ( a : X ) : f (S a) (S a).x = 0 :=
begin
  -- I want a tactic that will unfold `(S a).x` to `a.x`, but leave the other `(S a)` entirely alone.

-- Use transitivity for first simplification
  transitivity,
  { -- Select subterm
    apply congr_arg (f (S a)),
    -- Unfold S
    unfold S,
    -- Resolve meta variable
    refl,
  },
  dsimp,
  -- admit,
end


import topology.continuous_function.compact

import for_mathlib.SemiNormedGroup

import locally_constant.completion_aux
import free_pfpng.main
import prop819
.

noncomputable theory

universes u

open category_theory opposite ProFiltPseuNormGrp₁
open function (surjective)
open_locale nnreal

variables (S : Profinite.{u})
variables (V : SemiNormedGroup.{u}) [complete_space V] [separated_space V]
variables (V' : Type u) [normed_group V'] [complete_space V']

def LCC : Profinite.{u}ᵒᵖ ⥤ Ab.{u} :=
SemiNormedGroup.LCC.obj V ⋙ forget₂ _ _

local attribute [instance] locally_constant.semi_normed_group locally_constant.pseudo_metric_space

open uniform_space

lemma continuous_map.bdd_above_range_norm (f : C(S, V')) :
  bdd_above (set.range (λ (s : ↥S), ∥f s∥)) :=
(is_compact_range $ continuous_norm.comp f.continuous).bdd_above

def Condensed.of_top_ab_map_normed_group_hom {S T : Profinite.{u}ᵒᵖ} (f : S ⟶ T) :
  normed_group_hom C(_, V') C(_, V') :=
{ to_fun := (Condensed.of_top_ab.presheaf.{u} V').map f,
  map_add' := λ _ _, add_monoid_hom.map_add _ _ _,
  bound' := begin
    refine ⟨1, λ g, _⟩,
    rw [one_mul, continuous_map.norm_eq_supr_norm],
    casesI is_empty_or_nonempty.{u+1} (unop T : Profinite),
    { simp only [real.csupr_empty], apply norm_nonneg },
    apply csupr_le,
    intro s,
    rw [continuous_map.norm_eq_supr_norm],
    exact le_csupr (continuous_map.bdd_above_range_norm _ _ _) (f.unop s),
  end }

lemma Condensed.of_top_ab_map_continuous {S T : Profinite.{u}ᵒᵖ} (f : S ⟶ T) :
  @continuous C(_, V') C(_, V') _ _
    ((Condensed.of_top_ab.presheaf.{u} V').map f) :=
(Condensed.of_top_ab_map_normed_group_hom V' f).continuous

lemma locally_constant.to_continuous_map_isometry :
  isometry (locally_constant.to_continuous_map : locally_constant S V' → C(S, V')) :=
begin
  intros f g,
  simp only [edist_dist, dist_eq_norm, continuous_map.norm_eq_supr_norm,
    locally_constant.norm_def, locally_constant.to_continuous_map_eq_coe,
    continuous_map.coe_sub, locally_constant.coe_continuous_map, pi.sub_apply],
  refl,
end

lemma locally_constant.to_continuous_map_uniform_inducing :
  uniform_inducing (locally_constant.to_continuous_map : locally_constant S V' → C(S, V')) :=
(locally_constant.to_continuous_map_isometry S V').uniform_inducing

lemma locally_constant.to_continuous_map_uniform_continuous :
  uniform_continuous (locally_constant.to_continuous_map : locally_constant S V' → C(S, V')) :=
(locally_constant.to_continuous_map_uniform_inducing S V').uniform_continuous

lemma locally_constant.to_continuous_map_dense_range :
  dense_range (locally_constant.to_continuous_map : locally_constant S V' → C(S, V')) :=
locally_constant.density.loc_const_dense _

def locally_constant.pkg : abstract_completion (locally_constant S V') :=
{ space := C(S, V'),
  coe := locally_constant.to_continuous_map,
  uniform_struct := by apply_instance,
  complete := by apply_instance,
  separation := by apply_instance,
  uniform_inducing := locally_constant.to_continuous_map_uniform_inducing S V',
  dense := locally_constant.to_continuous_map_dense_range S V', }

def LCC_iso_Cond_of_top_ab_equiv :
  completion (locally_constant S V') ≃ C(S, V') :=
(@completion.cpkg (locally_constant S V') _).compare_equiv (locally_constant.pkg S V')

def LCC_iso_Cond_of_top_ab_add_equiv :
  completion (locally_constant S V') ≃+ C(S, V') :=
{ to_fun := completion.extension locally_constant.to_continuous_map,
  map_add' := begin
    intros f g,
    apply completion.induction_on₂ f g,
    { apply is_closed_eq,
      { exact completion.continuous_extension.comp continuous_add },
      { exact (completion.continuous_extension.comp continuous_fst).add
              (completion.continuous_extension.comp continuous_snd), } },
    { clear f g, intros f g,
      rw [← completion.coe_add,
        completion.extension_coe, completion.extension_coe, completion.extension_coe],
      { refl },
      all_goals { apply locally_constant.to_continuous_map_uniform_continuous } }
  end,
  .. LCC_iso_Cond_of_top_ab_equiv S V' }

lemma LCC_iso_Cond_of_top_ab_natural {S T : Profinite.{u}} (f : S ⟶ T) :
  LCC_iso_Cond_of_top_ab_add_equiv S V' ∘
  completion.map (locally_constant.comap f) =
  (Condensed.of_top_ab.presheaf.{u} V').map f.op ∘
  LCC_iso_Cond_of_top_ab_add_equiv T V' :=
begin
  dsimp [LCC_iso_Cond_of_top_ab_add_equiv],
  apply completion.ext,
  { refine completion.continuous_extension.comp completion.continuous_map, },
  { refine (Condensed.of_top_ab_map_continuous _ _).comp completion.continuous_extension, },
  intro g,
  ext s,
  simp only [function.comp_app],
  rw [completion.map_coe, completion.extension_coe, completion.extension_coe,
    locally_constant.to_continuous_map_eq_coe, locally_constant.coe_continuous_map,
    locally_constant.to_continuous_map_eq_coe, locally_constant.coe_comap],
  { refl },
  { exact f.continuous },
  { apply locally_constant.to_continuous_map_uniform_continuous },
  { apply locally_constant.to_continuous_map_uniform_continuous },
  { exact (locally_constant.comap_hom f f.2).uniform_continuous, }
end

def LCC_iso_Cond_of_top_ab :
  LCC.{u} V ≅ Condensed.of_top_ab.presheaf.{u} V :=
nat_iso.of_components
  (λ S, add_equiv.to_AddCommGroup_iso $ LCC_iso_Cond_of_top_ab_add_equiv (unop S) V)
  begin
    intros S T f,
    ext1 φ,
    have := LCC_iso_Cond_of_top_ab_natural V f.unop,
    convert congr_fun this φ using 1,
    clear this,
    delta LCC SemiNormedGroup.LCC,
    simp only [add_equiv.to_AddCommGroup_iso_hom, category_theory.comp_apply,
      add_equiv.coe_to_add_monoid_hom, add_equiv.apply_eq_iff_eq,
      functor.comp_map, curry.obj_obj_map, uncurry.obj_map,
      category_theory.functor.map_id, nat_trans.id_app,
      SemiNormedGroup.LocallyConstant_obj_map,
      SemiNormedGroup.Completion_map],
    erw [category.id_comp],
    refl,
  end

def Condensed_LCC : Condensed.{u} Ab.{u+1} :=
{ val := LCC.{u} V ⋙ Ab.ulift.{u+1},
  cond := begin
    let e := LCC_iso_Cond_of_top_ab V,
    let e' := iso_whisker_right e Ab.ulift.{u+1},
    apply presheaf.is_sheaf_of_iso proetale_topology.{u} e',
    exact (Condensed.of_top_ab _).2,
  end }

def Condensed_LCC_iso_of_top_ab :
  Condensed_LCC V ≅ Condensed.of_top_ab V :=
Sheaf.iso.mk _ _ $ iso_whisker_right (LCC_iso_Cond_of_top_ab _) _


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import topology.algebra.monoid
import algebra.module.prod
import topology.homeomorph

/-!
# Continuous monoid action

In this file we define class `has_continuous_smul`. We say `has_continuous_smul M α` if `M` acts on
`α` and the map `(c, x) ↦ c • x` is continuous on `M × α`. We reuse this class for topological
(semi)modules, vector spaces and algebras.

## Main definitions

* `has_continuous_smul M α` : typeclass saying that the map `(c, x) ↦ c • x` is continuous
  on `M × α`;
* `homeomorph.smul_of_unit`: scalar multiplication by a unit of `M` as a homeomorphism of `α`;
* `homeomorph.smul_of_ne_zero`: if a group with zero `G₀` (e.g., a field) acts on `α` and `c : G₀`
  is a nonzero element of `G₀`, then scalar multiplication by `c` is a homeomorphism of `α`;
* `homeomorph.smul`: scalar multiplication by an element of a group `G` acting on `α`
  is a homeomorphism of `α`.

## Main results

Besides homeomorphisms mentioned above, in this file we provide lemmas like `continuous.smul`
or `filter.tendsto.smul` that provide dot-syntax access to `continuous_smul`.
-/

open_locale topological_space
open filter

/-- Class `has_continuous_smul M α` says that the scalar multiplication `(•) : M → α → α`
is continuous in both arguments. We use the same class for all kinds of multiplicative actions,
including (semi)modules and algebras. -/
class has_continuous_smul (M α : Type*) [has_scalar M α]
  [topological_space M] [topological_space α] : Prop :=
(continuous_smul : continuous (λp : M × α, p.1 • p.2))

export has_continuous_smul (continuous_smul)

variables {M α β : Type*} [topological_space M] [topological_space α]

section has_scalar

variables [has_scalar M α] [has_continuous_smul M α]

lemma filter.tendsto.smul {f : β → M} {g : β → α} {l : filter β} {c : M} {a : α}
  (hf : tendsto f l (𝓝 c)) (hg : tendsto g l (𝓝 a)) :
  tendsto (λ x, f x • g x) l (𝓝 $ c • a) :=
(continuous_smul.tendsto _).comp (hf.prod_mk_nhds hg)

lemma filter.tendsto.const_smul {f : β → α} {l : filter β} {a : α} (hf : tendsto f l (𝓝 a))
  (c : M) :
  tendsto (λ x, c • f x) l (𝓝 (c • a)) :=
tendsto_const_nhds.smul hf

lemma filter.tendsto.smul_const {f : β → M} {l : filter β} {c : M}
  (hf : tendsto f l (𝓝 c)) (a : α) :
  tendsto (λ x, (f x) • a) l (𝓝 (c • a)) :=
hf.smul tendsto_const_nhds

variables [topological_space β] {f : β → M} {g : β → α} {b : β} {s : set β}

lemma continuous_within_at.smul (hf : continuous_within_at f s b)
  (hg : continuous_within_at g s b) :
  continuous_within_at (λ x, f x • g x) s b :=
hf.smul hg

lemma continuous_within_at.const_smul (hg : continuous_within_at g s b) (c : M) :
  continuous_within_at (λ x, c • g x) s b :=
hg.const_smul c

lemma continuous_at.smul (hf : continuous_at f b) (hg : continuous_at g b) :
  continuous_at (λ x, f x • g x) b :=
hf.smul hg

lemma continuous_at.const_smul (hg : continuous_at g b) (c : M) :
  continuous_at (λ x, c • g x) b :=
hg.const_smul c

lemma continuous_on.smul (hf : continuous_on f s) (hg : continuous_on g s) :
  continuous_on (λ x, f x • g x) s :=
λ x hx, (hf x hx).smul (hg x hx)

lemma continuous_on.const_smul (hg : continuous_on g s) (c : M) :
  continuous_on (λ x, c • g x) s :=
λ x hx, (hg x hx).const_smul c

@[continuity]
lemma continuous.smul (hf : continuous f) (hg : continuous g) :
  continuous (λ x, f x • g x) :=
continuous_smul.comp (hf.prod_mk hg)

lemma continuous.const_smul (hg : continuous g) (c : M) :
  continuous (λ x, c • g x) :=
continuous_smul.comp (continuous_const.prod_mk hg)

end has_scalar

section monoid

variables [monoid M] [mul_action M α] [has_continuous_smul M α]

lemma units.tendsto_const_smul_iff {f : β → α} {l : filter β} {a : α} (u : units M) :
  tendsto (λ x, (u : M) • f x) l (𝓝 $ (u : M) • a) ↔ tendsto f l (𝓝 a) :=
⟨λ h, by simpa only [u.inv_smul_smul] using h.const_smul ((u⁻¹ : units M) : M),
  λ h, h.const_smul _⟩

lemma is_unit.tendsto_const_smul_iff {f : β → α} {l : filter β} {a : α} {c : M} (hc : is_unit c) :
  tendsto (λ x, c • f x) l (𝓝 $ c • a) ↔ tendsto f l (𝓝 a) :=
let ⟨u, hu⟩ := hc in hu ▸ u.tendsto_const_smul_iff

variables [topological_space β] {f : β → α} {b : β} {c : M} {s : set β}

lemma is_unit.continuous_within_at_const_smul_iff (hc : is_unit c) :
  continuous_within_at (λ x, c • f x) s b ↔ continuous_within_at f s b :=
hc.tendsto_const_smul_iff

lemma is_unit.continuous_on_const_smul_iff (hc : is_unit c) :
  continuous_on (λ x, c • f x) s ↔ continuous_on f s :=
forall_congr $ λ b, forall_congr $ λ hb, hc.continuous_within_at_const_smul_iff

lemma is_unit.continuous_at_const_smul_iff (hc : is_unit c) :
  continuous_at (λ x, c • f x) b ↔ continuous_at f b :=
hc.tendsto_const_smul_iff

lemma is_unit.continuous_const_smul_iff (hc : is_unit c) :
  continuous (λ x, c • f x) ↔ continuous f :=
by simp only [continuous_iff_continuous_at, hc.continuous_at_const_smul_iff]

/-- Scalar multiplication by a unit of a monoid `M` acting on `α` is a homeomorphism from `α`
to itself. -/
protected def homeomorph.smul_of_unit (u : units M) : α ≃ₜ α :=
{ to_equiv := units.smul_perm_hom u,
  continuous_to_fun  := continuous_id.const_smul _,
  continuous_inv_fun := continuous_id.const_smul _ }

lemma is_unit.is_open_map_smul (hc : is_unit c) : is_open_map (λ x : α, c • x) :=
let ⟨u, hu⟩ := hc in hu ▸ (homeomorph.smul_of_unit u).is_open_map

lemma is_unit.is_closed_map_smul (hc : is_unit c) : is_closed_map (λ x : α, c • x) :=
let ⟨u, hu⟩ := hc in hu ▸ (homeomorph.smul_of_unit u).is_closed_map

end monoid

section group_with_zero

variables {G₀ : Type*} [topological_space G₀] [group_with_zero G₀] [mul_action G₀ α]
  [has_continuous_smul G₀ α]

lemma tendsto_const_smul_iff' {f : β → α} {l : filter β} {a : α} {c : G₀} (hc : c ≠ 0) :
  tendsto (λ x, c • f x) l (𝓝 $ c • a) ↔ tendsto f l (𝓝 a) :=
(is_unit.mk0 c hc).tendsto_const_smul_iff

variables [topological_space β] {f : β → α} {b : β} {c : G₀} {s : set β}

lemma continuous_within_at_const_smul_iff' (hc : c ≠ 0) :
  continuous_within_at (λ x, c • f x) s b ↔ continuous_within_at f s b :=
(is_unit.mk0 c hc).tendsto_const_smul_iff

lemma continuous_on_const_smul_iff' (hc : c ≠ 0) :
  continuous_on (λ x, c • f x) s ↔ continuous_on f s :=
(is_unit.mk0 c hc).continuous_on_const_smul_iff

lemma continuous_at_const_smul_iff' (hc : c ≠ 0) :
  continuous_at (λ x, c • f x) b ↔ continuous_at f b :=
(is_unit.mk0 c hc).continuous_at_const_smul_iff

lemma continuous_const_smul_iff' (hc : c ≠ 0) :
  continuous (λ x, c • f x) ↔ continuous f :=
(is_unit.mk0 c hc).continuous_const_smul_iff

/-- Scalar multiplication by a non-zero element of a group with zero acting on `α` is a
homeomorphism from `α` onto itself. -/
protected def homeomorph.smul_of_ne_zero (c : G₀) (hc : c ≠ 0) : α ≃ₜ α :=
homeomorph.smul_of_unit (units.mk0 c hc)

lemma is_open_map_smul' {c : G₀} (hc : c ≠ 0) : is_open_map (λ x : α, c • x) :=
(is_unit.mk0 c hc).is_open_map_smul

/-- `smul` is a closed map in the second argument.

The lemma that `smul` is a closed map in the first argument (for a normed space over a complete
normed field) is `is_closed_map_smul_left` in `analysis.normed_space.finite_dimension`. -/
lemma is_closed_map_smul' {c : G₀} (hc : c ≠ 0) : is_closed_map (λ x : α, c • x) :=
(is_unit.mk0 c hc).is_closed_map_smul

end group_with_zero

section group

variables {G : Type*} [topological_space G] [group G] [mul_action G α]
  [has_continuous_smul G α]

lemma tendsto_const_smul_iff {f : β → α} {l : filter β} {a : α} (c : G) :
  tendsto (λ x, c • f x) l (𝓝 $ c • a) ↔ tendsto f l (𝓝 a) :=
(to_units c).tendsto_const_smul_iff

variables [topological_space β] {f : β → α} {b : β}  {s : set β}

lemma continuous_within_at_const_smul_iff (c : G) :
  continuous_within_at (λ x, c • f x) s b ↔ continuous_within_at f s b :=
(group.is_unit c).tendsto_const_smul_iff

lemma continuous_on_const_smul_iff (c : G) :
  continuous_on (λ x, c • f x) s ↔ continuous_on f s :=
(group.is_unit c).continuous_on_const_smul_iff

lemma continuous_at_const_smul_iff (c : G) :
  continuous_at (λ x, c • f x) b ↔ continuous_at f b :=
(group.is_unit c).continuous_at_const_smul_iff

lemma continuous_const_smul_iff (c : G) :
  continuous (λ x, c • f x) ↔ continuous f :=
(group.is_unit c).continuous_const_smul_iff

/-- Scalar multiplication by a unit of a monoid `M` acting on `α` is a homeomorphism from `α`
to itself. -/
protected def homeomorph.smul (c : G) : α ≃ₜ α :=
homeomorph.smul_of_unit (to_units c)

lemma is_open_map_smul (c : G) : is_open_map (λ x : α, c • x) :=
(homeomorph.smul c).is_open_map

lemma is_closed_map_smul (c : G) : is_closed_map (λ x : α, c • x) :=
(homeomorph.smul c).is_closed_map

end group

instance has_continuous_mul.has_continuous_smul {M : Type*} [monoid M]
  [topological_space M] [has_continuous_mul M] :
  has_continuous_smul M M :=
⟨continuous_mul⟩

instance [topological_space β] [has_scalar M α] [has_scalar M β] [has_continuous_smul M α]
  [has_continuous_smul M β] :
  has_continuous_smul M (α × β) :=
⟨(continuous_fst.smul (continuous_fst.comp continuous_snd)).prod_mk
  (continuous_fst.smul (continuous_snd.comp continuous_snd))⟩


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

! This file was ported from Lean 3 source module data.list.lemmas
! leanprover-community/mathlib commit 2ec920d35348cb2d13ac0e1a2ad9df0fdf1a76b4
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Set.Function
import Mathbin.Data.List.Basic

/-! # Some lemmas about lists involving sets

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

Split out from `data.list.basic` to reduce its dependencies.
-/

open List

variable {α β γ : Type _}

namespace List

#print List.injOn_insertNth_index_of_not_mem /-
theorem injOn_insertNth_index_of_not_mem (l : List α) (x : α) (hx : x ∉ l) :
    Set.InjOn (fun k => insertNth k x l) { n | n ≤ l.length } :=
  by
  induction' l with hd tl IH
  · intro n hn m hm h
    simp only [Set.mem_singleton_iff, Set.setOf_eq_eq_singleton, length, nonpos_iff_eq_zero] at
      hn hm
    simp [hn, hm]
  · intro n hn m hm h
    simp only [length, Set.mem_setOf_eq] at hn hm
    simp only [mem_cons_iff, not_or] at hx
    cases n <;> cases m
    · rfl
    · simpa [hx.left] using h
    · simpa [Ne.symm hx.left] using h
    · simp only [true_and_iff, eq_self_iff_true, insert_nth_succ_cons] at h
      rw [Nat.succ_inj']
      refine' IH hx.right _ _ h
      · simpa [Nat.succ_le_succ_iff] using hn
      · simpa [Nat.succ_le_succ_iff] using hm
#align list.inj_on_insert_nth_index_of_not_mem List.injOn_insertNth_index_of_not_mem
-/

/- warning: list.foldr_range_subset_of_range_subset -> List.foldr_range_subset_of_range_subset is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {γ : Type.{u3}} {f : β -> α -> α} {g : γ -> α -> α}, (HasSubset.Subset.{u1} (Set.{u1} (α -> α)) (Set.hasSubset.{u1} (α -> α)) (Set.range.{u1, succ u2} (α -> α) β f) (Set.range.{u1, succ u3} (α -> α) γ g)) -> (forall (a : α), HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) (Set.range.{u1, succ u2} α (List.{u2} β) (List.foldr.{u2, u1} β α f a)) (Set.range.{u1, succ u3} α (List.{u3} γ) (List.foldr.{u3, u1} γ α g a)))
but is expected to have type
  forall {α : Type.{u3}} {β : Type.{u2}} {γ : Type.{u1}} {f : β -> α -> α} {g : γ -> α -> α}, (HasSubset.Subset.{u3} (Set.{u3} (α -> α)) (Set.instHasSubsetSet.{u3} (α -> α)) (Set.range.{u3, succ u2} (α -> α) β f) (Set.range.{u3, succ u1} (α -> α) γ g)) -> (forall (a : α), HasSubset.Subset.{u3} (Set.{u3} α) (Set.instHasSubsetSet.{u3} α) (Set.range.{u3, succ u2} α (List.{u2} β) (List.foldr.{u2, u3} β α f a)) (Set.range.{u3, succ u1} α (List.{u1} γ) (List.foldr.{u1, u3} γ α g a)))
Case conversion may be inaccurate. Consider using '#align list.foldr_range_subset_of_range_subset List.foldr_range_subset_of_range_subsetₓ'. -/
theorem foldr_range_subset_of_range_subset {f : β → α → α} {g : γ → α → α}
    (hfg : Set.range f ⊆ Set.range g) (a : α) : Set.range (foldr f a) ⊆ Set.range (foldr g a) :=
  by
  rintro _ ⟨l, rfl⟩
  induction' l with b l H
  · exact ⟨[], rfl⟩
  · cases' hfg (Set.mem_range_self b) with c hgf
    cases' H with m hgf'
    rw [foldr_cons, ← hgf, ← hgf']
    exact ⟨c :: m, rfl⟩
#align list.foldr_range_subset_of_range_subset List.foldr_range_subset_of_range_subset

/- warning: list.foldl_range_subset_of_range_subset -> List.foldl_range_subset_of_range_subset is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {γ : Type.{u3}} {f : α -> β -> α} {g : α -> γ -> α}, (HasSubset.Subset.{u1} (Set.{u1} (α -> α)) (Set.hasSubset.{u1} (α -> α)) (Set.range.{u1, succ u2} (α -> α) β (fun (a : β) (c : α) => f c a)) (Set.range.{u1, succ u3} (α -> α) γ (fun (b : γ) (c : α) => g c b))) -> (forall (a : α), HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) (Set.range.{u1, succ u2} α (List.{u2} β) (List.foldl.{u1, u2} α β f a)) (Set.range.{u1, succ u3} α (List.{u3} γ) (List.foldl.{u1, u3} α γ g a)))
but is expected to have type
  forall {α : Type.{u3}} {β : Type.{u2}} {γ : Type.{u1}} {f : α -> β -> α} {g : α -> γ -> α}, (HasSubset.Subset.{u3} (Set.{u3} (α -> α)) (Set.instHasSubsetSet.{u3} (α -> α)) (Set.range.{u3, succ u2} (α -> α) β (fun (a : β) (c : α) => f c a)) (Set.range.{u3, succ u1} (α -> α) γ (fun (b : γ) (c : α) => g c b))) -> (forall (a : α), HasSubset.Subset.{u3} (Set.{u3} α) (Set.instHasSubsetSet.{u3} α) (Set.range.{u3, succ u2} α (List.{u2} β) (List.foldl.{u3, u2} α β f a)) (Set.range.{u3, succ u1} α (List.{u1} γ) (List.foldl.{u3, u1} α γ g a)))
Case conversion may be inaccurate. Consider using '#align list.foldl_range_subset_of_range_subset List.foldl_range_subset_of_range_subsetₓ'. -/
theorem foldl_range_subset_of_range_subset {f : α → β → α} {g : α → γ → α}
    (hfg : (Set.range fun a c => f c a) ⊆ Set.range fun b c => g c b) (a : α) :
    Set.range (foldl f a) ⊆ Set.range (foldl g a) :=
  by
  change (Set.range fun l => _) ⊆ Set.range fun l => _
  simp_rw [← foldr_reverse] at hfg⊢
  simp_rw [Set.range_comp _ List.reverse, reverse_involutive.bijective.surjective.range_eq,
    Set.image_univ]
  exact foldr_range_subset_of_range_subset hfg a
#align list.foldl_range_subset_of_range_subset List.foldl_range_subset_of_range_subset

/- warning: list.foldr_range_eq_of_range_eq -> List.foldr_range_eq_of_range_eq is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {γ : Type.{u3}} {f : β -> α -> α} {g : γ -> α -> α}, (Eq.{succ u1} (Set.{u1} (α -> α)) (Set.range.{u1, succ u2} (α -> α) β f) (Set.range.{u1, succ u3} (α -> α) γ g)) -> (forall (a : α), Eq.{succ u1} (Set.{u1} α) (Set.range.{u1, succ u2} α (List.{u2} β) (List.foldr.{u2, u1} β α f a)) (Set.range.{u1, succ u3} α (List.{u3} γ) (List.foldr.{u3, u1} γ α g a)))
but is expected to have type
  forall {α : Type.{u3}} {β : Type.{u2}} {γ : Type.{u1}} {f : β -> α -> α} {g : γ -> α -> α}, (Eq.{succ u3} (Set.{u3} (α -> α)) (Set.range.{u3, succ u2} (α -> α) β f) (Set.range.{u3, succ u1} (α -> α) γ g)) -> (forall (a : α), Eq.{succ u3} (Set.{u3} α) (Set.range.{u3, succ u2} α (List.{u2} β) (List.foldr.{u2, u3} β α f a)) (Set.range.{u3, succ u1} α (List.{u1} γ) (List.foldr.{u1, u3} γ α g a)))
Case conversion may be inaccurate. Consider using '#align list.foldr_range_eq_of_range_eq List.foldr_range_eq_of_range_eqₓ'. -/
theorem foldr_range_eq_of_range_eq {f : β → α → α} {g : γ → α → α} (hfg : Set.range f = Set.range g)
    (a : α) : Set.range (foldr f a) = Set.range (foldr g a) :=
  (foldr_range_subset_of_range_subset hfg.le a).antisymm
    (foldr_range_subset_of_range_subset hfg.ge a)
#align list.foldr_range_eq_of_range_eq List.foldr_range_eq_of_range_eq

/- warning: list.foldl_range_eq_of_range_eq -> List.foldl_range_eq_of_range_eq is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {γ : Type.{u3}} {f : α -> β -> α} {g : α -> γ -> α}, (Eq.{succ u1} (Set.{u1} (α -> α)) (Set.range.{u1, succ u2} (α -> α) β (fun (a : β) (c : α) => f c a)) (Set.range.{u1, succ u3} (α -> α) γ (fun (b : γ) (c : α) => g c b))) -> (forall (a : α), Eq.{succ u1} (Set.{u1} α) (Set.range.{u1, succ u2} α (List.{u2} β) (List.foldl.{u1, u2} α β f a)) (Set.range.{u1, succ u3} α (List.{u3} γ) (List.foldl.{u1, u3} α γ g a)))
but is expected to have type
  forall {α : Type.{u3}} {β : Type.{u2}} {γ : Type.{u1}} {f : α -> β -> α} {g : α -> γ -> α}, (Eq.{succ u3} (Set.{u3} (α -> α)) (Set.range.{u3, succ u2} (α -> α) β (fun (a : β) (c : α) => f c a)) (Set.range.{u3, succ u1} (α -> α) γ (fun (b : γ) (c : α) => g c b))) -> (forall (a : α), Eq.{succ u3} (Set.{u3} α) (Set.range.{u3, succ u2} α (List.{u2} β) (List.foldl.{u3, u2} α β f a)) (Set.range.{u3, succ u1} α (List.{u1} γ) (List.foldl.{u3, u1} α γ g a)))
Case conversion may be inaccurate. Consider using '#align list.foldl_range_eq_of_range_eq List.foldl_range_eq_of_range_eqₓ'. -/
theorem foldl_range_eq_of_range_eq {f : α → β → α} {g : α → γ → α}
    (hfg : (Set.range fun a c => f c a) = Set.range fun b c => g c b) (a : α) :
    Set.range (foldl f a) = Set.range (foldl g a) :=
  (foldl_range_subset_of_range_subset hfg.le a).antisymm
    (foldl_range_subset_of_range_subset hfg.ge a)
#align list.foldl_range_eq_of_range_eq List.foldl_range_eq_of_range_eq

end List


import logic.basic

variables {α β : Type*} {a b : α} {c d : β}

protected lemma iff.ne : (a = b ↔ c = d) → (a ≠ b ↔ c ≠ d) := iff.not


import data.option.basic
import tactic

universe variable u
variables {α : Type u}

class pmagma (α : Type u) :=
(mul : α → α → option α)
infixl ` ⬝ ` := pmagma.mul
infix ` ↓= `:50 := λ x y, x = some y
prefix `↓`:80 := some

abbreviation defined : option α → bool := option.is_some
abbreviation udefined : option α → bool := option.is_none

def pmagma.mmul [pmagma α] : option α → option α → option α
| ↓x ↓y := x ⬝ y
| _ _   := none
instance pm_mul [pmagma α] : has_mul (option α) := {mul := @pmagma.mmul α _}

@[simp] lemma pmagma.none_l [pmagma α] (p : option α) : none * p = none := option.cases_on p rfl (λ _, rfl)
@[simp] lemma pmagma.none_r [pmagma α] (p : option α) : p * none = none := option.cases_on p rfl (λ _, rfl)

lemma str_l [pmagma α] {p q : option α} : defined (p * q) → defined p :=
begin
  contrapose,
  assume (h0 : ¬ defined p),
  have e : p = none, from option.not_is_some_iff_eq_none.mp h0,
  rw e,
  simp,
end

lemma str_r [pmagma α] {p q : option α} : defined (p * q) → defined q :=
begin
  contrapose,
  assume (h0 : ¬ defined q),
  have e : q = none, from option.not_is_some_iff_eq_none.mp h0,
  rw e,
  simp,
end

def tot [pmagma α] (a : α) : Prop := ∀ x : α, defined (↓a * ↓x) = tt

def pmagma.equiv [pmagma α] (a b : option α) : Prop := ∀ x : α, a * ↓x = b * ↓x
infix ` ≃ `:50 := pmagma.equiv

@[refl] lemma pmagma.refl [pmagma α] (a : option α) : a ≃ a := λ x, rfl

@[trans] lemma pmagma.trans [pmagma α] (a b c : option α) (eab : a ≃ b) (ebc : b ≃ c) : a ≃ c :=
by { intros x, rw (eab x), exact ebc x, }

def total_in (A : set α) [pmagma α] : Prop := ∀ {x y}, x ∈ A → y ∈ A → defined (↓x * ↓y)

def extensional_in (A : set α) [pmagma α] : Prop :=
∀ {x y}, x ∈ A → y ∈ A → (∀ z, z ∈ A → ↓x * ↓z = ↓y * ↓z) → x = y

/- Partial Combinatory Algebra -/
class pca (α : Type u) extends pmagma α :=
(k : α)
(k_constant : ∀ x y : α, k ⬝ x * y = x)
(s : α)
(s_defined : ∀ x y : α, defined (s ⬝ x * y))
(s_substitution : ∀ x y z : α, s ⬝ x * y * z = (x ⬝ z) * (y ⬝ z))

namespace pca

variables [pca α]

lemma ktot : tot (k : α) :=
by { intros x, have h : defined (k ⬝ x * x) = tt, { rw k_constant x x, refl, }, exact str_l h, }

lemma stot : tot (s : α) := λ a, str_l (s_defined a a)

def const (x : α) : α := option.get (ktot x)
def subst (x y : α) : α := option.get (s_defined x y)
def subst' (x : α) : α := option.get (stot x)
notation `𝚔` := const
notation `𝚜` := subst
notation `𝚜'` := subst'

@[simp] lemma k_simp (a : α) : ↓k * ↓a = ↓(𝚔 a) := by { simp [const], }
@[simp] lemma s_simp (a b : α) : ↓s * ↓a * ↓b = ↓(𝚜 a b) := by { simp [subst], refl }
@[simp] lemma k_simp0 (a b : α) : ↓(𝚔 a) * ↓b = ↓a := by { rw ← k_simp, exact k_constant _ _, }
@[simp] lemma s_simp0 (a b c : α) : ↓(𝚜 a b) * ↓c = (↓a * ↓c) * (↓b * ↓c) := by { rw ← s_simp, exact s_substitution _ _ _, }
@[simp] lemma s'_simp (a b : α) : ↓(𝚜' a) * ↓b = ↓𝚜 a b := by { simp[subst'], }

def i : α := 𝚜 k k
@[simp] lemma i_simp (a : α) : ↓i * ↓a = ↓a := by { simp [i], }
lemma itot : tot (i : α) := by { intros x, simp, refl, }

class nontotal (α : Type u) [pmagma α] :=
(div0 div1 : α)
(nontot : div0 ⬝ div1 = none)

namespace nontotal

@[simp] lemma nontototal_simp [pmagma α] [nontotal α] : (↓div0 * ↓div1 : option α) = none := nontot

def divergent [nontotal α] : α := 𝚜 (𝚔 div0) (𝚔 div1)
theorem divergent_udefined [nontotal α] (a : α) : udefined (↓divergent * ↓a) = tt := by { simp[divergent], refl, }

theorem k_ne_s [nontotal α] : (k : α) ≠ s :=
begin
  assume e : k = s,
  have e0 : ↓(i : α) = ↓divergent,
  { calc
      ↓(i : α) = ↓k * (↓k * ↓i) * (↓k * ↓divergent) * ↓divergent : by simp
      ...      = ↓s * (↓k * ↓i) * (↓k * ↓divergent) * ↓divergent : by rw e
      ...      = ↓divergent                                      : by simp, },
  have c  : defined (↓(i : α) * ↓k) = tt, { simp, refl, },
  have c0 : defined (↓(i : α) * ↓k) = ff, { rw e0, simp[divergent], },
  show false, from bool_iff_false.mpr c0 c,
end

instance [nontotal α] : nontrivial α := ⟨⟨k, s, k_ne_s⟩⟩

end nontotal

end pca


import polycodable
import npolynomial
import promise
import polysize

variables {α β : Type*}

open ptree.pencodable (encode decode)

theorem fix_time_le {c : code} {x₀ : ptree} {N : ℕ} (b₁ b₂ : ℕ → ℕ) (mb : monotone b₁)
  (h₁ : time_bound c b₁) (h₂ : ∀ {x : ptree}, x ∈ (c.fix_iterator x₀).states → x.sizeof ≤ b₂ x₀.sizeof)
  (hN : N ∈ (c.fix_iterator x₀).time (pfun.pure 1)) :
  ∃ t ∈ c.fix.time x₀, t ≤ (b₁ (b₂ x₀.sizeof)) * N + x₀.sizeof :=
begin
  simp [code.time],
  refine execution.time_le (c.fix_iterator x₀) (b₁ (b₂ x₀.sizeof)) c.time _ _ hN,
  { intros, rw time_dom_iff_eval_dom, change x ∈ c.eval.dom, rw eval_dom_of_time_bound h₁, triv, },
  intros x t hx ht,
  rcases h₁ x with ⟨t, tmp, ht'⟩, cases part.mem_unique ht tmp,
  exact ht'.trans (mb (h₂ hx)),
end

theorem polytime_fix_on_pred {c : code} (pc : polytime c) (pred : set ptree)
  (hs : ∃ p : polynomial ℕ, ∀ {x₀ x : ptree}, x₀ ∈ pred → x ∈ (c.fix_iterator x₀).states → x.sizeof ≤ p.eval x₀.sizeof)
  (hn : ∃ q : polynomial ℕ, ∀ {x₀ : ptree}, x₀ ∈ pred → ∃ N ∈ (c.fix_iterator x₀).time (pfun.pure 1), N ≤ q.eval x₀.sizeof) :
  polytime_promise c.fix pred  :=
begin
  cases pc with f pc, cases hs with p hs, cases hn with q hn, use (f.comp p) * q + polynomial.monomial 1 1, simp,
  intros v hv, rcases hn hv with ⟨N, hN, N_le⟩,
  obtain ⟨t, ht, t_le⟩ := fix_time_le (λ n, f.eval n) (λ n, p.eval n) (monotone_polynomial_nat _) pc (λ _, hs hv) hN,
  refine ⟨t, ht, t_le.trans _⟩, mono*; exact zero_le',
end

theorem polytime_fix {c init : code} (pc : polytime c) (pinit : polytime init)
  (hs : ∃ p : polynomial ℕ, ∀ {x₀ x : ptree}, x ∈ (c.fix_iterator (pinit.to_fun x₀)).states → x.sizeof ≤ p.eval (pinit.to_fun x₀).sizeof)
  (hn : ∃ q : polynomial ℕ, ∀ (x₀ : ptree), ∃ N ∈ (c.fix_iterator (pinit.to_fun x₀)).time (pfun.pure 1), N ≤ q.eval (pinit.to_fun x₀).sizeof) :
  polytime (c.fix.comp init) :=
begin
  have ran_eq : init.eval.ran = set.range pinit.to_fun,
  { ext, simp [pfun.mem_ran_iff, part.get_eq_iff_mem], },
  simpa [← ran_eq, pinit.dom_univ] using polytime_promise_comp (polytime_fix_on_pred pc (set.range pinit.to_fun) _ _) (polytime_promise.univ.mpr pinit),
  { cases hs with p hs, use p, rintros x₀ x' ⟨x, rfl⟩ hx', exact hs hx', },
  { cases hn with q hn, use q, rintros x₀ ⟨x, rfl⟩, apply hn, },
end

-- @[simps]
def mk_iterator {α} (f : α →. bool × α) (x₀ : bool × α) : execution (bool × α) :=
{ next := λ x, if x.1 = tt then (part.some none) else ((f x.2).map some),
  start := x₀ }

@[simp] lemma mk_iterator_some {f : α →. bool × α} {x₀ x x' : bool × α} :
  some x' ∈ (mk_iterator f x₀).next x ↔ x.1 = ff ∧ x' ∈ f x.2 :=
by { simp only [mk_iterator], split_ifs with h, { simp [h], }, rw bool_iff_false at h, simp [-prod.exists, h, and_comm], }

@[simp] lemma mk_iterator_none {f : α →. bool × α} {x₀ x : bool × α} :
  none ∈ (mk_iterator f x₀).next x ↔ x.1 = tt :=
by { simp only [mk_iterator], split_ifs with h; simp [h], }

@[simp] lemma mk_iterator_dom {f : α →. bool × α} {x₀ x : bool × α} :
  ((mk_iterator f x₀).next x).dom ↔ x.1 = tt ∨ (f x.2).dom :=
by simp [mk_iterator, apply_ite part.dom]

@[simp] lemma mk_iterator_start {f : α →. bool × α} {x₀ : bool × α} : (mk_iterator f x₀).start = x₀ := rfl

@[simp] lemma mk_iterator_change_start {f : α →. bool × α} {x₀ x₀' : bool × α} :
  (execution.mk (mk_iterator f x₀).next x₀') = (mk_iterator f x₀') :=
by { ext : 1; simp, refl, }

@[simp] lemma some_eq_ite_none_some {α} (P : Prop) [decidable P] (a b : α) :
  (some a = if P then none else some b) ↔ ¬P ∧ a = b :=
by { split_ifs; simp; tauto, }

@[simp] lemma none_eq_ite_none_some {α} (P : Prop) [decidable P] (b : α) :
  (none = if P then none else some b) ↔ P := by { split_ifs; simpa, }

@[simps]
def code.fix_respects [ptree.pencodable α] (c : code) (f : α → bool × α) (sc : ∀ x : bool × α, c.eval (encode x) = part.some (encode (f x.2))) (x₀ : bool × α) :
  (mk_iterator ↑f x₀) ∼ₛ (c.fix_iterator (encode x₀)) :=
{ rel := λ x ex, ex = encode x,
  dom_iff := λ _ _ _ _, by { rintro rfl, conv_lhs { simp, }, conv_rhs { simp [code.fix_iterator, sc, apply_ite part.dom], }, },
  some_iff := λ x ex x' ex' _ _, by { rintro rfl, cases x, simp [sc], rintros rfl rfl _, exact id, },
  none_iff := λ x ex hx hex, by { rintro rfl, cases x with x₁ x₂, simp [encode], cases x₁; simp, },
  start := rfl }

theorem polytime_fun.eval' {α β} [polycodable α] [polycodable β] (f : α → bool × α) (init : β → bool × α)
  (hf : polytime_fun f) (hinit : polytime_fun init)
  (hs : ∃ p : polynomial ℕ, ∀ {x₀ x}, x ∈ (mk_iterator ↑f (init x₀)).states → (encode x).sizeof ≤ p.eval (encode $ init x₀).sizeof)
  (hn : ∃ q : polynomial ℕ, ∀ x₀, ∃ N ∈ (mk_iterator ↑f (init x₀)).time (pfun.pure 1), N ≤ q.eval (encode $ init x₀).sizeof)
  (g : β → α) (hg : ∀ x, (tt, g x) ∈ (mk_iterator ↑f (init x)).eval) : polytime_fun g :=
begin
  suffices : polytime_fun (λ x, (tt, g x)), { exact polytime_fun.snd.comp this, },
  obtain ⟨c, pc, sc⟩ : polytime_fun (λ x : bool × α, f x.2) := by polyfun,
  let R := code.fix_respects c f sc,
  rw polytime_fun_iff at hinit, rcases hinit with ⟨ci, pci, sci⟩,
  use c.fix.comp ci, split,
  { apply polytime_fix pc pci,
    { cases hs with p hs, simp [sci],
      use p, intros x₀ x hx,
      obtain ⟨x, hy, hrel⟩ := (R (init (decode x₀))).symm.exists_state_of hx,
      simp at hrel, subst hrel, exact hs hy, },
    { cases hn with q hn, simp [sci],
      use q, intros x₀, specialize R (init (decode x₀)), specialize hn (decode x₀),
      simpa [R.time_pure_eq] using hn, } },
  intro x, simp [sci], rw ← code.fix_iterator,
  simpa [part.eq_some_iff] using (R (init x)).mem_eval_of (hg x),
end

@[simps]
def curry_state {α β} (f : β → α → bool × α) (x : β) (y : bool × α) :
  (mk_iterator ↑(f x) y) ∼ₛ (mk_iterator ↑(λ x' : β × α, ((f x'.1 x'.2).1, x'.1, (f x'.1 x'.2).2)) (y.1, x, y.2)) :=
{ rel := λ a b, b = (a.1, x, a.2),
  dom_iff := by { intros, simp, },
  some_iff := λ a b a' b' _ _, by { rintro rfl, simp, rintros _ rfl _ rfl, refl, },
  none_iff := λ a a' _ _, by { rintro rfl, simp, },
  start := rfl }

theorem polytime_fun.eval {α β} [polycodable α] [polycodable β] {f : β → α → bool × α} {init : β → bool × α}
  (hf : polytime_fun₂ f) (hinit : polytime_fun init)
  (hs : ∃ p : polynomial ℕ, ∀ {x₀ x}, x ∈ (mk_iterator ↑(f x₀) (init x₀)).states → (encode x).sizeof ≤ p.eval (encode x₀).sizeof)
  (hn : ∃ q : polynomial ℕ, ∀ x₀, ∃ N ∈ (mk_iterator ↑(f x₀) (init x₀)).time (pfun.pure 1), N ≤ q.eval (encode x₀).sizeof)
  (g : β → α) (hg : ∀ x, (tt, g x) ∈ (mk_iterator ↑(f x) (init x)).eval) : polytime_fun g :=
begin
  suffices : polytime_fun (λ x : β, (x, g x)), { apply polytime_fun.snd.comp this, },
  let R := curry_state f,
  apply polytime_fun.eval' (λ x : β × α, ((f x.1 x.2).1, x.1, (f x.1 x.2).2)) (λ x : β, ((init x).1, x, (init x).2)),
  { polyfun, }, { polyfun, },
  { cases hs with p hs, use p + polynomial.monomial 1 1,
    rintros x₀ ⟨b, x₀', s⟩ H,
    obtain ⟨⟨b', s'⟩, h₁, h₂⟩ := (R x₀ (init x₀)).symm.exists_state_of H,
    simp at h₂, rcases h₂ with ⟨rfl, rfl, rfl⟩,
    specialize hs h₁, simp at hs ⊢,
    ac_change ((encode b).sizeof + (encode s).sizeof + 1) + ((encode x₀').sizeof + 1) ≤ _,
    mono, { refine hs.trans _, apply monotone_polynomial_nat, linarith only, }, { linarith only, }, },
  { cases hn with q hn, use q, intros x₀,
    simp_rw (R x₀ (init x₀)).symm.time_pure_eq,
    rcases hn x₀ with ⟨N, h, N_le⟩, refine ⟨N, h, N_le.trans _⟩,
    simp, apply monotone_polynomial_nat, linarith only, },
  intro x,
  obtain ⟨⟨r₁, r₂, r₃⟩, hr₁, hr₂⟩ := (R x (init x)).mem_eval_of (hg x),
  simp at hr₂, rcases hr₂ with ⟨rfl, rfl, rfl⟩, exact hr₁,
end

noncomputable instance penc_states {σ : Type*} [ptree.pencodable σ] (f : execution σ) : ptree.pencodable f.states :=
@set_encodable _ _ _ (classical.dec_pred _) _ f.start_mem_states

lemma penc_states_encode {σ} [ptree.pencodable σ] {f : execution σ} (x : f.states) :
  encode (x : σ) = encode x := rfl

theorem polytime_fun.eval_of_polysize {α β} [polycodable α] [polycodable β] {f : β → α → bool × α} {init : β → bool × α}
  (hf : polytime_fun₂ f) (hinit : polytime_fun init)
  (hfs : polysize_fun_safe (λ (x₀ : β) (y : (mk_iterator ↑(f x₀) (init x₀)).states), f x₀ (y : bool × α).2))
  (hn : ∃ q : polynomial ℕ, ∀ x₀, ∃ N ∈ (mk_iterator ↑(f x₀) (init x₀)).time (pfun.pure 1), N ≤ q.eval (encode x₀).sizeof)
  (g : β → α) (hg : ∀ x, (tt, g x) ∈ (mk_iterator ↑(f x) (init x)).eval) : polytime_fun g :=
begin
  refine polytime_fun.eval hf hinit _ hn g hg,
  rcases hfs with ⟨p, hp⟩, rcases hn with ⟨q, hn⟩, dsimp only at hp,
  obtain ⟨p₂, hp₂⟩ := polysize_of_polytime_fun hinit,
  use p₂ + p * q, intros x₀,
  suffices : ∀ (s : ℕ × bool × α), s ∈ ((mk_iterator ↑(f x₀) (init x₀)).time_with (pfun.pure 1)).states → (encode s.2).sizeof ≤ p₂.eval (encode x₀).sizeof + (p.eval (encode x₀).sizeof) * s.1,
  { intros s hs,
    obtain ⟨⟨t, s'⟩, h₁, h₂⟩ := (execution.time_with_tr (mk_iterator ↑(f x₀) (init x₀)) (pfun.pure 1) (by simp)).exists_state_of hs,
    simp at h₂, subst h₂,
    specialize this _ h₁, specialize hn x₀, specialize hp x₀, simp at this ⊢,
    refine this.trans _,
    mono*, any_goals { exact zero_le' },
    rcases hn with ⟨N, hN, N_le⟩,
    exact (execution.state_time_le_time _ _ hN h₁).trans N_le, },
  intros s hs, apply execution.step_induction hs,
  { specialize hp₂ x₀, simpa [execution.time_with], },
  rintros ⟨t, s⟩ ⟨t', s'⟩ hs ih,
  simp [execution.time_with, ← apply_ite part.some],
  rintros rfl _ rfl,
  specialize hp x₀ ⟨s, _⟩,
  { obtain ⟨⟨_, s'⟩, h₁, h₂⟩ := (execution.time_with_tr (mk_iterator ↑(f x₀) (init x₀)) (pfun.pure 1) (by simp)).symm.exists_state_of hs, simp at h₂, rwa ← h₂, },
  refine hp.trans _, rw [add_comm 1 t, mul_add], simp [← add_assoc],
  exact ih.trans rfl.le,
end

@[simp]
def iterator_evaln {α : Type*} (f : α → bool × α) : ℕ → bool × α → option α
| 0 _ := none
| (n+1) (b, x) := cond b (some x) (iterator_evaln n (f x))

lemma eval_of_iterator_evaln {α} {f : α → bool × α} {N : ℕ} {x₀ : bool × α} {y : α}
  (hy : y ∈ iterator_evaln f N x₀) : ∃ n ≤ N, (n, tt, y) ∈ ((mk_iterator ↑f x₀).time_with (pfun.pure 1)).eval :=
begin
  induction N with N ih generalizing x₀, { contradiction, },
  cases x₀ with b₀ x₀,
  cases b₀, swap,
  { refine ⟨0, zero_le', _⟩, rw [execution.time_with, execution.mem_eval],
    simp at hy, subst hy, split, { exact execution.start_mem_states _, }, simp, },
  simp at hy, specialize ih hy, rcases ih with ⟨n, H, n_mem⟩,
  refine ⟨n+1, _, _⟩, { simpa [nat.succ_eq_add_one], },
  rw ← @execution.eval_from _ _ (1, f x₀), swap,
  { apply execution.mem_states_of_fwd (execution.start_mem_states _), simp [execution.time_with], },
  simp only [execution.time_with], rw track_with_change_start,
  simp,
  have := (mk_iterator ↑f (f x₀)).time_fwd (pfun.pure 1) 1, simp at this, rw this,
  rw ← part.eq_some_iff at n_mem, simp [n_mem],
end

theorem polytime_fun.evaln_of_polysize {α β} [polycodable α] [polycodable β] (f : β → α → bool × α) (init : β → bool × α)
  (N : β → ℕ) (hf : polytime_fun₂ f) (hinit : polytime_fun init)
  (hfs : polysize_fun_safe (λ (x₀ : β) (y : (mk_iterator ↑(f x₀) (init x₀)).states), f x₀ (y : bool × α).2))
  (hn : ∃ q : polynomial ℕ, ∀ x₀, N x₀ ≤ q.eval (encode x₀).sizeof)
  (g : β → α) (hg : ∀ x, g x ∈ iterator_evaln (f x) (N x) (init x)) : polytime_fun g :=
begin
  refine polytime_fun.eval_of_polysize hf hinit hfs _ g _,
  { rcases hn with ⟨q, hn⟩, use q, intros x₀,
    obtain ⟨n, n_le, hn'⟩ := eval_of_iterator_evaln (hg x₀),
    use n, refine ⟨_, n_le.trans (hn _)⟩,
    simp only [execution.time], rw ← part.eq_some_iff at hn', simp [hn'], },
  intros x₀,
  obtain ⟨_, _, hn'⟩ := eval_of_iterator_evaln (hg x₀),
  obtain ⟨y, hy, hrel⟩ := (execution.time_with_tr (mk_iterator ↑(f x₀) (init x₀)) (pfun.pure 1) (by simp)).symm.mem_eval_of hn',
  simp at hrel, rwa ← hrel,
end


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Kenny Lau, Joey van Langen, Casper Putz
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.fintype.basic
import Mathlib.data.nat.choose.default
import Mathlib.data.int.modeq
import Mathlib.algebra.module.basic
import Mathlib.algebra.iterate_hom
import Mathlib.group_theory.order_of_element
import Mathlib.algebra.group.type_tags
import Mathlib.PostPort

universes u l u_1 u_2 v

namespace Mathlib

/-!
# Characteristic of semirings
-/

/-- The generator of the kernel of the unique homomorphism ℕ → α for a semiring α -/
class char_p (α : Type u) [semiring α] (p : ℕ)
where
  cast_eq_zero_iff : ∀ (x : ℕ), ↑x = 0 ↔ p ∣ x

theorem char_p.cast_eq_zero (α : Type u) [semiring α] (p : ℕ) [char_p α p] : ↑p = 0 :=
  iff.mpr (char_p.cast_eq_zero_iff α p p) (dvd_refl p)

@[simp] theorem char_p.cast_card_eq_zero (R : Type u_1) [ring R] [fintype R] : ↑(fintype.card R) = 0 := sorry

theorem char_p.int_cast_eq_zero_iff (R : Type u) [ring R] (p : ℕ) [char_p R p] (a : ℤ) : ↑a = 0 ↔ ↑p ∣ a := sorry

theorem char_p.int_coe_eq_int_coe_iff (R : Type u_1) [ring R] (p : ℕ) [char_p R p] (a : ℤ) (b : ℤ) : ↑a = ↑b ↔ int.modeq (↑p) a b := sorry

theorem char_p.eq (α : Type u) [semiring α] {p : ℕ} {q : ℕ} (c1 : char_p α p) (c2 : char_p α q) : p = q :=
  nat.dvd_antisymm (iff.mp (char_p.cast_eq_zero_iff α p q) (char_p.cast_eq_zero α q))
    (iff.mp (char_p.cast_eq_zero_iff α q p) (char_p.cast_eq_zero α p))

protected instance char_p.of_char_zero (α : Type u) [semiring α] [char_zero α] : char_p α 0 :=
  char_p.mk
    fun (x : ℕ) =>
      eq.mpr (id (Eq._oldrec (Eq.refl (↑x = 0 ↔ 0 ∣ x)) (propext zero_dvd_iff)))
        (eq.mpr (id (Eq._oldrec (Eq.refl (↑x = 0 ↔ x = 0)) (Eq.symm nat.cast_zero)))
          (eq.mpr (id (Eq._oldrec (Eq.refl (↑x = ↑0 ↔ x = 0)) (propext nat.cast_inj))) (iff.refl (x = 0))))

theorem char_p.exists (α : Type u) [semiring α] : ∃ (p : ℕ), char_p α p := sorry

theorem char_p.exists_unique (α : Type u) [semiring α] : exists_unique fun (p : ℕ) => char_p α p := sorry

theorem char_p.congr {R : Type u} [semiring R] {p : ℕ} (q : ℕ) [hq : char_p R q] (h : q = p) : char_p R p :=
  h ▸ hq

/-- Noncomputable function that outputs the unique characteristic of a semiring. -/
def ring_char (α : Type u) [semiring α] : ℕ :=
  classical.some (char_p.exists_unique α)

namespace ring_char

theorem spec (R : Type u) [semiring R] (x : ℕ) : ↑x = 0 ↔ ring_char R ∣ x := sorry

theorem eq (R : Type u) [semiring R] {p : ℕ} (C : char_p R p) : p = ring_char R :=
  and.right (classical.some_spec (char_p.exists_unique R)) p C

protected instance char_p (R : Type u) [semiring R] : char_p R (ring_char R) :=
  char_p.mk (spec R)

theorem of_eq {R : Type u} [semiring R] {p : ℕ} (h : ring_char R = p) : char_p R p :=
  char_p.congr (ring_char R) h

theorem eq_iff {R : Type u} [semiring R] {p : ℕ} : ring_char R = p ↔ char_p R p :=
  { mp := of_eq, mpr := Eq.symm ∘ eq R }

theorem dvd {R : Type u} [semiring R] {x : ℕ} (hx : ↑x = 0) : ring_char R ∣ x :=
  iff.mp (spec R x) hx

end ring_char

theorem add_pow_char_of_commute (R : Type u) [semiring R] {p : ℕ} [fact (nat.prime p)] [char_p R p] (x : R) (y : R) (h : commute x y) : (x + y) ^ p = x ^ p + y ^ p := sorry

theorem add_pow_char_pow_of_commute (R : Type u) [semiring R] {p : ℕ} [fact (nat.prime p)] [char_p R p] {n : ℕ} (x : R) (y : R) (h : commute x y) : (x + y) ^ p ^ n = x ^ p ^ n + y ^ p ^ n := sorry

theorem sub_pow_char_of_commute (R : Type u) [ring R] {p : ℕ} [fact (nat.prime p)] [char_p R p] (x : R) (y : R) (h : commute x y) : (x - y) ^ p = x ^ p - y ^ p := sorry

theorem sub_pow_char_pow_of_commute (R : Type u) [ring R] {p : ℕ} [fact (nat.prime p)] [char_p R p] {n : ℕ} (x : R) (y : R) (h : commute x y) : (x - y) ^ p ^ n = x ^ p ^ n - y ^ p ^ n := sorry

theorem add_pow_char (α : Type u) [comm_semiring α] {p : ℕ} [fact (nat.prime p)] [char_p α p] (x : α) (y : α) : (x + y) ^ p = x ^ p + y ^ p :=
  add_pow_char_of_commute α x y (commute.all x y)

theorem add_pow_char_pow (R : Type u) [comm_semiring R] {p : ℕ} [fact (nat.prime p)] [char_p R p] {n : ℕ} (x : R) (y : R) : (x + y) ^ p ^ n = x ^ p ^ n + y ^ p ^ n :=
  add_pow_char_pow_of_commute R x y (commute.all x y)

theorem sub_pow_char (α : Type u) [comm_ring α] {p : ℕ} [fact (nat.prime p)] [char_p α p] (x : α) (y : α) : (x - y) ^ p = x ^ p - y ^ p :=
  sub_pow_char_of_commute α x y (commute.all x y)

theorem sub_pow_char_pow (R : Type u) [comm_ring R] {p : ℕ} [fact (nat.prime p)] [char_p R p] {n : ℕ} (x : R) (y : R) : (x - y) ^ p ^ n = x ^ p ^ n - y ^ p ^ n :=
  sub_pow_char_pow_of_commute R x y (commute.all x y)

theorem eq_iff_modeq_int (R : Type u_1) [ring R] (p : ℕ) [char_p R p] (a : ℤ) (b : ℤ) : ↑a = ↑b ↔ int.modeq (↑p) a b := sorry

theorem char_p.neg_one_ne_one (R : Type u_1) [ring R] (p : ℕ) [char_p R p] [fact (bit0 1 < p)] : -1 ≠ 1 := sorry

theorem ring_hom.char_p_iff_char_p {K : Type u_1} {L : Type u_2} [field K] [field L] (f : K →+* L) (p : ℕ) : char_p K p ↔ char_p L p := sorry

/-- The frobenius map that sends x to x^p -/
def frobenius (R : Type u) [comm_semiring R] (p : ℕ) [fact (nat.prime p)] [char_p R p] : R →+* R :=
  ring_hom.mk (fun (x : R) => x ^ p) sorry sorry sorry (add_pow_char R)

theorem frobenius_def {R : Type u} [comm_semiring R] (p : ℕ) [fact (nat.prime p)] [char_p R p] (x : R) : coe_fn (frobenius R p) x = x ^ p :=
  rfl

theorem iterate_frobenius {R : Type u} [comm_semiring R] (p : ℕ) [fact (nat.prime p)] [char_p R p] (x : R) (n : ℕ) : nat.iterate (⇑(frobenius R p)) n x = x ^ p ^ n := sorry

theorem frobenius_mul {R : Type u} [comm_semiring R] (p : ℕ) [fact (nat.prime p)] [char_p R p] (x : R) (y : R) : coe_fn (frobenius R p) (x * y) = coe_fn (frobenius R p) x * coe_fn (frobenius R p) y :=
  ring_hom.map_mul (frobenius R p) x y

theorem frobenius_one {R : Type u} [comm_semiring R] (p : ℕ) [fact (nat.prime p)] [char_p R p] : coe_fn (frobenius R p) 1 = 1 :=
  one_pow p

theorem monoid_hom.map_frobenius {R : Type u} [comm_semiring R] {S : Type v} [comm_semiring S] (f : R →* S) (p : ℕ) [fact (nat.prime p)] [char_p R p] [char_p S p] (x : R) : coe_fn f (coe_fn (frobenius R p) x) = coe_fn (frobenius S p) (coe_fn f x) :=
  monoid_hom.map_pow f x p

theorem ring_hom.map_frobenius {R : Type u} [comm_semiring R] {S : Type v} [comm_semiring S] (g : R →+* S) (p : ℕ) [fact (nat.prime p)] [char_p R p] [char_p S p] (x : R) : coe_fn g (coe_fn (frobenius R p) x) = coe_fn (frobenius S p) (coe_fn g x) :=
  ring_hom.map_pow g x p

theorem monoid_hom.map_iterate_frobenius {R : Type u} [comm_semiring R] {S : Type v} [comm_semiring S] (f : R →* S) (p : ℕ) [fact (nat.prime p)] [char_p R p] [char_p S p] (x : R) (n : ℕ) : coe_fn f (nat.iterate (⇑(frobenius R p)) n x) = nat.iterate (⇑(frobenius S p)) n (coe_fn f x) :=
  function.semiconj.iterate_right (monoid_hom.map_frobenius f p) n x

theorem ring_hom.map_iterate_frobenius {R : Type u} [comm_semiring R] {S : Type v} [comm_semiring S] (g : R →+* S) (p : ℕ) [fact (nat.prime p)] [char_p R p] [char_p S p] (x : R) (n : ℕ) : coe_fn g (nat.iterate (⇑(frobenius R p)) n x) = nat.iterate (⇑(frobenius S p)) n (coe_fn g x) :=
  monoid_hom.map_iterate_frobenius (ring_hom.to_monoid_hom g) p x n

theorem monoid_hom.iterate_map_frobenius {R : Type u} [comm_semiring R] (x : R) (f : R →* R) (p : ℕ) [fact (nat.prime p)] [char_p R p] (n : ℕ) : nat.iterate (⇑f) n (coe_fn (frobenius R p) x) = coe_fn (frobenius R p) (nat.iterate (⇑f) n x) :=
  monoid_hom.iterate_map_pow f x n p

theorem ring_hom.iterate_map_frobenius {R : Type u} [comm_semiring R] (x : R) (f : R →+* R) (p : ℕ) [fact (nat.prime p)] [char_p R p] (n : ℕ) : nat.iterate (⇑f) n (coe_fn (frobenius R p) x) = coe_fn (frobenius R p) (nat.iterate (⇑f) n x) :=
  ring_hom.iterate_map_pow f x n p

theorem frobenius_zero (R : Type u) [comm_semiring R] (p : ℕ) [fact (nat.prime p)] [char_p R p] : coe_fn (frobenius R p) 0 = 0 :=
  ring_hom.map_zero (frobenius R p)

theorem frobenius_add (R : Type u) [comm_semiring R] (p : ℕ) [fact (nat.prime p)] [char_p R p] (x : R) (y : R) : coe_fn (frobenius R p) (x + y) = coe_fn (frobenius R p) x + coe_fn (frobenius R p) y :=
  ring_hom.map_add (frobenius R p) x y

theorem frobenius_nat_cast (R : Type u) [comm_semiring R] (p : ℕ) [fact (nat.prime p)] [char_p R p] (n : ℕ) : coe_fn (frobenius R p) ↑n = ↑n :=
  ring_hom.map_nat_cast (frobenius R p) n

theorem frobenius_neg (R : Type u) [comm_ring R] (p : ℕ) [fact (nat.prime p)] [char_p R p] (x : R) : coe_fn (frobenius R p) (-x) = -coe_fn (frobenius R p) x :=
  ring_hom.map_neg (frobenius R p) x

theorem frobenius_sub (R : Type u) [comm_ring R] (p : ℕ) [fact (nat.prime p)] [char_p R p] (x : R) (y : R) : coe_fn (frobenius R p) (x - y) = coe_fn (frobenius R p) x - coe_fn (frobenius R p) y :=
  ring_hom.map_sub (frobenius R p) x y

theorem frobenius_inj (α : Type u) [comm_ring α] [no_zero_divisors α] (p : ℕ) [fact (nat.prime p)] [char_p α p] : function.injective ⇑(frobenius α p) := sorry

namespace char_p

theorem char_p_to_char_zero (α : Type u) [ring α] [char_p α 0] : char_zero α :=
  char_zero_of_inj_zero fun (n : ℕ) (h0 : ↑n = 0) => eq_zero_of_zero_dvd (iff.mp (cast_eq_zero_iff α 0 n) h0)

theorem cast_eq_mod (α : Type u) [ring α] (p : ℕ) [char_p α p] (k : ℕ) : ↑k = ↑(k % p) := sorry

theorem char_ne_zero_of_fintype (α : Type u) [ring α] (p : ℕ) [hc : char_p α p] [fintype α] : p ≠ 0 :=
  fun (h : p = 0) =>
    (fun (this : char_zero α) => absurd nat.cast_injective (not_injective_infinite_fintype coe)) (char_p_to_char_zero α)

theorem char_ne_one (α : Type u) [integral_domain α] (p : ℕ) [hc : char_p α p] : p ≠ 1 := sorry

theorem char_is_prime_of_two_le (α : Type u) [integral_domain α] (p : ℕ) [hc : char_p α p] (hp : bit0 1 ≤ p) : nat.prime p := sorry

theorem char_is_prime_or_zero (α : Type u) [integral_domain α] (p : ℕ) [hc : char_p α p] : nat.prime p ∨ p = 0 := sorry

theorem char_is_prime_of_pos (α : Type u) [integral_domain α] (p : ℕ) [h : fact (0 < p)] [char_p α p] : fact (nat.prime p) :=
  or.resolve_right (char_is_prime_or_zero α p) (iff.mp pos_iff_ne_zero h)

theorem char_is_prime (α : Type u) [integral_domain α] [fintype α] (p : ℕ) [char_p α p] : nat.prime p :=
  or.resolve_right (char_is_prime_or_zero α p) (char_ne_zero_of_fintype α p)

protected instance subsingleton {R : Type u_1} [semiring R] [char_p R 1] : subsingleton R :=
  subsingleton.intro
    ((fun (this : ∀ (r : R), r = 0) (a b : R) =>
        (fun (this : a = b) => this)
          (eq.mpr (id (Eq._oldrec (Eq.refl (a = b)) (this a)))
            (eq.mpr (id (Eq._oldrec (Eq.refl (0 = b)) (this b))) (Eq.refl 0))))
      fun (r : R) =>
        Eq.trans
          (Eq.trans
            (Eq.trans (eq.mpr (id (Eq._oldrec (Eq.refl (r = 1 * r)) (one_mul r))) (Eq.refl r))
              (eq.mpr (id (Eq._oldrec (Eq.refl (1 * r = ↑1 * r)) nat.cast_one)) (Eq.refl (1 * r))))
            (eq.mpr (id (Eq._oldrec (Eq.refl (↑1 * r = 0 * r)) (cast_eq_zero R 1))) (Eq.refl (0 * r))))
          (eq.mpr (id (Eq._oldrec (Eq.refl (0 * r = 0)) (zero_mul r))) (Eq.refl 0)))

theorem false_of_nontrivial_of_char_one {R : Type u_1} [semiring R] [nontrivial R] [char_p R 1] : False :=
  false_of_nontrivial_of_subsingleton R

theorem ring_char_ne_one {R : Type u_1} [semiring R] [nontrivial R] : ring_char R ≠ 1 := sorry

theorem nontrivial_of_char_ne_one {v : ℕ} (hv : v ≠ 1) {R : Type u_1} [semiring R] [hr : char_p R v] : nontrivial R := sorry

end char_p

theorem char_p_of_ne_zero (n : ℕ) (R : Type u_1) [comm_ring R] [fintype R] (hn : fintype.card R = n) (hR : ∀ (i : ℕ), i < n → ↑i = 0 → i = 0) : char_p R n := sorry

theorem char_p_of_prime_pow_injective (R : Type u_1) [comm_ring R] [fintype R] (p : ℕ) [hp : fact (nat.prime p)] (n : ℕ) (hn : fintype.card R = p ^ n) (hR : ∀ (i : ℕ), i ≤ n → ↑p ^ i = 0 → i = n) : char_p R (p ^ n) := sorry


/-
Copyright (c) 2022 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Joël Riou
-/
import category_theory.arrow

/-!
# Commutative squares

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

This file provide an API for commutative squares in categories.
If `top`, `left`, `right` and `bottom` are four morphisms which are the edges
of a square, `comm_sq top left right bottom` is the predicate that this
square is commutative.

The structure `comm_sq` is extended in `category_theory/shapes/limits/comm_sq.lean`
as `is_pullback` and `is_pushout` in order to define pullback and pushout squares.

## Future work

Refactor `lift_struct` from `arrow.lean` and lifting properties using `comm_sq.lean`.

-/

namespace category_theory

variables {C : Type*} [category C]

/-- The proposition that a square
```
  W ---f---> X
  |          |
  g          h
  |          |
  v          v
  Y ---i---> Z

```
is a commuting square.
-/
structure comm_sq {W X Y Z : C} (f : W ⟶ X) (g : W ⟶ Y) (h : X ⟶ Z) (i : Y ⟶ Z) : Prop :=
(w : f ≫ h = g ≫ i)

attribute [reassoc] comm_sq.w

namespace comm_sq

variables {W X Y Z : C} {f : W ⟶ X} {g : W ⟶ Y} {h : X ⟶ Z} {i : Y ⟶ Z}

lemma flip (p : comm_sq f g h i) : comm_sq g f i h := ⟨p.w.symm⟩

lemma of_arrow {f g : arrow C} (h : f ⟶ g) : comm_sq f.hom h.left h.right g.hom := ⟨h.w.symm⟩

/-- The commutative square in the opposite category associated to a commutative square. -/
lemma op (p : comm_sq f g h i) : comm_sq i.op h.op g.op f.op :=
⟨by simp only [← op_comp, p.w]⟩

/-- The commutative square associated to a commutative square in the opposite category. -/
lemma unop {W X Y Z : Cᵒᵖ} {f : W ⟶ X} {g : W ⟶ Y} {h : X ⟶ Z} {i : Y ⟶ Z}
  (p : comm_sq f g h i) : comm_sq i.unop h.unop g.unop f.unop :=
⟨by simp only [← unop_comp, p.w]⟩

end comm_sq

namespace functor

variables {D : Type*} [category D]
variables (F : C ⥤ D) {W X Y Z : C} {f : W ⟶ X} {g : W ⟶ Y} {h : X ⟶ Z} {i : Y ⟶ Z}

lemma map_comm_sq (s : comm_sq f g h i) : comm_sq (F.map f) (F.map g) (F.map h) (F.map i) :=
⟨by simpa using congr_arg (λ k : W ⟶ Z, F.map k) s.w⟩

end functor

alias functor.map_comm_sq ← comm_sq.map

namespace comm_sq

variables {A B X Y : C} {f : A ⟶ X} {i : A ⟶ B} {p : X ⟶ Y} {g : B ⟶ Y}

/-- The datum of a lift in a commutative square, i.e. a up-right-diagonal
morphism which makes both triangles commute. -/
@[ext, nolint has_nonempty_instance]
structure lift_struct (sq : comm_sq f i p g) :=
(l : B ⟶ X) (fac_left' : i ≫ l = f) (fac_right' : l ≫ p = g)

namespace lift_struct

restate_axiom fac_left'
restate_axiom fac_right'

/-- A `lift_struct` for a commutative square gives a `lift_struct` for the
corresponding square in the opposite category. -/
@[simps]
def op {sq : comm_sq f i p g} (l : lift_struct sq) : lift_struct sq.op :=
{ l := l.l.op,
  fac_left' := by rw [← op_comp, l.fac_right],
  fac_right' := by rw [← op_comp, l.fac_left], }

/-- A `lift_struct` for a commutative square in the opposite category
gives a `lift_struct` for the corresponding square in the original category. -/
@[simps]
def unop {A B X Y : Cᵒᵖ} {f : A ⟶ X} {i : A ⟶ B} {p : X ⟶ Y} {g : B ⟶ Y} {sq : comm_sq f i p g}
  (l : lift_struct sq) : lift_struct sq.unop :=
{ l := l.l.unop,
  fac_left' := by rw [← unop_comp, l.fac_right],
  fac_right' := by rw [← unop_comp, l.fac_left], }

/-- Equivalences of `lift_struct` for a square and the corresponding square
in the opposite category. -/
@[simps]
def op_equiv (sq : comm_sq f i p g) : lift_struct sq ≃ lift_struct sq.op :=
{ to_fun := op,
  inv_fun := unop,
  left_inv := by tidy,
  right_inv := by tidy, }

/-- Equivalences of `lift_struct` for a square in the oppositive category and
the corresponding square in the original category. -/
def unop_equiv {A B X Y : Cᵒᵖ} {f : A ⟶ X} {i : A ⟶ B} {p : X ⟶ Y} {g : B ⟶ Y}
  (sq : comm_sq f i p g) : lift_struct sq ≃ lift_struct sq.unop :=
{ to_fun := unop,
  inv_fun := op,
  left_inv := by tidy,
  right_inv := by tidy, }

end lift_struct

instance subsingleton_lift_struct_of_epi (sq : comm_sq f i p g) [epi i] :
  subsingleton (lift_struct sq) :=
⟨λ l₁ l₂, by { ext, simp only [← cancel_epi i, lift_struct.fac_left], }⟩

instance subsingleton_lift_struct_of_mono (sq : comm_sq f i p g) [mono p] :
  subsingleton (lift_struct sq) :=
⟨λ l₁ l₂, by { ext, simp only [← cancel_mono p, lift_struct.fac_right], }⟩

variable (sq : comm_sq f i p g)

/-- The assertion that a square has a `lift_struct`. -/
class has_lift : Prop := (exists_lift : nonempty sq.lift_struct)

namespace has_lift

variable {sq}

lemma mk' (l : sq.lift_struct) : has_lift sq := ⟨nonempty.intro l⟩

variable (sq)

lemma iff : has_lift sq ↔ nonempty sq.lift_struct :=
by { split, exacts [λ h, h.exists_lift, λ h, mk h], }

lemma iff_op : has_lift sq ↔ has_lift sq.op :=
begin
  rw [iff, iff],
  exact nonempty.congr (lift_struct.op_equiv sq).to_fun (lift_struct.op_equiv sq).inv_fun,
end

lemma iff_unop {A B X Y : Cᵒᵖ} {f : A ⟶ X} {i : A ⟶ B} {p : X ⟶ Y} {g : B ⟶ Y}
  (sq : comm_sq f i p g) : has_lift sq ↔ has_lift sq.unop :=
begin
  rw [iff, iff],
  exact nonempty.congr (lift_struct.unop_equiv sq).to_fun (lift_struct.unop_equiv sq).inv_fun,
end

end has_lift

/-- A choice of a diagonal morphism that is part of a `lift_struct` when
the square has a lift. -/
noncomputable
def lift [hsq : has_lift sq] : B ⟶ X :=
hsq.exists_lift.some.l

@[simp, reassoc]
lemma fac_left [hsq : has_lift sq] : i ≫ sq.lift = f :=
hsq.exists_lift.some.fac_left

@[simp, reassoc]
lemma fac_right [hsq : has_lift sq] : sq.lift ≫ p = g :=
hsq.exists_lift.some.fac_right

end comm_sq

end category_theory


/-
Copyright (c) 2021 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import tactic.itauto

section itauto₀
variables p q r : Prop
variables h : p ∧ q ∨ p ∧ r
include h
example : p ∧ p :=
by itauto

end itauto₀

section itauto₃

example (p : Prop) : ¬ (p ↔ ¬ p) := by itauto
example (p : Prop) : ¬ (p = ¬ p) := by itauto
example (p : Prop) : p ≠ ¬ p := by itauto

example (p : Prop) : p ∧ true ↔ p := by itauto
example (p : Prop) : p ∨ false ↔ p := by itauto
example (p q : Prop) (h0 : q) : p → q := by itauto
example (p q r : Prop) : p ∨ (q ∧ r) → (p ∨ q) ∧ (r ∨ p ∨ r) := by itauto
example (p q r : Prop) : p ∨ (q ∧ r) → (p ∨ q) ∧ (r ∨ p ∨ r) := by itauto
example (p q r : Prop) (h : p) : (p → q ∨ r) → q ∨ r := by itauto
example (p q : Prop) (h : ¬ (p ↔ q)) (h' : p) : ¬ q := by itauto
example (p q : Prop) (h : ¬ (p ↔ q)) (h' : q) : ¬ p := by itauto
example (p q : Prop) (h : ¬ (p ↔ q)) (h' : ¬ q) (h'' : ¬ p) : false := by itauto
example (p q r : Prop) (h : p ↔ q) (h' : r ↔ q) (h'' : ¬ r) : ¬ p := by itauto
example (p q r : Prop) (h : p ↔ q) (h' : r ↔ q) : p ↔ r := by itauto
example (p q : Prop) : xor p q → (p ↔ ¬ q) := by itauto
example (p q : Prop) : xor p q → xor q p := by itauto

example (p q r : Prop) (h : ¬ (p ↔ q)) (h' : r ↔ q) : ¬ (p ↔ r) := by itauto

example (p : Prop) : p → ¬ (p → ¬ p) := by itauto

example (p : Prop) (em : p ∨ ¬ p) : ¬ (p ↔ ¬ p) := by itauto

example (p : Prop) [decidable p] : p ∨ ¬ p := by itauto*
example (p : Prop) [decidable p] : ¬ (p ↔ ¬ p) := by itauto
example (p q r : Prop) [decidable p] : (p → (q ∨ r)) → ((p → q) ∨ (p → r)) := by itauto*
example (p q r : Prop) [decidable q] : (p → (q ∨ r)) → ((p → q) ∨ (p → r)) := by itauto [q]

example (xl yl zl xr yr zr : Prop) :
  (xl ∧ yl ∨ xr ∧ yr) ∧ zl ∨ (xl ∧ yr ∨ xr ∧ yl) ∧ zr ↔
    xl ∧ (yl ∧ zl ∨ yr ∧ zr) ∨ xr ∧ (yl ∧ zr ∨ yr ∧ zl) :=
by itauto

example : 0 < 1 ∨ ¬ 0 < 1 := by itauto*
example (p : Prop) (h : 0 < 1 → p) (h2 : ¬ 0 < 1 → p) : p := by itauto*

example (b : bool) : ¬ b ∨ b := by itauto*
example (p : Prop) : ¬ p ∨ p := by itauto! [p]
example (p : Prop) : ¬ p ∨ p := by itauto!*

-- failure tests
example (p q r : Prop) : true :=
begin
  have : p ∨ ¬ p, {success_if_fail {itauto}, sorry}, clear this,
  have : ¬ (p ↔ q) → ¬ p → q, {success_if_fail {itauto}, sorry}, clear this,
  have : ¬ (p ↔ q) → (r ↔ q) → (p ↔ ¬ r), {success_if_fail {itauto}, sorry}, clear this,
  trivial
end

example (P : ℕ → Prop) (n : ℕ) (h : ¬ (n = 7 ∨ n = 0) ∧ P n) : ¬ (P n → n = 7 ∨ n = 0) :=
by itauto

section modulo_symmetry
variables {p q r : Prop} {α : Type} {x y : α}
variables (h : x = y)
variables (h'' : (p ∧ q ↔ q ∨ r) ↔ (r ∧ p ↔ r ∨ q))
include h
include h''
example (h' : ¬ x = y) : p ∧ q := by itauto
example : x = y := by itauto
end modulo_symmetry

end itauto₃
example (p1 p2 p3 p4 p5 p6 f : Prop)
  (h : (
      (p1 ∧ p2 ∧ p3 ∧ p4 ∧ p5 ∧ p6 ∧ true) ∨
      (((p1 → f) → f) → f) ∨
      (p2 → f) ∨
      (p3 → f) ∨
      (p4 → f) ∨
      (p5 → f) ∨
      (p6 → f) ∨
      false
    ) → f) : f :=
by itauto