import .monoidal_category

open categories.monoidal_category

universes u₁ v₁

variables {C : Type u₁} [𝒞 : monoidal_category.{u₁ v₁} C]
include 𝒞

inductive monoidal_coherence_step : C → Type u₁
| left_unitor : Π X : C, monoidal_coherence_step ((monoidal_category.tensor_unit C) ⊗ X)
| left_tensor : Π (X Y : C) [monoidal_coherence_step Y], monoidal_coherence_step (X ⊗ Y)

def monoidal_coherence_step_result : Π (X : C) [monoidal_coherence_step X], C
| _ (monoidal_coherence_step.left_unitor Y) := Y
| _ (@monoidal_coherence_step.left_tensor _ _ X Y S) := X ⊗ (@monoidal_coherence_step_result Y S)

inductive monoidal_coherence : C → C → Type u₁
| identity : Π X : C, monoidal_coherence X X
| compose : Π {X Y : C} [S : monoidal_coherence_step Y], monoidal_coherence X Y → monoidal_coherence X (@monoidal_coherence_step_result _ _ _ S)

attribute [class] monoidal_coherence_step monoidal_coherence
attribute [instance] monoidal_coherence_step.left_unitor monoidal_coherence_step.left_tensor
attribute [instance] monoidal_coherence.identity monoidal_coherence.compose monoidal_coherence.compose

example (X : C) : monoidal_coherence_step ((monoidal_category.tensor_unit C) ⊗ X) := by apply_instance
example (X Y : C) : monoidal_coherence_step (Y ⊗ ((monoidal_category.tensor_unit C) ⊗ X)) := by apply_instance

example (X : C) : monoidal_coherence X X := by apply_instance
example (X : C) : monoidal_coherence ((monoidal_category.tensor_unit C) ⊗ X) X :=
begin

end
example (X : C) : monoidal_coherence ((monoidal_category.tensor_unit C) ⊗ ((monoidal_category.tensor_unit C) ⊗ X)) X :=
begin
  sorry
end

class monoidal_coherence_isomorphism (X Y : C) :=
  (iso : X ≅ Y)

#print monoidal_coherence_isomorphism

instance coherent_identity (X : C) : @monoidal_coherence_isomorphism C 𝒞 X X :=
{ iso := sorry }

instance coherent_identity (X Y Z: C) : @monoidal_coherence_isomorphism C 𝒞 ((X ⊗ Y) ⊗ Z) (X ⊗ (Y ⊗ Z)) :=
{ iso := sorry }


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta, Alena Gusakov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.finset.default
import Mathlib.data.fintype.basic
import Mathlib.algebra.geom_sum
import Mathlib.tactic.default
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Colex

We define the colex ordering for finite sets, and give a couple of important
lemmas and properties relating to it.

The colex ordering likes to avoid large values - it can be thought of on
`finset ℕ` as the "binary" ordering. That is, order A based on
`∑_{i ∈ A} 2^i`.
It's defined here in a slightly more general way, requiring only `has_lt α` in
the definition of colex on `finset α`. In the context of the Kruskal-Katona
theorem, we are interested in particular on how colex behaves for sets of a
fixed size. If the size is 3, colex on ℕ starts
123, 124, 134, 234, 125, 135, 235, 145, 245, 345, ...

## Main statements
* `colex_hom`: strictly monotone functions preserve colex
* Colex order properties - linearity, decidability and so on.
* `forall_lt_of_colex_lt_of_forall_lt`: if A < B in colex, and everything
  in B is < t, then everything in A is < t. This confirms the idea that
  an enumeration under colex will exhaust all sets using elements < t before
  allowing t to be included.
* `binary_iff`: colex for α = ℕ is the same as binary
  (this also proves binary expansions are unique)

## Notation
We define `<` and `≤` to denote colex ordering, useful in particular when
multiple orderings are available in context.

## Tags
colex, colexicographic, binary

## References
* https://github.com/b-mehta/maths-notes/blob/master/iii/mich/combinatorics.pdf

## Todo
Show the subset ordering is a sub-relation of the colex ordering.
-/

/--
We define this type synonym to refer to the colexicographic ordering on finsets
rather than the natural subset ordering.
-/
def finset.colex (α : Type u_1) := finset α

/--
A convenience constructor to turn a `finset α` into a `finset.colex α`, useful in order to
use the colex ordering rather than the subset ordering.
-/
def finset.to_colex {α : Type u_1} (s : finset α) : finset.colex α := s

@[simp] theorem colex.eq_iff {α : Type u_1} (A : finset α) (B : finset α) :
    finset.to_colex A = finset.to_colex B ↔ A = B :=
  iff.refl (finset.to_colex A = finset.to_colex B)

/--
`A` is less than `B` in the colex ordering if the largest thing that's not in both sets is in B.
In other words, max (A ▵ B) ∈ B (if the maximum exists).
-/
protected instance finset.colex.has_lt {α : Type u_1} [HasLess α] : HasLess (finset.colex α) :=
  { Less :=
      fun (A B : finset α) => ∃ (k : α), (∀ {x : α}, k < x → (x ∈ A ↔ x ∈ B)) ∧ ¬k ∈ A ∧ k ∈ B }

/-- We can define (≤) in the obvious way. -/
protected instance finset.colex.has_le {α : Type u_1} [HasLess α] : HasLessEq (finset.colex α) :=
  { LessEq := fun (A B : finset.colex α) => A < B ∨ A = B }

theorem colex.lt_def {α : Type u_1} [HasLess α] (A : finset α) (B : finset α) :
    finset.to_colex A < finset.to_colex B ↔
        ∃ (k : α), (∀ {x : α}, k < x → (x ∈ A ↔ x ∈ B)) ∧ ¬k ∈ A ∧ k ∈ B :=
  iff.rfl

theorem colex.le_def {α : Type u_1} [HasLess α] (A : finset α) (B : finset α) :
    finset.to_colex A ≤ finset.to_colex B ↔ finset.to_colex A < finset.to_colex B ∨ A = B :=
  iff.rfl

/-- If everything in A is less than k, we can bound the sum of powers. -/
theorem nat.sum_pow_two_lt {k : ℕ} {A : finset ℕ} (h₁ : ∀ {x : ℕ}, x ∈ A → x < k) :
    finset.sum A (pow (bit0 1)) < bit0 1 ^ k :=
  sorry

namespace colex

/-- Strictly monotone functions preserve the colex ordering. -/
theorem hom {α : Type u_1} {β : Type u_2} [linear_order α] [DecidableEq β] [preorder β] {f : α → β}
    (h₁ : strict_mono f) (A : finset α) (B : finset α) :
    finset.to_colex (finset.image f A) < finset.to_colex (finset.image f B) ↔
        finset.to_colex A < finset.to_colex B :=
  sorry

/-- A special case of `colex_hom` which is sometimes useful. -/
@[simp] theorem hom_fin {n : ℕ} (A : finset (fin n)) (B : finset (fin n)) :
    finset.to_colex (finset.image (fun (n_1 : fin n) => ↑n_1) A) <
          finset.to_colex (finset.image (fun (n_1 : fin n) => ↑n_1) B) ↔
        finset.to_colex A < finset.to_colex B :=
  hom (fun (x y : fin n) (k : x < y) => k) A B

protected instance has_lt.lt.is_irrefl {α : Type u_1} [HasLess α] :
    is_irrefl (finset.colex α) Less :=
  is_irrefl.mk
    fun (A : finset.colex α) (h : A < A) =>
      exists.elim h
        fun (_x : α) (_x : (∀ {x : α}, _x < x → (x ∈ A ↔ x ∈ A)) ∧ ¬_x ∈ A ∧ _x ∈ A) => sorry

theorem lt_trans {α : Type u_1} [linear_order α] {a : finset.colex α} {b : finset.colex α}
    {c : finset.colex α} : a < b → b < c → a < c :=
  sorry

theorem le_trans {α : Type u_1} [linear_order α] (a : finset.colex α) (b : finset.colex α)
    (c : finset.colex α) : a ≤ b → b ≤ c → a ≤ c :=
  fun (AB : a ≤ b) (BC : b ≤ c) =>
    or.elim AB
      (fun (k : a < b) =>
        or.elim BC (fun (t : b < c) => Or.inl (lt_trans k t)) fun (t : b = c) => t ▸ AB)
      fun (k : a = b) => Eq.symm k ▸ BC

protected instance has_lt.lt.is_trans {α : Type u_1} [linear_order α] :
    is_trans (finset.colex α) Less :=
  is_trans.mk fun (_x _x_1 _x_2 : finset.colex α) => lt_trans

protected instance has_lt.lt.is_asymm {α : Type u_1} [linear_order α] :
    is_asymm (finset.colex α) Less :=
  Mathlib.is_asymm_of_is_trans_of_is_irrefl

protected instance has_lt.lt.is_strict_order {α : Type u_1} [linear_order α] :
    is_strict_order (finset.colex α) Less :=
  is_strict_order.mk

theorem lt_trichotomy {α : Type u_1} [linear_order α] (A : finset.colex α) (B : finset.colex α) :
    A < B ∨ A = B ∨ B < A :=
  sorry

protected instance has_lt.lt.is_trichotomous {α : Type u_1} [linear_order α] :
    is_trichotomous (finset.colex α) Less :=
  is_trichotomous.mk lt_trichotomy

-- It should be possible to do this computably but it doesn't seem to make any difference for now.

protected instance finset.colex.linear_order {α : Type u_1} [linear_order α] :
    linear_order (finset.colex α) :=
  linear_order.mk LessEq (partial_order.lt._default LessEq) sorry le_trans sorry sorry
    (classical.dec_rel LessEq) Mathlib.decidable_eq_of_decidable_le
    Mathlib.decidable_lt_of_decidable_le

protected instance has_lt.lt.is_incomp_trans {α : Type u_1} [linear_order α] :
    is_incomp_trans (finset.colex α) Less :=
  is_incomp_trans.mk
    fun (A B C : finset.colex α) (ᾰ : ¬A < B ∧ ¬B < A) (ᾰ_1 : ¬B < C ∧ ¬C < B) =>
      and.dcases_on ᾰ
        fun (nAB : ¬A < B) (nBA : ¬B < A) =>
          and.dcases_on ᾰ_1
            fun (nBC : ¬B < C) (nCB : ¬C < B) =>
              eq.mpr
                (id
                  (Eq._oldrec (Eq.refl (¬A < C ∧ ¬C < A))
                    (or.resolve_right (or.resolve_left (lt_trichotomy A B) nAB) nBA)))
                (eq.mpr
                  (id
                    (Eq._oldrec (Eq.refl (¬B < C ∧ ¬C < B))
                      (or.resolve_right (or.resolve_left (lt_trichotomy B C) nBC) nCB)))
                  (eq.mpr
                    (id (Eq._oldrec (Eq.refl (¬C < C ∧ ¬C < C)) (propext (and_self (¬C < C)))))
                    (irrefl C)))

protected instance has_lt.lt.is_strict_weak_order {α : Type u_1} [linear_order α] :
    is_strict_weak_order (finset.colex α) Less :=
  is_strict_weak_order.mk

protected instance has_lt.lt.is_strict_total_order {α : Type u_1} [linear_order α] :
    is_strict_total_order (finset.colex α) Less :=
  is_strict_total_order.mk

/-- If {r} is less than or equal to s in the colexicographical sense,
  then s contains an element greater than or equal to r. -/
theorem mem_le_of_singleton_le {α : Type u_1} [linear_order α] {r : α} {s : finset α} :
    finset.to_colex (singleton r) ≤ finset.to_colex s → ∃ (x : α), ∃ (H : x ∈ s), r ≤ x :=
  sorry

/-- s.to_colex < finset.to_colex {r} iff all elements of s are less than r. -/
theorem lt_singleton_iff_mem_lt {α : Type u_1} [linear_order α] {r : α} {s : finset α} :
    finset.to_colex s < finset.to_colex (singleton r) ↔ ∀ (x : α), x ∈ s → x < r :=
  sorry

/-- Colex is an extension of the base ordering on α. -/
theorem singleton_lt_iff_lt {α : Type u_1} [linear_order α] {r : α} {s : α} :
    finset.to_colex (singleton r) < finset.to_colex (singleton s) ↔ r < s :=
  sorry

/--
If A is before B in colex, and everything in B is small, then everything in A is small.
-/
theorem forall_lt_of_colex_lt_of_forall_lt {α : Type u_1} [linear_order α] {A : finset α}
    {B : finset α} (t : α) (h₁ : finset.to_colex A < finset.to_colex B)
    (h₂ : ∀ (x : α), x ∈ B → x < t) (x : α) (H : x ∈ A) : x < t :=
  sorry

/-- Colex doesn't care if you remove the other set -/
@[simp] theorem sdiff_lt_sdiff_iff_lt {α : Type u_1} [HasLess α] [DecidableEq α] (A : finset α)
    (B : finset α) :
    finset.to_colex (A \ B) < finset.to_colex (B \ A) ↔ finset.to_colex A < finset.to_colex B :=
  sorry

/-- For subsets of ℕ, we can show that colex is equivalent to binary. -/
theorem sum_pow_two_lt_iff_lt (A : finset ℕ) (B : finset ℕ) :
    finset.sum A (pow (bit0 1)) < finset.sum B (pow (bit0 1)) ↔
        finset.to_colex A < finset.to_colex B :=
  sorry

end Mathlib


import .semantics
open nnf subtype list

inductive node (Γ : sseqt) : Type
| closed : unsatisfiable (Γ.m ++ Γ.b) → node
| open_ : {x : model // (minfo x.1).id = Γ}  → node

open node

def contra_rule_seqt {Δ : sseqt} {n} (h : var n ∈ Δ.m ∧ neg n ∈ Δ.m) : node Δ :=
begin
  left,
  {exact unsat_contra_seqt h.1 h.2}
end

def and_rule_seqt {Γ Δ : sseqt} (i : and_instance_seqt Γ Δ) : node Δ → node Γ
| (closed h) := begin
                  left,
                  {apply unsat_of_closed_and_seqt, repeat {assumption}},
                end
| (open_ w)  :=
begin
right,
swap,
clear and_rule_seqt,
cases i with φ ψ h,
cases w with w pw,
cases w with wt pwa,
cases wt with iw lw sgw,
let rhtk := and φ ψ :: iw.htk,
have hhtk : hintikka rhtk,
  {split,
   {intros n hn, cases hn,
    {contradiction},
    {intro hne, cases hne, contradiction,
     apply iw.hhtk.hno_contra, exact hn, exact hne} },
   {intros φ' ψ' h, cases h with heq hmem,
    {injection heq with eq₁ eq₂,
     rw eq₁,
     right,
     apply iw.mhtk,
     simp at pw,
     rw pw, simp},
    {right,
     apply iw.hhtk.hand_left, exact hmem} },
   {intros φ' ψ' h, cases h with heq hmem,
    {injection heq with eq₁ eq₂,
     rw eq₂,
     right,
     apply iw.mhtk,
     simp at pw,
     rw pw, simp},
    {right,
     apply iw.hhtk.hand_right, exact hmem}},
   {intros φ' ψ' h, cases h with heq hmem,
    {contradiction},
    {have := iw.hhtk.hor hmem, cases this,
     {left, right, exact this},
     {right, right, exact this}}},
   {intros φ' h, cases h with heq hmem,
    {contradiction},
    {right, apply iw.hhtk.hbox, exact hmem}}},
have mhtk : Γ.m ⊆ rhtk,
  {intros x hx, by_cases heq : x = and φ ψ,
   {rw heq, simp},
   {have : x ∈ iw.id.m,
     {simp at pw, rw pw, dsimp, right, right,
      have := (mem_erase_of_ne heq).2 hx, exact this},
    right, apply iw.mhtk this }},
let im : info := ⟨Γ, rhtk, hhtk, mhtk⟩,
let tm : tmodel := tmodel.cons im lw sgw,
have ptm : ptmodel tm,
  {split,
   {simp, have := pwa.1.bhist, simp at pw, simp at this, rw pw at this, simp at this, exact this},
   {simp, have := pwa.1.sbox, simp at this, exact this},
   {simp, have := pwa.1.pdia, simp at this, exact this},
   {simp, have := pwa.1.bdia, simp at pw, simp at this,
    rw pw at this, simp at this,
    intros s rq hdesc hmem, rw eq_desc_of_eq_children at hdesc, swap, exact iw, swap, exact sgw,
    have := this s rq hdesc hmem,
    cases this with hl hr,
    {left, exact hl},
    {right, rcases hr with ⟨d, hd⟩, rw eq_desc_of_eq_children at hd, split, exact hd} },
   {simp, have := pwa.1.reqb, simp at pw, simp at this, rw pw at this, simp at this, exact this},
   {simp, have := pwa.1.sreq, simp at pw, simp at this, rw pw at this, simp at this, exact this}},
have gpt : global_pt tm,
  {intros s hs, have := pwa.2 s, rw eq_desc_of_eq_children at this, apply this, exact hs},
have hinfo : (minfo tm).id = Γ, {simp},
exact ⟨⟨tm, ⟨ptm, gpt⟩⟩, hinfo⟩
end

inductive batch_eq : list model → list sseqt → Prop
| bs_nil : batch_eq [] []
| bs_cons (m:model) (Γ:sseqt) (l₁ l₂) : (minfo m.1).id = Γ →
                                        batch_eq l₁ l₂ →
                                        batch_eq (m::l₁) (Γ::l₂)

open batch_eq

theorem be_ex : Π l Γ,
batch_eq l Γ → ∀ (m : model), m ∈ l → ∃ i ∈ Γ, (minfo m.1).id = i
| l Γ bs_nil := λ m hm, by simpa using hm
| l Γ (bs_cons m Δ l₁ l₂ h hbs) :=
begin
  intros n hn,
  cases hn,
  {split, swap, exact Δ, split, simp, rw hn, exact h},
  {have : ∃ (i : sseqt) (H : i ∈ l₂), (minfo (n.val)).id = i,
     {apply be_ex, exact hbs, exact hn},
   rcases this with ⟨w, hw, hsat⟩, split, swap, exact w, split,
   {simp [hw]}, {exact hsat}}
end

theorem be_forall : Π l Γ,
batch_eq l Γ → ∀ i ∈ Γ, ∃ (m : model) (h : m ∈ l), (minfo m.1).id = i
| l Γ bs_nil := λ m hm, by simpa using hm
| l Γ (bs_cons m Δ l₁ l₂ h hbs) :=
begin
  intros i hi,
  cases hi, {split, swap, exact m, split, simp, rw hi, exact h},
  {have : ∃ (n : model) (H : n ∈ l₁), (minfo (n.val)).id = i,
     {apply be_forall, exact hbs, exact hi},
   rcases this with ⟨w, hw, hsat⟩, split, swap, exact w, split,
   {simp [hw]}, {exact hsat} }
end

theorem mem_be_box : Π l Γ,
batch_eq l (unmodal_seqt Γ) → ∀ (m : model), m ∈l → ∀ φ, box φ ∈ Γ.b → box φ ∈ htk m.1 :=
begin
  intros l Γ hbs m hm φ hφ,
  have := be_ex _ _ hbs _ hm,
  rcases this with ⟨i,hin,hi⟩,
  have := unmodal_mem_box _ _ hin φ hφ,
  rw ←hi at this,
  cases m with m pm,
  cases m with im lm sgm,
  simp, simp at this,
  apply im.mhtk this
end

theorem mem_be_dia : Π l Γ,
batch_eq l (unmodal_seqt Γ) → ∀ φ, dia φ ∈ Γ.m → φ ∉ Γ.h →
∃ (i : model) (h : i ∈ l), φ ∈ htk i.1 :=
begin
  intros l Γ hbs φ h₁ h₂,
  have := mem_unmodal_seqt _ _ ⟨h₂, h₁⟩,
  rcases this with ⟨w, hmem, hw⟩,
  have := be_forall _ _ hbs w hmem,
  rcases this with ⟨m, hm, heq⟩,
  split, split, exact hm,
  cases m with m pm,
  cases m with im lm sgm,
  rw ←heq at hw, simp, simp at hw,
  apply im.mhtk hw
end

def dia_rule_seqt {p : sseqt → Prop} (f : Π Γ, p Γ → node Γ): Π Γ : list sseqt, (∀ i∈Γ, p i) →
psum ({i // i ∈ Γ ∧ unsatisfiable (sseqt.m i ++ sseqt.b i)})
{x : list model // batch_eq x Γ}
| [] h := psum.inr ⟨[], bs_nil⟩
| (hd :: tl) h :=
match f hd (h hd (by simp)) with
| (node.closed pr) := psum.inl ⟨hd, by simp, pr⟩
| (node.open_ w₁) :=
  match dia_rule_seqt tl (λ x hx, h x $ by simp [hx]) with
  | (psum.inl uw) := begin
                       left, rcases uw with ⟨w, hin, h⟩,
                       split, split, swap, exact h, simp [hin]
                     end
  | (psum.inr w₂) := psum.inr ⟨(w₁.1::w₂), bs_cons _ _ _ _ w₁.2 w₂.2⟩
  end
end

@[simp] def dia_rule_loop (h b : list nnf) : list nnf → list psig
| [] := []
| (dia φ::tl) := if φ ∈ h then ⟨φ, b⟩ :: dia_rule_loop tl else dia_rule_loop tl
| (e::tl) := dia_rule_loop tl

theorem mem_loop_left : Π h b m φ (h₁ : φ ∈ h) (h₂ : dia φ ∈ m),
(⟨φ, b⟩ : psig) ∈ dia_rule_loop h b m
| h b [] φ h₁ h₂ := absurd h₂ $ list.not_mem_nil _
| h b (hd :: tl) φ h₁ h₂ :=
begin
cases h' : hd,
case nnf.dia : ψ
{simp, by_cases hc : ψ ∈ h,
 {rw if_pos, cases h₂,
  {rw h' at h₂, injection h₂ with heq, left, rw heq},
  {right, apply mem_loop_left, exact h₁, exact h₂}, exact hc },
 {rw if_neg, cases h₂, {rw h' at h₂, injection h₂ with heq, rw heq at h₁, contradiction}, {apply mem_loop_left, exact h₁, exact h₂},
 exact hc}},
all_goals
{simp, rw h' at h₂, cases h₂, contradiction, apply mem_loop_left, repeat {assumption}}
end

theorem mem_loop_right_aux : Π h b m φ, (⟨φ, b⟩ : psig) ∈ dia_rule_loop h b m → dia φ ∈ m
| h b [] φ h₁ := absurd h₁ $ list.not_mem_nil _
| h b (hd :: tl) φ h₁ :=
begin
cases h₂ : hd,
case nnf.dia : ψ
{rw h₂ at h₁, dsimp at h₁,
 by_cases hc : ψ ∈ h,
 {rw if_pos at h₁, cases h₁, {simp at h₁, rw h₁, simp}, {have := mem_loop_right_aux h b tl φ h₁, right, exact this},exact hc},
 {rw if_neg at h₁, have := mem_loop_right_aux h b tl φ h₁, right, exact this, exact hc} },
all_goals
{rw h₂ at h₁, simp at h₁, right, apply mem_loop_right_aux, exact h₁}
end

theorem mem_loop_right : Π h b m φ, (⟨φ, b⟩ : psig) ∈ dia_rule_loop h b m → φ ∈ h
| h b [] φ h₁ := absurd h₁ $ list.not_mem_nil _
| h b (hd :: tl) φ h₁ :=
begin
cases h₂ : hd,
case nnf.dia : ψ
{rw h₂ at h₁, dsimp at h₁,
 by_cases hc : ψ ∈ h,
 {rw if_pos at h₁, cases h₁, {simp at h₁, rw h₁, exact hc}, {have := mem_loop_right h b tl φ h₁, exact this},exact hc},
 {rw if_neg at h₁, have := mem_loop_right h b tl φ h₁, exact this, exact hc} },
all_goals
{rw h₂ at h₁, simp at h₁, apply mem_loop_right, exact h₁}
end

theorem mem_loop_box : Π h b m (rq : psig), rq ∈ dia_rule_loop h b m → rq.b = b
| h b [] rq h₁ := absurd h₁ $ list.not_mem_nil _
| h b (hd :: tl) rq h₁ :=
begin
cases h₂ : hd,
case nnf.dia : ψ
{rw h₂ at h₁, dsimp at h₁,
 by_cases hc : ψ ∈ h,
 {rw if_pos at h₁, cases h₁, rw h₁, apply mem_loop_box, exact h₁, exact hc},
 {rw if_neg at h₁, apply mem_loop_box, exact h₁, exact hc}},
all_goals
{rw h₂ at h₁, simp at h₁, apply mem_loop_box, exact h₁}
end

theorem mem_loop_dia : Π h b m (rq : psig), rq ∈ dia_rule_loop h b m → ∃ (φ : nnf) (h : φ ∈ h), rq.d = φ
| h b [] rq h₁ := absurd h₁ $ list.not_mem_nil _
| h b (hd :: tl) rq h₁ :=
begin
cases h₂ : hd,
case nnf.dia : ψ
{rw h₂ at h₁, dsimp at h₁,
 by_cases hc : ψ ∈ h,
 {rw if_pos at h₁, cases h₁, split, split, exact hc, rw h₁,
  apply mem_loop_dia, exact h₁, exact hc},
 {rw if_neg at h₁, apply mem_loop_dia, exact h₁, exact hc}},
all_goals
{rw h₂ at h₁, simp at h₁, apply mem_loop_dia, exact h₁}
end

@[simp] def models_to_tmodels (l : list model) : list tmodel :=
list.map (λ x : model, x.1) l

theorem pt_of_m_to_tm (l : list model) : ∀ (m : tmodel), m ∈ models_to_tmodels l → (ptmodel m) ∧ global_pt m :=
list.mapp _ _
begin intros x hx, exact x.2 end

def box_new_rule_seqt {Γ Δ : sseqt} (i : box_new_instance_seqt Γ Δ) : node Δ → node Γ
| (closed h) := begin
                  left,
                  {apply unsat_of_closed_box_new, repeat {assumption}},
                end
| (open_ w)  :=
begin
right,
swap,
clear box_new_rule_seqt,
cases i with φ h₁ h₂,
cases w with w pw,
cases w with wt pwa,
cases wt with iw lw sgw,
let rhtk := box φ :: iw.htk,
have hhtk : hintikka rhtk,
  {split,
   {intros n hn, cases hn,
    {contradiction},
    {intro hne, cases hne, contradiction,
     apply iw.hhtk.hno_contra, exact hn, exact hne} },
   {intros φ' ψ' h, cases h with heq hmem,
    {injection heq with eq₁ eq₂},
    {right,
     apply iw.hhtk.hand_left, exact hmem} },
   {intros φ' ψ' h, cases h with heq hmem,
    {injection heq with eq₁ eq₂},
    {right,
     apply iw.hhtk.hand_right, exact hmem}},
   {intros φ' ψ' h, cases h with heq hmem,
    {contradiction},
    {have := iw.hhtk.hor hmem, cases this,
     {left, right, exact this},
     {right, right, exact this}}},
   {intros φ' h, cases h with heq hmem,
    {injection heq with heq', rw heq',
     right, apply iw.mhtk, simp at pw, rw pw, simp},
    {right, apply iw.hhtk.hbox, exact hmem}}},
have mhtk : Γ.m ⊆ rhtk,
  {intros x hx, by_cases heq : x = box φ,
   {rw heq, simp},
   {have : x ∈ iw.id.m,
     {simp at pw, rw pw, dsimp, right,
      have := (mem_erase_of_ne heq).2 hx, exact this},
    right, apply iw.mhtk this }},
let im : info := ⟨Γ, rhtk, hhtk, mhtk⟩,
let tm : tmodel := tmodel.cons im lw sgw,
have ptm : ptmodel tm,
  {split,
   {simp, have := pwa.1.bhist, simp at pw, simp at this, rw pw at this, simp at this,
    intros s hs φ hφ, apply this, exact hs, right, exact hφ},
   {simp, have := pwa.1.sbox, simp at this,
    have hbhist := pwa.1.bhist, simp at hbhist,
    intros s hs ψ hψ, cases hψ,
    {apply hbhist _ hs, simp at pw, rw pw, simp, left, exact hψ},
    {apply this, exact hs, exact hψ}},
   {simp, have := pwa.1.pdia, simp at this, exact this},
   {simp, have := pwa.1.bdia, simp at pw, simp at this,
    rw pw at this, simp at this,
    intros s rq hdesc hmem, rw eq_desc_of_eq_children at hdesc, swap, exact iw, swap, exact sgw,
    have := this s rq hdesc hmem,
    cases this with hl hr,
    {left, exact hl},
    {right, rcases hr with ⟨d, hd⟩, rw eq_desc_of_eq_children at hd, split, exact hd} },
   {simp, have := pwa.1.reqb, simp at pw, simp at this, rw pw at this, simp at this,
    intros rq hrq ψ hor, cases hor with hl hr,
    {cases hl, apply this, exact hrq, right, left, exact hl, apply this, exact hrq, left, exact hl},
    {apply this, exact hrq, right, right, exact hr}},
   {simp, have := pwa.1.sreq, simp at pw, simp at this, rw pw at this, simp at this, exact this}},
have gpt : global_pt tm,
  {intros s hs, have := pwa.2 s, rw eq_desc_of_eq_children at this, apply this, exact hs},
have hinfo : (minfo tm).id = Γ, {simp},
exact ⟨⟨tm, ⟨ptm, gpt⟩⟩, hinfo⟩
end

def box_rule_seqt {Γ Δ : sseqt} (i : box_dup_instance_seqt Γ Δ) : node Δ → node Γ
| (closed h) := begin
                  left,
                  {apply unsat_of_closed_box_dup, repeat {assumption}},
                end
| (open_ w)  :=
begin
right,
swap,
clear box_rule_seqt,
cases i with φ h₁ h₂,
cases w with w pw,
cases w with wt pwa,
cases wt with iw lw sgw,
let rhtk := box φ :: iw.htk,
have hhtk : hintikka rhtk,
  {split,
   {intros n hn, cases hn,
    {contradiction},
    {intro hne, cases hne, contradiction,
     apply iw.hhtk.hno_contra, exact hn, exact hne} },
   {intros φ' ψ' h, cases h with heq hmem,
    {injection heq with eq₁ eq₂},
    {right,
     apply iw.hhtk.hand_left, exact hmem} },
   {intros φ' ψ' h, cases h with heq hmem,
    {injection heq with eq₁ eq₂},
    {right,
     apply iw.hhtk.hand_right, exact hmem}},
   {intros φ' ψ' h, cases h with heq hmem,
    {contradiction},
    {have := iw.hhtk.hor hmem, cases this,
     {left, right, exact this},
     {right, right, exact this}}},
   {intros φ' h, cases h with heq hmem,
    {injection heq with heq', rw heq',
     right, apply iw.mhtk, simp at pw, rw pw, simp},
    {right, apply iw.hhtk.hbox, exact hmem}}},
have mhtk : Γ.m ⊆ rhtk,
  {intros x hx, by_cases heq : x = box φ,
   {rw heq, simp},
   {have : x ∈ iw.id.m,
     {simp at pw, rw pw, dsimp, right,
      have := (mem_erase_of_ne heq).2 hx, exact this},
    right, apply iw.mhtk this }},
let im : info := ⟨Γ, rhtk, hhtk, mhtk⟩,
let tm : tmodel := tmodel.cons im lw sgw,
have ptm : ptmodel tm,
  {split,
   {simp, have := pwa.1.bhist, simp at pw, simp at this, rw pw at this, simp at this,
    intros s hs φ hφ, apply this, exact hs, exact hφ},
   {simp, have := pwa.1.sbox, simp at this,
    have hbhist := pwa.1.bhist, simp at hbhist,
    intros s hs ψ hψ, cases hψ,
    {apply hbhist _ hs, simp at pw, rw pw, simp, rw hψ, exact h₂},
    {apply this, exact hs, exact hψ}},
   {simp, have := pwa.1.pdia, simp at this, exact this},
   {simp, have := pwa.1.bdia, simp at pw, simp at this,
    rw pw at this, simp at this,
    intros s rq hdesc hmem, rw eq_desc_of_eq_children at hdesc, swap, exact iw, swap, exact sgw,
    have := this s rq hdesc hmem,
    cases this with hl hr,
    {left, exact hl},
    {right, rcases hr with ⟨d, hd⟩, rw eq_desc_of_eq_children at hd, split, exact hd} },
   {simp, have := pwa.1.reqb, simp at pw, simp at this, rw pw at this, simp at this,
    intros rq hrq ψ hor, cases hor with hl hr,
    {cases hl, apply this, exact hrq, right, rw hl, exact h₂, apply this, exact hrq, left, exact hl},
    {apply this, exact hrq, right, exact hr}},
   {simp, have := pwa.1.sreq, simp at pw, simp at this, rw pw at this, simp at this, exact this}},
have gpt : global_pt tm,
  {intros s hs, have := pwa.2 s, rw eq_desc_of_eq_children at this, apply this, exact hs},
have hinfo : (minfo tm).id = Γ, {simp},
exact ⟨⟨tm, ⟨ptm, gpt⟩⟩, hinfo⟩
end

def build_model {Γ} (h : model_constructible Γ) : node Γ :=
begin
right,
split, swap,
{let mΓ : sseqt := Γ,
 let mhtk := Γ.m,
 have mhhtk : hintikka Γ.m, {apply hintikka_mc h},
 have mmhtk : Γ.m ⊆ Γ.m, {simp},
 split, swap,
 {let minfo : info := ⟨mΓ, mhtk, mhhtk, mmhtk⟩,
  exact tmodel.cons minfo [] [] },
 {split,
  {split,
   {simp},
   {simp},
   {simp, intros φ hφ, apply h.no_dia, exact hφ},
   {simp, intros s rq hdesc, exfalso, apply desc_not_nil, swap, exact hdesc, refl},
   {simp},
   {simp}},
  {intros x hx, exfalso, apply desc_not_nil, swap, exact hx, refl}}},
{simp}
end

def or_rule_seqt {Γ₁ Γ₂ Δ} (i : or_instance_seqt Δ Γ₁ Γ₂) :
            node Γ₁ → node Γ₂ → node Δ
| (open_ w) _ :=
begin
right,
clear or_rule_seqt,
cases i with φ ψ h,
cases w with w pw,
cases w with wt pwa,
cases wt with iw lw sgw,
let rhtk := or φ ψ :: iw.htk,
have hhtk : hintikka rhtk,
  {split,
   {intros n hn, cases hn,
    {contradiction},
    {intro hne, cases hne, contradiction,
     apply iw.hhtk.hno_contra, exact hn, exact hne} },
   {intros φ' ψ' h, cases h with heq hmem,
    {injection heq with eq₁ eq₂},
    {right,
     apply iw.hhtk.hand_left, exact hmem} },
   {intros φ' ψ' h, cases h with heq hmem,
    {injection heq with eq₁ eq₂},
    {right,
     apply iw.hhtk.hand_right, exact hmem}},
   {intros φ' ψ' h, cases h with heq hmem,
    {injection heq with heq₁ heq₂, rw heq₁, rw heq₂, left, simp at pw, have := iw.mhtk, rw pw at this, simp at this, right, exact this.1},
    {have := iw.hhtk.hor hmem, cases this,
     {left, right, exact this},
     {right, right, exact this}}},
   {intros φ' h, cases h with heq hmem,
    {contradiction},
    {right, apply iw.hhtk.hbox, exact hmem}}},
have mhtk : Δ.m ⊆ rhtk,
  {intros x hx, by_cases heq : x = or φ ψ,
   {rw heq, simp},
   {have : x ∈ iw.id.m,
     {simp at pw, rw pw, dsimp, right,
      have := (mem_erase_of_ne heq).2 hx, exact this},
    right, apply iw.mhtk this }},
let im : info := ⟨Δ, rhtk, hhtk, mhtk⟩,
let tm : tmodel := tmodel.cons im lw sgw,
have ptm : ptmodel tm,
  {split,
   {simp, have := pwa.1.bhist, simp at pw, simp at this, rw pw at this, simp at this, exact this},
   {simp, have := pwa.1.sbox, simp at this, exact this},
   {simp, have := pwa.1.pdia, simp at this, exact this},
   {simp, have := pwa.1.bdia, simp at pw, simp at this,
    rw pw at this, simp at this,
    intros s rq hdesc hmem, rw eq_desc_of_eq_children at hdesc, swap, exact iw, swap, exact sgw,
    have := this s rq hdesc hmem,
    cases this with hl hr,
    {left, exact hl},
    {right, rcases hr with ⟨d, hd⟩, rw eq_desc_of_eq_children at hd, split, exact hd} },
   {simp, have := pwa.1.reqb, simp at pw, simp at this, rw pw at this, simp at this, exact this},
   {simp, have := pwa.1.sreq, simp at pw, simp at this, rw pw at this, simp at this, exact this}},
have gpt : global_pt tm,
  {intros s hs, have := pwa.2 s, rw eq_desc_of_eq_children at this, apply this, exact hs},
have hinfo : (minfo tm).id = Δ, {simp},
exact ⟨⟨tm, ⟨ptm, gpt⟩⟩, hinfo⟩
end
| _ (open_ w) :=
begin
right,
clear or_rule_seqt,
cases i with φ ψ h,
cases w with w pw,
cases w with wt pwa,
cases wt with iw lw sgw,
let rhtk := or φ ψ :: iw.htk,
have hhtk : hintikka rhtk,
  {split,
   {intros n hn, cases hn,
    {contradiction},
    {intro hne, cases hne, contradiction,
     apply iw.hhtk.hno_contra, exact hn, exact hne} },
   {intros φ' ψ' h, cases h with heq hmem,
    {injection heq with eq₁ eq₂},
    {right,
     apply iw.hhtk.hand_left, exact hmem} },
   {intros φ' ψ' h, cases h with heq hmem,
    {injection heq with eq₁ eq₂},
    {right,
     apply iw.hhtk.hand_right, exact hmem}},
   {intros φ' ψ' h, cases h with heq hmem,
    {injection heq with heq₁ heq₂, rw heq₁, rw heq₂, right, simp at pw, have := iw.mhtk, rw pw at this, simp at this, right, exact this.1},
    {have := iw.hhtk.hor hmem, cases this,
     {left, right, exact this},
     {right, right, exact this}}},
   {intros φ' h, cases h with heq hmem,
    {contradiction},
    {right, apply iw.hhtk.hbox, exact hmem}}},
have mhtk : Δ.m ⊆ rhtk,
  {intros x hx, by_cases heq : x = or φ ψ,
   {rw heq, simp},
   {have : x ∈ iw.id.m,
     {simp at pw, rw pw, dsimp, right,
      have := (mem_erase_of_ne heq).2 hx, exact this},
    right, apply iw.mhtk this }},
let im : info := ⟨Δ, rhtk, hhtk, mhtk⟩,
let tm : tmodel := tmodel.cons im lw sgw,
have ptm : ptmodel tm,
  {split,
   {simp, have := pwa.1.bhist, simp at pw, simp at this, rw pw at this, simp at this, exact this},
   {simp, have := pwa.1.sbox, simp at this, exact this},
   {simp, have := pwa.1.pdia, simp at this, exact this},
   {simp, have := pwa.1.bdia, simp at pw, simp at this,
    rw pw at this, simp at this,
    intros s rq hdesc hmem, rw eq_desc_of_eq_children at hdesc, swap, exact iw, swap, exact sgw,
    have := this s rq hdesc hmem,
    cases this with hl hr,
    {left, exact hl},
    {right, rcases hr with ⟨d, hd⟩, rw eq_desc_of_eq_children at hd, split, exact hd} },
   {simp, have := pwa.1.reqb, simp at pw, simp at this, rw pw at this, simp at this, exact this},
   {simp, have := pwa.1.sreq, simp at pw, simp at this, rw pw at this, simp at this, exact this}},
have gpt : global_pt tm,
  {intros s hs, have := pwa.2 s, rw eq_desc_of_eq_children at this, apply this, exact hs},
have hinfo : (minfo tm).id = Δ, {simp},
exact ⟨⟨tm, ⟨ptm, gpt⟩⟩, hinfo⟩
end
| (closed h₁) (closed h₂):= begin
                              left,
                              apply unsat_of_closed_or_seqt,
                              repeat {assumption}
                            end

def open_rule_seqt {Γ₁ Γ₂ Δ} {m : model} (i : or_instance_seqt Δ Γ₁ Γ₂) (hid : (minfo m.1).id = Γ₁) : node Δ :=
begin
right,
cases i with φ ψ h,
cases m with wt pwa,
cases wt with iw lw sgw,
let rhtk := or φ ψ :: iw.htk,
have hhtk : hintikka rhtk,
  {split,
   {intros n hn, cases hn,
    {contradiction},
    {intro hne, cases hne, contradiction,
     apply iw.hhtk.hno_contra, exact hn, exact hne} },
   {intros φ' ψ' h, cases h with heq hmem,
    {injection heq with eq₁ eq₂},
    {right,
     apply iw.hhtk.hand_left, exact hmem} },
   {intros φ' ψ' h, cases h with heq hmem,
    {injection heq with eq₁ eq₂},
    {right,
     apply iw.hhtk.hand_right, exact hmem}},
   {intros φ' ψ' h, cases h with heq hmem,
    {injection heq with heq₁ heq₂, rw heq₁, rw heq₂, left, simp at hid, have := iw.mhtk, rw hid at this, simp at this, right, exact this.1},
    {have := iw.hhtk.hor hmem, cases this,
     {left, right, exact this},
     {right, right, exact this}}},
   {intros φ' h, cases h with heq hmem,
    {contradiction},
    {right, apply iw.hhtk.hbox, exact hmem}}},
have mhtk : Δ.m ⊆ rhtk,
  {intros x hx, by_cases heq : x = or φ ψ,
   {rw heq, simp},
   {have : x ∈ iw.id.m,
     {simp at hid, rw hid, dsimp, right,
      have := (mem_erase_of_ne heq).2 hx, exact this},
    right, apply iw.mhtk this }},
let im : info := ⟨Δ, rhtk, hhtk, mhtk⟩,
let tm : tmodel := tmodel.cons im lw sgw,
have ptm : ptmodel tm,
  {split,
   {simp, have := pwa.1.bhist, simp at hid, simp at this, rw hid at this, simp at this, exact this},
   {simp, have := pwa.1.sbox, simp at this, exact this},
   {simp, have := pwa.1.pdia, simp at this, exact this},
   {simp, have := pwa.1.bdia, simp at hid, simp at this,
    rw hid at this, simp at this,
    intros s rq hdesc hmem, rw eq_desc_of_eq_children at hdesc, swap, exact iw, swap, exact sgw,
    have := this s rq hdesc hmem,
    cases this with hl hr,
    {left, exact hl},
    {right, rcases hr with ⟨d, hd⟩, rw eq_desc_of_eq_children at hd, split, exact hd} },
   {simp, have := pwa.1.reqb, simp at hid, simp at this, rw hid at this, simp at this, exact this},
   {simp, have := pwa.1.sreq, simp at hid, simp at this, rw hid at this, simp at this, exact this}},
have gpt : global_pt tm,
  {intros s hs, have := pwa.2 s, rw eq_desc_of_eq_children at this, apply this, exact hs},
have hinfo : (minfo tm).id = Δ, {simp},
exact ⟨⟨tm, ⟨ptm, gpt⟩⟩, hinfo⟩
end


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

! This file was ported from Lean 3 source module data.finsupp.to_dfinsupp
! leanprover-community/mathlib commit 59694bd07f0a39c5beccba34bd9f413a160782bf
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Module.Equiv
import Mathlib.Data.Dfinsupp.Basic
import Mathlib.Data.Finsupp.Basic

/-!
# Conversion between `Finsupp` and homogenous `Dfinsupp`

This module provides conversions between `Finsupp` and `Dfinsupp`.
It is in its own file since neither `Finsupp` or `Dfinsupp` depend on each other.

## Main definitions

* "identity" maps between `Finsupp` and `Dfinsupp`:
  * `Finsupp.toDfinsupp : (ι →₀ M) → (Π₀ i : ι, M)`
  * `Dfinsupp.toFinsupp : (Π₀ i : ι, M) → (ι →₀ M)`
  * Bundled equiv versions of the above:
    * `finsuppEquivDfinsupp : (ι →₀ M) ≃ (Π₀ i : ι, M)`
    * `finsuppAddEquivDfinsupp : (ι →₀ M) ≃+ (Π₀ i : ι, M)`
    * `finsuppLequivDfinsupp R : (ι →₀ M) ≃ₗ[R] (Π₀ i : ι, M)`
* stronger versions of `Finsupp.split`:
  * `sigmaFinsuppEquivDfinsupp : ((Σ i, η i) →₀ N) ≃ (Π₀ i, (η i →₀ N))`
  * `sigmaFinsuppAddEquivDfinsupp : ((Σ i, η i) →₀ N) ≃+ (Π₀ i, (η i →₀ N))`
  * `sigmaFinsuppLequivDfinsupp : ((Σ i, η i) →₀ N) ≃ₗ[R] (Π₀ i, (η i →₀ N))`

## Theorems

The defining features of these operations is that they preserve the function and support:

* `Finsupp.toDfinsupp_coe`
* `Finsupp.toDfinsupp_support`
* `Dfinsupp.toFinsupp_coe`
* `Dfinsupp.toFinsupp_support`

and therefore map `Finsupp.single` to `Dfinsupp.single` and vice versa:

* `Finsupp.toDfinsupp_single`
* `Dfinsupp.toFinsupp_single`

as well as preserving arithmetic operations.

For the bundled equivalences, we provide lemmas that they reduce to `Finsupp.toDfinsupp`:

* `finsupp_add_equiv_dfinsupp_apply`
* `finsupp_lequiv_dfinsupp_apply`
* `finsupp_add_equiv_dfinsupp_symm_apply`
* `finsupp_lequiv_dfinsupp_symm_apply`

## Implementation notes

We provide `Dfinsupp.toFinsupp` and `finsuppEquivDfinsupp` computably by adding
`[DecidableEq ι]` and `[Π m : M, Decidable (m ≠ 0)]` arguments. To aid with definitional unfolding,
these arguments are also present on the `noncomputable` equivs.
-/

variable {ι : Type _} {R : Type _} {M : Type _}

/-! ### Basic definitions and lemmas -/

section Defs

/-- Interpret a `Finsupp` as a homogenous `Dfinsupp`. -/
def Finsupp.toDfinsupp [Zero M] (f : ι →₀ M) : Π₀ _i : ι, M where
  toFun := f
  support' :=
    Trunc.mk
      ⟨f.support.1, fun i => (Classical.em (f i = 0)).symm.imp_left Finsupp.mem_support_iff.mpr⟩
#align finsupp.to_dfinsupp Finsupp.toDfinsupp

@[simp]
theorem Finsupp.toDfinsupp_coe [Zero M] (f : ι →₀ M) : ⇑f.toDfinsupp = f :=
  rfl
#align finsupp.to_dfinsupp_coe Finsupp.toDfinsupp_coe

section

variable [DecidableEq ι] [Zero M]

@[simp]
theorem Finsupp.toDfinsupp_single (i : ι) (m : M) :
    (Finsupp.single i m).toDfinsupp = Dfinsupp.single i m := by
  ext
  simp [Finsupp.single_apply, Dfinsupp.single_apply]
#align finsupp.to_dfinsupp_single Finsupp.toDfinsupp_single

variable [∀ m : M, Decidable (m ≠ 0)]

@[simp]
theorem toDfinsupp_support (f : ι →₀ M) : f.toDfinsupp.support = f.support := by
  ext
  simp
#align to_dfinsupp_support toDfinsupp_support

/-- Interpret a homogenous `Dfinsupp` as a `Finsupp`.

Note that the elaborator has a lot of trouble with this definition - it is often necessary to
write `(Dfinsupp.toFinsupp f : ι →₀ M)` instead of `f.toFinsupp`, as for some unknown reason
using dot notation or omitting the type ascription prevents the type being resolved correctly. -/
def Dfinsupp.toFinsupp (f : Π₀ _i : ι, M) : ι →₀ M :=
  ⟨f.support, f, fun i => by simp only [Dfinsupp.mem_support_iff]⟩
#align dfinsupp.to_finsupp Dfinsupp.toFinsupp

@[simp]
theorem Dfinsupp.toFinsupp_coe (f : Π₀ _i : ι, M) : ⇑f.toFinsupp = f :=
  rfl
#align dfinsupp.to_finsupp_coe Dfinsupp.toFinsupp_coe

@[simp]
theorem Dfinsupp.toFinsupp_support (f : Π₀ _i : ι, M) : f.toFinsupp.support = f.support := by
  ext
  simp
#align dfinsupp.to_finsupp_support Dfinsupp.toFinsupp_support

@[simp]
theorem Dfinsupp.toFinsupp_single (i : ι) (m : M) :
    (Dfinsupp.single i m : Π₀ _i : ι, M).toFinsupp = Finsupp.single i m := by
  ext
  simp [Finsupp.single_apply, Dfinsupp.single_apply]
#align dfinsupp.to_finsupp_single Dfinsupp.toFinsupp_single

@[simp]
theorem Finsupp.toDfinsupp_toFinsupp (f : ι →₀ M) : f.toDfinsupp.toFinsupp = f :=
  FunLike.coe_injective rfl
#align finsupp.to_dfinsupp_to_finsupp Finsupp.toDfinsupp_toFinsupp

@[simp]
theorem Dfinsupp.toFinsupp_toDfinsupp (f : Π₀ _i : ι, M) : f.toFinsupp.toDfinsupp = f :=
  FunLike.coe_injective rfl
#align dfinsupp.to_finsupp_to_dfinsupp Dfinsupp.toFinsupp_toDfinsupp

end

end Defs

/-! ### Lemmas about arithmetic operations -/

section Lemmas

namespace Finsupp

@[simp]
theorem toDfinsupp_zero [Zero M] : (0 : ι →₀ M).toDfinsupp = 0 :=
  FunLike.coe_injective rfl
#align finsupp.to_dfinsupp_zero Finsupp.toDfinsupp_zero

@[simp]
theorem toDfinsupp_add [AddZeroClass M] (f g : ι →₀ M) :
    (f + g).toDfinsupp = f.toDfinsupp + g.toDfinsupp :=
  FunLike.coe_injective rfl
#align finsupp.to_dfinsupp_add Finsupp.toDfinsupp_add

@[simp]
theorem toDfinsupp_neg [AddGroup M] (f : ι →₀ M) : (-f).toDfinsupp = -f.toDfinsupp :=
  FunLike.coe_injective rfl
#align finsupp.to_dfinsupp_neg Finsupp.toDfinsupp_neg

@[simp]

@[simp]
theorem toDfinsupp_smul [Monoid R] [AddMonoid M] [DistribMulAction R M] (r : R) (f : ι →₀ M) :
    (r • f).toDfinsupp = r • f.toDfinsupp :=
  FunLike.coe_injective rfl
#align finsupp.to_dfinsupp_smul Finsupp.toDfinsupp_smul

end Finsupp

namespace Dfinsupp

variable [DecidableEq ι]

@[simp]
theorem toFinsupp_zero [Zero M] [∀ m : M, Decidable (m ≠ 0)] : toFinsupp 0 = (0 : ι →₀ M) :=
  FunLike.coe_injective rfl
#align dfinsupp.to_finsupp_zero Dfinsupp.toFinsupp_zero

@[simp]
theorem toFinsupp_add [AddZeroClass M] [∀ m : M, Decidable (m ≠ 0)] (f g : Π₀ _i : ι, M) :
    (toFinsupp (f + g) : ι →₀ M) = toFinsupp f + toFinsupp g :=
  FunLike.coe_injective <| Dfinsupp.coe_add _ _
#align dfinsupp.to_finsupp_add Dfinsupp.toFinsupp_add

@[simp]
theorem toFinsupp_neg [AddGroup M] [∀ m : M, Decidable (m ≠ 0)] (f : Π₀ _i : ι, M) :
    (toFinsupp (-f) : ι →₀ M) = -toFinsupp f :=
  FunLike.coe_injective <| Dfinsupp.coe_neg _
#align dfinsupp.to_finsupp_neg Dfinsupp.toFinsupp_neg

@[simp]
theorem toFinsupp_sub [AddGroup M] [∀ m : M, Decidable (m ≠ 0)] (f g : Π₀ _i : ι, M) :
    (toFinsupp (f - g) : ι →₀ M) = toFinsupp f - toFinsupp g :=
  FunLike.coe_injective <| Dfinsupp.coe_sub _ _
#align dfinsupp.to_finsupp_sub Dfinsupp.toFinsupp_sub

@[simp]
theorem toFinsupp_smul [Monoid R] [AddMonoid M] [DistribMulAction R M] [∀ m : M, Decidable (m ≠ 0)]
    (r : R) (f : Π₀ _i : ι, M) : (toFinsupp (r • f) : ι →₀ M) = r • toFinsupp f :=
  FunLike.coe_injective <| Dfinsupp.coe_smul _ _
#align dfinsupp.to_finsupp_smul Dfinsupp.toFinsupp_smul

end Dfinsupp

end Lemmas

/-! ### Bundled `Equiv`s -/

section Equivs

/-- `Finsupp.toDfinsupp` and `Dfinsupp.toFinsupp` together form an equiv. -/
@[simps (config := { fullyApplied := false })]
def finsuppEquivDfinsupp [DecidableEq ι] [Zero M] [∀ m : M, Decidable (m ≠ 0)] :
    (ι →₀ M) ≃ Π₀ _i : ι, M where
  toFun := Finsupp.toDfinsupp
  invFun := Dfinsupp.toFinsupp
  left_inv := Finsupp.toDfinsupp_toFinsupp
  right_inv := Dfinsupp.toFinsupp_toDfinsupp
#align finsupp_equiv_dfinsupp finsuppEquivDfinsupp

/-- The additive version of `finsupp.toFinsupp`. Note that this is `noncomputable` because
`Finsupp.add` is noncomputable. -/
@[simps (config := { fullyApplied := false })]
def finsuppAddEquivDfinsupp [DecidableEq ι] [AddZeroClass M] [∀ m : M, Decidable (m ≠ 0)] :
    (ι →₀ M) ≃+ Π₀ _i : ι, M :=
  { finsuppEquivDfinsupp with
    toFun := Finsupp.toDfinsupp
    invFun := Dfinsupp.toFinsupp
    map_add' := Finsupp.toDfinsupp_add }
#align finsupp_add_equiv_dfinsupp finsuppAddEquivDfinsupp

variable (R)

/-- The additive version of `Finsupp.toTinsupp`. Note that this is `noncomputable` because
`Finsupp.add` is noncomputable. -/
-- porting note: `simps` generated lemmas that did not pass `simpNF` lints, manually added below
--@[simps? (config := { fullyApplied := false })]
def finsuppLequivDfinsupp [DecidableEq ι] [Semiring R] [AddCommMonoid M]
    [∀ m : M, Decidable (m ≠ 0)] [Module R M] : (ι →₀ M) ≃ₗ[R] Π₀ _i : ι, M :=
  { finsuppEquivDfinsupp with
    toFun := Finsupp.toDfinsupp
    invFun := Dfinsupp.toFinsupp
    map_smul' := Finsupp.toDfinsupp_smul
    map_add' := Finsupp.toDfinsupp_add }
#align finsupp_lequiv_dfinsupp finsuppLequivDfinsupp

-- porting note: `simps` generated as ` ↑(finsuppLequivDfinsupp R).toLinearMap = Finsupp.toDfinsupp`
@[simp]
theorem finsuppLequivDfinsupp_apply_apply [DecidableEq ι] [Semiring R] [AddCommMonoid M]
    [∀ m : M, Decidable (m ≠ 0)] [Module R M] :
      (↑(finsuppLequivDfinsupp (M := M) R) : (ι →₀ M) → _) = Finsupp.toDfinsupp := by
       simp only [@LinearEquiv.coe_coe]; rfl

@[simp]
theorem finsuppLequivDfinsupp_symm_apply [DecidableEq ι] [Semiring R] [AddCommMonoid M]
    [∀ m : M, Decidable (m ≠ 0)] [Module R M] :
    ↑(LinearEquiv.symm (finsuppLequivDfinsupp (ι := ι) (M := M) R)) = Dfinsupp.toFinsupp :=
  rfl

-- porting note: moved noncomputable declaration into section begin
noncomputable section Sigma

/-! ### Stronger versions of `Finsupp.split` -/
--noncomputable section

variable {η : ι → Type _} {N : Type _} [Semiring R]

open Finsupp

/-- `Finsupp.split` is an equivalence between `(Σ i, η i) →₀ N` and `Π₀ i, (η i →₀ N)`. -/
def sigmaFinsuppEquivDfinsupp [Zero N] : ((Σi, η i) →₀ N) ≃ Π₀ i, η i →₀ N where
  toFun f := ⟨split f, Trunc.mk ⟨(splitSupport f : Finset ι).val, fun i => by
          rw [← Finset.mem_def, mem_splitSupport_iff_nonzero]
          exact (em _).symm⟩⟩
  invFun f := by
    haveI := Classical.decEq ι
    haveI := fun i => Classical.decEq (η i →₀ N)
    refine'
      onFinset (Finset.sigma f.support fun j => (f j).support) (fun ji => f ji.1 ji.2) fun g hg =>
        Finset.mem_sigma.mpr ⟨_, mem_support_iff.mpr hg⟩
    simp only [Ne.def, Dfinsupp.mem_support_toFun]
    intro h
    dsimp at hg
    rw [h] at hg
    simp only [coe_zero, Pi.zero_apply, not_true] at hg
  left_inv f := by ext; simp [split]
  right_inv f := by ext; simp [split]
#align sigma_finsupp_equiv_dfinsupp sigmaFinsuppEquivDfinsupp

@[simp]
theorem sigmaFinsuppEquivDfinsupp_apply [Zero N] (f : (Σi, η i) →₀ N) :
    (sigmaFinsuppEquivDfinsupp f : ∀ i, η i →₀ N) = Finsupp.split f :=
  rfl
#align sigma_finsupp_equiv_dfinsupp_apply sigmaFinsuppEquivDfinsupp_apply

@[simp]
theorem sigmaFinsuppEquivDfinsupp_symm_apply [Zero N] (f : Π₀ i, η i →₀ N) (s : Σi, η i) :
    (sigmaFinsuppEquivDfinsupp.symm f : (Σi, η i) →₀ N) s = f s.1 s.2 :=
  rfl
#align sigma_finsupp_equiv_dfinsupp_symm_apply sigmaFinsuppEquivDfinsupp_symm_apply

@[simp]
theorem sigmaFinsuppEquivDfinsupp_support [DecidableEq ι] [Zero N]
    [∀ (i : ι) (x : η i →₀ N), Decidable (x ≠ 0)] (f : (Σi, η i) →₀ N) :
    (sigmaFinsuppEquivDfinsupp f).support = Finsupp.splitSupport f := by
  ext
  rw [Dfinsupp.mem_support_toFun]
  exact (Finsupp.mem_splitSupport_iff_nonzero _ _).symm
#align sigma_finsupp_equiv_dfinsupp_support sigmaFinsuppEquivDfinsupp_support

@[simp]
theorem sigmaFinsuppEquivDfinsupp_single [DecidableEq ι] [Zero N] (a : Σi, η i) (n : N) :
    sigmaFinsuppEquivDfinsupp (Finsupp.single a n) =
      @Dfinsupp.single _ (fun i => η i →₀ N) _ _ a.1 (Finsupp.single a.2 n) := by
  obtain ⟨i, a⟩ := a
  ext (j b)
  by_cases h : i = j
  · subst h
    classical simp [split_apply, Finsupp.single_apply]
  suffices Finsupp.single (⟨i, a⟩ : Σi, η i) n ⟨j, b⟩ = 0 by simp [split_apply, dif_neg h, this]
  have H : (⟨i, a⟩ : Σi, η i) ≠ ⟨j, b⟩ := by simp [h]
  classical rw [Finsupp.single_apply, if_neg H]
#align sigma_finsupp_equiv_dfinsupp_single sigmaFinsuppEquivDfinsupp_single

-- Without this Lean fails to find the `AddZeroClass` instance on `Π₀ i, (η i →₀ N)`.
attribute [-instance] Finsupp.zero

@[simp]
theorem sigmaFinsuppEquivDfinsupp_add [AddZeroClass N] (f g : (Σi, η i) →₀ N) :
    sigmaFinsuppEquivDfinsupp (f + g) =
      (sigmaFinsuppEquivDfinsupp f + sigmaFinsuppEquivDfinsupp g : Π₀ i : ι, η i →₀ N) := by
  ext
  rfl
#align sigma_finsupp_equiv_dfinsupp_add sigmaFinsuppEquivDfinsupp_add

/-- `Finsupp.split` is an additive equivalence between `(Σ i, η i) →₀ N` and `Π₀ i, (η i →₀ N)`. -/
@[simps]
def sigmaFinsuppAddEquivDfinsupp [AddZeroClass N] : ((Σi, η i) →₀ N) ≃+ Π₀ i, η i →₀ N :=
  { sigmaFinsuppEquivDfinsupp with
    toFun := sigmaFinsuppEquivDfinsupp
    invFun := sigmaFinsuppEquivDfinsupp.symm
    map_add' := sigmaFinsuppEquivDfinsupp_add }
#align sigma_finsupp_add_equiv_dfinsupp sigmaFinsuppAddEquivDfinsupp

attribute [-instance] Finsupp.addZeroClass

--tofix: r • (sigma_finsupp_equiv_dfinsupp f) doesn't work.
@[simp]
theorem sigmaFinsuppEquivDfinsupp_smul {R} [Monoid R] [AddMonoid N] [DistribMulAction R N] (r : R)
    (f : (Σi, η i) →₀ N) :
    sigmaFinsuppEquivDfinsupp (r • f) =
      @SMul.smul R (Π₀ i, η i →₀ N) MulAction.toSMul r (sigmaFinsuppEquivDfinsupp f) := by
  ext
  rfl
#align sigma_finsupp_equiv_dfinsupp_smul sigmaFinsuppEquivDfinsupp_smul

attribute [-instance] Finsupp.addMonoid

/-- `Finsupp.split` is a linear equivalence between `(Σ i, η i) →₀ N` and `Π₀ i, (η i →₀ N)`. -/
@[simps]
def sigmaFinsuppLequivDfinsupp [AddCommMonoid N] [Module R N] :
    ((Σi, η i) →₀ N) ≃ₗ[R] Π₀ i, η i →₀ N :=
    -- porting notes: was
    -- sigmaFinsuppAddEquivDfinsupp with map_smul' := sigmaFinsuppEquivDfinsupp_smul
    -- but times out
  { sigmaFinsuppEquivDfinsupp with
    toFun := sigmaFinsuppEquivDfinsupp
    invFun := sigmaFinsuppEquivDfinsupp.symm
    map_add' := sigmaFinsuppEquivDfinsupp_add
    map_smul' := sigmaFinsuppEquivDfinsupp_smul }
#align sigma_finsupp_lequiv_dfinsupp sigmaFinsuppLequivDfinsupp

end Sigma

end Equivs


import .X
import .action_Idem_X
import category_theory.natural_transformation
import category_theory.types
import data.quot
open CommRing
open X
open A2
open A2_disc
open idem_action_X
namespace π
variables (R : Type)[comm_ring R]
#check (A(R)).r
/--
##  X :=  R ↦ { (x,y) ∈ A^2 ∣ (x-y)^2 inversible}   we define   π : X ⟹ A2_disc    (x,y) →  (x+y, xy)
##            We want to show that the group of automorphism of  π  is Idem(R) and
-/
def π {R : Type }[comm_ring R] : X(R) → A2_disc(R) :=  λ η, begin
            have H : (η.x + η.y) * (η.x + η.y)  -↑4 * (η.x* η.y) = (η.x - η.y)^2,
                ring,simp,ring,
            have certif : ((η.x + η.y) * (η.x + η.y)  -↑4 * (η.x* η.y)) * η.inv = 1,
                rw H,
                exact η.certif,
            exact { ζ :=  {a := η.x + η.y, b := η.x * η.y},
                    inv_disc := η.inv,
                    certif_disc := certif},
        end
lemma Γ (R : CommRing) :  𝕏.obj(R) →  𝔸2_disc.obj(R) :=   π
lemma Γ_im_x {R : CommRing} (η  : X R) : (π  η ).ζ.a = η.x +η.y := rfl
lemma Γ_im_y {R : CommRing} (η  : X R) : (π η ).ζ.b = η.x *η.y := rfl
lemma naturality'' (A B : CommRing)(f : A ⟶   B) :(𝕏.map f  ≫  π ) = ( π  ≫  𝔸2_disc.map (f)) := begin
    rw [category_theory.types_comp,category_theory.types_comp],
    funext,
    have T : (π  ∘ 𝕏.map f) x =  π  (( 𝕏.map f) x),   ---- faire des lemmes !!!
        exact rfl,
    rw T,
    have T' : (𝔸2_disc.map f ∘ π ) x = (𝔸2_disc.map f)(π  x),
        exact rfl,
    have T'' : 𝔸2_disc.map f  = map_A2_disc f ,
        exact rfl,
    have T''' : 𝕏.map f = map_X f,
        exact rfl,
    rw T',
    rw T'',
    rw T''',
    ext,
    rw Γ_im_x (map_X f (x)),
    rw  A2_disc.map_comp_a (f) (π x),
    rw Γ_im_x (x),
    rw map_comp_x,
    rw map_comp_y,
    rw ← ring_hom.map_add f,
    rw Γ_im_y,
    rw map_comp_b,
    rw Γ_im_y (x),
    rw map_comp_x,
    rw map_comp_y,
    rw ← ring_hom.map_mul,
end
def φ  :   𝕏  ⟶  𝔸2_disc  := {
    app := λ R, π ,
    naturality' :=  naturality'',
}
#print φ
#check φ
end π
namespace fiber_π
open π
def fiber_π  (R : Type )[comm_ring R] :  A2_disc R → set (X(R)) :=   λ ζ, {η : X(R) | π (η) = ζ }
end fiber_π
open  fiber_π

#print fiber_π


import condensed.adjunctions
import category_theory.adjunction.evaluation
import for_mathlib.sheafification_mono

open category_theory
open category_theory.grothendieck_topology
open opposite

universe u

variables (F : Profinite.{u}ᵒᵖ ⥤ Ab.{u+1}) (G : Condensed.{u} Ab.{u+1})
variables (η : F ⟶ G.val)

theorem Condensed_Ab_sheafify_lift_mono_of_exists :
  (∀ (B : Profinite.{u}) (t : F.obj (op B)), η.app (op B) t = 0 →
    (∃ (α : Type u) [fintype α] (X : α → Profinite.{u}) (π : Π a : α, X a ⟶ B)
      (surj : ∀ b : B, ∃ (a : α) (x : X a), π a x = b),
      ∀ a : α, F.map (π a).op t = 0)) → mono (proetale_topology.sheafify_lift η G.cond) :=
begin
  intros h,
  apply sheafify_lift_mono_of_exists_cover,
  intros B t ht,
  specialize h B t ht,
  obtain ⟨α, hα, X, π, surj, h⟩ := h,
  resetI,
  let W : proetale_topology.cover B := ⟨sieve.generate (presieve.of_arrows X π), _⟩,
  use W,
  rintros ⟨Z,f,⟨A,g,hg,⟨a⟩,rfl⟩⟩,
  dsimp, simp [h a],
  use [presieve.of_arrows X π, α, hα, X, π, surj],
  apply sieve.le_generate,
end

theorem presheaf_to_Condensed_Ab_map_mono_of_exists
  (h : ∀ (B : Profinite.{u}) (t : F.obj (op B)), η.app (op B) t = 0 →
    (∃ (α : Type u) [fintype α] (X : α → Profinite.{u}) (π : Π a : α, X a ⟶ B)
      (surj : ∀ b : B, ∃ (a : α) (x : X a), π a x = b),
      ∀ a : α, F.map (π a).op t = 0)):
  mono (((sheafification_adjunction
    proetale_topology Ab.{u+1}).hom_equiv _ G).symm η) :=
begin
  apply faithful_reflects_mono (Sheaf_to_presheaf proetale_topology Ab.{u+1}),
  dsimp [sheafification_adjunction],
  apply Condensed_Ab_sheafify_lift_mono_of_exists,
  exact h
end


/-
Copyright (c) 2019 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.endomorphism
import Mathlib.category_theory.category.Cat
import Mathlib.algebra.category.Mon.basic
import Mathlib.PostPort

universes u v w u_1

namespace Mathlib

/-!
# Single-object category

Single object category with a given monoid of endomorphisms.  It is defined to facilitate transfering
some definitions and lemmas (e.g., conjugacy etc.) from category theory to monoids and groups.

## Main definitions

Given a type `α` with a monoid structure, `single_obj α` is `unit` type with `category` structure
such that `End (single_obj α).star` is the monoid `α`.  This can be extended to a functor `Mon ⥤
Cat`.

If `α` is a group, then `single_obj α` is a groupoid.

An element `x : α` can be reinterpreted as an element of `End (single_obj.star α)` using
`single_obj.to_End`.

## Implementation notes

- `category_struct.comp` on `End (single_obj.star α)` is `flip (*)`, not `(*)`. This way
  multiplication on `End` agrees with the multiplication on `α`.

- By default, Lean puts instances into `category_theory` namespace instead of
  `category_theory.single_obj`, so we give all names explicitly.
-/

namespace category_theory

/-- Type tag on `unit` used to define single-object categories and groupoids. -/
def single_obj (α : Type u) := Unit

namespace single_obj

/-- One and `flip (*)` become `id` and `comp` for morphisms of the single object category. -/
protected instance category_struct (α : Type u) [HasOne α] [Mul α] :
    category_struct (single_obj α) :=
  category_struct.mk (fun (_x : single_obj α) => 1)
    fun (_x _x_1 _x_2 : single_obj α) (x : _x ⟶ _x_1) (y : _x_1 ⟶ _x_2) => y * x

/-- Monoid laws become category laws for the single object category. -/
protected instance category (α : Type u) [monoid α] : category (single_obj α) := category.mk

/--
Groupoid structure on `single_obj α`.

See https://stacks.math.columbia.edu/tag/0019.
-/
protected instance groupoid (α : Type u) [group α] : groupoid (single_obj α) :=
  groupoid.mk fun (_x _x_1 : single_obj α) (x : _x ⟶ _x_1) => x⁻¹

/-- The single object in `single_obj α`. -/
protected def star (α : Type u) : single_obj α := Unit.unit

/-- The endomorphisms monoid of the only object in `single_obj α` is equivalent to the original
     monoid α. -/
def to_End (α : Type u) [monoid α] : α ≃* End (single_obj.star α) :=
  mul_equiv.mk (equiv.to_fun (equiv.refl α)) (equiv.inv_fun (equiv.refl α)) sorry sorry sorry

theorem to_End_def (α : Type u) [monoid α] (x : α) : coe_fn (to_End α) x = x := rfl

/-- There is a 1-1 correspondence between monoid homomorphisms `α → β` and functors between the
    corresponding single-object categories. It means that `single_obj` is a fully faithful
    functor.

See https://stacks.math.columbia.edu/tag/001F --
although we do not characterize when the functor is full or faithful.
-/
def map_hom (α : Type u) (β : Type v) [monoid α] [monoid β] :
    (α →* β) ≃ single_obj α ⥤ single_obj β :=
  equiv.mk (fun (f : α →* β) => functor.mk id fun (_x _x : single_obj α) => ⇑f)
    (fun (f : single_obj α ⥤ single_obj β) => monoid_hom.mk (functor.map f) sorry sorry) sorry sorry

theorem map_hom_id (α : Type u) [monoid α] : coe_fn (map_hom α α) (monoid_hom.id α) = 𝟭 := rfl

theorem map_hom_comp {α : Type u} {β : Type v} [monoid α] [monoid β] (f : α →* β) {γ : Type w}
    [monoid γ] (g : β →* γ) :
    coe_fn (map_hom α γ) (monoid_hom.comp g f) = coe_fn (map_hom α β) f ⋙ coe_fn (map_hom β γ) g :=
  rfl

end single_obj

end category_theory

namespace monoid_hom

/-- Reinterpret a monoid homomorphism `f : α → β` as a functor `(single_obj α) ⥤ (single_obj β)`.
See also `category_theory.single_obj.map_hom` for an equivalence between these types. -/
def to_functor {α : Type u} {β : Type v} [monoid α] [monoid β] (f : α →* β) :
    category_theory.single_obj α ⥤ category_theory.single_obj β :=
  coe_fn (category_theory.single_obj.map_hom α β) f

@[simp] theorem id_to_functor (α : Type u) [monoid α] : to_functor (id α) = 𝟭 := rfl

@[simp] theorem comp_to_functor {α : Type u} {β : Type v} [monoid α] [monoid β] (f : α →* β)
    {γ : Type w} [monoid γ] (g : β →* γ) : to_functor (comp g f) = to_functor f ⋙ to_functor g :=
  rfl

end monoid_hom

namespace units

/--
The units in a monoid are (multiplicatively) equivalent to
the automorphisms of `star` when we think of the monoid as a single-object category. -/
def to_Aut (α : Type u) [monoid α] :
    units α ≃* category_theory.Aut (category_theory.single_obj.star α) :=
  mul_equiv.trans (map_equiv (category_theory.single_obj.to_End α))
    (category_theory.Aut.units_End_equiv_Aut (category_theory.single_obj.star α))

@[simp] theorem to_Aut_hom (α : Type u) [monoid α] (x : units α) :
    category_theory.iso.hom (coe_fn (to_Aut α) x) =
        coe_fn (category_theory.single_obj.to_End α) ↑x :=
  rfl

@[simp] theorem to_Aut_inv (α : Type u) [monoid α] (x : units α) :
    category_theory.iso.inv (coe_fn (to_Aut α) x) =
        coe_fn (category_theory.single_obj.to_End α) ↑(x⁻¹) :=
  rfl

end units

namespace Mon

/-- The fully faithful functor from `Mon` to `Cat`. -/
def to_Cat : Mon ⥤ category_theory.Cat :=
  category_theory.functor.mk
    (fun (x : Mon) => category_theory.Cat.of (category_theory.single_obj ↥x))
    fun (x y : Mon) (f : x ⟶ y) => coe_fn (category_theory.single_obj.map_hom ↥x ↥y) f

protected instance to_Cat_full : category_theory.full to_Cat :=
  category_theory.full.mk
    fun (x y : Mon) => equiv.inv_fun (category_theory.single_obj.map_hom ↥x ↥y)

protected instance to_Cat_faithful : category_theory.faithful to_Cat := category_theory.faithful.mk

end Mathlib


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Stephen Morgan, Scott Morrison, Floris van Doorn
-/
import category_theory.eq_to_hom
import data.ulift

/-!
# Discrete categories

We define `discrete α := α` for any type `α`, and use this type alias
to provide a `small_category` instance whose only morphisms are the identities.

There is an annoying technical difficulty that it has turned out to be inconvenient
to allow categories with morphisms living in `Prop`,
so instead of defining `X ⟶ Y` in `discrete α` as `X = Y`,
one might define it as `plift (X = Y)`.
In fact, to allow `discrete α` to be a `small_category`
(i.e. with morphisms in the same universe as the objects),
we actually define the hom type `X ⟶ Y` as `ulift (plift (X = Y))`.

`discrete.functor` promotes a function `f : I → C` (for any category `C`) to a functor
`discrete.functor f : discrete I ⥤ C`.

Similarly, `discrete.nat_trans` and `discrete.nat_iso` promote `I`-indexed families of morphisms,
or `I`-indexed families of isomorphisms to natural transformations or natural isomorphism.

We show equivalences of types are the same as (categorical) equivalences of the corresponding
discrete categories.
-/

namespace category_theory

-- morphism levels before object levels. See note [category_theory universes].
universes v₁ v₂ v₃ u₁ u₂ u₃

/--
A type synonym for promoting any type to a category,
with the only morphisms being equalities.
-/
def discrete (α : Type u₁) := α

/--
The "discrete" category on a type, whose morphisms are equalities.

Because we do not allow morphisms in `Prop` (only in `Type`),
somewhat annoyingly we have to define `X ⟶ Y` as `ulift (plift (X = Y))`.

See https://stacks.math.columbia.edu/tag/001A
-/
instance discrete_category (α : Type u₁) : small_category (discrete α) :=
{ hom  := λ X Y, ulift (plift (X = Y)),
  id   := λ X, ulift.up (plift.up rfl),
  comp := λ X Y Z g f, by { rcases f with ⟨⟨rfl⟩⟩, exact g } }

namespace discrete

variables {α : Type u₁}

instance [inhabited α] : inhabited (discrete α) :=
by { dsimp [discrete], apply_instance }

instance [subsingleton α] : subsingleton (discrete α) :=
by { dsimp [discrete], apply_instance }

/-- Extract the equation from a morphism in a discrete category. -/

@[simp] lemma id_def (X : discrete α) : ulift.up (plift.up (eq.refl X)) = 𝟙 X := rfl

variables {C : Type u₂} [category.{v₂} C]

instance {I : Type u₁} {i j : discrete I} (f : i ⟶ j) : is_iso f :=
⟨⟨eq_to_hom (eq_of_hom f).symm, by tidy⟩⟩

/--
Any function `I → C` gives a functor `discrete I ⥤ C`.
-/
def functor {I : Type u₁} (F : I → C) : discrete I ⥤ C :=
{ obj := F,
  map := λ X Y f, begin cases f, cases f, cases f, exact 𝟙 (F X) end }

@[simp] lemma functor_obj  {I : Type u₁} (F : I → C) (i : I) :
  (discrete.functor F).obj i = F i := rfl

lemma functor_map  {I : Type u₁} (F : I → C) {i : discrete I} (f : i ⟶ i) :
  (discrete.functor F).map f = 𝟙 (F i) :=
by { cases f, cases f, cases f, refl }

/--
For functors out of a discrete category,
a natural transformation is just a collection of maps,
as the naturality squares are trivial.
-/
def nat_trans {I : Type u₁} {F G : discrete I ⥤ C}
  (f : Π i : discrete I, F.obj i ⟶ G.obj i) : F ⟶ G :=
{ app := f }

@[simp] lemma nat_trans_app  {I : Type u₁} {F G : discrete I ⥤ C}
  (f : Π i : discrete I, F.obj i ⟶ G.obj i) (i) : (discrete.nat_trans f).app i = f i :=
rfl

/--
For functors out of a discrete category,
a natural isomorphism is just a collection of isomorphisms,
as the naturality squares are trivial.
-/
def nat_iso {I : Type u₁} {F G : discrete I ⥤ C}
  (f : Π i : discrete I, F.obj i ≅ G.obj i) : F ≅ G :=
nat_iso.of_components f (by tidy)

@[simp]
lemma nat_iso_hom_app {I : Type u₁} {F G : discrete I ⥤ C}
  (f : Π i : discrete I, F.obj i ≅ G.obj i) (i : I) :
  (discrete.nat_iso f).hom.app i = (f i).hom :=
rfl

@[simp]
lemma nat_iso_inv_app {I : Type u₁} {F G : discrete I ⥤ C}
  (f : Π i : discrete I, F.obj i ≅ G.obj i) (i : I) :
  (discrete.nat_iso f).inv.app i = (f i).inv :=
rfl

@[simp]
lemma nat_iso_app {I : Type u₁} {F G : discrete I ⥤ C}
  (f : Π i : discrete I, F.obj i ≅ G.obj i) (i : I) :
  (discrete.nat_iso f).app i = f i :=
by tidy

/-- Every functor `F` from a discrete category is naturally isomorphic (actually, equal) to
  `discrete.functor (F.obj)`. -/
@[simp]
def nat_iso_functor {I : Type u₁} {F : discrete I ⥤ C} : F ≅ discrete.functor (F.obj) :=
nat_iso $ λ i, iso.refl _

/-- Composing `discrete.functor F` with another functor `G` amounts to composing `F` with `G.obj` -/
@[simp]
def comp_nat_iso_discrete {I : Type u₁} {D : Type u₃} [category.{v₃} D]
 (F : I → C) (G : C ⥤ D) : discrete.functor F ⋙ G ≅ discrete.functor (G.obj ∘ F) :=
nat_iso $ λ i, iso.refl _

/--
We can promote a type-level `equiv` to
an equivalence between the corresponding `discrete` categories.
-/
@[simps]
def equivalence {I : Type u₁} {J : Type u₂} (e : I ≃ J) : discrete I ≌ discrete J :=
{ functor := discrete.functor (e : I → J),
  inverse := discrete.functor (e.symm : J → I),
  unit_iso := discrete.nat_iso (λ i, eq_to_iso (by simp)),
  counit_iso := discrete.nat_iso (λ j, eq_to_iso (by simp)), }

/-- We can convert an equivalence of `discrete` categories to a type-level `equiv`. -/
@[simps]
def equiv_of_equivalence {α : Type u₁} {β : Type u₂} (h : discrete α ≌ discrete β) : α ≃ β :=
{ to_fun := h.functor.obj,
  inv_fun := h.inverse.obj,
  left_inv := λ a, eq_of_hom (h.unit_iso.app a).2,
  right_inv := λ a, eq_of_hom (h.counit_iso.app a).1 }

end discrete

namespace discrete
variables {J : Type v₁}

open opposite

/-- A discrete category is equivalent to its opposite category. -/
protected def opposite (α : Type u₁) : (discrete α)ᵒᵖ ≌ discrete α :=
let F : discrete α ⥤ (discrete α)ᵒᵖ := discrete.functor (λ x, op x) in
begin
  refine equivalence.mk (functor.left_op F) F _ (discrete.nat_iso $ λ X, by simp [F]),
  refine nat_iso.of_components (λ X, by simp [F]) _,
  tidy
end

variables {C : Type u₂} [category.{v₂} C]

@[simp] lemma functor_map_id
  (F : discrete J ⥤ C) {j : discrete J} (f : j ⟶ j) : F.map f = 𝟙 (F.obj j) :=
begin
  have h : f = 𝟙 j, { cases f, cases f, ext, },
  rw h,
  simp,
end

end discrete

end category_theory


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Yury G. Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.analysis.specific_limits
import Mathlib.order.iterate
import Mathlib.order.semiconj_Sup
import Mathlib.algebra.iterate_hom
import Mathlib.PostPort

universes l u_1

namespace Mathlib

/-!
# Translation number of a monotone real map that commutes with `x ↦ x + 1`

Let `f : ℝ → ℝ` be a monotone map such that `f (x + 1) = f x + 1` for all `x`. Then the limit
$$
  \tau(f)=\lim_{n\to\infty}{f^n(x)-x}{n}
$$
exists and does not depend on `x`. This number is called the *translation number* of `f`.
Different authors use different notation for this number: `τ`, `ρ`, `rot`, etc

In this file we define a structure `circle_deg1_lift` for bundled maps with these properties, define
translation number of `f : circle_deg1_lift`, prove some estimates relating `f^n(x)-x` to `τ(f)`. In
case of a continuous map `f` we also prove that `f` admits a point `x` such that `f^n(x)=x+m` if and
only if `τ(f)=m/n`.

Maps of this type naturally appear as lifts of orientation preserving circle homeomorphisms. More
precisely, let `f` be an orientation preserving homeomorphism of the circle $S^1=ℝ/ℤ$, and
consider a real number `a` such that
`⟦a⟧ = f 0`, where `⟦⟧` means the natural projection `ℝ → ℝ/ℤ`. Then there exists a unique
continuous function `F : ℝ → ℝ` such that `F 0 = a` and `⟦F x⟧ = f ⟦x⟧` for all `x` (this fact is
not formalized yet). This function is strictly monotone, continuous, and satisfies
`F (x + 1) = F x + 1`. The number `⟦τ F⟧ : ℝ / ℤ` is called the *rotation number* of `f`.
It does not depend on the choice of `a`.

## Main definitions

* `circle_deg1_lift`: a monotone map `f : ℝ → ℝ` such that `f (x + 1) = f x + 1` for all `x`;
  the type `circle_deg1_lift` is equipped with `lattice` and `monoid` structures; the
  multiplication is given by composition: `(f * g) x = f (g x)`.
* `circle_deg1_lift.translation_number`: translation number of `f : circle_deg1_lift`.

## Main statements

We prove the following properties of `circle_deg1_lift.translation_number`.

* `circle_deg1_lift.translation_number_eq_of_dist_bounded`: if the distance between `(f^n) 0`
  and `(g^n) 0` is bounded from above uniformly in `n : ℕ`, then `f` and `g` have equal
  translation numbers.

* `circle_deg1_lift.translation_number_eq_of_semiconj_by`: if two `circle_deg1_lift` maps `f`, `g`
  are semiconjugate by a `circle_deg1_lift` map, then `τ f = τ g`.

* `circle_deg1_lift.translation_number_units_inv`: if `f` is an invertible `circle_deg1_lift` map
  (equivalently, `f` is a lift of an orientation-preserving circle homeomorphism), then
  the translation number of `f⁻¹` is the negative of the translation number of `f`.

* `circle_deg1_lift.translation_number_mul_of_commute`: if `f` and `g` commute, then
  `τ (f * g) = τ f + τ g`.

* `circle_deg1_lift.translation_number_eq_rat_iff`: the translation number of `f` is equal to
  a rational number `m / n` if and only if `(f^n) x = x + m` for some `x`.

* `circle_deg1_lift.semiconj_of_bijective_of_translation_number_eq`: if `f` and `g` are two
  bijective `circle_deg1_lift` maps and their translation numbers are equal, then these
  maps are semiconjugate to each other.

* `circle_deg1_lift.semiconj_of_group_action_of_forall_translation_number_eq`: let `f₁` and `f₂` be
  two actions of a group `G` on the circle by degree 1 maps (formally, `f₁` and `f₂` are two
  homomorphisms from `G →* circle_deg1_lift`). If the translation numbers of `f₁ g` and `f₂ g` are
  equal to each other for all `g : G`, then these two actions are semiconjugate by some `F :
  circle_deg1_lift`. This is a version of Proposition 5.4 from [Étienne Ghys, Groupes
  d'homeomorphismes du cercle et cohomologie bornee][ghys87:groupes].

## Notation

We use a local notation `τ` for the translation number of `f : circle_deg1_lift`.

## Implementation notes

We define the translation number of `f : circle_deg1_lift` to be the limit of the sequence
`(f ^ (2 ^ n)) 0 / (2 ^ n)`, then prove that `((f ^ n) x - x) / n` tends to this number for any `x`.
This way it is much easier to prove that the limit exists and basic properties of the limit.

We define translation number for a wider class of maps `f : ℝ → ℝ` instead of lifts of orientation
preserving circle homeomorphisms for two reasons:

* non-strictly monotone circle self-maps with discontinuities naturally appear as Poincaré maps
  for some flows on the two-torus (e.g., one can take a constant flow and glue in a few Cherry
  cells);
* definition and some basic properties still work for this class.

## References

* [Étienne Ghys, Groupes d'homeomorphismes du cercle et cohomologie bornee][ghys87:groupes]

## TODO

Here are some short-term goals.

* Introduce a structure or a typeclass for lifts of circle homeomorphisms. We use `units
  circle_deg1_lift` for now, but it's better to have a dedicated type (or a typeclass?).

* Prove that the `semiconj_by` relation on circle homeomorphisms is an equivalence relation.

* Introduce `conditionally_complete_lattice` structure, use it in the proof of
  `circle_deg1_lift.semiconj_of_group_action_of_forall_translation_number_eq`.

* Prove that the orbits of the irrational rotation are dense in the circle. Deduce that a
  homeomorphism with an irrational rotation is semiconjugate to the corresponding irrational
  translation by a continuous `circle_deg1_lift`.

## Tags

circle homeomorphism, rotation number
-/

/-!
### Definition and monoid structure
-/

/-- A lift of a monotone degree one map `S¹ → S¹`. -/
structure circle_deg1_lift
where
  to_fun : ℝ → ℝ
  monotone' : monotone to_fun
  map_add_one' : ∀ (x : ℝ), to_fun (x + 1) = to_fun x + 1

namespace circle_deg1_lift

protected instance has_coe_to_fun : has_coe_to_fun circle_deg1_lift :=
  has_coe_to_fun.mk (fun (_x : circle_deg1_lift) => ℝ → ℝ) to_fun

@[simp] theorem coe_mk (f : ℝ → ℝ) (h₁ : monotone f) (h₂ : ∀ (x : ℝ), f (x + 1) = f x + 1) : ⇑(mk f h₁ h₂) = f :=
  rfl

protected theorem monotone (f : circle_deg1_lift) : monotone ⇑f :=
  monotone' f

theorem mono (f : circle_deg1_lift) {x : ℝ} {y : ℝ} (h : x ≤ y) : coe_fn f x ≤ coe_fn f y :=
  circle_deg1_lift.monotone f h

theorem strict_mono_iff_injective (f : circle_deg1_lift) : strict_mono ⇑f ↔ function.injective ⇑f :=
  monotone.strict_mono_iff_injective (circle_deg1_lift.monotone f)

@[simp] theorem map_add_one (f : circle_deg1_lift) (x : ℝ) : coe_fn f (x + 1) = coe_fn f x + 1 :=
  map_add_one' f

@[simp] theorem map_one_add (f : circle_deg1_lift) (x : ℝ) : coe_fn f (1 + x) = 1 + coe_fn f x := sorry

theorem coe_inj {f : circle_deg1_lift} {g : circle_deg1_lift} : ⇑f = ⇑g → f = g := sorry

theorem ext {f : circle_deg1_lift} {g : circle_deg1_lift} (h : ∀ (x : ℝ), coe_fn f x = coe_fn g x) : f = g :=
  coe_inj (funext h)

theorem ext_iff {f : circle_deg1_lift} {g : circle_deg1_lift} : f = g ↔ ∀ (x : ℝ), coe_fn f x = coe_fn g x :=
  { mp := fun (h : f = g) (x : ℝ) => h ▸ rfl, mpr := fun (h : ∀ (x : ℝ), coe_fn f x = coe_fn g x) => ext h }

protected instance monoid : monoid circle_deg1_lift :=
  monoid.mk (fun (f g : circle_deg1_lift) => mk (⇑f ∘ ⇑g) sorry sorry) sorry (mk id monotone_id sorry) sorry sorry

protected instance inhabited : Inhabited circle_deg1_lift :=
  { default := 1 }

@[simp] theorem coe_mul (f : circle_deg1_lift) (g : circle_deg1_lift) : ⇑(f * g) = ⇑f ∘ ⇑g :=
  rfl

theorem mul_apply (f : circle_deg1_lift) (g : circle_deg1_lift) (x : ℝ) : coe_fn (f * g) x = coe_fn f (coe_fn g x) :=
  rfl

@[simp] theorem coe_one : ⇑1 = id :=
  rfl

protected instance units_has_coe_to_fun : has_coe_to_fun (units circle_deg1_lift) :=
  has_coe_to_fun.mk (fun (_x : units circle_deg1_lift) => ℝ → ℝ) fun (f : units circle_deg1_lift) => ⇑↑f

@[simp] theorem units_coe (f : units circle_deg1_lift) : ⇑↑f = ⇑f :=
  rfl

@[simp] theorem units_inv_apply_apply (f : units circle_deg1_lift) (x : ℝ) : coe_fn (f⁻¹) (coe_fn f x) = x := sorry

@[simp] theorem units_apply_inv_apply (f : units circle_deg1_lift) (x : ℝ) : coe_fn f (coe_fn (f⁻¹) x) = x := sorry

/-- If a lift of a circle map is bijective, then it is an order automorphism of the line. -/
def to_order_iso : units circle_deg1_lift →* ℝ ≃o ℝ :=
  monoid_hom.mk
    (fun (f : units circle_deg1_lift) =>
      rel_iso.mk (equiv.mk (⇑f) (⇑(f⁻¹)) (units_inv_apply_apply f) (units_apply_inv_apply f)) sorry)
    sorry sorry

@[simp] theorem coe_to_order_iso (f : units circle_deg1_lift) : ⇑(coe_fn to_order_iso f) = ⇑f :=
  rfl

@[simp] theorem coe_to_order_iso_symm (f : units circle_deg1_lift) : ⇑(order_iso.symm (coe_fn to_order_iso f)) = ⇑(f⁻¹) :=
  rfl

@[simp] theorem coe_to_order_iso_inv (f : units circle_deg1_lift) : ⇑(coe_fn to_order_iso f⁻¹) = ⇑(f⁻¹) :=
  rfl

theorem is_unit_iff_bijective {f : circle_deg1_lift} : is_unit f ↔ function.bijective ⇑f := sorry

theorem coe_pow (f : circle_deg1_lift) (n : ℕ) : ⇑(f ^ n) = nat.iterate (⇑f) n := sorry

theorem semiconj_by_iff_semiconj {f : circle_deg1_lift} {g₁ : circle_deg1_lift} {g₂ : circle_deg1_lift} : semiconj_by f g₁ g₂ ↔ function.semiconj ⇑f ⇑g₁ ⇑g₂ :=
  ext_iff

theorem commute_iff_commute {f : circle_deg1_lift} {g : circle_deg1_lift} : commute f g ↔ function.commute ⇑f ⇑g :=
  ext_iff

/-!
### Translate by a constant
-/

/-- The map `y ↦ x + y` as a `circle_deg1_lift`. More precisely, we define a homomorphism from
`multiplicative ℝ` to `units circle_deg1_lift`, so the translation by `x` is
`translation (multiplicative.of_add x)`. -/
def translate : multiplicative ℝ →* units circle_deg1_lift :=
  monoid_hom.comp
    (units.map
      (monoid_hom.mk (fun (x : multiplicative ℝ) => mk (fun (y : ℝ) => coe_fn multiplicative.to_add x + y) sorry sorry)
        sorry sorry))
    (mul_equiv.to_monoid_hom to_units)

@[simp] theorem translate_apply (x : ℝ) (y : ℝ) : coe_fn (coe_fn translate (coe_fn multiplicative.of_add x)) y = x + y :=
  rfl

@[simp] theorem translate_inv_apply (x : ℝ) (y : ℝ) : coe_fn (coe_fn translate (coe_fn multiplicative.of_add x)⁻¹) y = -x + y :=
  rfl

@[simp] theorem translate_gpow (x : ℝ) (n : ℤ) : coe_fn translate (coe_fn multiplicative.of_add x) ^ n = coe_fn translate (coe_fn multiplicative.of_add (↑n * x)) := sorry

@[simp] theorem translate_pow (x : ℝ) (n : ℕ) : coe_fn translate (coe_fn multiplicative.of_add x) ^ n = coe_fn translate (coe_fn multiplicative.of_add (↑n * x)) :=
  translate_gpow x ↑n

@[simp] theorem translate_iterate (x : ℝ) (n : ℕ) : nat.iterate (⇑(coe_fn translate (coe_fn multiplicative.of_add x))) n =
  ⇑(coe_fn translate (coe_fn multiplicative.of_add (↑n * x))) := sorry

/-!
### Commutativity with integer translations

In this section we prove that `f` commutes with translations by an integer number. First we formulate
these statements (for a natural or an integer number, addition on the left or on the right, addition
or subtraction) using `function.commute`, then reformulate as `simp` lemmas `map_int_add` etc.
-/

theorem commute_nat_add (f : circle_deg1_lift) (n : ℕ) : function.commute (⇑f) (Add.add ↑n) := sorry

theorem commute_add_nat (f : circle_deg1_lift) (n : ℕ) : function.commute ⇑f fun (x : ℝ) => x + ↑n := sorry

theorem commute_sub_nat (f : circle_deg1_lift) (n : ℕ) : function.commute ⇑f fun (x : ℝ) => x - ↑n := sorry

theorem commute_add_int (f : circle_deg1_lift) (n : ℤ) : function.commute ⇑f fun (x : ℝ) => x + ↑n := sorry

theorem commute_int_add (f : circle_deg1_lift) (n : ℤ) : function.commute (⇑f) (Add.add ↑n) := sorry

theorem commute_sub_int (f : circle_deg1_lift) (n : ℤ) : function.commute ⇑f fun (x : ℝ) => x - ↑n := sorry

@[simp] theorem map_int_add (f : circle_deg1_lift) (m : ℤ) (x : ℝ) : coe_fn f (↑m + x) = ↑m + coe_fn f x :=
  commute_int_add f m x

@[simp] theorem map_add_int (f : circle_deg1_lift) (x : ℝ) (m : ℤ) : coe_fn f (x + ↑m) = coe_fn f x + ↑m :=
  commute_add_int f m x

@[simp] theorem map_sub_int (f : circle_deg1_lift) (x : ℝ) (n : ℤ) : coe_fn f (x - ↑n) = coe_fn f x - ↑n :=
  commute_sub_int f n x

@[simp] theorem map_add_nat (f : circle_deg1_lift) (x : ℝ) (n : ℕ) : coe_fn f (x + ↑n) = coe_fn f x + ↑n :=
  map_add_int f x ↑n

@[simp] theorem map_nat_add (f : circle_deg1_lift) (n : ℕ) (x : ℝ) : coe_fn f (↑n + x) = ↑n + coe_fn f x :=
  map_int_add f (↑n) x

@[simp] theorem map_sub_nat (f : circle_deg1_lift) (x : ℝ) (n : ℕ) : coe_fn f (x - ↑n) = coe_fn f x - ↑n :=
  map_sub_int f x ↑n

theorem map_int_of_map_zero (f : circle_deg1_lift) (n : ℤ) : coe_fn f ↑n = coe_fn f 0 + ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn f ↑n = coe_fn f 0 + ↑n)) (Eq.symm (map_add_int f 0 n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn f ↑n = coe_fn f (0 + ↑n))) (zero_add ↑n))) (Eq.refl (coe_fn f ↑n)))

@[simp] theorem map_fract_sub_fract_eq (f : circle_deg1_lift) (x : ℝ) : coe_fn f (fract x) - fract x = coe_fn f x - x := sorry

/-!
### Pointwise order on circle maps
-/

/-- Monotone circle maps form a lattice with respect to the pointwise order -/
protected instance lattice : lattice circle_deg1_lift :=
  lattice.mk (fun (f g : circle_deg1_lift) => mk (fun (x : ℝ) => max (coe_fn f x) (coe_fn g x)) sorry sorry)
    (fun (f g : circle_deg1_lift) => ∀ (x : ℝ), coe_fn f x ≤ coe_fn g x)
    (semilattice_sup.lt._default fun (f g : circle_deg1_lift) => ∀ (x : ℝ), coe_fn f x ≤ coe_fn g x) sorry sorry sorry
    sorry sorry sorry (fun (f g : circle_deg1_lift) => mk (fun (x : ℝ) => min (coe_fn f x) (coe_fn g x)) sorry sorry)
    sorry sorry sorry

@[simp] theorem sup_apply (f : circle_deg1_lift) (g : circle_deg1_lift) (x : ℝ) : coe_fn (f ⊔ g) x = max (coe_fn f x) (coe_fn g x) :=
  rfl

@[simp] theorem inf_apply (f : circle_deg1_lift) (g : circle_deg1_lift) (x : ℝ) : coe_fn (f ⊓ g) x = min (coe_fn f x) (coe_fn g x) :=
  rfl

theorem iterate_monotone (n : ℕ) : monotone fun (f : circle_deg1_lift) => nat.iterate (⇑f) n :=
  fun (f g : circle_deg1_lift) (h : f ≤ g) => monotone.iterate_le_of_le (circle_deg1_lift.monotone f) h n

theorem iterate_mono {f : circle_deg1_lift} {g : circle_deg1_lift} (h : f ≤ g) (n : ℕ) : nat.iterate (⇑f) n ≤ nat.iterate (⇑g) n :=
  iterate_monotone n h

theorem pow_mono {f : circle_deg1_lift} {g : circle_deg1_lift} (h : f ≤ g) (n : ℕ) : f ^ n ≤ g ^ n := sorry

theorem pow_monotone (n : ℕ) : monotone fun (f : circle_deg1_lift) => f ^ n :=
  fun (f g : circle_deg1_lift) (h : f ≤ g) => pow_mono h n

/-!
### Estimates on `(f * g) 0`

We prove the estimates `f 0 + ⌊g 0⌋ ≤ f (g 0) ≤ f 0 + ⌈g 0⌉` and some corollaries with added/removed
floors and ceils.

We also prove that for two semiconjugate maps `g₁`, `g₂`, the distance between `g₁ 0` and `g₂ 0`
is less than two.
-/

theorem map_le_of_map_zero (f : circle_deg1_lift) (x : ℝ) : coe_fn f x ≤ coe_fn f 0 + ↑(ceil x) :=
  trans_rel_left LessEq (circle_deg1_lift.monotone f (le_ceil x)) (map_int_of_map_zero f (ceil x))

theorem map_map_zero_le (f : circle_deg1_lift) (g : circle_deg1_lift) : coe_fn f (coe_fn g 0) ≤ coe_fn f 0 + ↑(ceil (coe_fn g 0)) :=
  map_le_of_map_zero f (coe_fn g 0)

theorem floor_map_map_zero_le (f : circle_deg1_lift) (g : circle_deg1_lift) : floor (coe_fn f (coe_fn g 0)) ≤ floor (coe_fn f 0) + ceil (coe_fn g 0) :=
  trans_rel_left LessEq (floor_mono (map_map_zero_le f g)) (floor_add_int (coe_fn f 0) (ceil (coe_fn g 0)))

theorem ceil_map_map_zero_le (f : circle_deg1_lift) (g : circle_deg1_lift) : ceil (coe_fn f (coe_fn g 0)) ≤ ceil (coe_fn f 0) + ceil (coe_fn g 0) :=
  trans_rel_left LessEq (ceil_mono (map_map_zero_le f g)) (ceil_add_int (coe_fn f 0) (ceil (coe_fn g 0)))

theorem map_map_zero_lt (f : circle_deg1_lift) (g : circle_deg1_lift) : coe_fn f (coe_fn g 0) < coe_fn f 0 + coe_fn g 0 + 1 :=
  trans_rel_left Less (lt_of_le_of_lt (map_map_zero_le f g) (add_lt_add_left (ceil_lt_add_one (coe_fn g 0)) (coe_fn f 0)))
    (Eq.symm (add_assoc (coe_fn f 0) (coe_fn g 0) 1))

theorem le_map_of_map_zero (f : circle_deg1_lift) (x : ℝ) : coe_fn f 0 + ↑(floor x) ≤ coe_fn f x :=
  trans_rel_right LessEq (Eq.symm (map_int_of_map_zero f (floor x))) (circle_deg1_lift.monotone f (floor_le x))

theorem le_map_map_zero (f : circle_deg1_lift) (g : circle_deg1_lift) : coe_fn f 0 + ↑(floor (coe_fn g 0)) ≤ coe_fn f (coe_fn g 0) :=
  le_map_of_map_zero f (coe_fn g 0)

theorem le_floor_map_map_zero (f : circle_deg1_lift) (g : circle_deg1_lift) : floor (coe_fn f 0) + floor (coe_fn g 0) ≤ floor (coe_fn f (coe_fn g 0)) :=
  trans_rel_right LessEq (Eq.symm (floor_add_int (coe_fn f 0) (floor (coe_fn g 0)))) (floor_mono (le_map_map_zero f g))

theorem le_ceil_map_map_zero (f : circle_deg1_lift) (g : circle_deg1_lift) : ceil (coe_fn f 0) + floor (coe_fn g 0) ≤ ceil (coe_fn (f * g) 0) :=
  trans_rel_right LessEq (Eq.symm (ceil_add_int (coe_fn f 0) (floor (coe_fn g 0)))) (ceil_mono (le_map_map_zero f g))

theorem lt_map_map_zero (f : circle_deg1_lift) (g : circle_deg1_lift) : coe_fn f 0 + coe_fn g 0 - 1 < coe_fn f (coe_fn g 0) := sorry

theorem dist_map_map_zero_lt (f : circle_deg1_lift) (g : circle_deg1_lift) : dist (coe_fn f 0 + coe_fn g 0) (coe_fn f (coe_fn g 0)) < 1 := sorry

theorem dist_map_zero_lt_of_semiconj {f : circle_deg1_lift} {g₁ : circle_deg1_lift} {g₂ : circle_deg1_lift} (h : function.semiconj ⇑f ⇑g₁ ⇑g₂) : dist (coe_fn g₁ 0) (coe_fn g₂ 0) < bit0 1 := sorry

theorem dist_map_zero_lt_of_semiconj_by {f : circle_deg1_lift} {g₁ : circle_deg1_lift} {g₂ : circle_deg1_lift} (h : semiconj_by f g₁ g₂) : dist (coe_fn g₁ 0) (coe_fn g₂ 0) < bit0 1 :=
  dist_map_zero_lt_of_semiconj (iff.mp semiconj_by_iff_semiconj h)

/-!
### Limits at infinities and continuity
-/

protected theorem tendsto_at_bot (f : circle_deg1_lift) : filter.tendsto (⇑f) filter.at_bot filter.at_bot := sorry

protected theorem tendsto_at_top (f : circle_deg1_lift) : filter.tendsto (⇑f) filter.at_top filter.at_top := sorry

theorem continuous_iff_surjective (f : circle_deg1_lift) : continuous ⇑f ↔ function.surjective ⇑f := sorry

/-!
### Estimates on `(f^n) x`

If we know that `f x` is `≤`/`<`/`≥`/`>`/`=` to `x + m`, then we have a similar estimate on
`f^[n] x` and `x + n * m`.

For `≤`, `≥`, and `=` we formulate both `of` (implication) and `iff` versions because implications
work for `n = 0`. For `<` and `>` we formulate only `iff` versions.
-/

theorem iterate_le_of_map_le_add_int (f : circle_deg1_lift) {x : ℝ} {m : ℤ} (h : coe_fn f x ≤ x + ↑m) (n : ℕ) : nat.iterate (⇑f) n x ≤ x + ↑n * ↑m := sorry

theorem le_iterate_of_add_int_le_map (f : circle_deg1_lift) {x : ℝ} {m : ℤ} (h : x + ↑m ≤ coe_fn f x) (n : ℕ) : x + ↑n * ↑m ≤ nat.iterate (⇑f) n x := sorry

theorem iterate_eq_of_map_eq_add_int (f : circle_deg1_lift) {x : ℝ} {m : ℤ} (h : coe_fn f x = x + ↑m) (n : ℕ) : nat.iterate (⇑f) n x = x + ↑n * ↑m := sorry

theorem iterate_pos_le_iff (f : circle_deg1_lift) {x : ℝ} {m : ℤ} {n : ℕ} (hn : 0 < n) : nat.iterate (⇑f) n x ≤ x + ↑n * ↑m ↔ coe_fn f x ≤ x + ↑m := sorry

theorem iterate_pos_lt_iff (f : circle_deg1_lift) {x : ℝ} {m : ℤ} {n : ℕ} (hn : 0 < n) : nat.iterate (⇑f) n x < x + ↑n * ↑m ↔ coe_fn f x < x + ↑m := sorry

theorem iterate_pos_eq_iff (f : circle_deg1_lift) {x : ℝ} {m : ℤ} {n : ℕ} (hn : 0 < n) : nat.iterate (⇑f) n x = x + ↑n * ↑m ↔ coe_fn f x = x + ↑m := sorry

theorem le_iterate_pos_iff (f : circle_deg1_lift) {x : ℝ} {m : ℤ} {n : ℕ} (hn : 0 < n) : x + ↑n * ↑m ≤ nat.iterate (⇑f) n x ↔ x + ↑m ≤ coe_fn f x := sorry

theorem lt_iterate_pos_iff (f : circle_deg1_lift) {x : ℝ} {m : ℤ} {n : ℕ} (hn : 0 < n) : x + ↑n * ↑m < nat.iterate (⇑f) n x ↔ x + ↑m < coe_fn f x := sorry

theorem mul_floor_map_zero_le_floor_iterate_zero (f : circle_deg1_lift) (n : ℕ) : ↑n * floor (coe_fn f 0) ≤ floor (nat.iterate (⇑f) n 0) := sorry

/-!
### Definition of translation number
-/

/-- An auxiliary sequence used to define the translation number. -/
def transnum_aux_seq (f : circle_deg1_lift) (n : ℕ) : ℝ :=
  coe_fn (f ^ bit0 1 ^ n) 0 / bit0 1 ^ n

/-- The translation number of a `circle_deg1_lift`, $τ(f)=\lim_{n→∞}\frac{f^n(x)-x}{n}$. We use
an auxiliary sequence `\frac{f^{2^n}(0)}{2^n}` to define `τ(f)` because some proofs are simpler
this way. -/
def translation_number (f : circle_deg1_lift) : ℝ :=
  lim filter.at_top (transnum_aux_seq f)

-- TODO: choose two different symbols for `circle_deg1_lift.translation_number` and the future

-- `circle_mono_homeo.rotation_number`, then make them `localized notation`s

theorem transnum_aux_seq_def (f : circle_deg1_lift) : transnum_aux_seq f = fun (n : ℕ) => coe_fn (f ^ bit0 1 ^ n) 0 / bit0 1 ^ n :=
  rfl

theorem translation_number_eq_of_tendsto_aux (f : circle_deg1_lift) {τ' : ℝ} (h : filter.tendsto (transnum_aux_seq f) filter.at_top (nhds τ')) : translation_number f = τ' :=
  filter.tendsto.lim_eq h

theorem translation_number_eq_of_tendsto₀ (f : circle_deg1_lift) {τ' : ℝ} (h : filter.tendsto (fun (n : ℕ) => nat.iterate (⇑f) n 0 / ↑n) filter.at_top (nhds τ')) : translation_number f = τ' := sorry

theorem translation_number_eq_of_tendsto₀' (f : circle_deg1_lift) {τ' : ℝ} (h : filter.tendsto (fun (n : ℕ) => nat.iterate (⇑f) (n + 1) 0 / (↑n + 1)) filter.at_top (nhds τ')) : translation_number f = τ' :=
  translation_number_eq_of_tendsto₀ f (iff.mp (filter.tendsto_add_at_top_iff_nat 1) h)

theorem transnum_aux_seq_zero (f : circle_deg1_lift) : transnum_aux_seq f 0 = coe_fn f 0 := sorry

theorem transnum_aux_seq_dist_lt (f : circle_deg1_lift) (n : ℕ) : dist (transnum_aux_seq f n) (transnum_aux_seq f (n + 1)) < 1 / bit0 1 / bit0 1 ^ n := sorry

theorem tendsto_translation_number_aux (f : circle_deg1_lift) : filter.tendsto (transnum_aux_seq f) filter.at_top (nhds (translation_number f)) :=
  cauchy_seq.tendsto_lim (cauchy_seq_of_le_geometric_two 1 fun (n : ℕ) => le_of_lt (transnum_aux_seq_dist_lt f n))

theorem dist_map_zero_translation_number_le (f : circle_deg1_lift) : dist (coe_fn f 0) (translation_number f) ≤ 1 :=
  transnum_aux_seq_zero f ▸
    dist_le_of_le_geometric_two_of_tendsto₀ 1 (fun (n : ℕ) => le_of_lt (transnum_aux_seq_dist_lt f n))
      (tendsto_translation_number_aux f)

theorem tendsto_translation_number_of_dist_bounded_aux (f : circle_deg1_lift) (x : ℕ → ℝ) (C : ℝ) (H : ∀ (n : ℕ), dist (coe_fn (f ^ n) 0) (x n) ≤ C) : filter.tendsto (fun (n : ℕ) => x (bit0 1 ^ n) / bit0 1 ^ n) filter.at_top (nhds (translation_number f)) := sorry

theorem translation_number_eq_of_dist_bounded {f : circle_deg1_lift} {g : circle_deg1_lift} (C : ℝ) (H : ∀ (n : ℕ), dist (coe_fn (f ^ n) 0) (coe_fn (g ^ n) 0) ≤ C) : translation_number f = translation_number g :=
  Eq.symm
    (translation_number_eq_of_tendsto_aux g
      (tendsto_translation_number_of_dist_bounded_aux f (fun (n : ℕ) => coe_fn (g ^ n) 0) C H))

@[simp] theorem translation_number_one : translation_number 1 = 0 := sorry

theorem translation_number_eq_of_semiconj_by {f : circle_deg1_lift} {g₁ : circle_deg1_lift} {g₂ : circle_deg1_lift} (H : semiconj_by f g₁ g₂) : translation_number g₁ = translation_number g₂ :=
  translation_number_eq_of_dist_bounded (bit0 1)
    fun (n : ℕ) => le_of_lt (dist_map_zero_lt_of_semiconj_by (semiconj_by.pow_right H n))

theorem translation_number_eq_of_semiconj {f : circle_deg1_lift} {g₁ : circle_deg1_lift} {g₂ : circle_deg1_lift} (H : function.semiconj ⇑f ⇑g₁ ⇑g₂) : translation_number g₁ = translation_number g₂ :=
  translation_number_eq_of_semiconj_by (iff.mpr semiconj_by_iff_semiconj H)

theorem translation_number_mul_of_commute {f : circle_deg1_lift} {g : circle_deg1_lift} (h : commute f g) : translation_number (f * g) = translation_number f + translation_number g := sorry

@[simp] theorem translation_number_units_inv (f : units circle_deg1_lift) : translation_number ↑(f⁻¹) = -translation_number ↑f := sorry

@[simp] theorem translation_number_pow (f : circle_deg1_lift) (n : ℕ) : translation_number (f ^ n) = ↑n * translation_number f := sorry

@[simp] theorem translation_number_gpow (f : units circle_deg1_lift) (n : ℤ) : translation_number ↑(f ^ n) = ↑n * translation_number ↑f := sorry

@[simp] theorem translation_number_conj_eq (f : units circle_deg1_lift) (g : circle_deg1_lift) : translation_number (↑f * g * ↑(f⁻¹)) = translation_number g :=
  Eq.symm (translation_number_eq_of_semiconj_by (units.mk_semiconj_by f g))

@[simp] theorem translation_number_conj_eq' (f : units circle_deg1_lift) (g : circle_deg1_lift) : translation_number (↑(f⁻¹) * g * ↑f) = translation_number g :=
  translation_number_conj_eq (f⁻¹) g

theorem dist_pow_map_zero_mul_translation_number_le (f : circle_deg1_lift) (n : ℕ) : dist (coe_fn (f ^ n) 0) (↑n * translation_number f) ≤ 1 :=
  translation_number_pow f n ▸ dist_map_zero_translation_number_le (f ^ n)

theorem tendsto_translation_number₀' (f : circle_deg1_lift) : filter.tendsto (fun (n : ℕ) => coe_fn (f ^ (n + 1)) 0 / (↑n + 1)) filter.at_top (nhds (translation_number f)) := sorry

theorem tendsto_translation_number₀ (f : circle_deg1_lift) : filter.tendsto (fun (n : ℕ) => coe_fn (f ^ n) 0 / ↑n) filter.at_top (nhds (translation_number f)) :=
  iff.mp (filter.tendsto_add_at_top_iff_nat 1) (tendsto_translation_number₀' f)

/-- For any `x : ℝ` the sequence $\frac{f^n(x)-x}{n}$ tends to the translation number of `f`.
In particular, this limit does not depend on `x`. -/
theorem tendsto_translation_number (f : circle_deg1_lift) (x : ℝ) : filter.tendsto (fun (n : ℕ) => (coe_fn (f ^ n) x - x) / ↑n) filter.at_top (nhds (translation_number f)) := sorry

theorem tendsto_translation_number' (f : circle_deg1_lift) (x : ℝ) : filter.tendsto (fun (n : ℕ) => (coe_fn (f ^ (n + 1)) x - x) / (↑n + 1)) filter.at_top (nhds (translation_number f)) :=
  iff.mpr (filter.tendsto_add_at_top_iff_nat 1) (tendsto_translation_number f x)

theorem translation_number_mono : monotone translation_number :=
  fun (f g : circle_deg1_lift) (h : f ≤ g) =>
    le_of_tendsto_of_tendsto' (tendsto_translation_number₀ f) (tendsto_translation_number₀ g)
      fun (n : ℕ) => div_le_div_of_le_of_nonneg (pow_mono h n 0) (nat.cast_nonneg n)

theorem translation_number_translate (x : ℝ) : translation_number ↑(coe_fn translate (coe_fn multiplicative.of_add x)) = x := sorry

theorem translation_number_le_of_le_add (f : circle_deg1_lift) {z : ℝ} (hz : ∀ (x : ℝ), coe_fn f x ≤ x + z) : translation_number f ≤ z :=
  translation_number_translate z ▸ translation_number_mono fun (x : ℝ) => trans_rel_left LessEq (hz x) (add_comm x z)

theorem le_translation_number_of_add_le (f : circle_deg1_lift) {z : ℝ} (hz : ∀ (x : ℝ), x + z ≤ coe_fn f x) : z ≤ translation_number f := sorry

theorem translation_number_le_of_le_add_int (f : circle_deg1_lift) {x : ℝ} {m : ℤ} (h : coe_fn f x ≤ x + ↑m) : translation_number f ≤ ↑m := sorry

theorem translation_number_le_of_le_add_nat (f : circle_deg1_lift) {x : ℝ} {m : ℕ} (h : coe_fn f x ≤ x + ↑m) : translation_number f ≤ ↑m :=
  translation_number_le_of_le_add_int f h

theorem le_translation_number_of_add_int_le (f : circle_deg1_lift) {x : ℝ} {m : ℤ} (h : x + ↑m ≤ coe_fn f x) : ↑m ≤ translation_number f := sorry

theorem le_translation_number_of_add_nat_le (f : circle_deg1_lift) {x : ℝ} {m : ℕ} (h : x + ↑m ≤ coe_fn f x) : ↑m ≤ translation_number f :=
  le_translation_number_of_add_int_le f h

/-- If `f x - x` is an integer number `m` for some point `x`, then `τ f = m`.
On the circle this means that a map with a fixed point has rotation number zero. -/
theorem translation_number_of_eq_add_int (f : circle_deg1_lift) {x : ℝ} {m : ℤ} (h : coe_fn f x = x + ↑m) : translation_number f = ↑m :=
  le_antisymm (translation_number_le_of_le_add_int f (le_of_eq h))
    (le_translation_number_of_add_int_le f (le_of_eq (Eq.symm h)))

theorem floor_sub_le_translation_number (f : circle_deg1_lift) (x : ℝ) : ↑(floor (coe_fn f x - x)) ≤ translation_number f :=
  le_translation_number_of_add_int_le f (iff.mp le_sub_iff_add_le' (floor_le (coe_fn f x - x)))

theorem translation_number_le_ceil_sub (f : circle_deg1_lift) (x : ℝ) : translation_number f ≤ ↑(ceil (coe_fn f x - x)) :=
  translation_number_le_of_le_add_int f (iff.mp sub_le_iff_le_add' (le_ceil (coe_fn f x - x)))

theorem map_lt_of_translation_number_lt_int (f : circle_deg1_lift) {n : ℤ} (h : translation_number f < ↑n) (x : ℝ) : coe_fn f x < x + ↑n :=
  iff.mp not_le (mt (le_translation_number_of_add_int_le f) (iff.mpr not_le h))

theorem map_lt_of_translation_number_lt_nat (f : circle_deg1_lift) {n : ℕ} (h : translation_number f < ↑n) (x : ℝ) : coe_fn f x < x + ↑n :=
  map_lt_of_translation_number_lt_int f h x

theorem map_lt_add_floor_translation_number_add_one (f : circle_deg1_lift) (x : ℝ) : coe_fn f x < x + ↑(floor (translation_number f)) + 1 := sorry

theorem map_lt_add_translation_number_add_one (f : circle_deg1_lift) (x : ℝ) : coe_fn f x < x + translation_number f + 1 :=
  lt_of_lt_of_le (map_lt_add_floor_translation_number_add_one f x)
    (add_le_add (id (add_le_add (le_refl x) (id (floor_le (translation_number f))))) (le_refl 1))

theorem lt_map_of_int_lt_translation_number (f : circle_deg1_lift) {n : ℤ} (h : ↑n < translation_number f) (x : ℝ) : x + ↑n < coe_fn f x :=
  iff.mp not_le (mt (translation_number_le_of_le_add_int f) (iff.mpr not_le h))

theorem lt_map_of_nat_lt_translation_number (f : circle_deg1_lift) {n : ℕ} (h : ↑n < translation_number f) (x : ℝ) : x + ↑n < coe_fn f x :=
  lt_map_of_int_lt_translation_number f h x

/-- If `f^n x - x`, `n > 0`, is an integer number `m` for some point `x`, then
`τ f = m / n`. On the circle this means that a map with a periodic orbit has
a rational rotation number. -/
theorem translation_number_of_map_pow_eq_add_int (f : circle_deg1_lift) {x : ℝ} {n : ℕ} {m : ℤ} (h : coe_fn (f ^ n) x = x + ↑m) (hn : 0 < n) : translation_number f = ↑m / ↑n := sorry

/-- If a predicate depends only on `f x - x` and holds for all `0 ≤ x ≤ 1`,
then it holds for all `x`. -/
theorem forall_map_sub_of_Icc (f : circle_deg1_lift) (P : ℝ → Prop) (h : ∀ (x : ℝ), x ∈ set.Icc 0 1 → P (coe_fn f x - x)) (x : ℝ) : P (coe_fn f x - x) :=
  map_fract_sub_fract_eq f x ▸ h (fract x) { left := fract_nonneg x, right := le_of_lt (fract_lt_one x) }

theorem translation_number_lt_of_forall_lt_add (f : circle_deg1_lift) (hf : continuous ⇑f) {z : ℝ} (hz : ∀ (x : ℝ), coe_fn f x < x + z) : translation_number f < z := sorry

theorem lt_translation_number_of_forall_add_lt (f : circle_deg1_lift) (hf : continuous ⇑f) {z : ℝ} (hz : ∀ (x : ℝ), x + z < coe_fn f x) : z < translation_number f := sorry

/-- If `f` is a continuous monotone map `ℝ → ℝ`, `f (x + 1) = f x + 1`, then there exists `x`
such that `f x = x + τ f`. -/
theorem exists_eq_add_translation_number (f : circle_deg1_lift) (hf : continuous ⇑f) : ∃ (x : ℝ), coe_fn f x = x + translation_number f := sorry

theorem translation_number_eq_int_iff (f : circle_deg1_lift) (hf : continuous ⇑f) {m : ℤ} : translation_number f = ↑m ↔ ∃ (x : ℝ), coe_fn f x = x + ↑m := sorry

theorem continuous_pow (f : circle_deg1_lift) (hf : continuous ⇑f) (n : ℕ) : continuous ⇑(f ^ n) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (continuous ⇑(f ^ n))) (coe_pow f n))) (continuous.iterate hf n)

theorem translation_number_eq_rat_iff (f : circle_deg1_lift) (hf : continuous ⇑f) {m : ℤ} {n : ℕ} (hn : 0 < n) : translation_number f = ↑m / ↑n ↔ ∃ (x : ℝ), coe_fn (f ^ n) x = x + ↑m := sorry

/-- Consider two actions `f₁ f₂ : G →* circle_deg1_lift` of a group on the real line by lifts of
orientation preserving circle homeomorphisms. Suppose that for each `g : G` the homeomorphisms
`f₁ g` and `f₂ g` have equal rotation numbers. Then there exists `F : circle_deg1_lift`  such that
`F * f₁ g = f₂ g * F` for all `g : G`.

This is a version of Proposition 5.4 from [Étienne Ghys, Groupes d'homeomorphismes du cercle et
cohomologie bornee][ghys87:groupes]. -/
theorem semiconj_of_group_action_of_forall_translation_number_eq {G : Type u_1} [group G] (f₁ : G →* circle_deg1_lift) (f₂ : G →* circle_deg1_lift) (h : ∀ (g : G), translation_number (coe_fn f₁ g) = translation_number (coe_fn f₂ g)) : ∃ (F : circle_deg1_lift), ∀ (g : G), function.semiconj ⇑F ⇑(coe_fn f₁ g) ⇑(coe_fn f₂ g) := sorry

/-- If two lifts of circle homeomorphisms have the same translation number, then they are
semiconjugate by a `circle_deg1_lift`. This version uses arguments `f₁ f₂ : units circle_deg1_lift`
to assume that `f₁` and `f₂` are homeomorphisms. -/
theorem units_semiconj_of_translation_number_eq {f₁ : units circle_deg1_lift} {f₂ : units circle_deg1_lift} (h : translation_number ↑f₁ = translation_number ↑f₂) : ∃ (F : circle_deg1_lift), function.semiconj ⇑F ⇑f₁ ⇑f₂ := sorry

/-- If two lifts of circle homeomorphisms have the same translation number, then they are
semiconjugate by a `circle_deg1_lift`. This version uses assumptions `is_unit f₁` and `is_unit f₂`
to assume that `f₁` and `f₂` are homeomorphisms. -/
theorem semiconj_of_is_unit_of_translation_number_eq {f₁ : circle_deg1_lift} {f₂ : circle_deg1_lift} (h₁ : is_unit f₁) (h₂ : is_unit f₂) (h : translation_number f₁ = translation_number f₂) : ∃ (F : circle_deg1_lift), function.semiconj ⇑F ⇑f₁ ⇑f₂ := sorry

/-- If two lifts of circle homeomorphisms have the same translation number, then they are
semiconjugate by a `circle_deg1_lift`. This version uses assumptions `bijective f₁` and
`bijective f₂` to assume that `f₁` and `f₂` are homeomorphisms. -/
theorem semiconj_of_bijective_of_translation_number_eq {f₁ : circle_deg1_lift} {f₂ : circle_deg1_lift} (h₁ : function.bijective ⇑f₁) (h₂ : function.bijective ⇑f₂) (h : translation_number f₁ = translation_number f₂) : ∃ (F : circle_deg1_lift), function.semiconj ⇑F ⇑f₁ ⇑f₂ :=
  semiconj_of_is_unit_of_translation_number_eq (iff.mpr is_unit_iff_bijective h₁) (iff.mpr is_unit_iff_bijective h₂) h