import PnP2023.Lec_01_04.Intro
import PnP2023.Lec_01_04.OddExample
import PnP2023.Lec_01_06.NatEq
import PnP2023.Lec_01_11.NatLe
import PnP2023.Lec_01_13.NatRec
import PnP2023.Lec_01_18.NatSub
import PnP2023.Lec_01_20.NatMin
import PnP2023.Lec_01_20.NatMinus
import PnP2023.Lec_01_25.Answer
import PnP2023.Lec_02_01.Foundations
import PnP2023.Lec_02_03.InductiveTypes
import PnP2023.Lec_02_15.PropsAsTypes
import PnP2023.Lec_03_01.RandomIO
import PnP2023.Lec_03_08.Diaphontine
import PnP2023.Lec_03_10.FormalCalculus
import PnP2023.Lec_03_24.Sampling
/-!
# Proofs and Programs 2023

This course will introduce [Lean Theorem Prover 4](https://leanprover.github.io/), which is an _interactive theorem prover_ as well as a programming language and use it for various aspects of _proofs and programs_:

* Using programs (_interactive theorem provers_) to
    * verify proofs of results
    * help in generating proofs
* Proving correctness of programs
* Writing programs to find and/or verify proofs
* _Functional Programming_ in Lean

To study these things in a meaningful way, we will look at _foundations_ of _mathematics_ and of _computation_. We will introduce different foundational systems:

* _Dependent Type Theory_ (DTT): foundations used by Lean that include both proofs and computations in a unified way.
* Classical foundations:
  - _First-order logic:_ the usual foundations of mathematics.
  - _lambda-calculus:_ one of the equivalent formulations of the usual foundations of computation.

## Navigation

To browse the code, expand the `PnP2023` tab on the left.

-/

def hello := "to the course Proofs and Programs"


/-
Copyright (c) 2014 Parikshit Khanna. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro
-/

namespace List

open Nat

/-!
# Bootstrapping theorems for lists

These are theorems used in the definitions of `Std.Data.List.Basic`.
New theorems should be added to `Std.Data.List.Lemmas` if they are not needed by the bootstrap.
-/

attribute [simp] get get! get? reverseAux eraseIdx map join dropWhile find? findSome?
  replace elem lookup drop take takeWhile foldl foldr zipWith unzip range.loop enumFrom
  intersperse isPrefixOf isEqv dropLast iota mapM.loop mapA List.forM forA filterAuxM
  filterMapM.loop List.foldlM firstM anyM allM findM? findSomeM? forIn.loop forIn'.loop
  concat_eq_append append_assoc

@[simp] theorem head?_nil : @head? α [] = none := rfl
@[simp] theorem head?_cons : @head? α (a::l) = some a := rfl
@[simp 1100] theorem headD_nil : @headD α [] d = d := rfl
@[simp 1100] theorem headD_cons : @headD α (a::l) d = a := rfl
@[simp] theorem head_cons : @head α (a::l) h = a := rfl
@[simp] theorem tail!_cons : @tail! α (a::l) = l := rfl
@[simp 1100] theorem tailD_nil : @tailD α [] l' = l' := rfl
@[simp 1100] theorem tailD_cons : @tailD α (a::l) l' = l := rfl
@[simp] theorem any_nil : [].any f = false := rfl
@[simp] theorem any_cons : (a::l).any f = (f a || l.any f) := rfl
@[simp] theorem all_nil : [].all f = true := rfl
@[simp] theorem all_cons : (a::l).all f = (f a && l.all f) := rfl
@[simp] theorem or_nil : [].or = false := rfl
@[simp] theorem or_cons : (a::l).or = (a || l.or) := rfl
@[simp] theorem and_nil : [].and = true := rfl
@[simp] theorem and_cons : (a::l).and = (a && l.and) := rfl

/-! ### length -/

theorem eq_nil_of_length_eq_zero (_ : length l = 0) : l = [] := match l with | [] => rfl

theorem ne_nil_of_length_eq_succ (_ : length l = succ n) : l ≠ [] := fun _ => nomatch l

theorem length_eq_zero : length l = 0 ↔ l = [] :=
  ⟨eq_nil_of_length_eq_zero, fun h => h ▸ rfl⟩

/-! ### append -/

@[simp 1100] theorem singleton_append : [x] ++ l = x :: l := rfl

theorem append_inj :
    ∀ {s₁ s₂ t₁ t₂ : List α}, s₁ ++ t₁ = s₂ ++ t₂ → length s₁ = length s₂ → s₁ = s₂ ∧ t₁ = t₂
  | [], [], t₁, t₂, h, _ => ⟨rfl, h⟩
  | a :: s₁, b :: s₂, t₁, t₂, h, hl => by
    simp [append_inj (cons.inj h).2 (Nat.succ.inj hl)] at h ⊢; exact h

theorem append_inj_right (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length s₁ = length s₂) : t₁ = t₂ :=
  (append_inj h hl).right

theorem append_inj_left (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length s₁ = length s₂) : s₁ = s₂ :=
  (append_inj h hl).left

theorem append_inj' (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length t₁ = length t₂) : s₁ = s₂ ∧ t₁ = t₂ :=
  append_inj h <| @Nat.add_right_cancel _ (length t₁) _ <| by
  let hap := congrArg length h; simp only [length_append, ← hl] at hap; exact hap

theorem append_inj_right' (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length t₁ = length t₂) : t₁ = t₂ :=
  (append_inj' h hl).right

theorem append_inj_left' (h : s₁ ++ t₁ = s₂ ++ t₂) (hl : length t₁ = length t₂) : s₁ = s₂ :=
  (append_inj' h hl).left

theorem append_right_inj {t₁ t₂ : List α} (s) : s ++ t₁ = s ++ t₂ ↔ t₁ = t₂ :=
  ⟨fun h => append_inj_right h rfl, congrArg _⟩

theorem append_left_inj {s₁ s₂ : List α} (t) : s₁ ++ t = s₂ ++ t ↔ s₁ = s₂ :=
  ⟨fun h => append_inj_left' h rfl, congrArg (· ++ _)⟩

/-! ### map -/

theorem map_nil {f : α → β} : map f [] = [] := rfl

theorem map_cons (f : α → β) a l : map f (a :: l) = f a :: map f l := rfl

@[simp] theorem map_append (f : α → β) : ∀ l₁ l₂, map f (l₁ ++ l₂) = map f l₁ ++ map f l₂ := by
  intro l₁ <;> induction l₁ <;> intros <;> simp_all

@[simp] theorem map_id (l : List α) : map id l = l := by induction l <;> simp_all

@[simp] theorem map_map (g : β → γ) (f : α → β) (l : List α) :
  map g (map f l) = map (g ∘ f) l := by induction l <;> simp_all

/-! ### bind -/

@[simp] theorem nil_bind (f : α → List β) : List.bind [] f = [] := by simp [join, List.bind]

@[simp] theorem cons_bind x xs (f : α → List β) :
  List.bind (x :: xs) f = f x ++ List.bind xs f := by simp [join, List.bind]

@[simp] theorem append_bind xs ys (f : α → List β) :
  List.bind (xs ++ ys) f = List.bind xs f ++ List.bind ys f := by
  induction xs; {rfl}; simp_all [cons_bind, append_assoc]

/-! ### bind -/

@[simp] theorem bind_id (l : List (List α)) : List.bind l id = l.join := by simp [List.bind]

/-! ### reverse -/

theorem reverseAux_eq (as bs : List α) : reverseAux as bs = reverse as ++ bs :=
  reverseAux_eq_append ..

theorem reverse_map (f : α → β) (l : List α) : (l.map f).reverse = l.reverse.map f := by
  induction l <;> simp [*]

/-! ### take and drop -/

@[simp] theorem take_append_drop : ∀ (n : Nat) (l : List α), take n l ++ drop n l = l
  | 0, _ => rfl
  | _+1, [] => rfl
  | n+1, x :: xs => congrArg (cons x) <| take_append_drop n xs

@[simp] theorem length_drop : ∀ (i : Nat) (l : List α), length (drop i l) = length l - i
  | 0, _ => rfl
  | succ i, [] => Eq.symm (Nat.zero_sub (succ i))
  | succ i, x :: l => calc
    length (drop (succ i) (x :: l)) = length l - i := length_drop i l
    _ = succ (length l) - succ i := (Nat.succ_sub_succ_eq_sub (length l) i).symm

theorem drop_length_le {l : List α} (h : l.length ≤ i) : drop i l = [] :=
  length_eq_zero.1 (length_drop .. ▸ Nat.sub_eq_zero_of_le h)

theorem take_length_le {l : List α} (h : l.length ≤ i) : take i l = l := by
  have := take_append_drop i l
  rw [drop_length_le h, append_nil] at this; exact this

@[simp] theorem drop_length (l : List α) : drop l.length l = [] := drop_length_le (Nat.le_refl _)

@[simp] theorem take_length (l : List α) : take l.length l = l := take_length_le (Nat.le_refl _)

theorem take_concat_get (l : List α) (i : Nat) (h : i < l.length) :
    (l.take i).concat l[i] = l.take (i+1) :=
  Eq.symm <| (append_left_inj _).1 <| (take_append_drop (i+1) l).trans <| by
    rw [concat_eq_append, append_assoc, singleton_append, get_drop_eq_drop, take_append_drop]

theorem reverse_concat (l : List α) (a : α) : (l.concat a).reverse = a :: l.reverse := by
  rw [concat_eq_append, reverse_append]; rfl

@[simp] theorem foldlM_reverse [Monad m] (l : List α) (f : β → α → m β) (b) :
    l.reverse.foldlM f b = l.foldrM (fun x y => f y x) b := rfl

@[simp] theorem foldlM_append [Monad m] [LawfulMonad m] (f : β → α → m β) (b) (l l' : List α) :
    (l ++ l').foldlM f b = l.foldlM f b >>= l'.foldlM f := by
  induction l generalizing b <;> simp [*]

@[simp] theorem foldrM_nil [Monad m] (f : α → β → m β) (b) : [].foldrM f b = pure b := rfl

@[simp] theorem foldrM_cons [Monad m] [LawfulMonad m] (a : α) (l) (f : α → β → m β) (b) :
    (a :: l).foldrM f b = l.foldrM f b >>= f a := by
  simp only [foldrM]
  induction l <;> simp_all

@[simp] theorem foldrM_reverse [Monad m] (l : List α) (f : α → β → m β) (b) :
    l.reverse.foldrM f b = l.foldlM (fun x y => f y x) b :=
  (foldlM_reverse ..).symm.trans <| by simp

theorem foldl_eq_foldlM (f : β → α → β) (b) (l : List α) :
    l.foldl f b = l.foldlM (m := Id) f b := by
  induction l generalizing b <;> simp [*, foldl]

theorem foldr_eq_foldrM (f : α → β → β) (b) (l : List α) :
    l.foldr f b = l.foldrM (m := Id) f b := by
  induction l <;> simp [*]

@[simp] theorem foldl_reverse (l : List α) (f : β → α → β) (b) :
    l.reverse.foldl f b = l.foldr (fun x y => f y x) b := by simp [foldl_eq_foldlM, foldr_eq_foldrM]

@[simp] theorem foldr_reverse (l : List α) (f : α → β → β) (b) :
    l.reverse.foldr f b = l.foldl (fun x y => f y x) b :=
  (foldl_reverse ..).symm.trans <| by simp

@[simp] theorem foldrM_append [Monad m] [LawfulMonad m] (f : α → β → m β) (b) (l l' : List α) :
    (l ++ l').foldrM f b = l'.foldrM f b >>= l.foldrM f := by
  induction l <;> simp [*]

@[simp] theorem foldl_append {β : Type _} (f : β → α → β) (b) (l l' : List α) :
    (l ++ l').foldl f b = l'.foldl f (l.foldl f b) := by simp [foldl_eq_foldlM]

@[simp] theorem foldr_append (f : α → β → β) (b) (l l' : List α) :
    (l ++ l').foldr f b = l.foldr f (l'.foldr f b) := by simp [foldr_eq_foldrM]

@[simp] theorem foldr_self_append (l : List α) : l.foldr cons l' = l ++ l' := by
  induction l <;> simp [*]

/-- Alternate (non-tail-recursive) form of mapM for proofs. -/
@[simp] def mapM' [Monad m] (f : α → m β) : List α → m (List β)
  | [] => pure []
  | a :: l => return (← f a) :: (← l.mapM' f)

theorem mapM'_eq_mapM [Monad m] [LawfulMonad m] (f : α → m β) (l : List α) :
    mapM' f l = mapM f l := by simp [go, mapM] where
  go : ∀ l acc, mapM.loop f l acc = return acc.reverse ++ (← mapM' f l)
    | [], acc => by simp
    | a::l, acc => by simp [go l]

@[simp] theorem mapM_nil [Monad m] (f : α → m β) : [].mapM f = pure [] := rfl

@[simp] theorem mapM_cons [Monad m] [LawfulMonad m] (f : α → m β) :
    (a :: l).mapM f = (return (← f a) :: (← l.mapM f)) := by simp [← mapM'_eq_mapM]

@[simp] theorem mapM_append [Monad m] [LawfulMonad m] (f : α → m β) {l₁ l₂ : List α} :
    (l₁ ++ l₂).mapM f = (return (← l₁.mapM f) ++ (← l₂.mapM f)) := by induction l₁ <;> simp [*]


/-
Copyright (c) 2014 Parikshit Khanna. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.data.list.basic
import Mathlib.Lean3Lib.init.function
import Mathlib.Lean3Lib.init.meta.default
import Mathlib.Lean3Lib.init.data.nat.lemmas
import Mathlib.Lean3Lib.init.meta.interactive
import Mathlib.Lean3Lib.init.meta.smt.rsimp

universes u v w w₂ w₁

namespace Mathlib

namespace list

/- append -/

@[simp] theorem nil_append {α : Type u} (s : List α) : [] ++ s = s := rfl

@[simp] theorem cons_append {α : Type u} (x : α) (s : List α) (t : List α) :
    x :: s ++ t = x :: (s ++ t) :=
  rfl

@[simp] theorem append_nil {α : Type u} (t : List α) : t ++ [] = t := sorry

@[simp] theorem append_assoc {α : Type u} (s : List α) (t : List α) (u : List α) :
    s ++ t ++ u = s ++ (t ++ u) :=
  sorry

/- length -/

theorem length_cons {α : Type u} (a : α) (l : List α) : length (a :: l) = length l + 1 := rfl

@[simp] theorem length_append {α : Type u} (s : List α) (t : List α) :
    length (s ++ t) = length s + length t :=
  sorry

@[simp] theorem length_repeat {α : Type u} (a : α) (n : ℕ) : length (repeat a n) = n := sorry

@[simp] theorem length_tail {α : Type u} (l : List α) : length (tail l) = length l - 1 :=
  list.cases_on l (Eq.refl (length (tail [])))
    fun (l_hd : α) (l_tl : List α) => Eq.refl (length (tail (l_hd :: l_tl)))

-- TODO(Leo): cleanup proof after arith dec proc

@[simp] theorem length_drop {α : Type u} (i : ℕ) (l : List α) : length (drop i l) = length l - i :=
  sorry

/- map -/

theorem map_cons {α : Type u} {β : Type v} (f : α → β) (a : α) (l : List α) :
    map f (a :: l) = f a :: map f l :=
  rfl

@[simp] theorem map_append {α : Type u} {β : Type v} (f : α → β) (l₁ : List α) (l₂ : List α) :
    map f (l₁ ++ l₂) = map f l₁ ++ map f l₂ :=
  sorry

theorem map_singleton {α : Type u} {β : Type v} (f : α → β) (a : α) : map f [a] = [f a] := rfl

@[simp] theorem map_id {α : Type u} (l : List α) : map id l = l := sorry

@[simp] theorem map_map {α : Type u} {β : Type v} {γ : Type w} (g : β → γ) (f : α → β)
    (l : List α) : map g (map f l) = map (g ∘ f) l :=
  sorry

@[simp] theorem length_map {α : Type u} {β : Type v} (f : α → β) (l : List α) :
    length (map f l) = length l :=
  sorry

/- bind -/

@[simp] theorem nil_bind {α : Type u} {β : Type v} (f : α → List β) : list.bind [] f = [] := sorry

@[simp] theorem cons_bind {α : Type u} {β : Type v} (x : α) (xs : List α) (f : α → List β) :
    list.bind (x :: xs) f = f x ++ list.bind xs f :=
  sorry

@[simp] theorem append_bind {α : Type u} {β : Type v} (xs : List α) (ys : List α) (f : α → List β) :
    list.bind (xs ++ ys) f = list.bind xs f ++ list.bind ys f :=
  sorry

/- mem -/

@[simp] theorem mem_nil_iff {α : Type u} (a : α) : a ∈ [] ↔ False := iff.rfl

@[simp] theorem not_mem_nil {α : Type u} (a : α) : ¬a ∈ [] := iff.mp (mem_nil_iff a)

@[simp] theorem mem_cons_self {α : Type u} (a : α) (l : List α) : a ∈ a :: l := Or.inl rfl

@[simp] theorem mem_cons_iff {α : Type u} (a : α) (y : α) (l : List α) :
    a ∈ y :: l ↔ a = y ∨ a ∈ l :=
  iff.rfl

theorem mem_cons_eq {α : Type u} (a : α) (y : α) (l : List α) : a ∈ y :: l = (a = y ∨ a ∈ l) := rfl

theorem mem_cons_of_mem {α : Type u} (y : α) {a : α} {l : List α} : a ∈ l → a ∈ y :: l :=
  fun (H : a ∈ l) => Or.inr H

theorem eq_or_mem_of_mem_cons {α : Type u} {a : α} {y : α} {l : List α} :
    a ∈ y :: l → a = y ∨ a ∈ l :=
  fun (h : a ∈ y :: l) => h

@[simp] theorem mem_append {α : Type u} {a : α} {s : List α} {t : List α} :
    a ∈ s ++ t ↔ a ∈ s ∨ a ∈ t :=
  sorry

theorem mem_append_eq {α : Type u} (a : α) (s : List α) (t : List α) :
    a ∈ s ++ t = (a ∈ s ∨ a ∈ t) :=
  propext mem_append

theorem mem_append_left {α : Type u} {a : α} {l₁ : List α} (l₂ : List α) (h : a ∈ l₁) :
    a ∈ l₁ ++ l₂ :=
  iff.mpr mem_append (Or.inl h)

theorem mem_append_right {α : Type u} {a : α} (l₁ : List α) {l₂ : List α} (h : a ∈ l₂) :
    a ∈ l₁ ++ l₂ :=
  iff.mpr mem_append (Or.inr h)

@[simp] theorem not_bex_nil {α : Type u} (p : α → Prop) : ¬∃ (x : α), ∃ (H : x ∈ []), p x := sorry

@[simp] theorem ball_nil {α : Type u} (p : α → Prop) (x : α) (H : x ∈ []) : p x := false.elim

@[simp] theorem bex_cons {α : Type u} (p : α → Prop) (a : α) (l : List α) :
    (∃ (x : α), ∃ (H : x ∈ a :: l), p x) ↔ p a ∨ ∃ (x : α), ∃ (H : x ∈ l), p x :=
  sorry

@[simp] theorem ball_cons {α : Type u} (p : α → Prop) (a : α) (l : List α) :
    (∀ (x : α), x ∈ a :: l → p x) ↔ p a ∧ ∀ (x : α), x ∈ l → p x :=
  sorry

/- list subset -/

protected def subset {α : Type u} (l₁ : List α) (l₂ : List α) := ∀ {a : α}, a ∈ l₁ → a ∈ l₂

protected instance has_subset {α : Type u} : has_subset (List α) := has_subset.mk list.subset

@[simp] theorem nil_subset {α : Type u} (l : List α) : [] ⊆ l :=
  fun (b : α) (i : b ∈ []) => false.elim (iff.mp (mem_nil_iff b) i)

@[simp] theorem subset.refl {α : Type u} (l : List α) : l ⊆ l := fun (b : α) (i : b ∈ l) => i

theorem subset.trans {α : Type u} {l₁ : List α} {l₂ : List α} {l₃ : List α} (h₁ : l₁ ⊆ l₂)
    (h₂ : l₂ ⊆ l₃) : l₁ ⊆ l₃ :=
  fun (b : α) (i : b ∈ l₁) => h₂ (h₁ i)

@[simp] theorem subset_cons {α : Type u} (a : α) (l : List α) : l ⊆ a :: l :=
  fun (b : α) (i : b ∈ l) => Or.inr i

theorem subset_of_cons_subset {α : Type u} {a : α} {l₁ : List α} {l₂ : List α} :
    a :: l₁ ⊆ l₂ → l₁ ⊆ l₂ :=
  fun (s : a :: l₁ ⊆ l₂) (b : α) (i : b ∈ l₁) => s (mem_cons_of_mem a i)

theorem cons_subset_cons {α : Type u} {l₁ : List α} {l₂ : List α} (a : α) (s : l₁ ⊆ l₂) :
    a :: l₁ ⊆ a :: l₂ :=
  fun (b : α) (hin : b ∈ a :: l₁) =>
    or.elim (eq_or_mem_of_mem_cons hin) (fun (e : b = a) => Or.inl e)
      fun (i : b ∈ l₁) => Or.inr (s i)

@[simp] theorem subset_append_left {α : Type u} (l₁ : List α) (l₂ : List α) : l₁ ⊆ l₁ ++ l₂ :=
  fun (b : α) => mem_append_left l₂

@[simp] theorem subset_append_right {α : Type u} (l₁ : List α) (l₂ : List α) : l₂ ⊆ l₁ ++ l₂ :=
  fun (b : α) => mem_append_right l₁

theorem subset_cons_of_subset {α : Type u} (a : α) {l₁ : List α} {l₂ : List α} :
    l₁ ⊆ l₂ → l₁ ⊆ a :: l₂ :=
  fun (s : l₁ ⊆ l₂) (a_1 : α) (i : a_1 ∈ l₁) => Or.inr (s i)

theorem eq_nil_of_length_eq_zero {α : Type u} {l : List α} : length l = 0 → l = [] := sorry

theorem ne_nil_of_length_eq_succ {α : Type u} {l : List α} {n : ℕ} :
    length l = Nat.succ n → l ≠ [] :=
  sorry

@[simp] theorem length_map₂ {α : Type u} {β : Type v} {γ : Type w} (f : α → β → γ) (l₁ : List α)
    (l₂ : List β) : length (map₂ f l₁ l₂) = min (length l₁) (length l₂) :=
  sorry

@[simp] theorem length_take {α : Type u} (i : ℕ) (l : List α) :
    length (take i l) = min i (length l) :=
  sorry

theorem length_take_le {α : Type u} (n : ℕ) (l : List α) : length (take n l) ≤ n := sorry

theorem length_remove_nth {α : Type u} (l : List α) (i : ℕ) :
    i < length l → length (remove_nth l i) = length l - 1 :=
  sorry

@[simp] theorem partition_eq_filter_filter {α : Type u} (p : α → Prop) [decidable_pred p]
    (l : List α) : partition p l = (filter p l, filter (Not ∘ p) l) :=
  sorry

/- sublists -/

inductive sublist {α : Type u} : List α → List α → Prop where
| slnil : sublist [] []
| cons : ∀ (l₁ l₂ : List α) (a : α), sublist l₁ l₂ → sublist l₁ (a :: l₂)
| cons2 : ∀ (l₁ l₂ : List α) (a : α), sublist l₁ l₂ → sublist (a :: l₁) (a :: l₂)

infixl:50 " <+ " => Mathlib.list.sublist

theorem length_le_of_sublist {α : Type u} {l₁ : List α} {l₂ : List α} :
    l₁ <+ l₂ → length l₁ ≤ length l₂ :=
  sorry

/- filter -/

@[simp] theorem filter_nil {α : Type u} (p : α → Prop) [h : decidable_pred p] : filter p [] = [] :=
  rfl

@[simp] theorem filter_cons_of_pos {α : Type u} {p : α → Prop} [h : decidable_pred p] {a : α}
    (l : List α) : p a → filter p (a :: l) = a :: filter p l :=
  fun (pa : p a) => if_pos pa

@[simp] theorem filter_cons_of_neg {α : Type u} {p : α → Prop} [h : decidable_pred p] {a : α}
    (l : List α) : ¬p a → filter p (a :: l) = filter p l :=
  fun (pa : ¬p a) => if_neg pa

@[simp] theorem filter_append {α : Type u} {p : α → Prop} [h : decidable_pred p] (l₁ : List α)
    (l₂ : List α) : filter p (l₁ ++ l₂) = filter p l₁ ++ filter p l₂ :=
  sorry

@[simp] theorem filter_sublist {α : Type u} {p : α → Prop} [h : decidable_pred p] (l : List α) :
    filter p l <+ l :=
  sorry

/- map_accumr -/

-- This runs a function over a list returning the intermediate results and a

-- a final result.

def map_accumr {α : Type u} {β : Type v} {σ : Type w₂} (f : α → σ → σ × β) :
    List α → σ → σ × List β :=
  sorry

@[simp] theorem length_map_accumr {α : Type u} {β : Type v} {σ : Type w₂} (f : α → σ → σ × β)
    (x : List α) (s : σ) : length (prod.snd (map_accumr f x s)) = length x :=
  sorry

-- This runs a function over two lists returning the intermediate results and a

-- a final result.

def map_accumr₂ {α : Type u} {β : Type v} {φ : Type w₁} {σ : Type w₂} (f : α → β → σ → σ × φ) :
    List α → List β → σ → σ × List φ :=
  sorry

@[simp] theorem length_map_accumr₂ {α : Type u} {β : Type v} {φ : Type w₁} {σ : Type w₂}
    (f : α → β → σ → σ × φ) (x : List α) (y : List β) (c : σ) :
    length (prod.snd (map_accumr₂ f x y c)) = min (length x) (length y) :=
  sorry

end Mathlib


/-
Copyright (c) 2019 Johan Commelin All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.filter.lift
import Mathlib.topology.opens
import Mathlib.topology.algebra.ring
import Mathlib.PostPort

universes u_1 l u_2

namespace Mathlib

/-- The type of open subgroups of a topological additive group. -/
structure open_add_subgroup (G : Type u_1) [add_group G] [topological_space G]
extends add_subgroup G
where
  is_open' : is_open carrier

/-- The type of open subgroups of a topological group. -/
structure open_subgroup (G : Type u_1) [group G] [topological_space G]
extends subgroup G
where
  is_open' : is_open carrier

/-- Reinterpret an `open_subgroup` as a `subgroup`. -/
/-- Reinterpret an `open_add_subgroup` as an `add_subgroup`. -/
-- Tell Lean that `open_add_subgroup` is a namespace

namespace open_add_subgroup

end open_add_subgroup

namespace open_subgroup

protected instance has_coe_set {G : Type u_1} [group G] [topological_space G] : has_coe_t (open_subgroup G) (set G) :=
  has_coe_t.mk fun (U : open_subgroup G) => carrier U

protected instance has_mem {G : Type u_1} [group G] [topological_space G] : has_mem G (open_subgroup G) :=
  has_mem.mk fun (g : G) (U : open_subgroup G) => g ∈ ↑U

protected instance has_coe_subgroup {G : Type u_1} [group G] [topological_space G] : has_coe_t (open_subgroup G) (subgroup G) :=
  has_coe_t.mk to_subgroup

protected instance has_coe_opens {G : Type u_1} [group G] [topological_space G] : has_coe_t (open_subgroup G) (topological_space.opens G) :=
  has_coe_t.mk fun (U : open_subgroup G) => { val := ↑U, property := is_open' U }

@[simp] theorem mem_coe {G : Type u_1} [group G] [topological_space G] {U : open_subgroup G} {g : G} : g ∈ ↑U ↔ g ∈ U :=
  iff.rfl

@[simp] theorem mem_coe_opens {G : Type u_1} [group G] [topological_space G] {U : open_subgroup G} {g : G} : g ∈ ↑U ↔ g ∈ U :=
  iff.rfl

@[simp] theorem mem_coe_subgroup {G : Type u_1} [group G] [topological_space G] {U : open_subgroup G} {g : G} : g ∈ ↑U ↔ g ∈ U :=
  iff.rfl

theorem coe_injective {G : Type u_1} [group G] [topological_space G] : function.injective coe := sorry

theorem ext {G : Type u_1} [group G] [topological_space G] {U : open_subgroup G} {V : open_subgroup G} (h : ∀ (x : G), x ∈ U ↔ x ∈ V) : U = V :=
  coe_injective (set.ext h)

theorem ext_iff {G : Type u_1} [group G] [topological_space G] {U : open_subgroup G} {V : open_subgroup G} : U = V ↔ ∀ (x : G), x ∈ U ↔ x ∈ V :=
  { mp := fun (h : U = V) (x : G) => h ▸ iff.rfl, mpr := ext }

protected theorem is_open {G : Type u_1} [group G] [topological_space G] (U : open_subgroup G) : is_open ↑U :=
  is_open' U

protected theorem one_mem {G : Type u_1} [group G] [topological_space G] (U : open_subgroup G) : 1 ∈ U :=
  one_mem' U

protected theorem inv_mem {G : Type u_1} [group G] [topological_space G] (U : open_subgroup G) {g : G} (h : g ∈ U) : g⁻¹ ∈ U :=
  inv_mem' U h

protected theorem Mathlib.open_add_subgroup.add_mem {G : Type u_1} [add_group G] [topological_space G] (U : open_add_subgroup G) {g₁ : G} {g₂ : G} (h₁ : g₁ ∈ U) (h₂ : g₂ ∈ U) : g₁ + g₂ ∈ U :=
  open_add_subgroup.add_mem' U h₁ h₂

theorem mem_nhds_one {G : Type u_1} [group G] [topological_space G] (U : open_subgroup G) : ↑U ∈ nhds 1 :=
  mem_nhds_sets (open_subgroup.is_open U) (open_subgroup.one_mem U)

protected instance has_top {G : Type u_1} [group G] [topological_space G] : has_top (open_subgroup G) :=
  has_top.mk (mk (subgroup.carrier ⊤) sorry sorry sorry is_open_univ)

protected instance inhabited {G : Type u_1} [group G] [topological_space G] : Inhabited (open_subgroup G) :=
  { default := ⊤ }

theorem is_closed {G : Type u_1} [group G] [topological_space G] [has_continuous_mul G] (U : open_subgroup G) : is_closed ↑U := sorry

/-- The product of two open subgroups as an open subgroup of the product group. -/
def prod {G : Type u_1} [group G] [topological_space G] {H : Type u_2} [group H] [topological_space H] (U : open_subgroup G) (V : open_subgroup H) : open_subgroup (G × H) :=
  mk (set.prod ↑U ↑V) sorry sorry sorry sorry

protected instance partial_order {G : Type u_1} [group G] [topological_space G] : partial_order (open_subgroup G) :=
  partial_order.mk (fun (U V : open_subgroup G) => ∀ {x : G}, x ∈ U → x ∈ V) partial_order.lt sorry sorry sorry

protected instance semilattice_inf_top {G : Type u_1} [group G] [topological_space G] : semilattice_inf_top (open_subgroup G) :=
  semilattice_inf_top.mk ⊤ partial_order.le partial_order.lt sorry sorry sorry sorry
    (fun (U V : open_subgroup G) => mk (subgroup.carrier (↑U ⊓ ↑V)) sorry sorry sorry sorry) sorry sorry sorry

@[simp] theorem coe_inf {G : Type u_1} [group G] [topological_space G] {U : open_subgroup G} {V : open_subgroup G} : ↑(U ⊓ V) = ↑U ∩ ↑V :=
  rfl

@[simp] theorem coe_subset {G : Type u_1} [group G] [topological_space G] {U : open_subgroup G} {V : open_subgroup G} : ↑U ⊆ ↑V ↔ U ≤ V :=
  iff.rfl

@[simp] theorem coe_subgroup_le {G : Type u_1} [group G] [topological_space G] {U : open_subgroup G} {V : open_subgroup G} : ↑U ≤ ↑V ↔ U ≤ V :=
  iff.rfl

end open_subgroup

namespace subgroup

theorem Mathlib.add_subgroup.is_open_of_mem_nhds {G : Type u_1} [add_group G] [topological_space G] [has_continuous_add G] (H : add_subgroup G) {g : G} (hg : ↑H ∈ nhds g) : is_open ↑H := sorry

theorem is_open_of_open_subgroup {G : Type u_1} [group G] [topological_space G] [has_continuous_mul G] (H : subgroup G) {U : open_subgroup G} (h : open_subgroup.carrier U ≤ ↑H) : is_open ↑H :=
  is_open_of_mem_nhds H (filter.mem_sets_of_superset (open_subgroup.mem_nhds_one U) h)

theorem is_open_mono {G : Type u_1} [group G] [topological_space G] [has_continuous_mul G] {H₁ : subgroup G} {H₂ : subgroup G} (h : H₁ ≤ H₂) (h₁ : is_open ↑H₁) : is_open ↑H₂ :=
  is_open_of_open_subgroup H₂ h

end subgroup

namespace open_subgroup

protected instance semilattice_sup_top {G : Type u_1} [group G] [topological_space G] [has_continuous_mul G] : semilattice_sup_top (open_subgroup G) :=
  semilattice_sup_top.mk semilattice_inf_top.top semilattice_inf_top.le semilattice_inf_top.lt sorry sorry sorry sorry
    (fun (U V : open_subgroup G) => mk (subgroup.carrier (↑U ⊔ ↑V)) sorry sorry sorry sorry) sorry sorry sorry

end open_subgroup

namespace submodule

theorem is_open_mono {R : Type u_1} {M : Type u_2} [comm_ring R] [add_comm_group M] [topological_space M] [topological_add_group M] [module R M] {U : submodule R M} {P : submodule R M} (h : U ≤ P) (hU : is_open ↑U) : is_open ↑P :=
  add_subgroup.is_open_mono h hU

end submodule

namespace ideal

theorem is_open_of_open_subideal {R : Type u_1} [comm_ring R] [topological_space R] [topological_ring R] {U : ideal R} {I : ideal R} (h : U ≤ I) (hU : is_open ↑U) : is_open ↑I :=
  submodule.is_open_mono h hU


structure Lam where
  Repr : Type v → Type v
  Obsv : Type v → Type v

  observe
    {α : Type v}
  : Repr α → Obsv α

  val
    {α : Type v}
  : α → Repr α

  app
    {α β : Type v}
  : Repr (α → β) → Repr α → Repr β

def Lam.example
  (dsl : Lam)
: dsl.Repr Nat :=
  let v1 := dsl.val 7
  let v2 := dsl.val 3
  let f := dsl.val fun l r => l + r
  let tmp := dsl.app f v1
  dsl.app tmp v2

def Lam.eval : Lam where
  Repr := id
  Obsv := id

  observe := id

  val := id
  app f a := f a

#eval Lam.example Lam.eval


import Lean

import Smt.Reconstruction.Certifying.Boolean
import Smt.Reconstruction.Certifying.Util

namespace Smt.Reconstruction.Certifying

open Lean Elab Tactic Meta Expr
open List

theorem modusTollens {A B : Prop} : (A → B) → ¬ B → ¬ A := by
  intros f nb
  exact match Classical.em A with
  | Or.inl ha  => absurd (f ha) nb
  | Or.inr hna => hna

syntax (name := liftOrNToNeg) "liftOrNToNeg" term : tactic

@[tactic liftOrNToNeg] def evalLiftOrNToNeg : Tactic :=
  fun stx => withMainContext do
    let hyp ← elabTerm stx[1] none
    let hypType ← inferType hyp
    let props := map notExpr (collectPropsInOrChain hypType)
    let propsList: Expr := listExpr props $ Expr.sort Level.zero
    let deMorgan: Expr := mkApp (mkConst ``deMorgan₂) propsList
    let modusTollens: Expr ← mkAppM ``modusTollens #[deMorgan]
    let notNotHyp: Expr ← mkAppM ``notNotIntro #[hyp]
    let answer := mkApp modusTollens notNotHyp
    Tactic.closeMainGoal answer

example : ¬ A ∨ ¬ B ∨ ¬ C ∨ ¬ D → ¬ (A ∧ B ∧ C ∧ D) := by
  intro h
  liftOrNToNeg h
--  fun h => modusTollens (@deMorgan₂ [A, B, C, D]) (notNotIntro h)

end Smt.Reconstruction.Certifying


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

/-!
# Associator for binary disjoint union of categories.

The associator functor `((C ⊕ D) ⊕ E) ⥤ (C ⊕ (D ⊕ E))` and its inverse form an equivalence.
-/

universes v u

open category_theory
open sum

namespace category_theory.sum

variables (C : Type u) [category.{v} C]
          (D : Type u) [category.{v} D]
          (E : Type u) [category.{v} E]

/--
The associator functor `(C ⊕ D) ⊕ E ⥤ C ⊕ (D ⊕ E)` for sums of categories.
-/
def associator : (C ⊕ D) ⊕ E ⥤ C ⊕ (D ⊕ E) :=
{ obj := λ X, match X with
  | inl (inl X) := inl X
  | inl (inr X) := inr (inl X)
  | inr X := inr (inr X)
  end,
  map := λ X Y f, match X, Y, f with
  | inl (inl X), inl (inl Y), f := f
  | inl (inr X), inl (inr Y), f := f
  | inr X, inr Y, f := f
  end }

@[simp] lemma associator_obj_inl_inl (X) : (associator C D E).obj (inl (inl X)) = inl X := rfl
@[simp] lemma associator_obj_inl_inr (X) : (associator C D E).obj (inl (inr X)) = inr (inl X) := rfl
@[simp] lemma associator_obj_inr (X) : (associator C D E).obj (inr X) = inr (inr X) := rfl
@[simp] lemma associator_map_inl_inl {X Y : C} (f : inl (inl X) ⟶ inl (inl Y)) :
  (associator C D E).map f = f := rfl
@[simp] lemma associator_map_inl_inr {X Y : D} (f : inl (inr X) ⟶ inl (inr Y)) :
  (associator C D E).map f = f := rfl
@[simp] lemma associator_map_inr {X Y : E} (f : inr X ⟶ inr Y) :
  (associator C D E).map f = f := rfl

/--
The inverse associator functor `C ⊕ (D ⊕ E) ⥤ (C ⊕ D) ⊕ E` for sums of categories.
-/
def inverse_associator : C ⊕ (D ⊕ E) ⥤ (C ⊕ D) ⊕ E :=
{ obj := λ X, match X with
  | inl X := inl (inl X)
  | inr (inl X) := inl (inr X)
  | inr (inr X) := inr X
  end,
  map := λ X Y f, match X, Y, f with
  | inl X, inl Y, f := f
  | inr (inl X), inr (inl Y), f := f
  | inr (inr X), inr (inr Y), f := f
  end }

@[simp] lemma inverse_associator_obj_inl (X) :
  (inverse_associator C D E).obj (inl X) = inl (inl X) := rfl
@[simp] lemma inverse_associator_obj_inr_inl (X) :
  (inverse_associator C D E).obj (inr (inl X)) = inl (inr X) := rfl
@[simp] lemma inverse_associator_obj_inr_inr (X) :
  (inverse_associator C D E).obj (inr (inr X)) = inr X := rfl
@[simp]

/--
The equivalence of categories expressing associativity of sums of categories.
-/
def associativity : (C ⊕ D) ⊕ E ≌ C ⊕ (D ⊕ E) :=
equivalence.mk (associator C D E) (inverse_associator C D E)
  (nat_iso.of_components (λ X, eq_to_iso (by tidy)) (by tidy))
  (nat_iso.of_components (λ X, eq_to_iso (by tidy)) (by tidy))

instance associator_is_equivalence : is_equivalence (associator C D E) :=
(by apply_instance : is_equivalence (associativity C D E).functor)

instance inverse_associator_is_equivalence : is_equivalence (inverse_associator C D E) :=
(by apply_instance : is_equivalence (associativity C D E).inverse)

-- TODO unitors?
-- TODO pentagon natural transformation? ...satisfying?
end category_theory.sum


import new.unordered.chain
import new.ordered.chain_o
-- import algebra.category.Group.abelian
import algebra.homology.homotopy

noncomputable theory

section

open topological_space Top Top.sheaf
open category_theory
open opposite
open AddCommGroup (hiding has_zero_object)

open_locale big_operators

universe u
variables {X : Top.{u}} (𝓕 : sheaf Ab X) (U : X.oc)

namespace computing_homotopy

variables {𝓕 U}

def unordered_to_ordered.to_fun (n : ℕ) :
  C 𝓕 U n → C_o 𝓕 U n :=
λ f σ, f σ.to_fun

def unordered_to_ordered (n : ℕ) :
  C 𝓕 U n ⟶ C_o 𝓕 U n :=
{ to_fun := unordered_to_ordered.to_fun n,
  map_zero' := rfl,
  map_add' := λ _ _, rfl }

def chain_unordered_to_ordered :
  Cech_complex_wrt_cover_unordered 𝓕 U ⟶
  Cech_complex_wrt_cover_ordered   𝓕 U :=
{ f := λ n, unordered_to_ordered (n+1),
  comm' := λ i j (h : _ + 1 = _), begin
    subst h,
    ext f α,
    -- change unordered_to_ordered.to_fun (i + 1) ≫ _ = _,
    rw [comp_apply, comp_apply, unordered_to_ordered, add_monoid_hom.coe_mk,
      unordered_to_ordered, add_monoid_hom.coe_mk, unordered_to_ordered.to_fun,
      unordered_to_ordered.to_fun],
    simp only,
    erw d_o_to_succ,
    erw d_to_succ,
    rw dd_o_aux.d_o_def,
    rw dd_aux.d_def,
    rw finset.sum_congr rfl,
    rintros ⟨k, hk⟩ -,
    split_ifs,
    { rw [id], refl, },
    { refl, },
  end }

def vec2vec_o_of_inj.to_fun {n} {α : fin n → U.ι} (h : function.injective α) : fin n → U.ι :=
let β := finset.order_iso_of_fin (finset.image α finset.univ)
  (show (finset.image α finset.univ).card = n, begin
    rw finset.card_image_eq_iff_inj_on.mpr,
    rw finset.card_univ,
    rw fintype.card_fin,
    apply set.inj_on_of_injective,
    assumption
  end) in
(λ x, x.1 : finset.image α finset.univ → U.ι) ∘ β.to_fun

lemma vec2vec_o_of_inj.to_fun_mem {n} {α : fin n → U.ι} (h : function.injective α) (i : fin n) :
  vec2vec_o_of_inj.to_fun h i ∈ finset.image α finset.univ := finset.mem_image.mpr $
begin
  dunfold vec2vec_o_of_inj.to_fun,
  simp only [finset.mem_univ, subtype.val_eq_coe, order_iso.to_fun_eq_coe,
    function.comp_app, finset.coe_order_iso_of_fin_apply, exists_true_left],
  generalize_proofs card_eq,
  sorry
end

lemma vec2vec_o_of_inj.is_strict_mono {n} {α : fin n → U.ι} (h : function.injective α) :
  strict_mono (vec2vec_o_of_inj.to_fun h) := λ i j ineq,
begin
  rw vec2vec_o_of_inj.to_fun,
  simp only,
  rw function.comp_apply,
  rw function.comp_apply,
  simpa only [order_iso.to_fun_eq_coe, subtype.val_eq_coe, finset.coe_order_iso_of_fin_apply, order_embedding.lt_iff_lt],
end

def vec2vec_o_of_inj {n} {α : fin n → U.ι} (h : function.injective α) : vec_o U n :=
{ to_fun := vec2vec_o_of_inj.to_fun h,
  is_strict_mono := vec2vec_o_of_inj.is_strict_mono h }

lemma vec2vec_o_of_inj.mem_image {n} {α : fin n → U.ι} (h : function.injective α) (i : fin n) :
  vec2vec_o_of_inj h i ∈ finset.image α finset.univ :=
vec2vec_o_of_inj.to_fun_mem h i

lemma face.vec2vec_o_eq {n} {α : fin n → U.ι} (h : function.injective α) :
  face α =
  face_o (vec2vec_o_of_inj h) :=
opens.ext $ set.ext $ λ p,
begin
  erw [opens.mem_coe, opens.mem_coe, opens.fintype_infi, opens.mem_coe, opens.fintype_infi],
  split;
  intros hp i,
  { rcases finset.mem_image.mp (vec2vec_o_of_inj.mem_image h i) with ⟨j, _, hj⟩,
    specialize hp j,
    rw hj at hp,
    exact hp, },
  { sorry },
end

def ordered_to_unordered.to_fun (n : ℕ) :
  C_o 𝓕 U n → C 𝓕 U n := λ f α,
dite (function.injective α)
(λ h, match signature α with
  | sign.zero := 0 -- this will never occur
  | sign.pos := 𝓕.1.map (eq_to_hom (face.vec2vec_o_eq h)).op (f (vec2vec_o_of_inj h))
  | sign.neg := - 𝓕.1.map (eq_to_hom (face.vec2vec_o_eq h)).op (f (vec2vec_o_of_inj h))
  end)
(λ _, 0)

def ordered_to_unordered (n : ℕ) :
  C_o 𝓕 U n ⟶ C 𝓕 U n :=
{ to_fun := ordered_to_unordered.to_fun n,
  map_zero' := sorry,
  map_add' := sorry }

def chain_ordered_to_unordered :
  Cech_complex_wrt_cover_ordered   𝓕 U ⟶
  Cech_complex_wrt_cover_unordered 𝓕 U :=
{ f := λ n, ordered_to_unordered (n + 1),
  comm' := sorry }

end computing_homotopy

def chain_unordered_homotopically_equivalent_ordered :
  homotopy_equiv
    (Cech_complex_wrt_cover_unordered 𝓕 U)
    (Cech_complex_wrt_cover_ordered 𝓕 U)
    :=
{ hom := computing_homotopy.chain_unordered_to_ordered,
  inv := computing_homotopy.chain_ordered_to_unordered,
  homotopy_hom_inv_id := sorry,
  homotopy_inv_hom_id := sorry }

def cohomology_unordered_eq_ordered (n : ℕ) :
  Cech_Cohomology_Group_wrt_cover_unordered_nth 𝓕 U n ≅
  Cech_Cohomology_Group_wrt_cover_ordered_nth 𝓕 U n :=
@homology_obj_iso_of_homotopy_equiv
  ℕ Ab _ _ (complex_shape.up ℕ)
  (Cech_complex_wrt_cover_unordered 𝓕 U)
  (Cech_complex_wrt_cover_ordered 𝓕 U)
  _ _ _ _ (abelian.has_zero_object)
  (chain_unordered_homotopically_equivalent_ordered 𝓕 U)
  n

def example1 :
  Cech_Cohomology_Group_wrt_cover_unordered_nth 𝓕 U 0 ≅
  𝓕.1.obj (op ⊤) :=
cohomology_unordered_eq_ordered 𝓕 U 0 ≪≫ zeroth_Cech_Cohomology 𝓕 U

end


-- import laurent_measures.functor
import data.finset.basic
import analysis.special_functions.log.base
import for_mathlib.pi_induced
import laurent_measures.thm69
-- import data.real.basic

/-!
This files introduces the maps `Θ`, `Φ` (***and `Ψ` ???***), which are the "measurifications" of
`θ`, `ϕ` (*** and `ψ` ???***)
`laurent_measures.thm69`, they are morphisms in the right category.

We then prove in **???** that `θ_ϕ_exact` of `laurent_measures.thm69` becomes a short exact sequence
in the category **???**.
-/

noncomputable theory

universe u

namespace laurent_measures_ses

open laurent_measures pseudo_normed_group comphaus_filtered_pseudo_normed_group
open comphaus_filtered_pseudo_normed_group_hom
open_locale big_operators nnreal

section phi_to_hom

-- parameter {p : ℝ≥0}
-- variables [fact(0 < p)] [fact (p < 1)]
-- local notation `r` := @r p
-- local notation `ℳ` := real_measures p

variable {r : ℝ≥0}
variables [fact (0 < r)]
variable {S : Fintype}

local notation `ℒ` := laurent_measures r
local notation `ϖ` := (Fintype.of punit : Type u)

variables {M₁ M₂ : Type u} [comphaus_filtered_pseudo_normed_group M₁]
  [comphaus_filtered_pseudo_normed_group M₂]

def cfpng_hom_add (f g : comphaus_filtered_pseudo_normed_group_hom M₁ M₂) :
  (comphaus_filtered_pseudo_normed_group_hom M₁ M₂) :=
begin
  apply mk_of_bound (f.to_add_monoid_hom + g.to_add_monoid_hom) (f.bound.some + g.bound.some),
  intro c,
  refine ⟨_, _⟩,
  { intros x hx,
      simp only [comphaus_filtered_pseudo_normed_group_hom.coe_mk],
      simp only [add_monoid_hom.add_apply, coe_to_add_monoid_hom],
      convert pseudo_normed_group.add_mem_filtration (f.bound.some_spec hx) (g.bound.some_spec hx),
      rw add_mul, },
  let f₀ : filtration M₁ c → filtration M₂ (f.bound.some * c) := λ x, ⟨f x, f.bound.some_spec x.2⟩,
  have hf₀ : continuous f₀ := f.continuous _ (λ x, rfl),
  let g₀ : filtration M₁ c → filtration M₂ (g.bound.some * c) := λ x, ⟨g x, g.bound.some_spec x.2⟩,
  have hg₀ : continuous g₀ := g.continuous _ (λ x, rfl),
  simp only [add_monoid_hom.add_apply, coe_to_add_monoid_hom],
  haveI : fact ((f.bound.some * c + g.bound.some * c) ≤ ((f.bound.some + g.bound.some) * c) ) :=
    fact.mk (le_of_eq (add_mul _ _ _).symm),
  let ι : filtration M₂ (f.bound.some * c + g.bound.some * c) → filtration M₂
    ((f.bound.some + g.bound.some) * c) := cast_le,
  have hι : continuous ι := continuous_cast_le _ _,
  let S₀ : filtration M₂ (f.bound.some * c) × filtration M₂ (g.bound.some * c) →
    filtration M₂ (f.bound.some * c + g.bound.some * c) :=
      λ x, ⟨x.fst + x.snd, add_mem_filtration x.fst.2 x.snd.2⟩,
  have hS₀ := continuous_add' (f.bound.some * c) (g.bound.some * c),
  exact hι.comp (hS₀.comp (continuous.prod_mk hf₀ hg₀)),
end

def cfpng_hom_neg (f : comphaus_filtered_pseudo_normed_group_hom M₁ M₂) :
  (comphaus_filtered_pseudo_normed_group_hom M₁ M₂) :=
begin
  apply mk_of_bound (- f.to_add_monoid_hom) (f.bound.some),
  intro c,
  refine ⟨_, _⟩,
  { intros x hx,
    simp only [comphaus_filtered_pseudo_normed_group_hom.coe_mk],
    convert pseudo_normed_group.neg_mem_filtration (f.bound.some_spec hx) },
  let f₀ : filtration M₁ c → filtration M₂ (f.bound.some * c) := λ x, ⟨f x, f.bound.some_spec x.2⟩,
  have hf₀ : continuous f₀ := f.continuous _ (λ x, rfl),
  exact (continuous_neg' _).comp hf₀,
end

instance : add_comm_group (comphaus_filtered_pseudo_normed_group_hom M₁ M₂) :=
{ add := cfpng_hom_add,
  add_assoc := by {intros, ext, apply add_assoc},
  zero := 0,
  zero_add := by {intros, ext, apply zero_add},
  add_zero := by {intros, ext, apply add_zero},
  neg := cfpng_hom_neg,
  add_left_neg := by {intros, ext, apply add_left_neg},
  add_comm := by {intros, ext, apply add_comm} }

variable (S)

/-- The map on Laurent measures induced by multiplication by `T⁻¹ - 2` on `ℤ((T))ᵣ`. -/
def Φ : comphaus_filtered_pseudo_normed_group_hom (ℒ S) (ℒ S) := shift (1) - 2 • id
-- variable {S}

lemma Φ_eq_ϕ (F : ℒ S) : Φ S F = ϕ F := rfl

-- after the Φ refactor the below lemma is no longer true

-- lemma Φ_bound_by_3 [fact (r ≤ 1)] :
--   (Φ S : comphaus_filtered_pseudo_normed_group_hom (ℒ S) (ℒ S)).bound_by 3 :=
-- begin
--   let sh : comphaus_filtered_pseudo_normed_group_hom (ℒ S) (ℒ S) := shift (-1),
--   let shup : comphaus_filtered_pseudo_normed_group_hom (ℒ S) (ℒ S) := shift (1),
--   have Hsh : sh.bound_by 1,
--   { refine (mk_of_bound_bound_by _ _ _).mono 1 _,
--     rw [neg_neg], exact (pow_one r).le.trans (fact.out _) },
--   have Hshup : shup.bound_by 1,
--   { refine (mk_of_bound_bound_by _ _ _).mono (1) _,

--   }
--   suffices : (sh + sh + (-id)).bound_by (1 + 1 + 1),
--   { convert this using 1, ext1, dsimp only [Φ_eq_ϕ, ϕ], erw two_nsmul, }, -- was refl
--   refine (Hsh.add Hsh).add (mk_of_bound_bound_by _ _ _).neg,
-- end

lemma Φ_natural (S T : Fintype) (f : S ⟶ T) (F : ℒ S) (t : T) (n : ℤ) :
  Φ T (map f F) t n = laurent_measures.map f (Φ S F) t n :=
begin
  simp [Φ_eq_ϕ, ϕ, finset.mul_sum],
end

end phi_to_hom

section theta

open theta real_measures

parameter (p : ℝ≥0)
local notation `r` := @r p
local notation `ℳ` := real_measures p
local notation `ℒ` := laurent_measures r

variable {S : Fintype.{u}}

local notation `ϖ` := Fintype.of (punit : Type u)

def seval_ℒ_c (c : ℝ≥0) (s : S) : filtration (ℒ S) c → (filtration (ℒ ϖ) c) :=
λ F,
begin
  refine ⟨seval_ℒ S s F, _⟩,
  have hF := F.2,
  simp only [filtration, set.mem_set_of_eq, seval_ℒ, nnnorm, laurent_measures.coe_mk,
    fintype.univ_punit, finset.sum_singleton] at ⊢ hF,
  have := finset.sum_le_sum_of_subset (finset.singleton_subset_iff.mpr $ finset.mem_univ_val _),
  rw finset.sum_singleton at this,
  apply le_trans this hF,
end

variable [fact (0 < p)]

lemma θ_zero : θ (0 : ℒ S) = 0 :=
begin
  dsimp only [θ, theta.ϑ],
  funext,
  simp only [laurent_measures.zero_apply, int.cast_zero, zero_mul, tsum_zero, real_measures.zero_apply],
end

variable [fact (p < 1)]

lemma θ_add (F G : ℒ S) : θ (F + G) = θ F + θ G :=
begin
  dsimp only [θ, theta.ϑ],
  funext,
  simp only [laurent_measures.add_apply, int.cast_add, one_div, inv_zpow', zpow_neg,
    real_measures.add_apply, tsum_add],
  rw ← tsum_add,
  { congr,
    funext,
    rw add_mul },
  all_goals {apply summable_of_summable_norm, simp_rw [← inv_zpow, norm_mul, norm_zpow, norm_inv,
    real.norm_two] },
  exact aux_thm69.summable_smaller_radius_norm F.d half_lt_r (F.summable s) (λ n, lt_d_eq_zero _ _ _),
  exact aux_thm69.summable_smaller_radius_norm G.d half_lt_r (G.summable s) (λ n, lt_d_eq_zero _ _ _),
end

--for mathlib
lemma nnreal.rpow_int_cast (x : ℝ≥0) (n : ℤ) : x ^ n = x ^ (n : ℝ) := by {
  rw [← nnreal.coe_eq, nnreal.coe_zpow, ← real.rpow_int_cast, ← nnreal.coe_rpow] }

lemma nnreal.rpow_le_rpow_of_exponent_le {x : ℝ≥0} (x1 : 1 ≤ x) {y z : ℝ}
  (hyz : y ≤ z) :
  x ^ y ≤ x ^ z :=
by { cases x with x hx, exact real.rpow_le_rpow_of_exponent_le x1 hyz }

lemma nnreal.tsum_geom_arit_inequality (f: ℤ → ℝ) {r' : ℝ} (hr'1 : 0 < r') (hr'2 : r' ≤ 1)
  (hs1 : summable (λ n, f n)) (hs2 : summable (λ n, ∥(f n)∥₊ ^ r')) :
  ∥ tsum (λ n, f n) ∥₊ ^ r' ≤ tsum (λ n, ∥(f n)∥₊ ^ r' ) :=
begin
  rw ← summable_norm_iff at hs1,
  simp_rw ← _root_.coe_nnnorm at hs1,
  rw nnreal.summable_coe at hs1,
  refine le_trans (nnreal.rpow_le_rpow (nnnorm_tsum_le hs1) hr'1.le) _,
  have := λ s : finset ℤ, nnreal.rpow_sum_le_sum_rpow s (λ i, ∥f i∥₊) hr'1 hr'2,
  dsimp only at this,
  have s1' := filter.tendsto.comp (continuous.tendsto
    (nnreal.continuous_rpow_const hr'1.le) _) hs1.has_sum,
  dsimp [function.comp] at s1',
  apply tendsto_le_of_eventually_le s1' hs2.has_sum,
  delta filter.eventually_le,
  convert filter.univ_sets _,
  ext x,
  simp [this],
end

lemma aux_bound (F : ℒ S) (s : S) : ∀ (b : ℤ), ∥(F s b : ℝ) ∥₊ ^ (p : ℝ) *
  (2⁻¹ ^ (p : ℝ)) ^ (b : ℝ) ≤ ∥F s b∥₊ * r ^ b :=
begin
  intro b,
  rw [nnreal.rpow_int_cast],
  refine mul_le_mul_of_nonneg_right _ (real.rpow_nonneg_of_nonneg (nnreal.coe_nonneg _) _),
  have p_le_one : (p : ℝ) ≤ 1,
  { rw ← nnreal.coe_one,
    exact (nnreal.coe_lt_coe.mpr $ fact.out _).le },
  by_cases hF_nz : F s b = 0,
  { rw [hF_nz, int.cast_zero, nnnorm_zero, nnnorm_zero, nnreal.zero_rpow],
    rw [ne.def, ← nnreal.coe_zero, nnreal.coe_eq, ← ne.def],
    exact ne_of_gt (fact.out _) },
  { convert nnreal.rpow_le_rpow_of_exponent_le _ p_le_one,
    { rw nnreal.rpow_one,
      refl },
    { refine not_lt.mp (λ hf, hF_nz (int.abs_lt_one_iff.mp _)),
      suffices : (|F s b| : ℝ) < 1, exact_mod_cast this,
      rw ← int.norm_eq_abs,
      rwa [← nnreal.coe_lt_coe, ← nnnorm_norm, real.nnnorm_of_nonneg (norm_nonneg _)] at hf } }
end

lemma θ_bound : ∀ c : ℝ≥0, ∀ F : (ℒ S), F ∈ filtration (ℒ S) c → (θ F) ∈ filtration (ℳ S)
  (1 * c) :=
begin
  intros c F hF,
  rw laurent_measures.mem_filtration_iff at hF,
  dsimp only [laurent_measures.has_nnnorm] at hF,
  rw [one_mul, real_measures.mem_filtration_iff],
  dsimp only [real_measures.has_nnnorm, θ, theta.ϑ],
  let T := S.2.1,
  have ineq : ∀ (s ∈ T), ∥∑' (n : ℤ), ((F s n) : ℝ) * 2⁻¹ ^ n∥₊ ^ (p : ℝ) ≤ ∑' (n : ℤ),
    ∥ ((F s n) : ℝ) * 2⁻¹ ^ n∥₊ ^ (p : ℝ),
  { intros s hs,
    apply nnreal.tsum_geom_arit_inequality (λ n, ((F s n) * 2⁻¹ ^ n)),
    { norm_num, exact fact.out _},
    { suffices : p ≤ 1, assumption_mod_cast, exact fact.out _},
    { dsimp only,
      obtain ⟨d, hd⟩ := exists_bdd_filtration (r_pos) (r_lt_one) F,
      apply aux_thm69.summable_smaller_radius d (F.summable s) (hd s) half_lt_r },
    { dsimp only,
      simp_rw [nnnorm_mul, nnreal.mul_rpow],
      have := F.summable s,
      rw ← nnreal.summable_coe,
      apply summable_of_nonneg_of_le (λ i, _) _ this, apply nnreal.zero_le_coe,
      intro n,
      push_cast,
      apply mul_le_mul,
      { -- true because ∥integer∥ is either 0 or >= 1
        norm_cast,
        by_cases h : F s n = 0,
        { simp only [h, norm_zero],
          refine le_of_eq (real.zero_rpow _),
          norm_cast,
          exact ne_of_gt (fact.out _) },
        { nth_rewrite 1 (real.rpow_one (∥F s n∥)).symm,
          apply real.rpow_le_rpow_of_exponent_le,
          { rw [int.norm_eq_abs, le_abs'],
            norm_cast,
            rcases lt_trichotomy 0 (F s n) with (hF|hF|hF),
            { right, linarith },
            { exact false.elim (h hF.symm) },
            { left, change _ ≤ -(1 : ℤ), linarith, } },
          { norm_cast, exact fact.out _ } } },
      { apply le_of_eq,
        rw [← r_coe],
        rw real.norm_of_nonneg,
        { -- can't use pow_mul yet because one is int one is real
          rw [← real.rpow_int_cast, ← real.rpow_int_cast],
          rw [← real.rpow_mul, mul_comm, real.rpow_mul];
          norm_num },
        { apply zpow_nonneg,
          norm_num } },
      { refine (real.rpow_pos_of_pos _ _).le,
        rw norm_pos_iff,
        apply zpow_ne_zero,
        norm_num, },
      { apply norm_nonneg, } } },
  apply (finset.sum_le_sum ineq).trans,
  simp_rw [nnnorm_mul, nnnorm_zpow, nnnorm_inv, nnreal.mul_rpow, real.nnnorm_two,
    nnreal.rpow_int_cast, ← nnreal.rpow_mul (2 : ℝ≥0)⁻¹, mul_comm, nnreal.rpow_mul (2 : ℝ≥0)⁻¹],
  apply le_trans _ hF,
  apply finset.sum_le_sum,
  intros s hs,
  apply tsum_le_tsum,
  exact aux_bound p F s,
  refine nnreal.summable_of_le _ (F.2 s),
  exacts [aux_bound p F s, F.2 s],
end

lemma θ_bound' :  ∀ c : ℝ≥0, ∀ F : (ℒ S), F ∈ filtration (ℒ S) c → (θ F) ∈ filtration (ℳ S)
  c :=by { simpa [one_mul] using (θ_bound p)}

def θ_to_add : (ℒ S) →+ (ℳ S) :=
{ to_fun := λ F, θ F,
  map_zero' := θ_zero,
  map_add' := θ_add, }

variable (S)

open theta metric real_measures

def seval_ℳ_c (c : ℝ≥0) (s : S) : filtration (ℳ S) c → (filtration (ℳ ϖ) c) :=
λ x,
  begin
  refine ⟨(λ _, x.1 s), _⟩,
  have hx := x.2,
  simp only [filtration, set.mem_set_of_eq, nnnorm, laurent_measures.coe_mk,
    fintype.univ_punit, finset.sum_singleton] at ⊢ hx,
  have := finset.sum_le_sum_of_subset (finset.singleton_subset_iff.mpr $ finset.mem_univ_val _),
  rw finset.sum_singleton at this,
  apply le_trans this hx,
end

-- **[FAE]** From here everything might be useless until `lemma inducing_cast_ℳ`: check
-- also the `variable (c : ℝ≥0)` issue; the idea is to replace cast_ℳ_c with α, for which
-- everything seems to work

variable (c : ℝ≥0)

def box := {F : (ℳ S) // ∀ s, ∥ F s ∥₊ ^ (p : ℝ) ≤ c }

instance : has_coe (box S c) (ℳ S) := by {dsimp only [box], apply_instance}
instance : topological_space (ℳ S) := by {dsimp only [real_measures], apply_instance}
instance : topological_space (box S c) := by {dsimp only [box], apply_instance}

def equiv_box_ϖ : (box S c) ≃ Π (s : S), (filtration (ℳ ϖ) c) :=
begin
  fconstructor,
  { intros F s,
    use seval_ℳ S s F.1,
    simp only [real_measures.mem_filtration_iff, nnnorm, fintype.univ_punit,
      finset.sum_singleton, seval_ℳ],
    exact F.2 s },
  { intro G,
    use λ s, (G s).1 punit.star,
    intro s,
    simpa only [real_measures.mem_filtration_iff, nnnorm, fintype.univ_punit,
      finset.sum_singleton, seval_ℳ] using (G s).2 },
  { intro _,
    ext s,
    simpa only [seval_ℳ] },
  { intro G,
    ext s,
    simp only [seval_ℳ, subtype.val_eq_coe, subtype.coe_mk],
    induction x,
    refl }
end

def homeo_box_ϖ : (box S c) ≃ₜ Π (s : S), (filtration (ℳ ϖ) c) :=
{ to_equiv := equiv_box_ϖ S c,
  continuous_to_fun := begin
    apply continuous_pi,
    intro s,
    dsimp only [equiv_box_ϖ, seval_ℳ],
    refine continuous.subtype_mk (continuous_pi $ λ i, _) _,
    exact continuous_pi_iff.mp continuous_induced_dom s,
  end,
  continuous_inv_fun :=
  begin
    dsimp only [equiv_box_ϖ, seval_ℳ],
    refine continuous.subtype_mk _ _,
    apply continuous_pi,
    intro s,
    have h : continuous (λ (a : S → (filtration (ℳ ϖ) c)), (a s).val)
       := continuous.subtype_coe (continuous_apply s),
    have H := continuous_apply punit.star,
    exact H.comp h,
  end}

def α : filtration (ℳ S) c → box S c :=
begin
  intro x,
  use x,
  have hx := x.2,
  intro s,
  simp only [filtration, set.mem_set_of_eq, nnnorm, laurent_measures.coe_mk,
    fintype.univ_punit, finset.sum_singleton] at hx,
  have := finset.sum_le_sum_of_subset (finset.singleton_subset_iff.mpr $ finset.mem_univ_val _),
  rw finset.sum_singleton at this,
  apply le_trans this hx,
end

lemma coe_α_coe : (coe : (box S c) → (ℳ S)) ∘ (α S c) = coe := by {funext _, refl}

lemma inducing_α : inducing (α S c) :=
begin
  have ind_ind := @induced_compose _ _ (ℳ S) _ (α p S c) coe,
  rw [coe_α_coe p S c] at ind_ind,
  exact {induced := eq.symm ind_ind},
end

lemma seval_ℳ_α_commute (c : ℝ≥0) (s : S) :
 (λ F, ((homeo_box_ϖ S c) ∘ (α S c)) F s) = (λ F, seval_ℳ_c S c s F) := rfl

 lemma seval_ℳ_α_commute' {X : Type*} (c : ℝ≥0) {f : X → filtration (ℳ S) c} (s : S)  :
 (λ x, ((homeo_box_ϖ S c) ∘ (α S c)) (f x) s) = (λ x, seval_ℳ_c S c s (f x)) :=
 begin
  ext z,
  have h_commute := @seval_ℳ_α_commute p S _ _ c s,
  have := congr_fun h_commute (f z),
  simp only at this,
  rw this,
 end

@[nolint unused_arguments]
def seval_ℒ_bdd_c (c : ℝ≥0) (S : Fintype) (A : finset ℤ) (s : S) :
laurent_measures_bdd r S A c → laurent_measures_bdd r ϖ A c :=
begin
  intro F,
  use λ _, F s,
  have hF := F.2,
  simp only [filtration, set.mem_set_of_eq, seval_ℒ, nnnorm, laurent_measures.coe_mk,
    fintype.univ_punit, finset.sum_singleton] at ⊢ hF,
  have := finset.sum_le_sum_of_subset (finset.singleton_subset_iff.mpr $ finset.mem_univ_val _),
  rw finset.sum_singleton at this,
  apply le_trans this hF,
end

lemma continuous_seval_ℒ_c (c : ℝ≥0) (s : S) : continuous (seval_ℒ_c c s) :=
begin
  rw laurent_measures.continuous_iff,
  intro A,
  let := seval_ℒ_bdd_c p c S A s,
  have h_trunc : (@truncate r ϖ c A) ∘ (seval_ℒ_c p c s) =
    (seval_ℒ_bdd_c p c S A s) ∘ (@truncate r S c A),
  { ext ⟨F, hF⟩ π k,
    dsimp only [seval_ℒ_bdd_c, seval_ℒ_c],
    refl },
  rw h_trunc,
  apply continuous.comp,
  apply continuous_of_discrete_topology,
  apply truncate_continuous,
end

section topological_generalities

open metric set

variables {X : Type*} [topological_space X]

lemma reduction_balls {c : ℝ≥0} (f : X → (closed_ball (0 : ℝ) c)) (H : ∀ y : (closed_ball 0 c),
  ∀ ε : ℝ, is_open (f⁻¹' (ball y ε))) : continuous f :=
begin
  rw continuous_def,
  intros _ hU,
  rw is_open_iff_forall_mem_open,
  intros x hx,
  obtain ⟨ε, h₀, hε⟩ := (is_open_iff.mp hU) (f x) (mem_preimage.mp hx),
  use f⁻¹' (ball (f x) ε),
  exact ⟨preimage_mono hε, H (f x) ε, mem_ball_self h₀⟩,
end

lemma mem_filtration_le_monomial (F : filtration (ℒ ϖ) c) (n : ℕ) :
 ∥ ((F.1 punit.star n) : ℝ) ∥ ≤ c * ( r⁻¹ ^ n) :=
begin
  have h_le : ∑' n : ℤ, ∥ ((F.1 punit.star n) : ℝ) ∥ * r ^ n ≤ c,
  { have := (laurent_measures.mem_filtration_iff F.1 c).mp F.2,
    rw laurent_measures.nnnorm_def at this,
    simp only [fintype.univ_punit, finset.sum_singleton, ← nnreal.coe_le_coe,
    nnreal.coe_tsum, nnreal.coe_mul, nnreal.coe_zpow, laurent_measures.coe_nnnorm] at this,
    exact this },
  have := @sum_le_tsum ℝ _ _ _ _ (λ n, ∥ ((F.1 punit.star n) : ℝ) ∥ * r ^ n) {n} _
    (F.1.summable punit.star),
  simp only [finset.sum_singleton, zpow_coe_nat] at this,
  replace h_le := this.trans h_le,
  rwa [← inv_mul_le_iff', inv_pow, inv_inv ((r : ℝ) ^ n), mul_comm],
  { apply pow_pos, rw inv_pos, apply r_pos },
  { rintros b -,
    simp only [subtype.val_eq_coe],
    exact mul_nonneg (norm_nonneg _) (zpow_nonneg (le_of_lt (nnreal.coe_pos.mpr r_pos)) b) },
end

lemma mem_filtration_sum_le_geom (F : filtration (ℒ ϖ) c) (B : ℕ) : ∥ ∑' n : {x : ℕ // B ≤ x},
  ((F.1 punit.star n) : ℝ) * 2⁻¹ ^ n.1 ∥ ≤ ∥ (c : ℝ) * ∑' n : {x : ℕ // B ≤ x}, (2⁻¹ * r⁻¹) ^ n.1 ∥ :=
begin
  have two_r_nonneg : 0 ≤ (2⁻¹ * r⁻¹ : ℝ) := by {refine mul_nonneg (inv_nonneg.2 two_pos.le) (inv_nonneg.2 r.2) },
  have h_inj : function.injective (coe : {x : ℕ // B ≤ x} → ℕ) := subtype.coe_injective,
  have geom_pos : (0 : ℝ) ≤ c * ∑' (n : {x // B ≤ x}), (2⁻¹ * r⁻¹) ^ n.1,
  { apply mul_nonneg c.2 (tsum_nonneg _),
    intro b,
    apply pow_nonneg (two_r_nonneg) },
  nth_rewrite 1 [real.norm_eq_abs],
  rw [abs_eq_self.mpr geom_pos],
    apply (norm_tsum_le_tsum_norm _).trans,
  rw [← tsum_mul_left],
  apply tsum_le_tsum,
  { intro b,
    rw [norm_mul, mul_pow, mul_comm ((2⁻¹ : ℝ) ^ b.1) _, ← mul_assoc],
    rw [norm_pow, norm_inv, real.norm_two ],
    refine (mul_le_mul_right _).mpr _,
    { simp only [one_div, inv_pos, pow_pos, zero_lt_bit0, zero_lt_one] },
    { apply mem_filtration_le_monomial p c F } },
  swap,
  { by_cases hc : (c : ℝ) ≠ 0,
    { rw [← summable_mul_left_iff hc],
      have two_r_lt : (2⁻¹ * r⁻¹ : ℝ) < 1,
      { have := (div_lt_one (nnreal.coe_lt_coe.mpr (r_pos))).mpr half_lt_r,
        simp only [← inv_eq_one_div] at this ⊢,
        rw [div_eq_mul_inv, nnreal.coe_inv] at this,
        convert this,
        assumption', },
      exact (summable_geometric_of_lt_1 two_r_nonneg two_r_lt).comp_injective h_inj,
      },
    { rw not_ne_iff at hc,
      simp_rw [hc, zero_mul],
      exact summable_zero }, },
  all_goals { simp_rw [norm_mul, norm_pow, norm_inv, real.norm_two, subtype.val_eq_coe],
    refine ((aux_thm69.summable_iff_on_nat_less F.1.d _).mp (aux_thm69.summable_smaller_radius_norm
      F.1.d (half_lt_r) (F.1.summable punit.star)
      (λ n, lt_d_eq_zero F.1 punit.star n))).comp_injective h_inj,
    intros n hn,
    rw [lt_d_eq_zero F.1 punit.star n hn, norm_zero, zero_mul] },
end

def geom_B_nat (ε : ℝ) (hε : 0 < ε) : {B : ℕ // ∀ (F : filtration (ℒ ϖ) c), ∥ tsum (λ b :
  {n : ℕ // B ≤ n }, ((F.1 punit.star b.1) : ℝ) * 2⁻¹ ^ b.1 ) ∥ < ε ^ (p⁻¹ : ℝ)} :=
begin
  let g := (λ n : ℕ, (c : ℝ) * ((2⁻¹ * r⁻¹) ^ n)),
  have := tendsto_tsum_compl_at_top_zero g,
  rw tendsto_at_top at this,
  have h_pos : 0 < ε ^ (p⁻¹ : ℝ) := real.rpow_pos_of_pos hε _,
  specialize this (ε ^ (p⁻¹ : ℝ)) h_pos,
  let A := this.some,
    let B₀ : option ℕ → ℕ := λ a : (option ℕ), option.rec_on a (0 : ℕ) (λ n, n),
    set B := (B₀ A.max).succ with hB,
    use B,
    have h_incl : A ≤ finset.range B,
    rw finset.le_eq_subset,
    { by_cases H : A.nonempty,
      { intros a ha,
        obtain ⟨s, hs⟩ := finset.max_of_nonempty H,
        replace hB : s.succ = B, { simp only [*, option.mem_def], refl, },
        have h_mem := finset.mem_range_succ_iff.mpr (finset.le_max_of_mem ha hs),
        rwa hB at h_mem },
      { intros a ha,
        rw [finset.not_nonempty_iff_eq_empty] at H,
        finish }},
    let hA := this.some_spec,
    specialize hA (finset.range B) h_incl,
    rw [real.dist_0_eq_abs, ← real.norm_eq_abs] at hA,
    intro F,
    apply lt_of_le_of_lt (mem_filtration_sum_le_geom p c F B),
    convert hA using 1,
    apply congr_arg,
    simp_rw [subtype.val_eq_coe, ← tsum_mul_left],
    have set_eq : {n : ℕ | B ≤ n} = {n : ℕ | n ∉ finset.range B} :=
      by {simp only [finset.mem_range, not_lt]},
    exact tsum_congr_subtype g set_eq,
end

def eq_le_int_nat (B : ℕ) : {n : ℤ // (B : ℤ) ≤ n } ≃ {n : ℕ // B ≤ n} :=
{ to_fun :=
  begin
    intro b,
    use (int.eq_coe_of_zero_le ((int.coe_nat_nonneg B).trans b.2)).some,
    rw ← int.coe_nat_le,
    convert b.2,
    exact (Exists.some_spec (int.eq_coe_of_zero_le ((int.coe_nat_nonneg B).trans b.2))).symm,
  end,
  inv_fun := λ n, ⟨n, by {simp only [coe_coe, int.coe_nat_le], from n.2}⟩,
  left_inv :=
  begin
    rintro ⟨_, h⟩,
    simp only [coe_coe, subtype.coe_mk],
    exact (Exists.some_spec (int.eq_coe_of_zero_le ((int.coe_nat_nonneg B).trans h))).symm,
  end,
  right_inv :=
  begin
    rintro ⟨_, h⟩,
    simp only [coe_coe, subtype.coe_mk, int.coe_nat_inj'],
    exact ((@exists_eq' _ _).some_spec).symm,
  end, }

def geom_B_int (ε : ℝ) (hε : 0 < ε) : {B : ℤ // ∀ (F : filtration (ℒ ϖ) c), ∥ tsum (λ b :
  {n : ℤ // B ≤ n }, ((F.1 punit.star b.1) : ℝ) * 2⁻¹ ^ b.1 ) ∥ < ε ^ (p⁻¹ : ℝ)} :=
begin
  let ℬ := geom_B_nat p c ε hε,
  let B := ℬ.1,
  let hB := ℬ.2,
  use B,
  intro F,
  specialize hB F,
  convert hB using 1,
  apply congr_arg,
  exact ((eq_le_int_nat B).symm.tsum_eq (λ b : {n : ℤ // ↑B ≤ n },
  ((F.1 punit.star b.1) : ℝ) * 2⁻¹ ^ b.1 )).symm,
end

def geom_B (ε : ℝ) (hε : 0 < ε) : ℤ := (geom_B_int c ε hε).1

lemma tail_B (ε : ℝ) (hε : 0 < ε) :  ∀ (F : filtration (ℒ ϖ) c), ∥ tsum (λ b : {n : ℤ // geom_B c ε hε ≤ n },
  ((F.1 punit.star b.1) : ℝ) * 2⁻¹ ^ b.1 ) ∥ < ε ^ (p⁻¹ : ℝ) :=
begin
  intro F,
  have := (geom_B_int p c ε hε).2 F,
  exact this,
end

def U (F : filtration (ℒ ϖ) c) (B : ℤ) : set (filtration (ℒ ϖ) c) :=
  λ G, ∀ s n, n < B → F s n = G s n

lemma mem_U (F : filtration (ℒ ϖ) c) (B : ℤ) : F ∈ (U c F B) := λ _ _ _, rfl

lemma explodes_pow_r (ρ : ℝ≥0) (h₀ : 0 < ρ.1) (h₁ : ρ.1 < 1) (c : ℝ≥0) :
  ∃ n₀ : ℤ, ∀ (m : ℤ), m < n₀ → c < ρ ^ m :=
begin
  convert_to ∃ n₀ : ℕ, ∀ (m : ℕ), (- m : ℤ) < - n₀ → (c : ℝ) < ρ ^ ( - m : ℤ) using 0,
  { simp only [neg_lt_neg_iff, int.coe_nat_lt, zpow_neg, zpow_coe_nat, eq_iff_iff],
    split,
    { rintro ⟨n₀, hn₀⟩,
      induction n₀,
      { use n₀,
        intros m hm,
        rw [← int.coe_nat_lt] at hm,
        replace hm := neg_lt.mpr (lt_of_le_of_lt (neg_le_self (int.coe_nat_nonneg _)) hm),
        specialize hn₀ (- m) hm,
        rwa [← nnreal.coe_lt_coe, nnreal.coe_zpow, zpow_neg] at hn₀ },
      { use n₀ + 1,
        intros m hm,
        rw [← int.coe_nat_lt, ← neg_lt_neg_iff, ← int.neg_succ_of_nat_coe] at hm,
        specialize hn₀ (- m) hm,
        rwa [← nnreal.coe_lt_coe, nnreal.coe_zpow, zpow_neg] at hn₀ },},
    { rintro ⟨n₀, hn₀⟩,
      use - n₀,
      rintro ⟨m⟩ hm,
      {  have := right.neg_nonpos_iff.mpr (int.of_nat_nonneg n₀),
        rw [int.of_nat_eq_coe] at this,
        replace := ne_of_lt (lt_of_lt_of_le (lt_of_le_of_lt (int.of_nat_nonneg m) hm) this),
        finish },
      { rw [int.neg_succ_of_nat_coe, neg_lt_neg_iff, int.coe_nat_lt] at hm,
        specialize hn₀ (m + 1) hm,
        rwa [int.neg_succ_of_nat_coe, ← nnreal.coe_lt_coe, zpow_neg, zpow_coe_nat, nnreal.coe_inv,
          nnreal.coe_pow] }}},
  have h := (tendsto_pow_at_top_nhds_within_0_of_lt_1 h₀ h₁).inv_tendsto_zero,
  simp_rw [← zpow_coe_nat] at h,
  have : (λ (n : ℕ), ρ.1 ^ (n : ℤ))⁻¹ = (λ (n : ℕ), ρ.1 ^ (- n : ℤ)) := by {ext,
  simp only [pi.inv_apply, zpow_neg] },
  rw [this, filter.tendsto_at_top] at h,
  specialize h (c + 1),
  rw [nnreal.val_eq_coe] at h,
  simp_rw [← nnreal.coe_zpow] at h,
  obtain ⟨n₀, hn₀⟩ := filter.eventually.exists_forall_of_at_top h,
  use n₀,
  intros m hm,
  rw [neg_lt_neg_iff, int.coe_nat_lt] at hm,
  replace hm := le_of_lt hm,
  specialize hn₀ m hm,
  rw nnreal.coe_zpow at hn₀,
  refine lt_of_lt_of_le _ hn₀,
  exact lt_add_one _,
end

lemma is_open_U (F : filtration (ℒ ϖ) c) (B : ℤ) : is_open (U c F B) :=
begin
  let ι : filtration (ℒ ϖ) c → Π (i : ℤ), ℤ :=
    λ t i, truncate {i} t punit.star ⟨i,by simp⟩,
  have hι : continuous ι,
  { rw continuous_pi_iff, intros i,
    dsimp [ι],
    change continuous ((λ (t : laurent_measures_bdd r ϖ {i} c),
      t punit.star ⟨i,by simp⟩) ∘ truncate {i}),
    refine continuous.comp continuous_bot (truncate_continuous «r» (Fintype.of punit) c {i}) },
  obtain ⟨n₀,h₀⟩ : ∃ n₀ : ℤ, ∀ (m : ℤ) (H : ℒ ϖ) (hH : H ∈ filtration (ℒ ϖ) c),
    m < n₀ → H punit.star m = 0,
  { obtain ⟨n₀,h₀⟩ : ∃ n₀ : ℤ, ∀ (m : ℤ), m < n₀ → c < r^m := explodes_pow_r r r_pos r_lt_one c,
    use n₀, intros m H hH hm,
    exact eq_zero_of_filtration H _ hH punit.star m (h₀ m hm) },
  classical,
  let UU : set (Π (i : ℤ), ℤ) :=
    set.pi (set.Ico n₀ B) (λ i, if i ∈ set.Ico n₀ B then { F punit.star i } else ⊤),
  have hUU : is_open UU,
  { apply is_open_set_pi, exact finite_Ico n₀ B,
    intros a ha, trivial },
  convert hUU.preimage hι,
  ext G,
  split,
  { intros hG, dsimp [U, UU, ι] at ⊢ hG,
    intros i hi, rw if_pos hi,
    simp only [mem_singleton_iff],
    symmetry,
    apply hG, exact hi.2 },
  { intros hG, dsimp [U, UU, ι] at ⊢ hG,
    rintros ⟨⟩ n hn,
    symmetry,
    by_cases hn' : n < n₀,
    { erw [h₀ n G.1 G.2 hn', h₀ n F.1 F.2 hn'] },
    push_neg at hn',
    specialize hG n, simpa [hn', hn] using hG },
end

end topological_generalities

def θ_c (c : ℝ≥0) (T : Fintype) : (filtration (laurent_measures r T) c) →
  (filtration (real_measures p T) c) :=
begin
  intro f,
  rw [← one_mul c],
  use ⟨θ f, θ_bound p c f f.2⟩,
end

lemma commute_seval_ℒ_ℳ (c : ℝ≥0) (s : S) :
  (θ_c c (Fintype.of punit)) ∘ (seval_ℒ_c c s) = (seval_ℳ_c S c s) ∘ (θ_c c S) := by simpa only
  [seval_ℳ_c, seval_ℒ_c, seval_ℒ, θ_c, one_mul, subtype.coe_mk, eq_mpr_eq_cast, set_coe_cast]

lemma continuous_of_seval_ℳ_comp_continuous (c : ℝ≥0) {X : Type*} [topological_space X]
  {f : X → (filtration (ℳ S) c)} : (∀ s, continuous ((seval_ℳ_c S c s) ∘ f)) → continuous f :=
begin
  intro H,
  replace H : ∀ (s : S), continuous (λ x : X, ((homeo_box_ϖ p S c) ∘ (α p S c)) (f x) s),
  { intro,
    rw [seval_ℳ_α_commute' p S c s],
    exact H s },
  rw ← continuous_pi_iff at H,
  convert_to (continuous (λ x, (homeo_box_ϖ p S c) (α p S c (f x)))) using 0,
  { apply eq_iff_iff.mpr,
    rw [homeomorph.comp_continuous_iff, (inducing_α p S c).continuous_iff] },
  exact H,
end

lemma tsum_subtype_sub {f g : ℤ → ℝ} {B : ℤ}
  (hf : summable (λ (b : {x // B ≤ x}), f b * 2⁻¹ ^ b.1))
  (hg : summable (λ (b : {x // B ≤ x}), g b * 2⁻¹ ^ b.1)) :
  ∥ tsum ((λ (b : ℤ), (((g b) : ℝ) - f b) * 2⁻¹ ^ b) ∘ (coe : {b | B ≤ b} → ℤ)) ∥ =
  ∥ ∑' (b : {x // B ≤ x}), (g b : ℝ) * 2⁻¹ ^ b.1 - ∑' (b : {x // B ≤ x}),
    (f b : ℝ) * 2⁻¹ ^ b.1 ∥ :=
begin
  rw [← tsum_sub hg hf, tsum_eq_tsum_of_has_sum_iff_has_sum],
  intro _,
  simp_rw [sub_mul, iff_eq_eq],
  refl,
end

lemma aux_summability_no_norm (F : filtration (ℒ ϖ) c) : summable
  (λ b : ℤ, (((F punit.star b) : ℝ) * 2⁻¹ ^ b)) := aux_thm69.summable_smaller_radius F.1.d (F.1.summable punit.star)
      (λ n, lt_d_eq_zero F.1 punit.star n) half_lt_r

lemma aux_summability_subtype (F : filtration (ℒ ϖ) c) (B : ℤ) : summable (λ b : {x : ℤ // B ≤ x},
  (((F punit.star b) : ℝ) * 2⁻¹ ^ b.1)) :=
    by {exact (aux_summability_no_norm p c F).comp_injective subtype.coe_injective}

lemma pos_ε_pow (ε : ℝ) (hε : 0 < ε) : 0 < (ε / (2 : ℝ) ^ p.1) := by {apply div_pos hε
  (real.rpow_pos_of_pos _ _), simp only [zero_lt_bit0, zero_lt_one]}

lemma dist_lt_of_mem_U (ε : ℝ≥0) (hε : 0 < ε) (F G : filtration (ℒ ϖ) c) :
  G ∈ (U c F (geom_B c (ε / (2 : ℝ) ^ p.1) (pos_ε_pow ε hε))) → ∥ ((θ_c c ϖ G) : (ℳ ϖ)) - (θ_c c ϖ) F ∥ < ε :=
begin
  intro h_mem_G,
  rw real_measures.norm_def,
  simp only [fintype.univ_punit, real_measures.sub_apply, finset.sum_singleton],
  rw [← real.rpow_lt_rpow_iff _ _ _, ← real.rpow_mul,
    mul_inv_cancel, real.rpow_one],
  rotate,
  { rw ← nnreal.coe_zero,
    exact ne_of_gt (nnreal.coe_lt_coe.mpr (fact.out _)) },
  { apply norm_nonneg },
  { apply real.rpow_nonneg_of_nonneg (norm_nonneg _) },
  { rw ← nnreal.coe_zero,
    exact ε.2 },
  { rw [inv_pos, ← nnreal.coe_zero],
    exact (nnreal.coe_lt_coe.mpr (fact.out _)) },
  simp only [θ_c, one_mul, eq_mpr_eq_cast, set_coe_cast, subtype.coe_mk],
  dsimp only [θ, ϑ],
  have h_B : ∀ b : ℤ, b < (geom_B p c (ε / 2 ^ p.1) (pos_ε_pow p ε hε)) → ((G punit.star b) : ℝ) - (F punit.star b) = 0,
  { intros b hb,
    simp only [h_mem_G punit.star b hb, sub_self] },
  rw [← tsum_sub],
  rotate,
  {exact (aux_summability_no_norm p c G)},
  {exact (aux_summability_no_norm p c F)},
  simp_rw [← sub_mul],
  set B := (geom_B p c (ε / 2 ^ p.1) (pos_ε_pow p ε hε)) with def_B,
  let f := λ b : ℤ, ((((G : (ℒ ϖ)) punit.star b) - ((F : (ℒ ϖ)) punit.star b)) : ℝ)
    * 2⁻¹ ^ b,
  let g : ({ b : ℤ | B ≤ b}) → ℝ := f ∘ coe,
  let i : function.support g → ℤ := (coe : { b : ℤ | B ≤ b} → ℤ) ∘ (coe : function.support g → { b : ℤ | B ≤ b}),
  have hi : ∀ ⦃x y : ↥(function.support g)⦄, i x = i y → ↑x = ↑y,
  {intros _ _ h,
    simp only [subtype.coe_inj] at h,
    rwa [subtype.coe_inj] },
  have hf : function.support f ⊆ set.range i,
  { intros a ha,
    simp only [f, function.mem_support, ne.def] at ha,
    have ha' : B ≤ a,
    { by_contra',
      specialize h_B a this,
      simp only [one_div, inv_zpow', zpow_neg, mul_eq_zero, inv_eq_zero, not_or_distrib] at ha,
      replace ha := ha.1,
      simpa only },
    simp only [set.mem_set_of_eq, function.mem_support, ne.def, set.mem_range, set_coe.exists],
    use [a, ha', ha, refl _] },
  have hF := tail_B p c (ε.1 / 2 ^ p.1) (pos_ε_pow p ε hε) F,
  have hG := tail_B p c (ε.1 / 2 ^ p.1) (pos_ε_pow p ε hε) G,
  have h02 : (0 : ℝ) ≤ 2 := two_pos.le,
  have h02p : (0 : ℝ) ≤ 2 ^ p.val := real.rpow_nonneg_of_nonneg h02 _,
  rw [real.div_rpow ε.2 h02p, ← real.rpow_mul h02] at hF hG,
  simp_rw [@subtype.val_eq_coe _ _ p] at hF hG,
  have hp0 : (p : ℝ) ≠ 0 := nnreal.coe_ne_zero.mpr (ne_of_gt (fact.out _)),
  rw [mul_inv_cancel hp0, real.rpow_one] at hF hG,
  rw [tsum_eq_tsum_of_ne_zero_bij i hi hf (λ _, refl _)],
  dsimp only [f, g],
  rw [tsum_subtype_sub],
  rotate,
  { exact (aux_summability_subtype p c F B) },
  { exact (aux_summability_subtype p c G B) },
  apply lt_of_le_of_lt (norm_sub_le _ _),
  convert add_lt_add hG hF,
  simp only [nnreal.val_eq_coe, add_halves'],
end

lemma coe_pow_half (η : ℝ) (η_pos' : 0 < η) (η₀ : ℝ≥0) (hη₀ : η₀ = ⟨η, le_of_lt η_pos'⟩) :
  (η / 2) ^ (p : ℝ) = ((η₀ ^ (p : ℝ) : ℝ)) / 2 ^ (p.1) := by {rw [real.div_rpow (le_of_lt η_pos') _,
     nnreal.val_eq_coe, hη₀, subtype.coe_mk], simp only [zero_le_bit0, zero_le_one]}

section
variables {c}

def ξ (F : filtration (ℒ ϖ) c) : ℝ :=
(homeo_filtration_ϖ_ball c) (θ_c c (Fintype.of punit) F)

def hξ (F : filtration (ℒ ϖ) c) :
  ξ F = (homeo_filtration_ϖ_ball c) (θ_c c (Fintype.of punit) F) := rfl

lemma speed_aux' (ε η : ℝ) (η₀ : ℝ≥0) (hη₀ : η = η₀)
  (y : (closed_ball (0 : ℝ) (c ^ (p : ℝ)⁻¹)))
  (F G : (filtration (ℒ (Fintype.of punit)) c))
  (hF : |(((homeo_filtration_ϖ_ball c) (θ_c c (Fintype.of punit) F)) : ℝ) - y| < ε)
  (hη : η = ε - |(homeo_filtration_ϖ_ball c (θ_c c ϖ F)) - y|) (h_pos : 0 < (η / 2) ^ (p : ℝ))
  (h_pos : 0 < (η / 2) ^ (p:ℝ))
  (hp : 0 < (p:ℝ))
  (η_pos' : 0 < η)
  (h_η_η₀ : (η / 2) ^ (p:ℝ) = ↑η₀ ^ (p:ℝ) / 2 ^ p.val) (h_pos'')
  (hG : G ∈ U c F (geom_B c ((↑η₀ ^ (p:ℝ) / 2 ^ p.val)) h_pos'')) :
  ∥(θ_c c (Fintype.of punit) G).val - (θ_c c (Fintype.of punit) F).val∥ < η ^ (p:ℝ) :=
begin
  have foo : 0 < η₀ ^ (p:ℝ),
  { apply real.rpow_pos_of_pos, rw ← hη₀, exact η_pos' },
  -- exact dist_lt_of_mem_U p c (η₀ ^ (p : ℝ)) (real.rpow_pos_of_pos η_pos' _) F G hG
  have := dist_lt_of_mem_U p c (η₀ ^ (p : ℝ)) foo F G hG,
  convert this,
end

lemma speed_aux (ε η : ℝ) (η₀ : ℝ≥0) (hη₀ : η = η₀)
  (y : (closed_ball (0 : ℝ) (c ^ (p : ℝ)⁻¹)))
  (F G : (filtration (ℒ (Fintype.of punit)) c))
  (hF : |(((homeo_filtration_ϖ_ball c) (θ_c c (Fintype.of punit) F)) : ℝ) - y| < ε)
  (hη : η = ε - |(homeo_filtration_ϖ_ball c (θ_c c ϖ F)) - y|) (h_pos : 0 < (η / 2) ^ (p : ℝ))
  (h_pos : 0 < (η / 2) ^ (p:ℝ))
  (hp : 0 < (p:ℝ))
  (η_pos' : 0 < η)
  (h_η_η₀ : (η / 2) ^ (p:ℝ) = ↑η₀ ^ (p:ℝ) / 2 ^ p.val) (h_pos'')
  (hG : G ∈ U c F (geom_B c ((↑η₀ ^ (p:ℝ) / 2 ^ p.val)) h_pos'')) :
  |ξ G - ξ F| < ε - |ξ F - y| :=
begin
  repeat {rw hξ},
  rw [← real_measures.dist_eq,
    ← real.rpow_lt_rpow_iff
      (real.rpow_nonneg_of_nonneg (real_measures.norm_nonneg _) _) (sub_nonneg.mpr (le_of_lt hF)) hp,
    ← real.rpow_mul (real_measures.norm_nonneg _),
    inv_mul_cancel (ne_of_gt hp), real.rpow_one, ← hη],
  apply speed_aux', assumption'
end

lemma speed (ε η : ℝ) (y : closed_ball (0 : ℝ) (c ^ (p⁻¹ : ℝ)))
  (F G : filtration (ℒ ϖ) c)
  (hF : |(((homeo_filtration_ϖ_ball c) (θ_c c (Fintype.of punit) F)) : ℝ) - y| < ε)
  (hη : η = ε - |(homeo_filtration_ϖ_ball c (θ_c c ϖ F)) - y|) (h_pos : 0 < (η / 2) ^ (p : ℝ))
  (hG : G ∈ U c F (geom_B c ((η / 2) ^ (p:ℝ)) h_pos)) :
  |(ξ G) - (ξ F)| + |(ξ F) - y| < ε - |(ξ F) - y| + |(ξ F) - y| :=
begin
  have hp : 0 < (p : ℝ), { rw [← nnreal.coe_zero, nnreal.coe_lt_coe], from fact.out _ },
  have η_pos' : 0 < η := by {rw hη, from (sub_pos.mpr hF)},
  set η₀ : ℝ≥0 := ⟨η, le_of_lt η_pos'⟩ with hη₀,
  have h_η_η₀ := @coe_pow_half p _ _ η η_pos' η₀ hη₀,
  simp_rw [h_η_η₀] at hG,
  apply add_lt_add_right,
  apply @speed_aux p _ _ c ε η η₀ _ y F G,
  assumption',
  rw hη₀, refl,
end

end

lemma U_subset_preimage' (ε η : ℝ) (y : closed_ball (0 : ℝ) (c ^ (p⁻¹ : ℝ)))
  (F : filtration (ℒ ϖ) c)
  (hF : |(((homeo_filtration_ϖ_ball c) (θ_c c (Fintype.of punit) F)) : ℝ) - y| < ε)
  (hη : η = ε - |(homeo_filtration_ϖ_ball c (θ_c c ϖ F)) - y|) (h_pos : 0 < (η / 2) ^ (p : ℝ))
  (G : (filtration (ℒ (Fintype.of punit)) c))
  (hG : G ∈ U c F (geom_B c ((η / 2) ^ (p:ℝ)) h_pos)) :
  |ξ G - y| < ε :=
begin
  have aux : |(ξ p G) - (ξ p F)| + |(ξ p F) - y | < ε - | (ξ p F) - y | + | (ξ p F) - y |,
  { apply speed; assumption },
  replace aux : |(ξ p G) - (ξ p F)| + |(ξ p F) - y | < ε,
  { rwa [sub_add_cancel ε (| (ξ p F) - y |)] at aux },
  have := lt_of_le_of_lt (abs_sub_le (ξ p G) (ξ p F) y) aux,
  rw ← real.norm_eq_abs at this ⊢,
  exact this,
end

lemma U_subset_preimage (ε η : ℝ) (y : closed_ball (0 : ℝ) (c ^ (p⁻¹ : ℝ)))
  (F : filtration (ℒ ϖ) c)
  (hF : |(((homeo_filtration_ϖ_ball c) (θ_c c (Fintype.of punit) F)) : ℝ) - y| < ε)
  (hη : η = ε - |(homeo_filtration_ϖ_ball c (θ_c c ϖ F)) - y|) (h_pos : 0 < (η / 2) ^ (p : ℝ)) :
  (U c F (geom_B c ((η / 2) ^ (p : ℝ)) h_pos) )  ⊆
    ((homeo_filtration_ϖ_ball c) ∘ θ_c c (ϖ) ⁻¹' (ball y ε)) :=
begin
  intros G hG,
  simp only [set.mem_preimage, one_mul, eq_self_iff_true, eq_mpr_eq_cast, set_coe_cast,
    function.comp_app, mem_ball, subtype.dist_eq, real.dist_eq],
  apply U_subset_preimage'; assumption,
end

-- This is the main continuity property needed in `ses2.lean`
theorem continuous_θ_c (c : ℝ≥0) : continuous (θ_c c S) :=
begin
  apply continuous_of_seval_ℳ_comp_continuous,
  intro s,
  rw ← commute_seval_ℒ_ℳ,
  refine continuous.comp _ (continuous_seval_ℒ_c p S c s),
  apply (homeo_filtration_ϖ_ball c).comp_continuous_iff.mp,
  apply reduction_balls,
  intros y ε,
  rw is_open_iff_forall_mem_open,
  intros F hF,
  simp only [set.mem_preimage, one_mul, eq_self_iff_true, eq_mpr_eq_cast, set_coe_cast,
    function.comp_app, mem_ball, subtype.dist_eq, real.dist_eq] at hF,
  set η := ε - |(homeo_filtration_ϖ_ball c (θ_c p c ϖ F)) - y| with hη,
  have η_pos' : 0 < η := by {rw hη, from (sub_pos.mpr hF)},
  have η_pos : 0 < (η / 2) ^ (p : ℝ) := real.rpow_pos_of_pos (half_pos η_pos') _,
  set V := U p c F (geom_B p c ((η / 2) ^ (p : ℝ)) η_pos) with hV,
  simp_rw [real.div_rpow (le_of_lt η_pos') (le_of_lt (@two_pos ℝ _ _))] at hV,
  use V,
  exact and.intro (U_subset_preimage p c ε η y F hF hη η_pos)
    (and.intro (is_open_U p c F _) (mem_U p c F _)),
end

end theta

end laurent_measures_ses


import tactic

variables {R A : Type*} [comm_semiring R] [semiring A] [algebra R A]

-- I couldn't find this in mathlib

-- lemma alg_hom.eq_of_id (f : R →ₐ[R] A) : f = algebra.of_id R A :=
-- begin
--   have this_will_be_useful := f.commutes,
--   ext r,
--   specialize this_will_be_useful r,
--   unfold algebra_map algebra.to_ring_hom at this_will_be_useful,
--   exact this_will_be_useful,
-- end

lemma alg_hom.eq_of_id (f : R →ₐ[R] A) : f = algebra.of_id R A :=
alg_hom.ext (f.commutes)

instance alg_hom.subsingleton : subsingleton (R →ₐ[R] A) :=
subsingleton.intro $ λ f g, by { rw [alg_hom.eq_of_id f, alg_hom.eq_of_id g], }


import GroundZero.HITs.Interval
import GroundZero.Theorems.UA
import GroundZero.HITs.Merely

open GroundZero.HITs.Interval
open GroundZero.Proto (idfun)
open GroundZero.Types.Equiv
open GroundZero.Structures
open GroundZero.Types

namespace GroundZero
namespace Theorems.Equiv

universe u v w

hott def uniqDoesNotAddNewPaths {A : Type u} (a b : ∥A∥)
  (p : a = b) : HITs.Merely.uniq a b = p :=
propIsSet HITs.Merely.uniq _ _ _ _

hott def propEquiv {A : Type u} (H : prop A) : A ≃ ∥A∥ :=
propEquivLemma H HITs.Merely.uniq HITs.Merely.elem (HITs.Merely.rec H id)

hott def propFromEquiv {A : Type u} : A ≃ ∥A∥ → prop A :=
begin
  intro ⟨f, (⟨g, A⟩, _)⟩ a b; transitivity;
  exact (A a)⁻¹; symmetry; transitivity; exact (A b)⁻¹;
  apply Id.map g; exact HITs.Merely.uniq (f b) (f a)
end

hott def mapToHapply {A : Type u} {B : Type v}
  (c : A) (f g : A → B) (p : f = g) :
  Id.map (λ (f : A → B), f c) p = happly p c :=
begin induction p; reflexivity end

hott def hmtpyRewrite {A : Type u} (f : A → A) (H : f ~ id) (x : A) : H (f x) = Id.map f (H x) :=
begin have p := (Theorems.funext H)⁻¹; induction p; apply Id.symm; apply Equiv.idmap end

hott def qinvImplsIshae {A : Type u} {B : Type v} (f : A → B) : Qinv f → Ishae f :=
begin
  intro ⟨g, ⟨ε, η⟩⟩; let ε' := λ b, (ε (f (g b)))⁻¹ ⬝ (Id.map f (η (g b)) ⬝ ε b);
  existsi g; existsi η; existsi ε'; intro x; symmetry; transitivity;
  { apply Id.map (λ p, _ ⬝ (Id.map f p ⬝ _)); apply hmtpyRewrite (g ∘ f) };
  apply rewriteComp; transitivity; apply Id.map (· ⬝ _); symmetry; apply mapOverComp (g ∘ f);
  symmetry; apply @homotopySquare A B (f ∘ g ∘ f) f (λ x, ε (f x)) (g (f x)) x (η x)
end

hott def respectsEquivOverFst {A : Type u} {B : Type v}
  (φ : A ≃ B) (C : A → Type w) : (Σ x, C x) ≃ (Σ x, C (φ.left x)) :=
begin
  fapply Sigma.replaceIshae; apply qinvImplsIshae; existsi φ.1;
  apply Prod.mk; apply φ.leftForward; apply φ.forwardLeft
end

hott def fibEq {A : Type u} {B : Type v} (f : A → B) {y : B} {a b : A}
  (p : f a = y) (q : f b = y) : (Σ (γ : a = b), Id.map f γ ⬝ q = p) → @Id (fib f y) ⟨a, p⟩ ⟨b, q⟩ :=
begin
  intro ⟨γ, r⟩; fapply Sigma.prod; exact γ; transitivity; apply transportOverContrMap;
  transitivity; apply Id.map (· ⬝ p); apply Id.mapInv; apply rewriteComp; exact r⁻¹
end

hott def ishaeImplContrFib {A : Type u} {B : Type v}
  (f : A → B) : Ishae f → Π y, contr (fib f y) :=
begin
  intro ⟨g, η, ε, τ⟩ y; existsi ⟨g y, ε y⟩; intro ⟨x, p⟩; apply fibEq;
  existsi (Id.map g p)⁻¹ ⬝ η x; transitivity;
  apply Id.map (· ⬝ p); apply mapFunctoriality;
  transitivity; apply Id.map (_ ⬝ · ⬝ p); apply τ;
  transitivity; symmetry; apply Id.assoc; transitivity;
  { apply Id.map (· ⬝ _); transitivity; apply Id.mapInv;
    apply Id.map; symmetry; apply mapOverComp };
  apply rewriteComp; transitivity; apply Id.map (_ ⬝ ·);
  symmetry; apply idmap; apply homotopySquare
end

hott def compQinv₁ {A : Type u} {B : Type v} {C : Type w}
  (f : A → B) (g : B → A) (H : isQinv f g) :
  @Qinv (C → A) (C → B) (f ∘ ·) :=
begin
  existsi (g ∘ ·); apply Prod.mk <;> intro <;>
  apply Theorems.funext <;> intro; apply H.1; apply H.2
end

hott def compQinv₂ {A : Type u} {B : Type v} {C : Type w}
  (f : A → B) (g : B → A) (H : isQinv f g) :
  @Qinv (B → C) (A → C) (· ∘ f) :=
begin
  existsi (· ∘ g) <;> apply Prod.mk <;> intro G <;>
  apply Theorems.funext <;> intro <;>
  apply Id.map G; apply H.2; apply H.1
end

hott def linvContr {A : Type u} {B : Type v}
  (f : A → B) (H : Qinv f) : contr (linv f) :=
begin
  apply contrRespectsEquiv;
  { apply Equiv.symm; apply Sigma.respectsEquiv;
    intro g; symmetry; apply @Theorems.full A (λ _, A) (g ∘ f) };
  apply ishaeImplContrFib; apply qinvImplsIshae;
  fapply compQinv₂; exact H.1; exact H.2
end

hott def rinvContr {A : Type u} {B : Type v}
  (f : A → B) (H : Qinv f) : contr (rinv f) :=
begin
  apply contrRespectsEquiv;
  { apply Equiv.symm; apply Sigma.respectsEquiv;
    intro g; symmetry; apply @Theorems.full B (λ _, B) (f ∘ g) };
  apply ishaeImplContrFib; apply qinvImplsIshae;
  fapply compQinv₁; exact H.1; exact H.2
end

hott def productContr {A : Type u} {B : Type v} (h : contr A) (g : contr B) : contr (A × B) :=
begin existsi (h.1, g.1); intro p; fapply Product.prod; apply h.2; apply g.2 end

hott def biinvProp {A : Type u} {B : Type v} (f : A → B) : prop (biinv f) :=
begin
  apply lemContr; intro g; apply productContr;
  { apply linvContr; apply Qinv.ofBiinv; assumption };
  { apply rinvContr; apply Qinv.ofBiinv; assumption }
end

hott def equivHmtpyLem {A : Type u} {B : Type v}
  (f g : A ≃ B) (H : f.forward ~ g.forward) : f = g :=
begin fapply Sigma.prod; apply Theorems.funext; exact H; apply biinvProp end

hott def propEquivProp {A B : Type u} (G : prop B) : prop (A ≃ B) :=
begin intros f g; apply equivHmtpyLem; intro x; apply G end

hott def propExercise (π : Type u) : prop π ≃ (π ≃ ∥π∥) :=
begin
  existsi @propEquiv π; apply Prod.mk <;> existsi propFromEquiv;
  { intro x; apply propIsProp };
  { intro f; apply equivHmtpyLem;
    intro x; apply HITs.Merely.uniq }
end

hott def lemContrInv {A : Type u} (h : prop A) (x : A) : contr A := ⟨x, h x⟩

hott def lemContrEquiv {A : Type u} : (prop A) ≃ (A → contr A) :=
begin
  apply propEquivLemma; apply propIsProp; apply functionToContr;
  apply lemContrInv; apply lemContr
end

hott def contrToType {A : Type u} {B : A → Type v}
  (H : contr A) : (Σ x, B x) → B H.1 :=
λ w, subst (H.2 w.1)⁻¹ w.2

hott def typeToContr {A : Type u} {B : A → Type v}
  (H : contr A) : B H.1 → (Σ x, B x) :=
λ u, ⟨H.1, u⟩

-- HoTT 3.20
hott def contrFamily {A : Type u} {B : A → Type v} (H : contr A) : (Σ x, B x) ≃ B H.1 :=
begin
  existsi contrToType H; apply Prod.mk <;>
  existsi @typeToContr A B H <;> intro x;
  { fapply Sigma.prod; apply H.2; apply transportBackAndForward };
  { transitivity; apply Id.map (subst · x);
    apply propIsSet (contrImplProp H) _ _ _ (idp _);
    reflexivity }
end

hott def propset.Id (A B : Ω) (H : A.1 = B.1) : A = B :=
Sigma.prod H (propIsProp _ _)

noncomputable hott def propEqProp {A B : Type u} (G : prop B) : prop (A = B) :=
begin apply propRespectsEquiv; apply GroundZero.ua.univalence A B; apply propEquivProp G end

noncomputable hott def propsetIsSet : hset propset :=
begin
  intro ⟨x, H⟩ ⟨y, G⟩; apply transport (λ π, Π (p q : π), p = q);
  symmetry; apply GroundZero.ua; apply Sigma.sigmaPath;
  intro ⟨p, p'⟩ ⟨q, q'⟩; fapply Sigma.prod;
  { apply propEqProp; exact G };
  { apply propIsSet; apply propIsProp }
end

hott def hsetEquiv {A : Type u} {B : Type v} (g : hset B) : hset (A ≃ B) :=
begin
  fapply hsetRespectsSigma;
  { apply piHset; intro x; assumption };
  { intro x; apply propIsSet; apply biinvProp }
end

hott def bool.decode : 𝟐 ≃ 𝟐 → 𝟐 :=
λ e, e false

hott def bool.encode : 𝟐 → 𝟐 ≃ 𝟐
| false => ideqv 𝟐
| true  => ua.negBoolEquiv

hott def zeroEquiv.hset (A B : 0-Type) : hset (A ≃₀ B) :=
begin apply hsetEquiv; apply zeroEqvSet.forward; exact B.2 end

hott def boolEquivEqvBool : (𝟐 ≃ 𝟐) ≃ 𝟐 :=
begin
  existsi bool.decode; fapply Qinv.toBiinv; existsi bool.encode; apply Prod.mk;
  { intro x; induction x using Bool.casesOn <;> reflexivity };
  { intro ⟨φ, H⟩; apply equivHmtpyLem; intro x;
    match boolEqTotal (φ false), boolEqTotal (φ true) with
    | Sum.inl p₁, Sum.inl q₁ => _
    | Sum.inr p₂, Sum.inl q₁ => _
    | Sum.inl p₁, Sum.inr q₂ => _
    | Sum.inr p₂, Sum.inr q₂ => _;
    -- TODO: apply “or” here somehow
    { apply Proto.Empty.elim; apply ffNeqTt;
      apply eqvInj ⟨φ, H⟩; exact p₁ ⬝ q₁⁻¹ };
    { apply Id.trans; apply Id.map (bool.encode · x); apply p₂;
      symmetry; induction x using Bool.casesOn <;> assumption };
    { apply Id.trans; apply Id.map (bool.encode · x); apply p₁;
      symmetry; induction x using Bool.casesOn <;> assumption };
    { apply Proto.Empty.elim; apply ffNeqTt;
      apply eqvInj ⟨φ, H⟩; exact p₂ ⬝ q₂⁻¹ } }
end

hott def contrQinvFib {A : Type u} {B : Type v} (w : Qinv.eqv A B) (b : B) : contr (Σ a, b = w.1 a) :=
begin apply contrRespectsEquiv; apply respectsEquivOverFst (Qinv.toEquiv (Qinv.inv w)) (Id b); apply singl.contr end

hott def propQinvFib {A : Type u} {B : Type v} (w : Qinv.eqv A B) (b : B) : prop (Σ a, b = w.1 a) :=
contrImplProp (contrQinvFib w b)

hott def corrRev {A : Type u} {B : Type v} : Corr A B → Corr B A :=
λ w, ⟨λ a b, w.1 b a, (w.2.2, w.2.1)⟩

hott def corrOfQinv {A : Type u} {B : Type v} : Qinv.eqv A B → Corr A B :=
begin
  intro w; existsi (λ a b, b = w.1 a); apply Prod.mk <;> intros;
  apply contrRespectsEquiv; apply Sigma.hmtpyInvEqv; apply singl.contr;
  apply contrQinvFib
end

hott def qinvOfCorr {A : Type u} {B : Type v} : Corr A B → Qinv.eqv A B :=
begin
  intro w; fapply Sigma.mk; intro a; apply (w.2.1 a).1.1;
  fapply Sigma.mk; intro b; apply (w.2.2 b).1.1; apply Prod.mk;
  { intro b; apply Id.map Sigma.fst ((w.2.1 (w.2.2 b).1.1).2 ⟨b, (w.2.2 b).1.2⟩) };
  { intro a; apply Id.map Sigma.fst ((w.2.2 (w.2.1 a).1.1).2 ⟨a, (w.2.1 a).1.2⟩) }
end

section
  variable {A : Type u} {B : Type v} (e : Qinv.eqv A B)

  example : (qinvOfCorr (corrOfQinv e)).1 = e.1     := by reflexivity
  example : (qinvOfCorr (corrOfQinv e)).2.1 = e.2.1 := by reflexivity
end

section
  variable {A : Type u} {B : Type v}

  hott def corrOfBiinv : A ≃ B → Corr A B :=
  λ e, @corrOfQinv A B ⟨e.1, Qinv.ofBiinv e.1 e.2⟩

  hott def biinvOfCorr : Corr A B → A ≃ B :=
  Qinv.toEquiv ∘ qinvOfCorr

  hott def corrLem (R : A → B → Type w) (φ : A → B) (ρ : Π x, R x (φ x))
    (H : Π x y, R x y → φ x = y) (c : Π (x : A) (y : B) (w : R x y), ρ x =[H x y w] w)
    (x : A) (y : B) : (φ x = y) ≃ (R x y) :=
  begin
    fapply Sigma.mk; { intro p; apply transport (R x) p; apply ρ }; fapply Qinv.toBiinv;
    fapply Sigma.mk; intro r; exact (H x (φ x) (ρ x))⁻¹ ⬝ H x y r; apply Prod.mk;
    { intro r; dsimp; transitivity; apply Id.map; symmetry; apply c x (φ x) (ρ x);
      transitivity; apply substComp; transitivity; apply Id.map (subst (H x y r));
      apply transportForwardAndBack; apply c };
    { intro p; induction p; apply Id.invComp }
  end

  noncomputable hott def corrBiinvIdfun : corrOfBiinv ∘ @biinvOfCorr A B ~ idfun :=
  begin
    intro w; fapply Sigma.prod;
    apply Theorems.funext; intro x; apply Theorems.funext; intro y;
    change (y = (w.2.1 x).1.1) = (w.1 x y); apply ua; apply Equiv.trans;
    apply inveqv; fapply corrLem w.1 (λ x, (w.2.1 x).1.1) (λ x, (w.2.1 x).1.2)
      (λ x y ρ, Id.map Sigma.fst ((w.2.1 x).2 ⟨y, ρ⟩));
    { intros x y ρ; change _ = _; transitivity; symmetry;
      apply transportComp (w.1 x) Sigma.fst ((w.2.1 x).2 ⟨y, ρ⟩);
      apply apd Sigma.snd };
    apply productProp <;> { apply piProp; intros; apply contrIsProp }
  end

  hott def biinvCorrIdfun : biinvOfCorr ∘ @corrOfBiinv A B ~ idfun :=
  begin intro e; fapply equivHmtpyLem; intro; reflexivity end

  noncomputable hott def biinvEquivCorr : Corr A B ≃ (A ≃ B) :=
  begin
    existsi biinvOfCorr; fapply Qinv.toBiinv; existsi corrOfBiinv;
    apply Prod.mk; apply biinvCorrIdfun; apply corrBiinvIdfun
  end
end

end Theorems.Equiv
end GroundZero


-- See: https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/OO.20polymorphism.3F/near/297629381
namespace O4

inductive Geo_Type
| Point2D
| Point3D
| Point4D
| Square2D
deriving DecidableEq

open Geo_Type

structure Slots_Point2D where
  (x y : Float)
  deriving Repr

structure Slots_Point3D extends Slots_Point2D where
  z : Float
  deriving Repr

structure Slots_Point4D extends Slots_Point3D where
  w : Float
  deriving Repr

structure Slots_Square2D extends Slots_Point2D where
  width : Float
  deriving Repr

universe u

def Geo_Type.Slots : Geo_Type → Type
| Point2D => Slots_Point2D
| Point3D => Slots_Point3D
| Point4D => Slots_Point4D
| Square2D => Slots_Square2D

open Geo_Type

def toRepr : (T : Geo_Type) → Repr T.Slots
| Point2D => instReprSlots_Point2D
| Point3D => instReprSlots_Point3D
| Point4D => instReprSlots_Point4D
| Square2D => instReprSlots_Square2D

/-- Get casting function to first type from second type -/
def Geo_Type.cast : (t : Geo_Type) → (t' : Geo_Type) → Option (t'.Slots → t.Slots)
| Point2D, Point2D => some id
| Point2D, Point3D => some (λ x => x.toSlots_Point2D)
| Point3D, Point3D => some id
| Point2D, Point4D => some (λ x => x.toSlots_Point2D)
| Point3D, Point4D => some (λ x => x.toSlots_Point3D)
| Point4D, Point4D => some id
| Point2D, Square2D => some (λ x => x.toSlots_Point2D)
| Square2D, Square2D => some id
| _, _ => none

/-- Whether the second type is a subtype of the first. -/
def Geo_Type.supertype (t t' : Geo_Type) : Bool := (t.cast t').isSome

theorem Geo_Type.supertype.trans (h : Geo_Type.supertype t t') (h' : Geo_Type.supertype t' t'') :
  Geo_Type.supertype t t'' :=
by
  cases t
  all_goals
    cases t'
    all_goals
      cases t''
      all_goals
        simp at h
        try simp at h'
        try simp

def Option.get : (x : Option α) → x.isSome → α
| some v, _ => v
| none, h => by simp [Option.isSome] at h

/-- Get the cast function from a proof that `t'` is a subtype of `t`. -/
def Geo_Type.supertype.cast (h : Geo_Type.supertype t t') : t'.Slots → t.Slots :=
  Option.get (Geo_Type.cast t t') h

/-- Objects of subtype t -/
structure Obj (t : Geo_Type) where
  ty : Geo_Type
  sub : Geo_Type.supertype t ty
  slots : ty.Slots

instance : Coe Slots_Point2D (Obj Point2D) where coe s := ⟨Point2D, rfl, s⟩
instance : Coe Slots_Point3D (Obj Point3D) where coe s := ⟨Point3D, rfl, s⟩
instance : Coe Slots_Point4D (Obj Point4D) where coe s := ⟨Point4D, rfl, s⟩
instance : Coe Slots_Square2D (Obj Square2D) where coe s := ⟨Square2D, rfl, s⟩

/-- Extract the slots from an `Obj`. -/
def Obj.get (o : Obj t) : t.Slots := Geo_Type.supertype.cast o.sub o.slots

/-- Cast up, which can be done statically. -/
def Obj.cast_up (o : Obj t) (h : Geo_Type.supertype t' t := by rfl) : Obj t' where
  ty := o.ty
  sub := Geo_Type.supertype.trans h o.sub
  slots := o.slots

def Obj.can_cast (o : Obj t) (t' : Geo_Type) : Bool := Geo_Type.supertype t' o.ty

/-- Cast up or down using run-time information. -/
def Obj.cast (o : Obj t) (h : o.can_cast t') : Obj t' where
  ty := o.ty
  sub := h
  slots := o.slots

/-- Example using a run-time cast. -/
def Obj.get_w (o : Obj Point2D) : Float :=
  if h : o.can_cast Point4D then
    (o.cast h).get.w
  else
    0

#eval ({x := 1, y := 2 : Slots_Point2D} : Obj Point2D).get_w
-- 0.000000

#eval Id.run do
  let p := ({x := 1, y := 2, z := 3, w := 4 : Slots_Point4D} : Obj Point4D)
  return p.cast_up.get_w
-- 4.000000

def s2: Slots_Point2D := {x := 1, y := 2}
#eval s2

def o2: Obj Point2D := s2
#eval o2.slots

end O4


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

# Preorder homomorphisms

Bundled monotone functions, `x ≤ y → f x ≤ f y`.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.logic.function.iterate
import Mathlib.order.basic
import Mathlib.order.bounded_lattice
import Mathlib.order.complete_lattice
import Mathlib.tactic.monotonicity.default
import Mathlib.PostPort

universes u_1 u_2 l u_3

namespace Mathlib

/-! # Category of preorders -/

/-- Bundled monotone (aka, increasing) function -/
structure preorder_hom (α : Type u_1) (β : Type u_2) [preorder α] [preorder β] where
  to_fun : α → β
  monotone' : monotone to_fun

infixr:25 " →ₘ " => Mathlib.preorder_hom

namespace preorder_hom

protected instance has_coe_to_fun {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] :
    has_coe_to_fun (α →ₘ β) :=
  has_coe_to_fun.mk (fun (f : α →ₘ β) => α → β) to_fun

theorem monotone {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (f : α →ₘ β) :
    monotone ⇑f :=
  monotone' f

@[simp] theorem coe_fun_mk {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] {f : α → β}
    (hf : monotone f) (x : α) : coe_fn (mk f hf) x = f x :=
  rfl

theorem ext {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (f : α →ₘ β) (g : α →ₘ β)
    (h : ∀ (a : α), coe_fn f a = coe_fn g a) : f = g :=
  sorry

theorem coe_inj {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (f : α →ₘ β) (g : α →ₘ β)
    (h : ⇑f = ⇑g) : f = g :=
  ext f g
    fun (a : α) =>
      eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn f a = coe_fn g a)) h)) (Eq.refl (coe_fn g a))

/-- The identity function as bundled monotone function. -/
def id {α : Type u_1} [preorder α] : α →ₘ α := mk id monotone_id

protected instance inhabited {α : Type u_1} [preorder α] : Inhabited (α →ₘ α) := { default := id }

@[simp] theorem coe_id {α : Type u_1} [preorder α] : ⇑id = ⇑id := rfl

/-- The composition of two bundled monotone functions. -/
def comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} [preorder α] [preorder β] [preorder γ]
    (g : β →ₘ γ) (f : α →ₘ β) : α →ₘ γ :=
  mk (⇑g ∘ ⇑f) sorry

@[simp] theorem comp_id {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (f : α →ₘ β) :
    comp f id = f :=
  ext (comp f id) f fun (a : α) => Eq.refl (coe_fn (comp f id) a)

@[simp] theorem id_comp {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (f : α →ₘ β) :
    comp id f = f :=
  ext (comp id f) f fun (a : α) => Eq.refl (coe_fn (comp id f) a)

/-- `subtype.val` as a bundled monotone function.  -/
def subtype.val {α : Type u_1} [preorder α] (p : α → Prop) : Subtype p →ₘ α := mk subtype.val sorry

/-- The preorder structure of `α →ₘ β` is pointwise inequality: `f ≤ g ↔ ∀ a, f a ≤ g a`. -/
protected instance preorder {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] :
    preorder (α →ₘ β) :=
  preorder.lift to_fun

protected instance partial_order {α : Type u_1} [preorder α] {β : Type u_2} [partial_order β] :
    partial_order (α →ₘ β) :=
  partial_order.lift to_fun sorry

protected instance has_sup {α : Type u_1} [preorder α] {β : Type u_2} [semilattice_sup β] :
    has_sup (α →ₘ β) :=
  has_sup.mk fun (f g : α →ₘ β) => mk (fun (a : α) => coe_fn f a ⊔ coe_fn g a) sorry

protected instance semilattice_sup {α : Type u_1} [preorder α] {β : Type u_2} [semilattice_sup β] :
    semilattice_sup (α →ₘ β) :=
  semilattice_sup.mk has_sup.sup partial_order.le partial_order.lt sorry sorry sorry sorry sorry
    sorry

@[simp] theorem has_inf_inf_to_fun {α : Type u_1} [preorder α] {β : Type u_2} [semilattice_inf β]
    (f : α →ₘ β) (g : α →ₘ β) (a : α) : coe_fn (f ⊓ g) a = coe_fn f a ⊓ coe_fn g a :=
  Eq.refl (coe_fn (f ⊓ g) a)

protected instance semilattice_inf {α : Type u_1} [preorder α] {β : Type u_2} [semilattice_inf β] :
    semilattice_inf (α →ₘ β) :=
  semilattice_inf.mk has_inf.inf partial_order.le partial_order.lt sorry sorry sorry sorry sorry
    sorry

protected instance lattice {α : Type u_1} [preorder α] {β : Type u_2} [lattice β] :
    lattice (α →ₘ β) :=
  lattice.mk semilattice_sup.sup semilattice_sup.le semilattice_sup.lt sorry sorry sorry sorry sorry
    sorry semilattice_inf.inf sorry sorry sorry

protected instance has_bot {α : Type u_1} [preorder α] {β : Type u_2} [order_bot β] :
    has_bot (α →ₘ β) :=
  has_bot.mk (mk (fun (a : α) => ⊥) sorry)

protected instance order_bot {α : Type u_1} [preorder α] {β : Type u_2} [order_bot β] :
    order_bot (α →ₘ β) :=
  order_bot.mk ⊥ partial_order.le partial_order.lt sorry sorry sorry sorry

@[simp] theorem has_top_top_to_fun {α : Type u_1} [preorder α] {β : Type u_2} [order_top β]
    (a : α) : coe_fn ⊤ a = ⊤ :=
  Eq.refl (coe_fn ⊤ a)

protected instance order_top {α : Type u_1} [preorder α] {β : Type u_2} [order_top β] :
    order_top (α →ₘ β) :=
  order_top.mk ⊤ partial_order.le partial_order.lt sorry sorry sorry sorry

protected instance has_Inf {α : Type u_1} [preorder α] {β : Type u_2} [complete_lattice β] :
    has_Inf (α →ₘ β) :=
  has_Inf.mk
    fun (s : set (α →ₘ β)) => mk (fun (x : α) => Inf ((fun (f : α →ₘ β) => coe_fn f x) '' s)) sorry

@[simp] theorem has_Sup_Sup_to_fun {α : Type u_1} [preorder α] {β : Type u_2} [complete_lattice β]
    (s : set (α →ₘ β)) (x : α) : coe_fn (Sup s) x = Sup ((fun (f : α →ₘ β) => coe_fn f x) '' s) :=
  Eq.refl (coe_fn (Sup s) x)

protected instance complete_lattice {α : Type u_1} [preorder α] {β : Type u_2}
    [complete_lattice β] : complete_lattice (α →ₘ β) :=
  complete_lattice.mk lattice.sup lattice.le lattice.lt sorry sorry sorry sorry sorry sorry
    lattice.inf sorry sorry sorry order_top.top sorry order_bot.bot sorry Sup Inf sorry sorry sorry
    sorry

theorem iterate_sup_le_sup_iff {α : Type u_1} [semilattice_sup α] (f : α →ₘ α) :
    (∀ (n₁ n₂ : ℕ) (a₁ a₂ : α),
          nat.iterate (⇑f) (n₁ + n₂) (a₁ ⊔ a₂) ≤ nat.iterate (⇑f) n₁ a₁ ⊔ nat.iterate (⇑f) n₂ a₂) ↔
        ∀ (a₁ a₂ : α), coe_fn f (a₁ ⊔ a₂) ≤ coe_fn f a₁ ⊔ a₂ :=
  sorry

end Mathlib


class Inc (α : Type) :=
(inc : α → α)

export Inc (inc)

instance {α} [Inc α] : Inc (List α) :=
{ inc := (·.map inc) }

instance : Inc Nat :=
{ inc := Nat.succ }

#eval inc 10
#eval inc [1, 2, 3]

theorem ex1 : [(1, "hello"), (2, "world")].map (·.1) = [1, 2] :=
rfl

theorem ex2 : [(1, "hello"), (2, "world")].map (·.snd) = ["hello", "world"] :=
rfl

def sum (xs : List Nat) : Nat :=
(·.2) $ Id.run $ StateT.run (s:=0) do
  xs.forM fun x => modify (· + x)

#eval sum [1, 2, 3, 4]

theorem ex3 : sum [1, 2, 3] = 6 :=
rfl

theorem ex4 : sum [1, 2, 3, 4] = 10 :=
rfl


example (p : Prop) [Decidable p] (hnp : ¬ p) :
    if decide p then 0 = 1 else 1 = 1 := by
  simp [hnp, decideEqFalse Unit]


/-
Copyright (c) 2019 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot

! This file was ported from Lean 3 source module tactic.rename_var
! leanprover-community/mathlib commit 591a0a006de5e8fe75b1c55258123d91dd416b2d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.Interactive

/-!
# Rename bound variable tactic

This files defines a tactic `rename_var` whose main purpose is to teach
renaming of bound variables.

* `rename_var old new` renames all bound variables named `old` to `new` in the goal.
* `rename_var old new at h` does the same in hypothesis `h`.

```lean
example (P : ℕ →  ℕ → Prop) (h : ∀ n, ∃ m, P n m) : ∀ l, ∃ m, P l m :=
begin
  rename_var n q at h, -- h is now ∀ (q : ℕ), ∃ (m : ℕ), P q m,
  rename_var m n, -- goal is now ∀ (l : ℕ), ∃ (n : ℕ), P k n,
  exact h -- Lean does not care about those bound variable names
end
```

## Tags

teaching, tactic
-/

open Expr

/-- Rename bound variable `old` to `new` in an `expr`-/
unsafe def expr.rename_var (old new : Name) : expr → expr
  | pi n bi t b => pi (if n = old then new else n) bi (expr.rename_var t) (expr.rename_var b)
  | lam n bi t b => lam (if n = old then new else n) bi (expr.rename_var t) (expr.rename_var b)
  | app t b => app (expr.rename_var t) (expr.rename_var b)
  | e => e
#align expr.rename_var expr.rename_var

namespace Tactic

/-- Rename bound variable `old` to `new` in goal -/
unsafe def rename_var_at_goal (old new : Name) : tactic Unit := do
  let old_tgt ← target
  tactic.change (expr.rename_var old new old_tgt)
#align tactic.rename_var_at_goal tactic.rename_var_at_goal

/-- Rename bound variable `old` to `new` in assumption `h` -/
unsafe def rename_var_at_hyp (old new : Name) (e : expr) : tactic Unit := do
  let old_e ← infer_type e
  tactic.change_core (expr.rename_var old new old_e) (some e)
#align tactic.rename_var_at_hyp tactic.rename_var_at_hyp

end Tactic

namespace Tactic.Interactive

open Tactic

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
/-- `rename_var old new` renames all bound variables named `old` to `new` in the goal.
`rename_var old new at h` does the same in hypothesis `h`.
-/
unsafe def rename_var (old : parse ident) (new : parse ident) (l : parse location) : tactic Unit :=
  l.apply (rename_var_at_hyp old new) (rename_var_at_goal old new)
#align tactic.interactive.rename_var tactic.interactive.rename_var

end Tactic.Interactive

/-- `rename_var old new` renames all bound variables named `old` to `new` in the goal.
`rename_var old new at h` does the same in hypothesis `h`.
This is meant for teaching bound variables only. Such a renaming should never be relevant to Lean.

```lean
example (P : ℕ →  ℕ → Prop) (h : ∀ n, ∃ m, P n m) : ∀ l, ∃ m, P l m :=
begin
  rename_var n q at h, -- h is now ∀ (q : ℕ), ∃ (m : ℕ), P q m,
  rename_var m n, -- goal is now ∀ (l : ℕ), ∃ (n : ℕ), P k n,
  exact h -- Lean does not care about those bound variable names
end
```
-/
add_tactic_doc
  { Name := "rename_var"
    category := DocCategory.tactic
    declNames := [`tactic.interactive.rename_var]
    tags := ["renaming"] }