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

! This file was ported from Lean 3 source module order.iterate
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Logic.Function.Iterate
import Mathbin.Order.Monotone.Basic

/-!
# Inequalities on iterates

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

In this file we prove some inequalities comparing `f^[n] x` and `g^[n] x` where `f` and `g` are
two self-maps that commute with each other.

Current selection of inequalities is motivated by formalization of the rotation number of
a circle homeomorphism.
-/

variable {α β : Type _}

open Function

namespace Monotone

variable [Preorder α] {f : α → α} {x y : ℕ → α}

/-!
### Comparison of two sequences

If $f$ is a monotone function, then $∀ k, x_{k+1} ≤ f(x_k)$ implies that $x_k$ grows slower than
$f^k(x_0)$, and similarly for the reversed inequalities. If $x_k$ and $y_k$ are two sequences such
that $x_{k+1} ≤ f(x_k)$ and $y_{k+1} ≥ f(y_k)$ for all $k < n$, then $x_0 ≤ y_0$ implies
$x_n ≤ y_n$, see `monotone.seq_le_seq`.

If some of the inequalities in this lemma are strict, then we have $x_n < y_n$. The rest of the
lemmas in this section formalize this fact for different inequalities made strict.
-/

#print Monotone.seq_le_seq /-
theorem seq_le_seq (hf : Monotone f) (n : ℕ) (h₀ : x 0 ≤ y 0) (hx : ∀ k < n, x (k + 1) ≤ f (x k))
    (hy : ∀ k < n, f (y k) ≤ y (k + 1)) : x n ≤ y n :=
  by
  induction' n with n ihn
  · exact h₀
  · refine' (hx _ n.lt_succ_self).trans ((hf <| ihn _ _).trans (hy _ n.lt_succ_self))
    exact fun k hk => hx _ (hk.trans n.lt_succ_self)
    exact fun k hk => hy _ (hk.trans n.lt_succ_self)
#align monotone.seq_le_seq Monotone.seq_le_seq
-/

#print Monotone.seq_pos_lt_seq_of_lt_of_le /-
theorem seq_pos_lt_seq_of_lt_of_le (hf : Monotone f) {n : ℕ} (hn : 0 < n) (h₀ : x 0 ≤ y 0)
    (hx : ∀ k < n, x (k + 1) < f (x k)) (hy : ∀ k < n, f (y k) ≤ y (k + 1)) : x n < y n :=
  by
  induction' n with n ihn; · exact hn.false.elim
  suffices : x n ≤ y n
  exact (hx n n.lt_succ_self).trans_le ((hf this).trans <| hy n n.lt_succ_self)
  cases n; · exact h₀
  refine' (ihn n.zero_lt_succ (fun k hk => hx _ _) fun k hk => hy _ _).le <;>
    exact hk.trans n.succ.lt_succ_self
#align monotone.seq_pos_lt_seq_of_lt_of_le Monotone.seq_pos_lt_seq_of_lt_of_le
-/

#print Monotone.seq_pos_lt_seq_of_le_of_lt /-
theorem seq_pos_lt_seq_of_le_of_lt (hf : Monotone f) {n : ℕ} (hn : 0 < n) (h₀ : x 0 ≤ y 0)
    (hx : ∀ k < n, x (k + 1) ≤ f (x k)) (hy : ∀ k < n, f (y k) < y (k + 1)) : x n < y n :=
  hf.dual.seq_pos_lt_seq_of_lt_of_le hn h₀ hy hx
#align monotone.seq_pos_lt_seq_of_le_of_lt Monotone.seq_pos_lt_seq_of_le_of_lt
-/

#print Monotone.seq_lt_seq_of_lt_of_le /-
theorem seq_lt_seq_of_lt_of_le (hf : Monotone f) (n : ℕ) (h₀ : x 0 < y 0)
    (hx : ∀ k < n, x (k + 1) < f (x k)) (hy : ∀ k < n, f (y k) ≤ y (k + 1)) : x n < y n :=
  by
  cases n
  exacts[h₀, hf.seq_pos_lt_seq_of_lt_of_le n.zero_lt_succ h₀.le hx hy]
#align monotone.seq_lt_seq_of_lt_of_le Monotone.seq_lt_seq_of_lt_of_le
-/

#print Monotone.seq_lt_seq_of_le_of_lt /-
theorem seq_lt_seq_of_le_of_lt (hf : Monotone f) (n : ℕ) (h₀ : x 0 < y 0)
    (hx : ∀ k < n, x (k + 1) ≤ f (x k)) (hy : ∀ k < n, f (y k) < y (k + 1)) : x n < y n :=
  hf.dual.seq_lt_seq_of_lt_of_le n h₀ hy hx
#align monotone.seq_lt_seq_of_le_of_lt Monotone.seq_lt_seq_of_le_of_lt
-/

/-!
### Iterates of two functions

In this section we compare the iterates of a monotone function `f : α → α` to iterates of any
function `g : β → β`. If `h : β → α` satisfies `h ∘ g ≤ f ∘ h`, then `h (g^[n] x)` grows slower
than `f^[n] (h x)`, and similarly for the reversed inequality.

Then we specialize these two lemmas to the case `β = α`, `h = id`.
-/

variable {g : β → β} {h : β → α}

open Function

/- warning: monotone.le_iterate_comp_of_le -> Monotone.le_iterate_comp_of_le is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Preorder.{u1} α] {f : α -> α} {g : β -> β} {h : β -> α}, (Monotone.{u1, u1} α α _inst_1 _inst_1 f) -> (LE.le.{max u2 u1} (β -> α) (Pi.hasLe.{u2, u1} β (fun (ᾰ : β) => α) (fun (i : β) => Preorder.toLE.{u1} α _inst_1)) (Function.comp.{succ u2, succ u2, succ u1} β β α h g) (Function.comp.{succ u2, succ u1, succ u1} β α α f h)) -> (forall (n : Nat), LE.le.{max u2 u1} (β -> α) (Pi.hasLe.{u2, u1} β (fun (ᾰ : β) => α) (fun (i : β) => Preorder.toLE.{u1} α _inst_1)) (Function.comp.{succ u2, succ u2, succ u1} β β α h (Nat.iterate.{succ u2} β g n)) (Function.comp.{succ u2, succ u1, succ u1} β α α (Nat.iterate.{succ u1} α f n) h))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : Preorder.{u2} α] {f : α -> α} {g : β -> β} {h : β -> α}, (Monotone.{u2, u2} α α _inst_1 _inst_1 f) -> (LE.le.{max u2 u1} (β -> α) (Pi.hasLe.{u1, u2} β (fun (ᾰ : β) => α) (fun (i : β) => Preorder.toLE.{u2} α _inst_1)) (Function.comp.{succ u1, succ u1, succ u2} β β α h g) (Function.comp.{succ u1, succ u2, succ u2} β α α f h)) -> (forall (n : Nat), LE.le.{max u2 u1} (β -> α) (Pi.hasLe.{u1, u2} β (fun (ᾰ : β) => α) (fun (i : β) => Preorder.toLE.{u2} α _inst_1)) (Function.comp.{succ u1, succ u1, succ u2} β β α h (Nat.iterate.{succ u1} β g n)) (Function.comp.{succ u1, succ u2, succ u2} β α α (Nat.iterate.{succ u2} α f n) h))
Case conversion may be inaccurate. Consider using '#align monotone.le_iterate_comp_of_le Monotone.le_iterate_comp_of_leₓ'. -/
theorem le_iterate_comp_of_le (hf : Monotone f) (H : h ∘ g ≤ f ∘ h) (n : ℕ) :
    h ∘ g^[n] ≤ f^[n] ∘ h := fun x => by
  refine' hf.seq_le_seq n _ (fun k hk => _) fun k hk => _ <;> simp [iterate_succ', H _]
#align monotone.le_iterate_comp_of_le Monotone.le_iterate_comp_of_le

/- warning: monotone.iterate_comp_le_of_le -> Monotone.iterate_comp_le_of_le is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Preorder.{u1} α] {f : α -> α} {g : β -> β} {h : β -> α}, (Monotone.{u1, u1} α α _inst_1 _inst_1 f) -> (LE.le.{max u2 u1} (β -> α) (Pi.hasLe.{u2, u1} β (fun (ᾰ : β) => α) (fun (i : β) => Preorder.toLE.{u1} α _inst_1)) (Function.comp.{succ u2, succ u1, succ u1} β α α f h) (Function.comp.{succ u2, succ u2, succ u1} β β α h g)) -> (forall (n : Nat), LE.le.{max u2 u1} (β -> α) (Pi.hasLe.{u2, u1} β (fun (ᾰ : β) => α) (fun (i : β) => Preorder.toLE.{u1} α _inst_1)) (Function.comp.{succ u2, succ u1, succ u1} β α α (Nat.iterate.{succ u1} α f n) h) (Function.comp.{succ u2, succ u2, succ u1} β β α h (Nat.iterate.{succ u2} β g n)))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : Preorder.{u2} α] {f : α -> α} {g : β -> β} {h : β -> α}, (Monotone.{u2, u2} α α _inst_1 _inst_1 f) -> (LE.le.{max u2 u1} (β -> α) (Pi.hasLe.{u1, u2} β (fun (ᾰ : β) => α) (fun (i : β) => Preorder.toLE.{u2} α _inst_1)) (Function.comp.{succ u1, succ u2, succ u2} β α α f h) (Function.comp.{succ u1, succ u1, succ u2} β β α h g)) -> (forall (n : Nat), LE.le.{max u2 u1} (β -> α) (Pi.hasLe.{u1, u2} β (fun (ᾰ : β) => α) (fun (i : β) => Preorder.toLE.{u2} α _inst_1)) (Function.comp.{succ u1, succ u2, succ u2} β α α (Nat.iterate.{succ u2} α f n) h) (Function.comp.{succ u1, succ u1, succ u2} β β α h (Nat.iterate.{succ u1} β g n)))
Case conversion may be inaccurate. Consider using '#align monotone.iterate_comp_le_of_le Monotone.iterate_comp_le_of_leₓ'. -/
theorem iterate_comp_le_of_le (hf : Monotone f) (H : f ∘ h ≤ h ∘ g) (n : ℕ) :
    f^[n] ∘ h ≤ h ∘ g^[n] :=
  hf.dual.le_iterate_comp_of_le H n
#align monotone.iterate_comp_le_of_le Monotone.iterate_comp_le_of_le

#print Monotone.iterate_le_of_le /-
/-- If `f ≤ g` and `f` is monotone, then `f^[n] ≤ g^[n]`. -/
theorem iterate_le_of_le {g : α → α} (hf : Monotone f) (h : f ≤ g) (n : ℕ) : f^[n] ≤ g^[n] :=
  hf.iterate_comp_le_of_le h n
#align monotone.iterate_le_of_le Monotone.iterate_le_of_le
-/

#print Monotone.le_iterate_of_le /-
/-- If `f ≤ g` and `g` is monotone, then `f^[n] ≤ g^[n]`. -/
theorem le_iterate_of_le {g : α → α} (hg : Monotone g) (h : f ≤ g) (n : ℕ) : f^[n] ≤ g^[n] :=
  hg.dual.iterate_le_of_le h n
#align monotone.le_iterate_of_le Monotone.le_iterate_of_le
-/

end Monotone

/-!
### Comparison of iterations and the identity function

If $f(x) ≤ x$ for all $x$ (we express this as `f ≤ id` in the code), then the same is true for
any iterate of $f$, and similarly for the reversed inequality.
-/

namespace Function

section Preorder

variable [Preorder α] {f : α → α}

#print Function.id_le_iterate_of_id_le /-
/-- If $x ≤ f x$ for all $x$ (we write this as `id ≤ f`), then the same is true for any iterate
`f^[n]` of `f`. -/
theorem id_le_iterate_of_id_le (h : id ≤ f) (n : ℕ) : id ≤ f^[n] := by
  simpa only [iterate_id] using monotone_id.iterate_le_of_le h n
#align function.id_le_iterate_of_id_le Function.id_le_iterate_of_id_le
-/

#print Function.iterate_le_id_of_le_id /-
theorem iterate_le_id_of_le_id (h : f ≤ id) (n : ℕ) : f^[n] ≤ id :=
  @id_le_iterate_of_id_le αᵒᵈ _ f h n
#align function.iterate_le_id_of_le_id Function.iterate_le_id_of_le_id
-/

#print Function.monotone_iterate_of_id_le /-
theorem monotone_iterate_of_id_le (h : id ≤ f) : Monotone fun m => f^[m] :=
  monotone_nat_of_le_succ fun n x => by
    rw [iterate_succ_apply']
    exact h _
#align function.monotone_iterate_of_id_le Function.monotone_iterate_of_id_le
-/

#print Function.antitone_iterate_of_le_id /-
theorem antitone_iterate_of_le_id (h : f ≤ id) : Antitone fun m => f^[m] := fun m n hmn =>
  @monotone_iterate_of_id_le αᵒᵈ _ f h m n hmn
#align function.antitone_iterate_of_le_id Function.antitone_iterate_of_le_id
-/

end Preorder

/-!
### Iterates of commuting functions

If `f` and `g` are monotone and commute, then `f x ≤ g x` implies `f^[n] x ≤ g^[n] x`, see
`function.commute.iterate_le_of_map_le`. We also prove two strict inequality versions of this lemma,
as well as `iff` versions.
-/

namespace Commute

section Preorder

variable [Preorder α] {f g : α → α}

#print Function.Commute.iterate_le_of_map_le /-
theorem iterate_le_of_map_le (h : Commute f g) (hf : Monotone f) (hg : Monotone g) {x}
    (hx : f x ≤ g x) (n : ℕ) : (f^[n]) x ≤ (g^[n]) x := by
  refine' hf.seq_le_seq n _ (fun k hk => _) fun k hk => _ <;>
    simp [iterate_succ' f, h.iterate_right _ _, hg.iterate _ hx]
#align function.commute.iterate_le_of_map_le Function.Commute.iterate_le_of_map_le
-/

#print Function.Commute.iterate_pos_lt_of_map_lt /-
theorem iterate_pos_lt_of_map_lt (h : Commute f g) (hf : Monotone f) (hg : StrictMono g) {x}
    (hx : f x < g x) {n} (hn : 0 < n) : (f^[n]) x < (g^[n]) x := by
  refine' hf.seq_pos_lt_seq_of_le_of_lt hn _ (fun k hk => _) fun k hk => _ <;>
    simp [iterate_succ' f, h.iterate_right _ _, hg.iterate _ hx]
#align function.commute.iterate_pos_lt_of_map_lt Function.Commute.iterate_pos_lt_of_map_lt
-/

#print Function.Commute.iterate_pos_lt_of_map_lt' /-
theorem iterate_pos_lt_of_map_lt' (h : Commute f g) (hf : StrictMono f) (hg : Monotone g) {x}
    (hx : f x < g x) {n} (hn : 0 < n) : (f^[n]) x < (g^[n]) x :=
  @iterate_pos_lt_of_map_lt αᵒᵈ _ g f h.symm hg.dual hf.dual x hx n hn
#align function.commute.iterate_pos_lt_of_map_lt' Function.Commute.iterate_pos_lt_of_map_lt'
-/

end Preorder

variable [LinearOrder α] {f g : α → α}

#print Function.Commute.iterate_pos_lt_iff_map_lt /-
theorem iterate_pos_lt_iff_map_lt (h : Commute f g) (hf : Monotone f) (hg : StrictMono g) {x n}
    (hn : 0 < n) : (f^[n]) x < (g^[n]) x ↔ f x < g x :=
  by
  rcases lt_trichotomy (f x) (g x) with (H | H | H)
  · simp only [*, iterate_pos_lt_of_map_lt]
  · simp only [*, h.iterate_eq_of_map_eq, lt_irrefl]
  · simp only [lt_asymm H, lt_asymm (h.symm.iterate_pos_lt_of_map_lt' hg hf H hn)]
#align function.commute.iterate_pos_lt_iff_map_lt Function.Commute.iterate_pos_lt_iff_map_lt
-/

#print Function.Commute.iterate_pos_lt_iff_map_lt' /-
theorem iterate_pos_lt_iff_map_lt' (h : Commute f g) (hf : StrictMono f) (hg : Monotone g) {x n}
    (hn : 0 < n) : (f^[n]) x < (g^[n]) x ↔ f x < g x :=
  @iterate_pos_lt_iff_map_lt αᵒᵈ _ _ _ h.symm hg.dual hf.dual x n hn
#align function.commute.iterate_pos_lt_iff_map_lt' Function.Commute.iterate_pos_lt_iff_map_lt'
-/

#print Function.Commute.iterate_pos_le_iff_map_le /-
theorem iterate_pos_le_iff_map_le (h : Commute f g) (hf : Monotone f) (hg : StrictMono g) {x n}
    (hn : 0 < n) : (f^[n]) x ≤ (g^[n]) x ↔ f x ≤ g x := by
  simpa only [not_lt] using not_congr (h.symm.iterate_pos_lt_iff_map_lt' hg hf hn)
#align function.commute.iterate_pos_le_iff_map_le Function.Commute.iterate_pos_le_iff_map_le
-/

#print Function.Commute.iterate_pos_le_iff_map_le' /-
theorem iterate_pos_le_iff_map_le' (h : Commute f g) (hf : StrictMono f) (hg : Monotone g) {x n}
    (hn : 0 < n) : (f^[n]) x ≤ (g^[n]) x ↔ f x ≤ g x := by
  simpa only [not_lt] using not_congr (h.symm.iterate_pos_lt_iff_map_lt hg hf hn)
#align function.commute.iterate_pos_le_iff_map_le' Function.Commute.iterate_pos_le_iff_map_le'
-/

#print Function.Commute.iterate_pos_eq_iff_map_eq /-
theorem iterate_pos_eq_iff_map_eq (h : Commute f g) (hf : Monotone f) (hg : StrictMono g) {x n}
    (hn : 0 < n) : (f^[n]) x = (g^[n]) x ↔ f x = g x := by
  simp only [le_antisymm_iff, h.iterate_pos_le_iff_map_le hf hg hn,
    h.symm.iterate_pos_le_iff_map_le' hg hf hn]
#align function.commute.iterate_pos_eq_iff_map_eq Function.Commute.iterate_pos_eq_iff_map_eq
-/

end Commute

end Function

namespace Monotone

variable [Preorder α] {f : α → α} {x : α}

#print Monotone.monotone_iterate_of_le_map /-
/-- If `f` is a monotone map and `x ≤ f x` at some point `x`, then the iterates `f^[n] x` form
a monotone sequence. -/
theorem monotone_iterate_of_le_map (hf : Monotone f) (hx : x ≤ f x) : Monotone fun n => (f^[n]) x :=
  monotone_nat_of_le_succ fun n => by
    rw [iterate_succ_apply]
    exact hf.iterate n hx
#align monotone.monotone_iterate_of_le_map Monotone.monotone_iterate_of_le_map
-/

#print Monotone.antitone_iterate_of_map_le /-
/-- If `f` is a monotone map and `f x ≤ x` at some point `x`, then the iterates `f^[n] x` form
a antitone sequence. -/
theorem antitone_iterate_of_map_le (hf : Monotone f) (hx : f x ≤ x) : Antitone fun n => (f^[n]) x :=
  hf.dual.monotone_iterate_of_le_map hx
#align monotone.antitone_iterate_of_map_le Monotone.antitone_iterate_of_map_le
-/

end Monotone

namespace StrictMono

variable [Preorder α] {f : α → α} {x : α}

#print StrictMono.strictMono_iterate_of_lt_map /-
/-- If `f` is a strictly monotone map and `x < f x` at some point `x`, then the iterates `f^[n] x`
form a strictly monotone sequence. -/
theorem strictMono_iterate_of_lt_map (hf : StrictMono f) (hx : x < f x) :
    StrictMono fun n => (f^[n]) x :=
  strictMono_nat_of_lt_succ fun n => by
    rw [iterate_succ_apply]
    exact hf.iterate n hx
#align strict_mono.strict_mono_iterate_of_lt_map StrictMono.strictMono_iterate_of_lt_map
-/

#print StrictMono.strictAnti_iterate_of_map_lt /-
/-- If `f` is a strictly antitone map and `f x < x` at some point `x`, then the iterates `f^[n] x`
form a strictly antitone sequence. -/
theorem strictAnti_iterate_of_map_lt (hf : StrictMono f) (hx : f x < x) :
    StrictAnti fun n => (f^[n]) x :=
  hf.dual.strictMono_iterate_of_lt_map hx
#align strict_mono.strict_anti_iterate_of_map_lt StrictMono.strictAnti_iterate_of_map_lt
-/

end StrictMono


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

import data.stream.init
import data.part
import data.nat.upto

/-!
# Fixed point

This module defines a generic `fix` operator for defining recursive
computations that are not necessarily well-founded or productive.
An instance is defined for `part`.

## Main definition

 * class `has_fix`
 * `part.fix`
-/

universes u v

open_locale classical
variables {α : Type*} {β : α → Type*}

/-- `has_fix α` gives us a way to calculate the fixed point
of function of type `α → α`. -/
class has_fix (α : Type*) :=
(fix : (α → α) → α)

namespace part

open part nat nat.upto

section basic

variables (f : (Π a, part $ β a) → (Π a, part $ β a))

/-- A series of successive, finite approximation of the fixed point of `f`, defined by
`approx f n = f^[n] ⊥`. The limit of this chain is the fixed point of `f`. -/
def fix.approx : stream $ Π a, part $ β a
| 0 := ⊥
| (nat.succ i) := f (fix.approx i)

/-- loop body for finding the fixed point of `f` -/
def fix_aux {p : ℕ → Prop} (i : nat.upto p)
  (g : Π j : nat.upto p, i < j → Π a, part $ β a) : Π a, part $ β a :=
f $ λ x : α,
assert (¬p (i.val)) $ λ h : ¬ p (i.val),
g (i.succ h) (nat.lt_succ_self _) x

/-- The least fixed point of `f`.

If `f` is a continuous function (according to complete partial orders),
it satisfies the equations:

  1. `fix f = f (fix f)`          (is a fixed point)
  2. `∀ X, f X ≤ X → fix f ≤ X`   (least fixed point)
-/
protected def fix (x : α) : part $ β x :=
part.assert (∃ i, (fix.approx f i x).dom) $ λ h,
well_founded.fix.{1} (nat.upto.wf h) (fix_aux f) nat.upto.zero x

protected lemma fix_def {x : α} (h' : ∃ i, (fix.approx f i x).dom) :
  part.fix f x = fix.approx f (nat.succ $ nat.find h') x :=
begin
  let p := λ (i : ℕ), (fix.approx f i x).dom,
  have : p (nat.find h') := nat.find_spec h',
  generalize hk : nat.find h' = k,
  replace hk : nat.find h' = k + (@upto.zero p).val := hk,
  rw hk at this,
  revert hk,
  dsimp [part.fix], rw assert_pos h', revert this,
  generalize : upto.zero = z, intros,
  suffices : ∀ x',
    well_founded.fix (fix._proof_1 f x h') (fix_aux f) z x' = fix.approx f (succ k) x',
    from this _,
  induction k generalizing z; intro,
  { rw [fix.approx,well_founded.fix_eq,fix_aux],
    congr, ext : 1, rw assert_neg, refl,
    rw nat.zero_add at this,
    simpa only [not_not, subtype.val_eq_coe] },
  { rw [fix.approx,well_founded.fix_eq,fix_aux],
    congr, ext : 1,
    have hh : ¬(fix.approx f (z.val) x).dom,
    { apply nat.find_min h',
      rw [hk,nat.succ_add,← nat.add_succ],
      apply nat.lt_of_succ_le,
      apply nat.le_add_left },
    rw succ_add_eq_succ_add at this hk,
    rw [assert_pos hh, k_ih (upto.succ z hh) this hk] }
end

end basic

end part

namespace part

instance : has_fix (part α) :=
⟨λ f, part.fix (λ x u, f (x u)) ()⟩

end part

open sigma

namespace pi

instance part.has_fix {β} : has_fix (α → part β) := ⟨part.fix⟩

end pi


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Kenny Lau

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

/-!
# Lists with no duplicates

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

`list.nodup` is defined in `data/list/defs`. In this file we prove various properties of this
predicate.
-/

universe u v

open Nat Function

variable {α : Type u} {β : Type v} {l l₁ l₂ : List α} {r : α → α → Prop} {a b : α}

namespace List

#print List.forall_mem_ne /-
@[simp]
theorem forall_mem_ne {a : α} {l : List α} : (∀ a' : α, a' ∈ l → ¬a = a') ↔ a ∉ l :=
  ⟨fun h m => h _ m rfl, fun h a' m e => h (e.symm ▸ m)⟩
#align list.forall_mem_ne List.forall_mem_ne
-/

#print List.nodup_nil /-
@[simp]
theorem nodup_nil : @Nodup α [] :=
  Pairwise.nil
#align list.nodup_nil List.nodup_nil
-/

#print List.nodup_cons /-
@[simp]
theorem nodup_cons {a : α} {l : List α} : Nodup (a :: l) ↔ a ∉ l ∧ Nodup l := by
  simp only [nodup, pairwise_cons, forall_mem_ne]
#align list.nodup_cons List.nodup_cons
-/

#print List.Pairwise.nodup /-
protected theorem Pairwise.nodup {l : List α} {r : α → α → Prop} [IsIrrefl α r] (h : Pairwise r l) :
    Nodup l :=
  h.imp fun a b => ne_of_irrefl
#align list.pairwise.nodup List.Pairwise.nodup
-/

#print List.rel_nodup /-
theorem rel_nodup {r : α → β → Prop} (hr : Relator.BiUnique r) : (Forall₂ r ⇒ (· ↔ ·)) Nodup Nodup
  | _, _, forall₂.nil => by simp only [nodup_nil]
  | _, _, forall₂.cons hab h => by
    simpa only [nodup_cons] using Relator.rel_and (Relator.rel_not (rel_mem hr hab h)) (rel_nodup h)
#align list.rel_nodup List.rel_nodup
-/

#print List.Nodup.cons /-
protected theorem Nodup.cons (ha : a ∉ l) (hl : Nodup l) : Nodup (a :: l) :=
  nodup_cons.2 ⟨ha, hl⟩
#align list.nodup.cons List.Nodup.cons
-/

#print List.nodup_singleton /-
theorem nodup_singleton (a : α) : Nodup [a] :=
  pairwise_singleton _ _
#align list.nodup_singleton List.nodup_singleton
-/

#print List.Nodup.of_cons /-
theorem Nodup.of_cons (h : Nodup (a :: l)) : Nodup l :=
  (nodup_cons.1 h).2
#align list.nodup.of_cons List.Nodup.of_cons
-/

#print List.Nodup.not_mem /-
theorem Nodup.not_mem (h : (a :: l).Nodup) : a ∉ l :=
  (nodup_cons.1 h).1
#align list.nodup.not_mem List.Nodup.not_mem
-/

#print List.not_nodup_cons_of_mem /-
theorem not_nodup_cons_of_mem : a ∈ l → ¬Nodup (a :: l) :=
  imp_not_comm.1 Nodup.not_mem
#align list.not_nodup_cons_of_mem List.not_nodup_cons_of_mem
-/

#print List.Nodup.sublist /-
protected theorem Nodup.sublist : l₁ <+ l₂ → Nodup l₂ → Nodup l₁ :=
  Pairwise.sublist
#align list.nodup.sublist List.Nodup.sublist
-/

#print List.not_nodup_pair /-
theorem not_nodup_pair (a : α) : ¬Nodup [a, a] :=
  not_nodup_cons_of_mem <| mem_singleton_self _
#align list.not_nodup_pair List.not_nodup_pair
-/

#print List.nodup_iff_sublist /-
theorem nodup_iff_sublist {l : List α} : Nodup l ↔ ∀ a, ¬[a, a] <+ l :=
  ⟨fun d a h => not_nodup_pair a (d.Sublist h),
    by
    induction' l with a l IH <;> intro h; · exact nodup_nil
    exact
      (IH fun a s => h a <| sublist_cons_of_sublist _ s).cons fun al =>
        h a <| (singleton_sublist.2 al).cons_cons _⟩
#align list.nodup_iff_sublist List.nodup_iff_sublist
-/

#print List.nodup_iff_nthLe_inj /-
theorem nodup_iff_nthLe_inj {l : List α} :
    Nodup l ↔ ∀ i j h₁ h₂, nthLe l i h₁ = nthLe l j h₂ → i = j :=
  pairwise_iff_nthLe.trans
    ⟨fun H i j h₁ h₂ h =>
      ((lt_trichotomy _ _).resolve_left fun h' => H _ _ h₂ h' h).resolve_right fun h' =>
        H _ _ h₁ h' h.symm,
      fun H i j h₁ h₂ h => ne_of_lt h₂ (H _ _ _ _ h)⟩
#align list.nodup_iff_nth_le_inj List.nodup_iff_nthLe_inj
-/

#print List.Nodup.nthLe_inj_iff /-
theorem Nodup.nthLe_inj_iff {l : List α} (h : Nodup l) {i j : ℕ} (hi : i < l.length)
    (hj : j < l.length) : l.nthLe i hi = l.nthLe j hj ↔ i = j :=
  ⟨nodup_iff_nthLe_inj.mp h _ _ _ _, by simp (config := { contextual := true })⟩
#align list.nodup.nth_le_inj_iff List.Nodup.nthLe_inj_iff
-/

#print List.nodup_iff_get?_ne_get? /-
theorem nodup_iff_get?_ne_get? {l : List α} :
    l.Nodup ↔ ∀ i j : ℕ, i < j → j < l.length → l.get? i ≠ l.get? j :=
  by
  rw [nodup_iff_nth_le_inj]
  simp only [nth_le_eq_iff, some_nth_le_eq]
  constructor <;> rintro h i j h₁ h₂
  · exact mt (h i j (h₁.trans h₂) h₂) (ne_of_lt h₁)
  · intro h₃
    by_contra h₄
    cases' lt_or_gt_of_ne h₄ with h₅ h₅
    · exact h i j h₅ h₂ h₃
    · exact h j i h₅ h₁ h₃.symm
#align list.nodup_iff_nth_ne_nth List.nodup_iff_get?_ne_get?
-/

/- warning: list.nodup.ne_singleton_iff -> List.Nodup.ne_singleton_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {l : List.{u1} α}, (List.Nodup.{u1} α l) -> (forall (x : α), Iff (Ne.{succ u1} (List.{u1} α) l (List.cons.{u1} α x (List.nil.{u1} α))) (Or (Eq.{succ u1} (List.{u1} α) l (List.nil.{u1} α)) (Exists.{succ u1} α (fun (y : α) => Exists.{0} (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) y l) (fun (H : Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) y l) => Ne.{succ u1} α y x)))))
but is expected to have type
  forall {α : Type.{u1}} {l : List.{u1} α}, (List.Nodup.{u1} α l) -> (forall (x : α), Iff (Ne.{succ u1} (List.{u1} α) l (List.cons.{u1} α x (List.nil.{u1} α))) (Or (Eq.{succ u1} (List.{u1} α) l (List.nil.{u1} α)) (Exists.{succ u1} α (fun (y : α) => And (Membership.mem.{u1, u1} α (List.{u1} α) (List.instMembershipList.{u1} α) y l) (Ne.{succ u1} α y x)))))
Case conversion may be inaccurate. Consider using '#align list.nodup.ne_singleton_iff List.Nodup.ne_singleton_iffₓ'. -/
theorem Nodup.ne_singleton_iff {l : List α} (h : Nodup l) (x : α) :
    l ≠ [x] ↔ l = [] ∨ ∃ y ∈ l, y ≠ x :=
  by
  induction' l with hd tl hl
  · simp
  · specialize hl h.of_cons
    by_cases hx : tl = [x]
    · simpa [hx, and_comm, and_or_left] using h
    · rw [← Ne.def, hl] at hx
      rcases hx with (rfl | ⟨y, hy, hx⟩)
      · simp
      · have : tl ≠ [] := ne_nil_of_mem hy
        suffices ∃ (y : α)(H : y ∈ hd :: tl), y ≠ x by simpa [ne_nil_of_mem hy]
        exact ⟨y, mem_cons_of_mem _ hy, hx⟩
#align list.nodup.ne_singleton_iff List.Nodup.ne_singleton_iff

#print List.nthLe_eq_of_ne_imp_not_nodup /-
theorem nthLe_eq_of_ne_imp_not_nodup (xs : List α) (n m : ℕ) (hn : n < xs.length)
    (hm : m < xs.length) (h : xs.nthLe n hn = xs.nthLe m hm) (hne : n ≠ m) : ¬Nodup xs :=
  by
  rw [nodup_iff_nth_le_inj]
  simp only [exists_prop, exists_and_right, not_forall]
  exact ⟨n, m, ⟨hn, hm, h⟩, hne⟩
#align list.nth_le_eq_of_ne_imp_not_nodup List.nthLe_eq_of_ne_imp_not_nodup
-/

#print List.nthLe_index_of /-
@[simp]
theorem nthLe_index_of [DecidableEq α] {l : List α} (H : Nodup l) (n h) :
    indexOf (nthLe l n h) l = n :=
  nodup_iff_nthLe_inj.1 H _ _ _ h <| indexOf_nthLe <| indexOf_lt_length.2 <| nthLe_mem _ _ _
#align list.nth_le_index_of List.nthLe_index_of
-/

#print List.nodup_iff_count_le_one /-
theorem nodup_iff_count_le_one [DecidableEq α] {l : List α} : Nodup l ↔ ∀ a, count a l ≤ 1 :=
  nodup_iff_sublist.trans <|
    forall_congr' fun a =>
      have : [a, a] <+ l ↔ 1 < count a l := (@le_count_iff_replicate_sublist _ _ a l 2).symm
      (not_congr this).trans not_lt
#align list.nodup_iff_count_le_one List.nodup_iff_count_le_one
-/

#print List.nodup_replicate /-
theorem nodup_replicate (a : α) : ∀ {n : ℕ}, Nodup (replicate n a) ↔ n ≤ 1
  | 0 => by simp [Nat.zero_le]
  | 1 => by simp
  | n + 2 =>
    iff_of_false
      (fun H => nodup_iff_sublist.1 H a ((replicate_sublist_replicate _).2 (Nat.le_add_left 2 n)))
      (not_le_of_lt <| Nat.le_add_left 2 n)
#align list.nodup_replicate List.nodup_replicate
-/

#print List.count_eq_one_of_mem /-
@[simp]
theorem count_eq_one_of_mem [DecidableEq α] {a : α} {l : List α} (d : Nodup l) (h : a ∈ l) :
    count a l = 1 :=
  le_antisymm (nodup_iff_count_le_one.1 d a) (count_pos.2 h)
#align list.count_eq_one_of_mem List.count_eq_one_of_mem
-/

#print List.count_eq_of_nodup /-
theorem count_eq_of_nodup [DecidableEq α] {a : α} {l : List α} (d : Nodup l) :
    count a l = if a ∈ l then 1 else 0 :=
  by
  split_ifs with h
  · exact count_eq_one_of_mem d h
  · exact count_eq_zero_of_not_mem h
#align list.count_eq_of_nodup List.count_eq_of_nodup
-/

#print List.Nodup.of_append_left /-
theorem Nodup.of_append_left : Nodup (l₁ ++ l₂) → Nodup l₁ :=
  Nodup.sublist (sublist_append_left l₁ l₂)
#align list.nodup.of_append_left List.Nodup.of_append_left
-/

#print List.Nodup.of_append_right /-
theorem Nodup.of_append_right : Nodup (l₁ ++ l₂) → Nodup l₂ :=
  Nodup.sublist (sublist_append_right l₁ l₂)
#align list.nodup.of_append_right List.Nodup.of_append_right
-/

#print List.nodup_append /-
theorem nodup_append {l₁ l₂ : List α} : Nodup (l₁ ++ l₂) ↔ Nodup l₁ ∧ Nodup l₂ ∧ Disjoint l₁ l₂ :=
  by simp only [nodup, pairwise_append, disjoint_iff_ne]
#align list.nodup_append List.nodup_append
-/

#print List.disjoint_of_nodup_append /-
theorem disjoint_of_nodup_append {l₁ l₂ : List α} (d : Nodup (l₁ ++ l₂)) : Disjoint l₁ l₂ :=
  (nodup_append.1 d).2.2
#align list.disjoint_of_nodup_append List.disjoint_of_nodup_append
-/

#print List.Nodup.append /-
theorem Nodup.append (d₁ : Nodup l₁) (d₂ : Nodup l₂) (dj : Disjoint l₁ l₂) : Nodup (l₁ ++ l₂) :=
  nodup_append.2 ⟨d₁, d₂, dj⟩
#align list.nodup.append List.Nodup.append
-/

#print List.nodup_append_comm /-
theorem nodup_append_comm {l₁ l₂ : List α} : Nodup (l₁ ++ l₂) ↔ Nodup (l₂ ++ l₁) := by
  simp only [nodup_append, and_left_comm, disjoint_comm]
#align list.nodup_append_comm List.nodup_append_comm
-/

#print List.nodup_middle /-
theorem nodup_middle {a : α} {l₁ l₂ : List α} : Nodup (l₁ ++ a :: l₂) ↔ Nodup (a :: (l₁ ++ l₂)) :=
  by
  simp only [nodup_append, not_or, and_left_comm, and_assoc', nodup_cons, mem_append,
    disjoint_cons_right]
#align list.nodup_middle List.nodup_middle
-/

theorem Nodup.of_map (f : α → β) {l : List α} : Nodup (map f l) → Nodup l :=
  Pairwise.of_map f fun a b => mt <| congr_arg f
#align list.nodup.of_map List.Nodup.of_mapₓ

theorem Nodup.map_on {f : α → β} (H : ∀ x ∈ l, ∀ y ∈ l, f x = f y → x = y) (d : Nodup l) :
    (map f l).Nodup :=
  Pairwise.map _ (fun a b ⟨ma, mb, n⟩ e => n (H a ma b mb e)) (Pairwise.and_mem.1 d)
#align list.nodup.map_on List.Nodup.map_onₓ

#print List.inj_on_of_nodup_map /-
theorem inj_on_of_nodup_map {f : α → β} {l : List α} (d : Nodup (map f l)) :
    ∀ ⦃x⦄, x ∈ l → ∀ ⦃y⦄, y ∈ l → f x = f y → x = y :=
  by
  induction' l with hd tl ih
  · simp
  · simp only [map, nodup_cons, mem_map, not_exists, not_and, ← Ne.def] at d
    rintro _ (rfl | h₁) _ (rfl | h₂) h₃
    · rfl
    · apply (d.1 _ h₂ h₃.symm).elim
    · apply (d.1 _ h₁ h₃).elim
    · apply ih d.2 h₁ h₂ h₃
#align list.inj_on_of_nodup_map List.inj_on_of_nodup_map
-/

#print List.nodup_map_iff_inj_on /-
theorem nodup_map_iff_inj_on {f : α → β} {l : List α} (d : Nodup l) :
    Nodup (map f l) ↔ ∀ x ∈ l, ∀ y ∈ l, f x = f y → x = y :=
  ⟨inj_on_of_nodup_map, fun h => d.map_onₓ h⟩
#align list.nodup_map_iff_inj_on List.nodup_map_iff_inj_on
-/

#print List.Nodup.map /-
protected theorem Nodup.map {f : α → β} (hf : Injective f) : Nodup l → Nodup (map f l) :=
  Nodup.map_on fun x _ y _ h => hf h
#align list.nodup.map List.Nodup.map
-/

#print List.nodup_map_iff /-
theorem nodup_map_iff {f : α → β} {l : List α} (hf : Injective f) : Nodup (map f l) ↔ Nodup l :=
  ⟨Nodup.of_map _, Nodup.map hf⟩
#align list.nodup_map_iff List.nodup_map_iff
-/

#print List.nodup_attach /-
@[simp]
theorem nodup_attach {l : List α} : Nodup (attach l) ↔ Nodup l :=
  ⟨fun h => attach_map_val l ▸ h.map fun a b => Subtype.eq, fun h =>
    Nodup.of_map Subtype.val ((attach_map_val l).symm ▸ h)⟩
#align list.nodup_attach List.nodup_attach
-/

alias nodup_attach ↔ nodup.of_attach nodup.attach
#align list.nodup.of_attach List.Nodup.of_attach
#align list.nodup.attach List.Nodup.attach

attribute [protected] nodup.attach

#print List.Nodup.pmap /-
theorem Nodup.pmap {p : α → Prop} {f : ∀ a, p a → β} {l : List α} {H}
    (hf : ∀ a ha b hb, f a ha = f b hb → a = b) (h : Nodup l) : Nodup (pmap f l H) := by
  rw [pmap_eq_map_attach] <;>
    exact h.attach.map fun ⟨a, ha⟩ ⟨b, hb⟩ h => by congr <;> exact hf a (H _ ha) b (H _ hb) h
#align list.nodup.pmap List.Nodup.pmap
-/

/- warning: list.nodup.filter -> List.Nodup.filter is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (p : α -> Prop) [_inst_1 : DecidablePred.{succ u1} α p] {l : List.{u1} α}, (List.Nodup.{u1} α l) -> (List.Nodup.{u1} α (List.filterₓ.{u1} α p (fun (a : α) => _inst_1 a) l))
but is expected to have type
  forall {α : Type.{u1}} (p : α -> Bool) {_inst_1 : List.{u1} α}, (List.Nodup.{u1} α _inst_1) -> (List.Nodup.{u1} α (List.filter.{u1} α p _inst_1))
Case conversion may be inaccurate. Consider using '#align list.nodup.filter List.Nodup.filterₓ'. -/
theorem Nodup.filter (p : α → Prop) [DecidablePred p] {l} : Nodup l → Nodup (filter p l) :=
  Pairwise.filter p
#align list.nodup.filter List.Nodup.filter

#print List.nodup_reverse /-
@[simp]
theorem nodup_reverse {l : List α} : Nodup (reverse l) ↔ Nodup l :=
  pairwise_reverse.trans <| by simp only [nodup, Ne.def, eq_comm]
#align list.nodup_reverse List.nodup_reverse
-/

/- warning: list.nodup.erase_eq_filter -> List.Nodup.erase_eq_filter is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] {l : List.{u1} α}, (List.Nodup.{u1} α l) -> (forall (a : α), Eq.{succ u1} (List.{u1} α) (List.eraseₓ.{u1} α (fun (a : α) (b : α) => _inst_1 a b) l a) (List.filterₓ.{u1} α (fun (_x : α) => Ne.{succ u1} α _x a) (fun (a_1 : α) => Ne.decidable.{succ u1} α (fun (a : α) (b : α) => _inst_1 a b) a_1 a) l))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] {l : List.{u1} α}, (List.Nodup.{u1} α l) -> (forall (a : α), Eq.{succ u1} (List.{u1} α) (List.erase.{u1} α (instBEq.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) l a) (List.filter.{u1} α (fun (a_1 : α) => Decidable.decide (Ne.{succ u1} α a_1 a) (instDecidableNot (Eq.{succ u1} α a_1 a) (_inst_1 a_1 a))) l))
Case conversion may be inaccurate. Consider using '#align list.nodup.erase_eq_filter List.Nodup.erase_eq_filterₓ'. -/
theorem Nodup.erase_eq_filter [DecidableEq α] {l} (d : Nodup l) (a : α) :
    l.eraseₓ a = filter (· ≠ a) l :=
  by
  induction' d with b l m d IH; · rfl
  by_cases b = a
  · subst h
    rw [erase_cons_head, filter_cons_of_neg]
    symm
    rw [filter_eq_self]
    simpa only [Ne.def, eq_comm] using m
    exact not_not_intro rfl
  · rw [erase_cons_tail _ h, filter_cons_of_pos, IH]
    exact h
#align list.nodup.erase_eq_filter List.Nodup.erase_eq_filter

/- warning: list.nodup.erase -> List.Nodup.erase is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {l : List.{u1} α} [_inst_1 : DecidableEq.{succ u1} α] (a : α), (List.Nodup.{u1} α l) -> (List.Nodup.{u1} α (List.eraseₓ.{u1} α (fun (a : α) (b : α) => _inst_1 a b) l a))
but is expected to have type
  forall {α : Type.{u1}} {l : List.{u1} α} [_inst_1 : DecidableEq.{succ u1} α] (a : α), (List.Nodup.{u1} α l) -> (List.Nodup.{u1} α (List.erase.{u1} α (instBEq.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) l a))
Case conversion may be inaccurate. Consider using '#align list.nodup.erase List.Nodup.eraseₓ'. -/
theorem Nodup.erase [DecidableEq α] (a : α) : Nodup l → Nodup (l.eraseₓ a) :=
  Nodup.sublist <| erase_sublist _ _
#align list.nodup.erase List.Nodup.erase

/- warning: list.nodup.diff -> List.Nodup.diff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {l₁ : List.{u1} α} {l₂ : List.{u1} α} [_inst_1 : DecidableEq.{succ u1} α], (List.Nodup.{u1} α l₁) -> (List.Nodup.{u1} α (List.diffₓ.{u1} α (fun (a : α) (b : α) => _inst_1 a b) l₁ l₂))
but is expected to have type
  forall {α : Type.{u1}} {l₁ : List.{u1} α} {l₂ : List.{u1} α} [_inst_1 : DecidableEq.{succ u1} α], (List.Nodup.{u1} α l₁) -> (List.Nodup.{u1} α (List.diff.{u1} α (instBEq.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) l₁ l₂))
Case conversion may be inaccurate. Consider using '#align list.nodup.diff List.Nodup.diffₓ'. -/
theorem Nodup.diff [DecidableEq α] : l₁.Nodup → (l₁.diffₓ l₂).Nodup :=
  Nodup.sublist <| diff_sublist _ _
#align list.nodup.diff List.Nodup.diff

/- warning: list.nodup.mem_erase_iff -> List.Nodup.mem_erase_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {l : List.{u1} α} {a : α} {b : α} [_inst_1 : DecidableEq.{succ u1} α], (List.Nodup.{u1} α l) -> (Iff (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) a (List.eraseₓ.{u1} α (fun (a : α) (b : α) => _inst_1 a b) l b)) (And (Ne.{succ u1} α a b) (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) a l)))
but is expected to have type
  forall {α : Type.{u1}} {l : List.{u1} α} {a : α} {b : α} [_inst_1 : DecidableEq.{succ u1} α], (List.Nodup.{u1} α l) -> (Iff (Membership.mem.{u1, u1} α (List.{u1} α) (List.instMembershipList.{u1} α) a (List.erase.{u1} α (instBEq.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) l b)) (And (Ne.{succ u1} α a b) (Membership.mem.{u1, u1} α (List.{u1} α) (List.instMembershipList.{u1} α) a l)))
Case conversion may be inaccurate. Consider using '#align list.nodup.mem_erase_iff List.Nodup.mem_erase_iffₓ'. -/
theorem Nodup.mem_erase_iff [DecidableEq α] (d : Nodup l) : a ∈ l.eraseₓ b ↔ a ≠ b ∧ a ∈ l := by
  rw [d.erase_eq_filter, mem_filter, and_comm']
#align list.nodup.mem_erase_iff List.Nodup.mem_erase_iff

/- warning: list.nodup.not_mem_erase -> List.Nodup.not_mem_erase is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {l : List.{u1} α} {a : α} [_inst_1 : DecidableEq.{succ u1} α], (List.Nodup.{u1} α l) -> (Not (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) a (List.eraseₓ.{u1} α (fun (a : α) (b : α) => _inst_1 a b) l a)))
but is expected to have type
  forall {α : Type.{u1}} {l : List.{u1} α} {a : α} [_inst_1 : DecidableEq.{succ u1} α], (List.Nodup.{u1} α l) -> (Not (Membership.mem.{u1, u1} α (List.{u1} α) (List.instMembershipList.{u1} α) a (List.erase.{u1} α (instBEq.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) l a)))
Case conversion may be inaccurate. Consider using '#align list.nodup.not_mem_erase List.Nodup.not_mem_eraseₓ'. -/
theorem Nodup.not_mem_erase [DecidableEq α] (h : Nodup l) : a ∉ l.eraseₓ a := fun H =>
  (h.mem_erase_iff.1 H).1 rfl
#align list.nodup.not_mem_erase List.Nodup.not_mem_erase

#print List.nodup_join /-
theorem nodup_join {L : List (List α)} :
    Nodup (join L) ↔ (∀ l ∈ L, Nodup l) ∧ Pairwise Disjoint L := by
  simp only [nodup, pairwise_join, disjoint_left.symm, forall_mem_ne]
#align list.nodup_join List.nodup_join
-/

#print List.nodup_bind /-
theorem nodup_bind {l₁ : List α} {f : α → List β} :
    Nodup (l₁.bind f) ↔
      (∀ x ∈ l₁, Nodup (f x)) ∧ Pairwise (fun a b : α => Disjoint (f a) (f b)) l₁ :=
  by
  simp only [List.bind, nodup_join, pairwise_map, and_comm', and_left_comm, mem_map, exists_imp,
      and_imp] <;>
    rw [show (∀ (l : List β) (x : α), f x = l → x ∈ l₁ → nodup l) ↔ ∀ x : α, x ∈ l₁ → nodup (f x)
        from forall_swap.trans <| forall_congr' fun _ => forall_eq']
#align list.nodup_bind List.nodup_bind
-/

#print List.Nodup.product /-
protected theorem Nodup.product {l₂ : List β} (d₁ : l₁.Nodup) (d₂ : l₂.Nodup) :
    (l₁.product l₂).Nodup :=
  nodup_bind.2
    ⟨fun a ma => d₂.map <| LeftInverse.injective fun b => (rfl : (a, b).2 = b),
      d₁.imp fun a₁ a₂ n x h₁ h₂ =>
        by
        rcases mem_map.1 h₁ with ⟨b₁, mb₁, rfl⟩
        rcases mem_map.1 h₂ with ⟨b₂, mb₂, ⟨⟩⟩
        exact n rfl⟩
#align list.nodup.product List.Nodup.product
-/

/- warning: list.nodup.sigma -> List.Nodup.sigma is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {l₁ : List.{u1} α} {σ : α -> Type.{u2}} {l₂ : forall (a : α), List.{u2} (σ a)}, (List.Nodup.{u1} α l₁) -> (forall (a : α), List.Nodup.{u2} (σ a) (l₂ a)) -> (List.Nodup.{max u1 u2} (Sigma.{u1, u2} α (fun (a : α) => σ a)) (List.sigma.{u1, u2} α (fun (a : α) => σ a) l₁ l₂))
but is expected to have type
  forall {α : Type.{u2}} {l₁ : List.{u2} α} {σ : α -> Type.{u1}} {l₂ : forall (a : α), List.{u1} (σ a)}, (List.Nodup.{u2} α l₁) -> (forall (a : α), List.Nodup.{u1} (σ a) (l₂ a)) -> (List.Nodup.{max u2 u1} (Sigma.{u2, u1} α (fun (a : α) => σ a)) (List.sigma.{u2, u1} α (fun (a : α) => σ a) l₁ l₂))
Case conversion may be inaccurate. Consider using '#align list.nodup.sigma List.Nodup.sigmaₓ'. -/
theorem Nodup.sigma {σ : α → Type _} {l₂ : ∀ a, List (σ a)} (d₁ : Nodup l₁)
    (d₂ : ∀ a, Nodup (l₂ a)) : (l₁.Sigma l₂).Nodup :=
  nodup_bind.2
    ⟨fun a ma => (d₂ a).map fun b b' h => by injection h with _ h <;> exact eq_of_hEq h,
      d₁.imp fun a₁ a₂ n x h₁ h₂ =>
        by
        rcases mem_map.1 h₁ with ⟨b₁, mb₁, rfl⟩
        rcases mem_map.1 h₂ with ⟨b₂, mb₂, ⟨⟩⟩
        exact n rfl⟩
#align list.nodup.sigma List.Nodup.sigma

#print List.Nodup.filterMap /-
protected theorem Nodup.filterMap {f : α → Option β} (h : ∀ a a' b, b ∈ f a → b ∈ f a' → a = a') :
    Nodup l → Nodup (filterMap f l) :=
  Pairwise.filter_map f fun a a' n b bm b' bm' e => n <| h a a' b' (e ▸ bm) bm'
#align list.nodup.filter_map List.Nodup.filterMap
-/

#print List.Nodup.concat /-
protected theorem Nodup.concat (h : a ∉ l) (h' : l.Nodup) : (l.concat a).Nodup := by
  rw [concat_eq_append] <;> exact h'.append (nodup_singleton _) (disjoint_singleton.2 h)
#align list.nodup.concat List.Nodup.concat
-/

#print List.Nodup.insert /-
theorem Nodup.insert [DecidableEq α] (h : l.Nodup) : (insert a l).Nodup :=
  if h' : a ∈ l then by rw [insert_of_mem h'] <;> exact h
  else by rw [insert_of_not_mem h', nodup_cons] <;> constructor <;> assumption
#align list.nodup.insert List.Nodup.insert
-/

#print List.Nodup.union /-
theorem Nodup.union [DecidableEq α] (l₁ : List α) (h : Nodup l₂) : (l₁ ∪ l₂).Nodup :=
  by
  induction' l₁ with a l₁ ih generalizing l₂
  · exact h
  · exact (ih h).insert
#align list.nodup.union List.Nodup.union
-/

#print List.Nodup.inter /-
theorem Nodup.inter [DecidableEq α] (l₂ : List α) : Nodup l₁ → Nodup (l₁ ∩ l₂) :=
  Nodup.filter _
#align list.nodup.inter List.Nodup.inter
-/

/- warning: list.nodup.diff_eq_filter -> List.Nodup.diff_eq_filter is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] {l₁ : List.{u1} α} {l₂ : List.{u1} α}, (List.Nodup.{u1} α l₁) -> (Eq.{succ u1} (List.{u1} α) (List.diffₓ.{u1} α (fun (a : α) (b : α) => _inst_1 a b) l₁ l₂) (List.filterₓ.{u1} α (fun (_x : α) => Not (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) _x l₂)) (fun (a : α) => Not.decidable (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) a l₂) (List.decidableMem.{u1} α (fun (a : α) (b : α) => _inst_1 a b) a l₂)) l₁))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] {l₁ : List.{u1} α} {l₂ : List.{u1} α}, (List.Nodup.{u1} α l₁) -> (Eq.{succ u1} (List.{u1} α) (List.diff.{u1} α (instBEq.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) l₁ l₂) (List.filter.{u1} α (fun (a : α) => Decidable.decide (Not (Membership.mem.{u1, u1} α (List.{u1} α) (List.instMembershipList.{u1} α) a l₂)) (instDecidableNot (Membership.mem.{u1, u1} α (List.{u1} α) (List.instMembershipList.{u1} α) a l₂) (List.instDecidableMemListInstMembershipList.{u1} α (fun (a : α) (b : α) => _inst_1 a b) a l₂))) l₁))
Case conversion may be inaccurate. Consider using '#align list.nodup.diff_eq_filter List.Nodup.diff_eq_filterₓ'. -/
theorem Nodup.diff_eq_filter [DecidableEq α] :
    ∀ {l₁ l₂ : List α} (hl₁ : l₁.Nodup), l₁.diffₓ l₂ = l₁.filterₓ (· ∉ l₂)
  | l₁, [], hl₁ => by simp
  | l₁, a :: l₂, hl₁ =>
    by
    rw [diff_cons, (hl₁.erase _).diff_eq_filter, hl₁.erase_eq_filter, filter_filter]
    simp only [mem_cons_iff, not_or, and_comm]
#align list.nodup.diff_eq_filter List.Nodup.diff_eq_filter

/- warning: list.nodup.mem_diff_iff -> List.Nodup.mem_diff_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {l₁ : List.{u1} α} {l₂ : List.{u1} α} {a : α} [_inst_1 : DecidableEq.{succ u1} α], (List.Nodup.{u1} α l₁) -> (Iff (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) a (List.diffₓ.{u1} α (fun (a : α) (b : α) => _inst_1 a b) l₁ l₂)) (And (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) a l₁) (Not (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) a l₂))))
but is expected to have type
  forall {α : Type.{u1}} {l₁ : List.{u1} α} {l₂ : List.{u1} α} {a : α} [_inst_1 : DecidableEq.{succ u1} α], (List.Nodup.{u1} α l₁) -> (Iff (Membership.mem.{u1, u1} α (List.{u1} α) (List.instMembershipList.{u1} α) a (List.diff.{u1} α (instBEq.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) l₁ l₂)) (And (Membership.mem.{u1, u1} α (List.{u1} α) (List.instMembershipList.{u1} α) a l₁) (Not (Membership.mem.{u1, u1} α (List.{u1} α) (List.instMembershipList.{u1} α) a l₂))))
Case conversion may be inaccurate. Consider using '#align list.nodup.mem_diff_iff List.Nodup.mem_diff_iffₓ'. -/
theorem Nodup.mem_diff_iff [DecidableEq α] (hl₁ : l₁.Nodup) : a ∈ l₁.diffₓ l₂ ↔ a ∈ l₁ ∧ a ∉ l₂ :=
  by rw [hl₁.diff_eq_filter, mem_filter]
#align list.nodup.mem_diff_iff List.Nodup.mem_diff_iff

#print List.Nodup.set /-
protected theorem Nodup.set :
    ∀ {l : List α} {n : ℕ} {a : α} (hl : l.Nodup) (ha : a ∉ l), (l.set n a).Nodup
  | [], n, a, hl, ha => nodup_nil
  | b :: l, 0, a, hl, ha => nodup_cons.2 ⟨mt (mem_cons_of_mem _) ha, (nodup_cons.1 hl).2⟩
  | b :: l, n + 1, a, hl, ha =>
    nodup_cons.2
      ⟨fun h =>
        (mem_or_eq_of_mem_set h).elim (nodup_cons.1 hl).1 fun hba => ha (hba ▸ mem_cons_self _ _),
        hl.of_cons.set (mt (mem_cons_of_mem _) ha)⟩
#align list.nodup.update_nth List.Nodup.set
-/

/- warning: list.nodup.map_update -> List.Nodup.map_update is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] {l : List.{u1} α}, (List.Nodup.{u1} α l) -> (forall (f : α -> β) (x : α) (y : β), Eq.{succ u2} (List.{u2} β) (List.map.{u1, u2} α β (Function.update.{succ u1, succ u2} α (fun (ᾰ : α) => β) (fun (a : α) (b : α) => _inst_1 a b) f x y) l) (ite.{succ u2} (List.{u2} β) (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) x l) (List.decidableMem.{u1} α (fun (a : α) (b : α) => _inst_1 a b) x l) (List.set.{u2} β (List.map.{u1, u2} α β f l) (List.indexOfₓ.{u1} α (fun (a : α) (b : α) => _inst_1 a b) x l) y) (List.map.{u1, u2} α β f l)))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] {l : List.{u1} α}, (List.Nodup.{u1} α l) -> (forall (f : α -> β) (x : α) (y : β), Eq.{succ u2} (List.{u2} β) (List.map.{u1, u2} α β (Function.update.{succ u1, succ u2} α (fun (ᾰ : α) => β) (fun (a : α) (b : α) => _inst_1 a b) f x y) l) (ite.{succ u2} (List.{u2} β) (Membership.mem.{u1, u1} α (List.{u1} α) (List.instMembershipList.{u1} α) x l) (List.instDecidableMemListInstMembershipList.{u1} α (fun (a : α) (b : α) => _inst_1 a b) x l) (List.set.{u2} β (List.map.{u1, u2} α β f l) (List.indexOf.{u1} α (instBEq.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) x l) y) (List.map.{u1, u2} α β f l)))
Case conversion may be inaccurate. Consider using '#align list.nodup.map_update List.Nodup.map_updateₓ'. -/
theorem Nodup.map_update [DecidableEq α] {l : List α} (hl : l.Nodup) (f : α → β) (x : α) (y : β) :
    l.map (Function.update f x y) = if x ∈ l then (l.map f).set (l.indexOfₓ x) y else l.map f :=
  by
  induction' l with hd tl ihl; · simp
  rw [nodup_cons] at hl
  simp only [mem_cons_iff, map, ihl hl.2]
  by_cases H : hd = x
  · subst hd
    simp [update_nth, hl.1]
  · simp [Ne.symm H, H, update_nth, ← apply_ite (cons (f hd))]
#align list.nodup.map_update List.Nodup.map_update

#print List.Nodup.pairwise_of_forall_ne /-
theorem Nodup.pairwise_of_forall_ne {l : List α} {r : α → α → Prop} (hl : l.Nodup)
    (h : ∀ a ∈ l, ∀ b ∈ l, a ≠ b → r a b) : l.Pairwise r := by
  classical
    refine' pairwise_of_reflexive_on_dupl_of_forall_ne _ h
    intro x hx
    rw [nodup_iff_count_le_one] at hl
    exact absurd (hl x) hx.not_le
#align list.nodup.pairwise_of_forall_ne List.Nodup.pairwise_of_forall_ne
-/

#print List.Nodup.pairwise_of_set_pairwise /-
theorem Nodup.pairwise_of_set_pairwise {l : List α} {r : α → α → Prop} (hl : l.Nodup)
    (h : { x | x ∈ l }.Pairwise r) : l.Pairwise r :=
  hl.pairwise_of_forall_ne h
#align list.nodup.pairwise_of_set_pairwise List.Nodup.pairwise_of_set_pairwise
-/

#print List.Nodup.pairwise_coe /-
@[simp]
theorem Nodup.pairwise_coe [IsSymm α r] (hl : l.Nodup) : { a | a ∈ l }.Pairwise r ↔ l.Pairwise r :=
  by
  induction' l with a l ih
  · simp
  rw [List.nodup_cons] at hl
  have : ∀ b ∈ l, ¬a = b → r a b ↔ r a b := fun b hb =>
    imp_iff_right (ne_of_mem_of_not_mem hb hl.1).symm
  simp [Set.setOf_or, Set.pairwise_insert_of_symmetric (@symm_of _ r _), ih hl.2, and_comm',
    forall₂_congr this]
#align list.nodup.pairwise_coe List.Nodup.pairwise_coe
-/

end List

#print Option.toList_nodup /-
theorem Option.toList_nodup {α} : ∀ o : Option α, o.toList.Nodup
  | none => List.nodup_nil
  | some x => List.nodup_singleton x
#align option.to_list_nodup Option.toList_nodup
-/


import analysis.specific_limits.basic
import system_of_complexes.basic
import locally_constant.Vhat

/-!

# A technical lemma

This file has the definition of the completion of a system of
complexes of seminormed groups, and it proves a technical lemma
saying that a system of complexes of seminormed groups is admissible
and weak bounded exact, and if the groups in the complex are complete,
then it's bounded exact (for some slightly different constants).
-/

open finset filter
open_locale nnreal big_operators topological_space

namespace system_of_complexes

universe variables u

noncomputable def completion (C : system_of_complexes) : system_of_complexes :=
C ⋙ SemiNormedGroup.Completion.map_homological_complex _

namespace is_weak_bounded_exact

variables (C C₁ C₂ : system_of_complexes.{u})
variables {k k' K K' : ℝ≥0} {m m' : ℕ} {c₀ c₀' : ℝ≥0}

-- === We don't need the following two lemmas anytime soon

-- lemma controlled_y (hC : C.is_weak_bounded_exact k K m c₀) :
-- ∀ c ≥ c₀, ∀ i < m,
-- ∀ x : C (k^2 * c) (i+1),
-- ∀ (ε > 0) (δ > 0), ∃ y : C c i, ∥res x - C.d _ _ y∥
--                    ≤ K * ∥C.d _ (i+1) x∥ + ε ∧ ∥y∥ ≤ K*(K + 1)*∥x∥ + δ :=
-- by admit

-- lemma completion (hC : C.is_weak_bounded_exact k K m c₀) :
--   C.completion.is_weak_bounded_exact (k^2) K m c₀ :=
-- by admit

lemma strong_of_complete [hk : fact (1 ≤ k)]
  [∀ c i, separated_space (C c i)]
  (hC : C.is_weak_bounded_exact k K m c₀)
  (hC' : admissible C) [∀ c i, complete_space (C c i)] :
  ∀ δ > 0, C.is_bounded_exact (k^2) (K + δ) m c₀ :=
begin
  intros δ hδ,
  refine (hC.of_le hC' _ ⟨le_rfl⟩ le_rfl ⟨le_rfl⟩).to_exact hδ _,
  { constructor,
    calc k = k * 1 : by rw mul_one
    ... ≤ k * k : mul_le_mul' le_rfl hk.out
    ... = k ^ 2 : by rw pow_two },
  rintros c hc i hi x _ rfl hx,
  haveI : fact (k * c ≤ k ^ 2 * c) := by { rw [pow_two, mul_assoc], apply_instance },
  haveI : fact (k * (k * c) ≤ k ^ 2 * c) := by { rw [pow_two, mul_assoc], exact ⟨le_rfl⟩ },
  -- we need to consider the case `i = 0` separately
  obtain (rfl|⟨i,rfl⟩) : i = 0 ∨ ∃ i', i = i' + 1,
  { cases i, { left, refl }, { right, exact ⟨_, rfl⟩ } },
  { refine ⟨0, rfl, 0, _⟩,
    rw [map_zero, ← norm_le_zero_iff'],
    apply le_of_forall_pos_le_add,
    intros γ hγ,
    rw zero_add,
    obtain ⟨_, _, rfl, rfl, y, hy⟩ := hC c ⟨hc⟩ 0 (nat.zero_le m) (res x) γ hγ,
    rwa [res_res, d_eq_zero_apply, sub_zero, d_res, hx, map_zero, norm_zero, mul_zero, zero_add] at hy,
    dec_trivial },
  -- we continue with the case `i + 1`
  have hc₀kc : k * c ≥ c₀,
  calc c₀ ≤ c : hc
  ... ≤ 1*c : by rw one_mul
  ... ≤ k*c : mul_le_mul' hk.out (le_refl _),
  let K' := if K = 0 then 1 else K,
  have hK' : (0 : ℝ) < K',
  { dsimp [K'],
    split_ifs,
    norm_num,
    exact zero_lt_iff.mpr h },
  let ε : ℕ → ℝ := λ j, (2⁻¹*2⁻¹ ^ j) / K' / 2,
  have ε_pos : ∀ j, 0 < ε j,
  { intro j,
    dsimp [ε],
    refine div_pos (div_pos (mul_pos _ _) hK') zero_lt_two; simp },
  have ε_decr : ∀ j, ε (j+1) ≤ ε j,
  { intros j,
    dsimp [ε],
    field_simp,
    apply one_div_le_one_div_of_le;
    norm_num [hK', pow_succ], },
  have seq : ∀ j : ℕ, ∃ w : C (k*c) i, ∥res x - C.d i (i+1) w∥ ≤ ε j,
  { intro j,
    specialize hC (k*c) ⟨hc₀kc⟩ _ hi (res x) (ε j) (ε_pos j),
    obtain ⟨_, _, rfl, rfl, y, hy⟩ := hC,
    simp only [d_res, res_res, map_zero, hx, norm_zero, zero_add, mul_zero] at hy,
    refine ⟨y, hy⟩ },
  choose w hw using seq,
  let δ : ℕ → ℝ := λ j, 2⁻¹*2⁻¹ ^ j,
  have δ_pos : ∀ j, 0 < δ j, { norm_num [δ] },
  have hεδ : ∀ j, (K : ℝ) * (2 * ε j) + δ j ≤ 1 * 2⁻¹ ^ j,
  { intro j,
    dsimp [ε, δ],
    conv_rhs { congr, rw [show (1 : ℝ) = 2⁻¹ + 2⁻¹, by norm_num] },
    rw add_mul (2⁻¹ : ℝ) 2⁻¹,
    by_cases hK : K = 0,
    { simp only [hK, div_zero, nnreal.coe_zero, zero_div, zero_add, le_add_iff_nonneg_left, mul_zero, K', if_pos, zero_mul],
      apply mul_nonneg,
      norm_num,
      apply pow_nonneg,
      norm_num },
    { apply le_of_eq,
      congr' 1,
      simp only [K', if_neg hK],
      rw [mul_div_cancel' _ (two_ne_zero : (2 : ℝ) ≠ 0),
          mul_div_cancel' _ (nnreal.coe_ne_zero.mpr hK)]} },
  set i₀ := i - 1 with hi₀,
  have seq : ∀ j : ℕ, ∃ z : C c i₀, ∥res (w (j+1) - w j) - C.d i₀ i z∥
                      ≤ K*∥C.d i (i+1) (w (j+1) - w j)∥ + δ j,
  { intro j,
    have : i ≤ m, { exact i.le_succ.trans hi },
    obtain ⟨i', -, hi', rfl, hy⟩ := hC c ⟨hc⟩ i this (w (j+1) - w j) _ (δ_pos j),
    rw [← hi₀] at hi', subst i', exact hy },
  choose z hz using seq,
  let y : ℕ → C c i := λ j, res (w j) - ∑ l in range j, C.d _ _ (z l),
  have cau_y : cauchy_seq y,
  { apply cauchy_seq_of_le_geometric (2⁻¹ : ℝ) 1 (nnreal.two_inv_lt_one),
    intros j,
    have fact : ∥C.d _ (i+1) (w (j + 1) - w j)∥ ≤ 2*ε j :=
    calc ∥C.d _ (i+1) (w (j + 1) - w j)∥
        = ∥(C.d _ _ (w (j + 1)) - res x) + (res x - C.d _ _ (w j))∥ : by simp only [sub_add_sub_cancel, _root_.map_sub]
    ... ≤ ∥C.d _ _ (w (j + 1)) - res x∥ + ∥res x - C.d _ _ (w j)∥ : norm_add_le _ _
    ... = ∥res x - C.d _ _ (w (j + 1))∥ + ∥res x - C.d _ _ (w j)∥ : by { rw norm_sub_rev }
    ... ≤ ε (j+1) + ε j : add_le_add (hw $ j+1) (hw j)
    ... ≤ 2*ε j : by linarith [ε_decr j],
    calc dist (y j) (y (j + 1)) = ∥y (j+1) - y j∥ : by rw dist_eq_norm'
    ... = ∥res (w (j + 1)) - res (w j) - (∑ (l : ℕ) in range (j + 1), C.d _ _ (z l)
                                - ∑ (l : ℕ) in range j, C.d _ _ (z l))∥ : by { dsimp [y], congr' 1, abel }
    ... = ∥res (w (j + 1) - (w j)) - C.d _ _ (z j)∥ : by simp [_root_.map_sub, sum_range_succ]
    ... ≤ K * ∥C.d _ _ (w (j + 1) - w j)∥ + δ j : hz j
    ... ≤ K * (2* ε j) + δ j : by {apply add_le_add_right, apply mul_le_mul_of_nonneg_left fact (nnreal.coe_nonneg K)}
    ... ≤ 1 * 2⁻¹ ^ j : hεδ j },
  have hdyj : ∀ j, C.d _ _ (y j) = res (C.d _ _ $ w j),
  { intro j,
    calc C.d _ _ (y j) = C.d _ _ (res (w j) - ∑ l in range j, C.d _ i (z l)) : rfl
    ... = C.d _ _ (res (w j)) - ∑ l in range j, C.d i (i+1) (C.d _ _ (z l)) : by rw [_root_.map_sub, map_sum]
    ... = res (C.d _ _ (w j))  : by simp only [d_res, d_d, sum_const_zero, sub_zero] },

  have hblop : ∀ j, ∥res x - C.d _ _ (y j)∥  ≤ ε j,
  { intro j,
    calc ∥res x - C.d _ _ (y j)∥ = ∥res x - res (C.d _ _ $ w j)∥ : by rw hdyj
    ... = ∥(res (res x : C (k*c) (i+1)) - res (C.d _ _ $ w j) : C c _)∥ : by { rw  C.res_res }
    ... = ∥res (res x - (C.d _ _ $ w j))∥ : by simp only [_root_.map_sub]
    ... ≤ ∥res x - C.d _ _ (w j)∥ : by apply hC'.res_norm_noninc
    ... ≤ ε j : hw _},

  rcases cauchy_seq_tendsto_of_complete cau_y with ⟨y₀, hy₀⟩,
  refine ⟨_, rfl, y₀, _⟩,
  refine sub_eq_zero.1 (norm_le_zero_iff'.1 _),
  have lim_norm : tendsto (λ j, ∥res x - C.d _ _ (y j)∥) at_top (𝓝 ∥res x - C.d _ _ y₀∥),
  { have cont : continuous (λ y : C c i, ∥res x - C.d _ _ y∥),
      from continuous_norm.comp (continuous_const.sub $ normed_add_group_hom.continuous _),
    exact (cont.tendsto y₀).comp hy₀ },
  have lim_ε : tendsto ε at_top (𝓝 0),
  { rw show (0 : ℝ) = (2⁻¹*0)/K'/2, by norm_num,
    refine (tendsto.const_mul 2⁻¹ (tendsto_pow_at_top_nhds_0_of_lt_1 _ _)).div_const.div_const;
    norm_num },
  exact le_of_tendsto_of_tendsto' lim_norm lim_ε hblop,
end

end is_weak_bounded_exact

end system_of_complexes


-- Copyright (c) Microsoft Corporation. All rights reserved.
-- Licensed under the MIT license.

import .common
import .ops

def bitvector (sz:size) :=
{ x : nat // x < (2 ^ sz.val) }

instance (sz:size) : has_to_string (bitvector sz) :=
⟨λ s, to_string s.1⟩

instance (sz:size) : has_zero (bitvector sz) :=
⟨⟨0, -- 0 < sz → 0 < sz^n
  nat.pos_pow_of_pos sz dec_trivial⟩⟩

instance (sz:size): has_coe (bitvector sz) nat :=
⟨λ s, s.1⟩

namespace bitvector

private lemma nat.ne_zero_of_pos {n:ℕ} : n > 0 → n ≠ 0 :=
λ h contr, by simp [contr] at h; cases h

lemma bv_mod_lt (n : nat) (sz : nat) : n % (2^sz) < 2^sz :=
begin
    apply nat.mod_lt,
    apply nat.pos_pow_of_pos,
    tactic.comp_val
end

local notation `♯` := by apply bv_mod_lt

def to_int {sz:size} (x:bitvector sz) : ℤ :=
  if x.1 < (2 ^ (sz.val - 1)) then x.1
  else int.neg_succ_of_nat (2 ^ sz.val - x.1 - 1)

def of_int (sz:size) : ℤ → bitvector sz
| x@(int.of_nat q) :=
  ⟨q % (2 ^ sz.val), ♯⟩
| x@(int.neg_succ_of_nat p) :=
  ⟨(((2 ^ sz.val) - p - 1) % (2^sz.val)), ♯⟩

@[simp]
def all_one (sz:size) : bitvector sz := of_int sz (all_one_nat sz)

@[simp]
def int_min (sz:size) : bitvector sz := of_int sz (int_min_nat sz)

@[simp]
def zero (sz:size) : bitvector sz := of_int sz 0

def of_bool (b:bool) : bitvector (size.one) := of_int size.one (cond b 1 0)

variable {sz:size}

def signed_check (b1 b2:bitvector sz) (f:ℤ → ℤ → ℤ) : bool :=
  let i1 := to_int b1,
    i2 := to_int b2,
    s  := int.of_nat (2^(sz.val - 1)) in
  f i1 i2 < 0 - s ∨ s ≤ f i1 i2
def unsigned_check (b1 b2:bitvector sz) (f:ℤ → ℤ → ℤ) : bool :=
  let i1:ℤ := b1,
    i2:ℤ := b2,
    s    := int.of_nat (2 ^ sz.val) in
  f i1 i2 < 0 ∨ s ≤ f i1 i2

def add (b1 b2:bitvector sz) : bitvector sz :=
  ⟨(b1 + b2) % (2 ^ sz.val), ♯⟩

def add_overflows (signed:bool) (b1 b2:bitvector sz) : bool :=
  if signed then signed_check b1 b2 int.add
  else unsigned_check b1 b2 int.add

def sub (b1 b2:bitvector sz) : bitvector sz :=
  ⟨(b1 + (2 ^ sz.val) - b2) % (2 ^ sz.val), ♯⟩

def sub_overflows (signed:bool) (b1 b2:bitvector sz) : bool :=
  if signed then signed_check b1 b2 (λ i1 i2, int.add i1 (0-i2))
  else unsigned_check b1 b2 (λ i1 i2, int.add i1 (0-i2))

def mul (b1 b2:bitvector sz) : bitvector sz :=
  ⟨(b1 * b2) % (2 ^ sz.val), ♯⟩
def mul_overflows (signed:bool) (b1 b2:bitvector sz) : bool :=
  if signed then signed_check b1 b2 int.mul
  else unsigned_check b1 b2 int.mul

-- Returns 0 in case of division by zero
def udiv (b1 b2:bitvector sz) : bitvector sz :=
  ⟨(b1 / b2) % (2 ^ sz.val), ♯⟩

-- Returns 0 in case of division by zero
def urem (b1 b2:bitvector sz) : bitvector sz :=
  ⟨(b1 % b2) % (2 ^ sz.val), ♯⟩

-- Returns 0 in case of division by zero.
-- Returns 0 in case of INT_MIN / -1.
def sdiv (b1 b2:bitvector sz) : bitvector sz :=
  of_int sz (int.quot (to_int b1) (to_int b2))

-- Returns 0 in case of division by zero.
def srem (b1 b2:bitvector sz) : bitvector sz :=
  of_int sz (int.rem (to_int b1) (to_int b2))

-- Utility functions for bitwise operations.
def bits_to_nat (v : list bool) : ℕ :=
list.foldr (λ (b:bool) (x:ℕ), 2 * x + cond b 1 0) 0 v

def nat_to_bits : Π (sz:ℕ), ℕ → list bool
| 0 n       := []
| (nat.succ sz') n := to_bool (n % 2 = 1) :: (nat_to_bits sz' (n / 2))

def list_bitwise_op (f:bool → bool → bool) : ∀ (l1 l2: list bool), list bool
| (h1::t1) (h2::t2) := ((f h1 h2)::(list_bitwise_op t1 t2))
| (list.nil) (list.nil) := []
| _ _ := []

-- bitwise operation template.
def bitwise_op (f:bool → bool → bool) (b1 b2:bitvector sz) : bitvector sz :=
  ⟨bits_to_nat (list_bitwise_op f (nat_to_bits sz b1) (nat_to_bits sz b2)) % (2^sz.val), ♯⟩

def bitwise_or := @bitwise_op sz bor
def bitwise_and := @bitwise_op sz band
def bitwise_xor := @bitwise_op sz (λ b1 b2, ¬(b1 = b2))

def shl (b1 b2:bitvector sz): bitvector sz :=
  ⟨(b1 * (2^(if b2.val ≥ sz.val then sz.val else b2.val))) % 2^sz.val, ♯⟩
def shl_overflows (signed:bool) (b1 b2:bitvector sz) : bool :=
  if signed then
    let i1 := to_int b1, sft := b2.1 % sz, s := int.of_nat (2^(sz.val - 1)) in
    let v := i1 * int.of_nat (2^sft) in
    v < 0 - s ∨ s ≤ v
  else
    let i1 := b1.1, sft := b2.1 % sz, s := (2 ^ sz.val) in
    let v := i1 * (2^sft) in
    s ≤ v

def lshr (b1 b2:bitvector sz): bitvector sz :=
  ⟨(b1 / (2^(b2.val % sz))) % (2 ^ sz.val), ♯⟩
def ashr (b1 b2:bitvector sz): bitvector sz :=
  let n2  := b2.1 % sz,
      sgn := b1.1 / (2^(sz.val - 1)),
      mask := 2^sz.val - sgn * 2^(sz.val - n2) in
  ⟨((b1 / (2^(b2.val % sz.val))) + mask) % 2^sz.val, ♯⟩

def eq (b1 b2:bitvector sz) : bool :=
  b1 = b2
def ne (b1 b2:bitvector sz) : bool :=
  b1 ≠ b2
def sle (b1 b2:bitvector sz) : bool :=
  to_int b1 ≤ to_int b2
def slt (b1 b2:bitvector sz) : bool :=
  to_int b1 < to_int b2
def ule (b1 b2:bitvector sz) : bool :=
  b1.1 ≤ b2.1
def ult (b1 b2:bitvector sz) : bool :=
  b1.1 < b2.1

def zext (sz2:size) (b1:bitvector sz) : bitvector sz2 :=
  ⟨b1.1 % (2^sz2.val), ♯⟩
def sext (sz2:size) (b1:bitvector sz) : bitvector sz2 :=
  ⟨(of_int (sz.add sz2) (to_int b1)) % (2^sz2.val), ♯⟩
def trunc (sz2:size) (b1:bitvector sz) : bitvector sz2 :=
  ⟨b1.1 % (2^sz2.val), ♯⟩

end bitvector

instance bitvector_is_uint_like
: uint_like bitvector :=
⟨@bitvector.add, @bitvector.sub, @bitvector.mul,
  @bitvector.udiv, @bitvector.urem, @bitvector.sdiv, @bitvector.srem,
  @bitvector.bitwise_and, @bitvector.bitwise_or, @bitvector.bitwise_xor,
  @bitvector.shl, @bitvector.lshr, @bitvector.ashr,
  bitvector.zero, bitvector.all_one, bitvector.int_min,
  bitvector.of_int, @bitvector.zext, @bitvector.sext, @bitvector.trunc⟩

instance bool_bitvec_has_coe: has_coe bool (bitvector size.one) :=
⟨bitvector.of_bool⟩

@[reducible]
instance bitvector_has_comp
: has_comp bitvector bool :=
⟨@bitvector.eq, @bitvector.ne, @bitvector.sle, @bitvector.slt,
  @bitvector.ule, @bitvector.ult⟩

instance bitvector_has_overflow_check
: has_overflow_check bitvector bool :=
⟨@bitvector.add_overflows, @bitvector.sub_overflows,
 @bitvector.mul_overflows, @bitvector.shl_overflows⟩


import data.real.irrational
import topology.basic
import algebra.order.floor

--OUTPUT 1
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from
    begin
      assume (i j : ℤ) (hij : i ≠ j),
      -- $i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor$,
      have h1 : α * ↑i - int.nat_abs (α * ↑i) = int.fract (α * ↑i), from by auto [int.fract_eq_of_nat_abs_sub_lt_one],
      have h2 : α * ↑j - int.nat_abs (α * ↑j) = int.fract (α * ↑j), from by auto [int.fract_eq_of_nat_abs_sub_lt_one],
      have h3 : int.fract (α * ↑i) = int.fract (α * ↑j), from by auto [h1, h2],
      -- which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$.
      have h4 : α = (int.nat_abs (α * ↑i) - int.nat_abs (α * ↑j)) / (i - j), from by auto [h1, h2, h3],
      have h5 : (int.nat_abs (α * ↑i) - int.nat_abs (α * ↑j)) / (i - j) ∈ ℚ, from by auto [int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat_abs_of_nonneg, int.nat
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [ring]
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by auto using [use (a⁻¹ * b)],
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by auto using [use b * a⁻¹],

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
Density of irrational orbit
The fractional parts of the integer multiples of an irrational number form a dense subset of the unit interval
`proof`
Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
$$
i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
$$
which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$. Hence,
$$
S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
$$
is an infinite subset of $\left[0,1\right]$.

By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$. One can thus find pairs of elements of $S$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.

To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.

QED
-/
theorem  irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
FEW SHOT PROMPTS TO CODEX(END)-/


import group_theory.subgroup

theorem cpge_groupe_9_a_bis {G1 : Type*} [group G1] {G2 : Type*} [group G2]
(f : G1 →* G2) :  (∀ (a ∈ f.ker), ∀ (x : G1), f (x * a * x⁻¹) = 1)  := sorry


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.ring.ulift
import algebra.module.equiv

/-!
# `ulift` instances for module and multiplicative actions

This file defines instances for module, mul_action and related structures on `ulift` types.

(Recall `ulift α` is just a "copy" of a type `α` in a higher universe.)

We also provide `ulift.module_equiv : ulift M ≃ₗ[R] M`.

-/

namespace ulift
universes u v w
variable {R : Type u}
variable {M : Type v}
variable {N : Type w}

instance has_smul_left [has_smul R M] :
  has_smul (ulift R) M :=
⟨λ s x, s.down • x⟩

@[simp] lemma smul_down [has_smul R M] (s : ulift R) (x : M) : (s • x) = s.down • x := rfl

@[simp]
lemma smul_down' [has_smul R M] (s : R) (x : ulift M) :
  (s • x).down = s • x.down :=
rfl

instance is_scalar_tower [has_smul R M] [has_smul M N] [has_smul R N]
  [is_scalar_tower R M N] : is_scalar_tower (ulift R) M N :=
⟨λ x y z, show (x.down • y) • z = x.down • y • z, from smul_assoc _ _ _⟩

instance is_scalar_tower' [has_smul R M] [has_smul M N] [has_smul R N]
  [is_scalar_tower R M N] : is_scalar_tower R (ulift M) N :=
⟨λ x y z, show (x • y.down) • z = x • y.down • z, from smul_assoc _ _ _⟩

instance is_scalar_tower'' [has_smul R M] [has_smul M N] [has_smul R N]
  [is_scalar_tower R M N] : is_scalar_tower R M (ulift N) :=
⟨λ x y z, show up ((x • y) • z.down) = ⟨x • y • z.down⟩, by rw smul_assoc⟩

instance [has_smul R M] [has_smul Rᵐᵒᵖ M] [is_central_scalar R M] :
  is_central_scalar R (ulift M) :=
⟨λ r m, congr_arg up $ op_smul_eq_smul r m.down⟩

instance mul_action [monoid R] [mul_action R M] : mul_action (ulift R) M :=
{ smul := (•),
  mul_smul := λ _ _, mul_smul _ _,
  one_smul := one_smul _ }

instance mul_action' [monoid R] [mul_action R M] :
  mul_action R (ulift M) :=
{ smul := (•),
  mul_smul := λ r s f, by { cases f, ext, simp [mul_smul], },
  one_smul := λ f, by { ext, simp [one_smul], } }

instance distrib_mul_action [monoid R] [add_monoid M] [distrib_mul_action R M] :
  distrib_mul_action (ulift R) M :=
{ smul_zero := λ _, smul_zero _,
  smul_add := λ _, smul_add _ }

instance distrib_mul_action' [monoid R] [add_monoid M] [distrib_mul_action R M] :
  distrib_mul_action R (ulift M) :=
{ smul_zero := λ c, by { ext, simp [smul_zero], },
  smul_add := λ c f g, by { ext, simp [smul_add], },
  ..ulift.mul_action' }

instance mul_distrib_mul_action [monoid R] [monoid M] [mul_distrib_mul_action R M] :
  mul_distrib_mul_action (ulift R) M :=
{ smul_one := λ _, smul_one _,
  smul_mul := λ _, smul_mul' _ }

instance mul_distrib_mul_action' [monoid R] [monoid M] [mul_distrib_mul_action R M] :
  mul_distrib_mul_action R (ulift M) :=
{ smul_one := λ _, by { ext, simp [smul_one], },
  smul_mul := λ c f g, by { ext, simp [smul_mul'], },
  ..ulift.mul_action' }

instance smul_with_zero [has_zero R] [has_zero M] [smul_with_zero R M] :
  smul_with_zero (ulift R) M :=
{ smul_zero := λ _, smul_zero' _ _,
  zero_smul := zero_smul _,
  ..ulift.has_smul_left }

instance smul_with_zero' [has_zero R] [has_zero M] [smul_with_zero R M] :
  smul_with_zero R (ulift M) :=
{ smul_zero := λ _, ulift.ext _ _ $ smul_zero' _ _,
  zero_smul := λ _, ulift.ext _ _ $ zero_smul _ _ }

instance mul_action_with_zero [monoid_with_zero R] [has_zero M] [mul_action_with_zero R M] :
  mul_action_with_zero (ulift R) M :=
{ ..ulift.smul_with_zero }

instance mul_action_with_zero' [monoid_with_zero R] [has_zero M] [mul_action_with_zero R M] :
  mul_action_with_zero R (ulift M) :=
{ ..ulift.smul_with_zero' }

instance module [semiring R] [add_comm_monoid M] [module R M] : module (ulift R) M :=
{ add_smul := λ _ _, add_smul _ _,
  ..ulift.smul_with_zero }

instance module' [semiring R] [add_comm_monoid M] [module R M] : module R (ulift M) :=
{ add_smul := λ _ _ _, ulift.ext _ _ $ add_smul _ _ _,
  ..ulift.smul_with_zero' }

/--
The `R`-linear equivalence between `ulift M` and `M`.
-/
def module_equiv [semiring R] [add_comm_monoid M] [module R M] : ulift M ≃ₗ[R] M :=
{ to_fun := ulift.down,
  inv_fun := ulift.up,
  map_smul' := λ r x, rfl,
  map_add' := λ x y, rfl,
  left_inv := by tidy,
  right_inv := by tidy, }

end ulift


/-
Copyright (c) 2022 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import analysis.complex.abs_max
import analysis.complex.removable_singularity

/-!
# Schwarz lemma

In this file we prove several versions of the Schwarz lemma.

* `complex.norm_deriv_le_div_of_maps_to_ball`, `complex.abs_deriv_le_div_of_maps_to_ball`: if
  `f : ℂ → E` sends an open disk with center `c` and a positive radius `R₁` to an open ball with
  center `f c` and radius `R₂`, then the absolute value of the derivative of `f` at `c` is at most
  the ratio `R₂ / R₁`;

* `complex.dist_le_div_mul_dist_of_maps_to_ball`: if `f : ℂ → E` sends an open disk with center `c`
  and radius `R₁` to an open disk with center `f c` and radius `R₂`, then for any `z` in the former
  disk we have `dist (f z) (f c) ≤ (R₂ / R₁) * dist z c`;

* `complex.abs_deriv_le_one_of_maps_to_ball`: if `f : ℂ → ℂ` sends an open disk of positive radius
  to itself and the center of this disk to itself, then the absolute value of the derivative of `f`
  at the center of this disk is at most `1`;

* `complex.dist_le_dist_of_maps_to_ball`: if `f : ℂ → ℂ` sends an open disk to itself and the center
  `c` of this disk to itself, then for any point `z` of this disk we have `dist (f z) c ≤ dist z c`;

* `complex.abs_le_abs_of_maps_to_ball`: if `f : ℂ → ℂ` sends an open disk with center `0` to itself,
  then for any point `z` of this disk we have `abs (f z) ≤ abs z`.

## Implementation notes

We prove some versions of the Schwarz lemma for a map `f : ℂ → E` taking values in any normed space
over complex numbers.

## TODO

* Prove that these inequalities are strict unless `f` is an affine map.

* Prove that any diffeomorphism of the unit disk to itself is a Möbius map.

## Tags

Schwarz lemma
-/

open metric set function filter topological_space
open_locale topology

namespace complex

section space

variables {E : Type*} [normed_add_comm_group E] [normed_space ℂ E] {R R₁ R₂ : ℝ} {f : ℂ → E}
  {c z z₀ : ℂ}

/-- An auxiliary lemma for `complex.norm_dslope_le_div_of_maps_to_ball`. -/
lemma schwarz_aux {f : ℂ → ℂ} (hd : differentiable_on ℂ f (ball c R₁))
  (h_maps : maps_to f (ball c R₁) (ball (f c) R₂)) (hz : z ∈ ball c R₁) :
  ‖dslope f c z‖ ≤ R₂ / R₁ :=
begin
  have hR₁ : 0 < R₁, from nonempty_ball.1 ⟨z, hz⟩,
  suffices : ∀ᶠ r in 𝓝[<] R₁, ‖dslope f c z‖ ≤ R₂ / r,
  { refine ge_of_tendsto _ this,
    exact (tendsto_const_nhds.div tendsto_id hR₁.ne').mono_left nhds_within_le_nhds },
  rw mem_ball at hz,
  filter_upwards [Ioo_mem_nhds_within_Iio ⟨hz, le_rfl⟩] with r hr,
  have hr₀ : 0 < r, from dist_nonneg.trans_lt hr.1,
  replace hd : diff_cont_on_cl ℂ (dslope f c) (ball c r),
  { refine differentiable_on.diff_cont_on_cl _,
    rw closure_ball c hr₀.ne',
    exact ((differentiable_on_dslope $ ball_mem_nhds _ hR₁).mpr hd).mono
      (closed_ball_subset_ball hr.2) },
  refine norm_le_of_forall_mem_frontier_norm_le bounded_ball hd _ _,
  { rw frontier_ball c hr₀.ne',
    intros z hz,
    have hz' : z ≠ c, from ne_of_mem_sphere hz hr₀.ne',
    rw [dslope_of_ne _ hz', slope_def_module, norm_smul, norm_inv, mem_sphere_iff_norm.1 hz,
      ← div_eq_inv_mul, div_le_div_right hr₀, ← dist_eq_norm],
    exact le_of_lt (h_maps (mem_ball.2 (by { rw mem_sphere.1 hz, exact hr.2 }))) },
  { rw [closure_ball c hr₀.ne', mem_closed_ball],
    exact hr.1.le }
end

/-- Two cases of the **Schwarz Lemma** (derivative and distance), merged together. -/
lemma norm_dslope_le_div_of_maps_to_ball (hd : differentiable_on ℂ f (ball c R₁))
  (h_maps : maps_to f (ball c R₁) (ball (f c) R₂)) (hz : z ∈ ball c R₁) :
  ‖dslope f c z‖ ≤ R₂ / R₁ :=
begin
  have hR₁ : 0 < R₁, from nonempty_ball.1 ⟨z, hz⟩,
  have hR₂ : 0 < R₂, from nonempty_ball.1 ⟨f z, h_maps hz⟩,
  cases eq_or_ne (dslope f c z) 0 with hc hc,
  { rw [hc, norm_zero], exact div_nonneg hR₂.le hR₁.le },
  rcases exists_dual_vector ℂ _ hc with ⟨g, hg, hgf⟩,
  have hg' : ‖g‖₊ = 1, from nnreal.eq hg,
  have hg₀ : ‖g‖₊ ≠ 0, by simpa only [hg'] using one_ne_zero,
  calc ‖dslope f c z‖ = ‖dslope (g ∘ f) c z‖ :
    begin
      rw [g.dslope_comp, hgf, is_R_or_C.norm_of_real, norm_norm],
      exact λ _, hd.differentiable_at (ball_mem_nhds _ hR₁)
    end
  ... ≤ R₂ / R₁ :
    begin
      refine schwarz_aux (g.differentiable.comp_differentiable_on hd)
        (maps_to.comp _ h_maps) hz,
      simpa only [hg', nnreal.coe_one, one_mul] using g.lipschitz.maps_to_ball hg₀ (f c) R₂
    end
end

/-- Equality case in the **Schwarz Lemma**: in the setup of `norm_dslope_le_div_of_maps_to_ball`, if
`‖dslope f c z₀‖ = R₂ / R₁` holds at a point in the ball then the map `f` is affine. -/
lemma affine_of_maps_to_ball_of_exists_norm_dslope_eq_div [complete_space E]
  [strict_convex_space ℝ E] (hd : differentiable_on ℂ f (ball c R₁))
  (h_maps : set.maps_to f (ball c R₁) (ball (f c) R₂)) (h_z₀ : z₀ ∈ ball c R₁)
  (h_eq : ‖dslope f c z₀‖ = R₂ / R₁) :
  set.eq_on f (λ z, f c + (z - c) • dslope f c z₀) (ball c R₁) :=
begin
  set g := dslope f c,
  rintro z hz,
  by_cases z = c, { simp [h] },
  have h_R₁ : 0 < R₁ := nonempty_ball.mp ⟨_, h_z₀⟩,
  have g_le_div : ∀ z ∈ ball c R₁, ‖g z‖ ≤ R₂ / R₁,
    from λ z hz, norm_dslope_le_div_of_maps_to_ball hd h_maps hz,
  have g_max : is_max_on (norm ∘ g) (ball c R₁) z₀,
    from is_max_on_iff.mpr (λ z hz, by simpa [h_eq] using g_le_div z hz),
  have g_diff : differentiable_on ℂ g (ball c R₁),
    from (differentiable_on_dslope (is_open_ball.mem_nhds (mem_ball_self h_R₁))).mpr hd,
  have : g z = g z₀ := eq_on_of_is_preconnected_of_is_max_on_norm (convex_ball c R₁).is_preconnected
    is_open_ball g_diff h_z₀ g_max hz,
  simp [← this]
end

lemma affine_of_maps_to_ball_of_exists_norm_dslope_eq_div' [complete_space E]
  [strict_convex_space ℝ E] (hd : differentiable_on ℂ f (ball c R₁))
  (h_maps : set.maps_to f (ball c R₁) (ball (f c) R₂))
  (h_z₀ : ∃ z₀ ∈ ball c R₁, ‖dslope f c z₀‖ = R₂ / R₁) :
  ∃ C : E, ‖C‖ = R₂ / R₁ ∧ set.eq_on f (λ z, f c + (z - c) • C) (ball c R₁) :=
let ⟨z₀, h_z₀, h_eq⟩ := h_z₀ in
  ⟨dslope f c z₀, h_eq, affine_of_maps_to_ball_of_exists_norm_dslope_eq_div hd h_maps h_z₀ h_eq⟩

/-- The **Schwarz Lemma**: if `f : ℂ → E` sends an open disk with center `c` and a positive radius
`R₁` to an open ball with center `f c` and radius `R₂`, then the absolute value of the derivative of
`f` at `c` is at most the ratio `R₂ / R₁`. -/
lemma norm_deriv_le_div_of_maps_to_ball (hd : differentiable_on ℂ f (ball c R₁))
  (h_maps : maps_to f (ball c R₁) (ball (f c) R₂)) (h₀ : 0 < R₁) :
  ‖deriv f c‖ ≤ R₂ / R₁ :=
by simpa only [dslope_same] using norm_dslope_le_div_of_maps_to_ball hd h_maps (mem_ball_self h₀)

/-- The **Schwarz Lemma**: if `f : ℂ → E` sends an open disk with center `c` and radius `R₁` to an
open ball with center `f c` and radius `R₂`, then for any `z` in the former disk we have
`dist (f z) (f c) ≤ (R₂ / R₁) * dist z c`. -/
lemma dist_le_div_mul_dist_of_maps_to_ball (hd : differentiable_on ℂ f (ball c R₁))
  (h_maps : maps_to f (ball c R₁) (ball (f c) R₂)) (hz : z ∈ ball c R₁) :
  dist (f z) (f c) ≤ (R₂ / R₁) * dist z c :=
begin
  rcases eq_or_ne z c with rfl|hne, { simp only [dist_self, mul_zero] },
  simpa only [dslope_of_ne _ hne, slope_def_module, norm_smul, norm_inv,
    ← div_eq_inv_mul, ← dist_eq_norm, div_le_iff (dist_pos.2 hne)]
    using norm_dslope_le_div_of_maps_to_ball hd h_maps hz
end

end space

variables {f : ℂ → ℂ} {c z : ℂ} {R R₁ R₂ : ℝ}

/-- The **Schwarz Lemma**: if `f : ℂ → ℂ` sends an open disk with center `c` and a positive radius
`R₁` to an open disk with center `f c` and radius `R₂`, then the absolute value of the derivative of
`f` at `c` is at most the ratio `R₂ / R₁`. -/
lemma abs_deriv_le_div_of_maps_to_ball (hd : differentiable_on ℂ f (ball c R₁))
  (h_maps : maps_to f (ball c R₁) (ball (f c) R₂)) (h₀ : 0 < R₁) :
  abs (deriv f c) ≤ R₂ / R₁ :=
norm_deriv_le_div_of_maps_to_ball hd h_maps h₀

/-- The **Schwarz Lemma**: if `f : ℂ → ℂ` sends an open disk of positive radius to itself and the
center of this disk to itself, then the absolute value of the derivative of `f` at the center of
this disk is at most `1`. -/
lemma abs_deriv_le_one_of_maps_to_ball (hd : differentiable_on ℂ f (ball c R))
  (h_maps : maps_to f (ball c R) (ball c R)) (hc : f c = c) (h₀ : 0 < R) :
  abs (deriv f c) ≤ 1 :=
(norm_deriv_le_div_of_maps_to_ball hd (by rwa hc) h₀).trans_eq (div_self h₀.ne')

/-- The **Schwarz Lemma**: if `f : ℂ → ℂ` sends an open disk to itself and the center `c` of this
disk to itself, then for any point `z` of this disk we have `dist (f z) c ≤ dist z c`. -/
lemma dist_le_dist_of_maps_to_ball_self (hd : differentiable_on ℂ f (ball c R))
  (h_maps : maps_to f (ball c R) (ball c R)) (hc : f c = c) (hz : z ∈ ball c R) :
  dist (f z) c ≤ dist z c :=
have hR : 0 < R, from nonempty_ball.1 ⟨z, hz⟩,
by simpa only [hc, div_self hR.ne', one_mul]
  using dist_le_div_mul_dist_of_maps_to_ball hd (by rwa hc) hz

/-- The **Schwarz Lemma**: if `f : ℂ → ℂ` sends an open disk with center `0` to itself, the for any
point `z` of this disk we have `abs (f z) ≤ abs z`. -/
lemma abs_le_abs_of_maps_to_ball_self (hd : differentiable_on ℂ f (ball 0 R))
  (h_maps : maps_to f (ball 0 R) (ball 0 R)) (h₀ : f 0 = 0) (hz : abs z < R) :
  abs (f z) ≤ abs z :=
begin
  replace hz : z ∈ ball (0 : ℂ) R, from mem_ball_zero_iff.2 hz,
  simpa only [dist_zero_right] using dist_le_dist_of_maps_to_ball_self hd h_maps h₀ hz
end

end complex