/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Kenny Lau, Johan Commelin, Mario Carneiro, Kevin Buzzard

! This file was ported from Lean 3 source module deprecated.submonoid
! leanprover-community/mathlib commit 509de852e1de55e1efa8eacfa11df0823f26f226
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.GroupTheory.Submonoid.Basic
import Mathlib.Algebra.BigOperators.Basic
import Mathlib.Deprecated.Group

/-!
# Unbundled submonoids (deprecated)

This file is deprecated, and is no longer imported by anything in mathlib other than other
deprecated files, and test files. You should not need to import it.

This file defines unbundled multiplicative and additive submonoids. Instead of using this file,
please use `Submonoid G` and `AddSubmonoid A`, defined in `GroupTheory.Submonoid.Basic`.

## Main definitions

`IsAddSubmonoid (S : Set M)` : the predicate that `S` is the underlying subset of an additive
submonoid of `M`. The bundled variant `AddSubmonoid M` should be used in preference to this.

`IsSubmonoid (S : Set M)` : the predicate that `S` is the underlying subset of a submonoid
of `M`. The bundled variant `Submonoid M` should be used in preference to this.

## Tags
Submonoid, Submonoids, IsSubmonoid
-/

open BigOperators

variable {M : Type _} [Monoid M] {s : Set M}

variable {A : Type _} [AddMonoid A] {t : Set A}

/-- `s` is an additive submonoid: a set containing 0 and closed under addition.
Note that this structure is deprecated, and the bundled variant `AddSubmonoid A` should be
preferred. -/
structure IsAddSubmonoid (s : Set A) : Prop where
  /-- The proposition that s contains 0. -/
  zero_mem : (0 : A) ∈ s
  /-- The proposition that s is closed under addition. -/
  add_mem {a b} : a ∈ s → b ∈ s → a + b ∈ s
#align is_add_submonoid IsAddSubmonoid

/-- `s` is a submonoid: a set containing 1 and closed under multiplication.
Note that this structure is deprecated, and the bundled variant `Submonoid M` should be
preferred. -/
@[to_additive]
structure IsSubmonoid (s : Set M) : Prop where
  /-- The proposition that s contains 1. -/
  one_mem : (1 : M) ∈ s
  /-- The proposition that s is closed under multiplication. -/
  mul_mem {a b} : a ∈ s → b ∈ s → a * b ∈ s
#align is_submonoid IsSubmonoid

theorem Additive.isAddSubmonoid {s : Set M} :
    ∀ _ : IsSubmonoid s, @IsAddSubmonoid (Additive M) _ s
  | ⟨h₁, h₂⟩ => ⟨h₁, @h₂⟩
#align additive.is_add_submonoid Additive.isAddSubmonoid

theorem Additive.isAddSubmonoid_iff {s : Set M} :
    @IsAddSubmonoid (Additive M) _ s ↔ IsSubmonoid s :=
  ⟨fun ⟨h₁, h₂⟩ => ⟨h₁, @h₂⟩, Additive.isAddSubmonoid⟩
#align additive.is_add_submonoid_iff Additive.isAddSubmonoid_iff

theorem Multiplicative.isSubmonoid {s : Set A} :
    ∀ _ : IsAddSubmonoid s, @IsSubmonoid (Multiplicative A) _ s
  | ⟨h₁, h₂⟩ => ⟨h₁, @h₂⟩
#align multiplicative.is_submonoid Multiplicative.isSubmonoid

theorem Multiplicative.isSubmonoid_iff {s : Set A} :
    @IsSubmonoid (Multiplicative A) _ s ↔ IsAddSubmonoid s :=
  ⟨fun ⟨h₁, h₂⟩ => ⟨h₁, @h₂⟩, Multiplicative.isSubmonoid⟩
#align multiplicative.is_submonoid_iff Multiplicative.isSubmonoid_iff

/-- The intersection of two submonoids of a monoid `M` is a submonoid of `M`. -/
@[to_additive
      "The intersection of two `AddSubmonoid`s of an `AddMonoid` `M` is an `AddSubmonoid` of M."]
theorem IsSubmonoid.inter {s₁ s₂ : Set M} (is₁ : IsSubmonoid s₁) (is₂ : IsSubmonoid s₂) :
    IsSubmonoid (s₁ ∩ s₂) :=
  { one_mem := ⟨is₁.one_mem, is₂.one_mem⟩
    mul_mem := @fun _ _ hx hy => ⟨is₁.mul_mem hx.1 hy.1, is₂.mul_mem hx.2 hy.2⟩ }
#align is_submonoid.inter IsSubmonoid.inter
#align is_add_submonoid.inter IsAddSubmonoid.inter

/-- The intersection of an indexed set of submonoids of a monoid `M` is a submonoid of `M`. -/
@[to_additive
      "The intersection of an indexed set of `AddSubmonoid`s of an `AddMonoid` `M` is
      an `AddSubmonoid` of `M`."]
theorem IsSubmonoid.interᵢ {ι : Sort _} {s : ι → Set M} (h : ∀ y : ι, IsSubmonoid (s y)) :
    IsSubmonoid (Set.interᵢ s) :=
  { one_mem := Set.mem_interᵢ.2 fun y => (h y).one_mem
    mul_mem := fun h₁ h₂ =>
      Set.mem_interᵢ.2 fun y => (h y).mul_mem (Set.mem_interᵢ.1 h₁ y) (Set.mem_interᵢ.1 h₂ y) }
#align is_submonoid.Inter IsSubmonoid.interᵢ
#align is_add_submonoid.Inter IsAddSubmonoid.interᵢ

/-- The union of an indexed, directed, nonempty set of submonoids of a monoid `M` is a submonoid
    of `M`. -/
@[to_additive
      "The union of an indexed, directed, nonempty set of `AddSubmonoid`s of an `AddMonoid` `M`
      is an `AddSubmonoid` of `M`. "]
theorem isSubmonoid_unionᵢ_of_directed {ι : Type _} [hι : Nonempty ι] {s : ι → Set M}
    (hs : ∀ i, IsSubmonoid (s i)) (Directed : ∀ i j, ∃ k, s i ⊆ s k ∧ s j ⊆ s k) :
    IsSubmonoid (⋃ i, s i) :=
  { one_mem :=
      let ⟨i⟩ := hι
      Set.mem_unionᵢ.2 ⟨i, (hs i).one_mem⟩
    mul_mem := fun ha hb =>
      let ⟨i, hi⟩ := Set.mem_unionᵢ.1 ha
      let ⟨j, hj⟩ := Set.mem_unionᵢ.1 hb
      let ⟨k, hk⟩ := Directed i j
      Set.mem_unionᵢ.2 ⟨k, (hs k).mul_mem (hk.1 hi) (hk.2 hj)⟩ }
#align is_submonoid_Union_of_directed isSubmonoid_unionᵢ_of_directed
#align is_add_submonoid_Union_of_directed isAddSubmonoid_unionᵢ_of_directed

section powers

/-- The set of natural number powers `1, x, x², ...` of an element `x` of a monoid. -/
@[to_additive multiples
      "The set of natural number multiples `0, x, 2x, ...` of an element `x` of an `AddMonoid`."]
def powers (x : M) : Set M :=
  { y | ∃ n : ℕ, x ^ n = y }
#align powers powers
#align multiples multiples

/-- 1 is in the set of natural number powers of an element of a monoid. -/
@[to_additive "0 is in the set of natural number multiples of an element of an `AddMonoid`."]
theorem powers.one_mem {x : M} : (1 : M) ∈ powers x :=
  ⟨0, pow_zero _⟩
#align powers.one_mem powers.one_mem
#align multiples.zero_mem multiples.zero_mem

/-- An element of a monoid is in the set of that element's natural number powers. -/
@[to_additive
      "An element of an `AddMonoid` is in the set of that element's natural number multiples."]
theorem powers.self_mem {x : M} : x ∈ powers x :=
  ⟨1, pow_one _⟩
#align powers.self_mem powers.self_mem
#align multiples.self_mem multiples.self_mem

/-- The set of natural number powers of an element of a monoid is closed under multiplication. -/
@[to_additive
      "The set of natural number multiples of an element of an `AddMonoid` is closed under
      addition."]
theorem powers.mul_mem {x y z : M} : y ∈ powers x → z ∈ powers x → y * z ∈ powers x :=
  fun ⟨n₁, h₁⟩ ⟨n₂, h₂⟩ => ⟨n₁ + n₂, by simp only [pow_add, *]⟩
#align powers.mul_mem powers.mul_mem
#align multiples.add_mem multiples.add_mem

/-- The set of natural number powers of an element of a monoid `M` is a submonoid of `M`. -/
@[to_additive
      "The set of natural number multiples of an element of an `AddMonoid` `M` is
      an `AddSubmonoid` of `M`."]
theorem powers.isSubmonoid (x : M) : IsSubmonoid (powers x) :=
  { one_mem := powers.one_mem
    mul_mem := powers.mul_mem }
#align powers.is_submonoid powers.isSubmonoid
#align multiples.is_add_submonoid multiples.isAddSubmonoid

/-- A monoid is a submonoid of itself. -/
@[to_additive "An `AddMonoid` is an `AddSubmonoid` of itself."]
theorem Univ.isSubmonoid : IsSubmonoid (@Set.univ M) := by constructor <;> simp
#align univ.is_submonoid Univ.isSubmonoid
#align univ.is_add_submonoid Univ.isAddSubmonoid

/-- The preimage of a submonoid under a monoid hom is a submonoid of the domain. -/
@[to_additive
      "The preimage of an `AddSubmonoid` under an `AddMonoid` hom is
      an `AddSubmonoid` of the domain."]
theorem IsSubmonoid.preimage {N : Type _} [Monoid N] {f : M → N} (hf : IsMonoidHom f) {s : Set N}
    (hs : IsSubmonoid s) : IsSubmonoid (f ⁻¹' s) :=
  { one_mem := show f 1 ∈ s by (rw [IsMonoidHom.map_one hf]; exact hs.one_mem)
    mul_mem := fun {a b} (ha : f a ∈ s) (hb : f b ∈ s) =>
      show f (a * b) ∈ s by (rw [IsMonoidHom.map_mul' hf]; exact hs.mul_mem ha hb) }
#align is_submonoid.preimage IsSubmonoid.preimage
#align is_add_submonoid.preimage IsAddSubmonoid.preimage

/-- The image of a submonoid under a monoid hom is a submonoid of the codomain. -/
@[to_additive
      "The image of an `AddSubmonoid` under an `AddMonoid` hom is an `AddSubmonoid` of the
      codomain."]
theorem IsSubmonoid.image {γ : Type _} [Monoid γ] {f : M → γ} (hf : IsMonoidHom f) {s : Set M}
    (hs : IsSubmonoid s) : IsSubmonoid (f '' s) :=
  { one_mem := ⟨1, hs.one_mem, hf.map_one⟩
    mul_mem := @fun a b ⟨x, hx⟩ ⟨y, hy⟩ =>
      ⟨x * y, hs.mul_mem hx.1 hy.1, by rw [hf.map_mul, hx.2, hy.2]⟩ }
#align is_submonoid.image IsSubmonoid.image
#align is_add_submonoid.image IsAddSubmonoid.image

/-- The image of a monoid hom is a submonoid of the codomain. -/
@[to_additive "The image of an `AddMonoid` hom is an `AddSubmonoid` of the codomain."]
theorem Range.isSubmonoid {γ : Type _} [Monoid γ] {f : M → γ} (hf : IsMonoidHom f) :
    IsSubmonoid (Set.range f) := by
  rw [← Set.image_univ]
  exact Univ.isSubmonoid.image hf
#align range.is_submonoid Range.isSubmonoid
#align range.is_add_submonoid Range.isAddSubmonoid

/-- Submonoids are closed under natural powers. -/
@[to_additive
      "An `AddSubmonoid` is closed under multiplication by naturals."]
theorem IsSubmonoid.pow_mem {a : M} (hs : IsSubmonoid s) (h : a ∈ s) : ∀ {n : ℕ}, a ^ n ∈ s
  | 0 => by
    rw [pow_zero]
    exact hs.one_mem
  | n + 1 => by
    rw [pow_succ]
    exact hs.mul_mem h (IsSubmonoid.pow_mem hs h)
#align is_submonoid.pow_mem IsSubmonoid.pow_mem

/-- The set of natural number powers of an element of a submonoid is a subset of the submonoid. -/
@[to_additive IsAddSubmonoid.multiples_subset
      "The set of natural number multiples of an element of an `AddSubmonoid` is a subset of
      the `AddSubmonoid`."]
theorem IsSubmonoid.power_subset {a : M} (hs : IsSubmonoid s) (h : a ∈ s) : powers a ⊆ s :=
  fun _ ⟨_, hx⟩ => hx ▸ hs.pow_mem h
#align is_submonoid.power_subset IsSubmonoid.power_subset
#align is_add_submonoid.multiples_subset IsAddSubmonoid.multiples_subset

end powers

namespace IsSubmonoid

/-- The product of a list of elements of a submonoid is an element of the submonoid. -/
@[to_additive
      "The sum of a list of elements of an `AddSubmonoid` is an element of the `AddSubmonoid`."]
theorem list_prod_mem (hs : IsSubmonoid s) : ∀ {l : List M}, (∀ x ∈ l, x ∈ s) → l.prod ∈ s
  | [], _ => hs.one_mem
  | a :: l, h =>
    suffices a * l.prod ∈ s by simpa
    have : a ∈ s ∧ ∀ x ∈ l, x ∈ s := by simpa using h
    hs.mul_mem this.1 (list_prod_mem hs this.2)
#align is_submonoid.list_prod_mem IsSubmonoid.list_prod_mem
#align is_add_submonoid.list_sum_mem IsAddSubmonoid.list_sum_mem

/-- The product of a multiset of elements of a submonoid of a `CommMonoid` is an element of
the submonoid. -/
@[to_additive
      "The sum of a multiset of elements of an `AddSubmonoid` of an `AddCommMonoid`
      is an element of the `AddSubmonoid`. "]
theorem multiset_prod_mem {M} [CommMonoid M] {s : Set M} (hs : IsSubmonoid s) (m : Multiset M) :
    (∀ a ∈ m, a ∈ s) → m.prod ∈ s := by
  refine' Quotient.inductionOn m fun l hl => _
  rw [Multiset.quot_mk_to_coe, Multiset.coe_prod]
  exact list_prod_mem hs hl
#align is_submonoid.multiset_prod_mem IsSubmonoid.multiset_prod_mem
#align is_add_submonoid.multiset_sum_mem IsAddSubmonoid.multiset_sum_mem

/-- The product of elements of a submonoid of a `CommMonoid` indexed by a `Finset` is an element
of the submonoid. -/
@[to_additive
      "The sum of elements of an `AddSubmonoid` of an `AddCommMonoid` indexed by
      a `Finset` is an element of the `AddSubmonoid`."]
theorem finset_prod_mem {M A} [CommMonoid M] {s : Set M} (hs : IsSubmonoid s) (f : A → M) :
    ∀ t : Finset A, (∀ b ∈ t, f b ∈ s) → (∏ b in t, f b) ∈ s
  | ⟨m, hm⟩, _ => multiset_prod_mem hs _ (by simpa)
#align is_submonoid.finset_prod_mem IsSubmonoid.finset_prod_mem
#align is_add_submonoid.finset_sum_mem IsAddSubmonoid.finset_sum_mem

end IsSubmonoid

namespace AddMonoid

/-- The inductively defined membership predicate for the submonoid generated by a subset of a
    monoid.-/
inductive InClosure (s : Set A) : A → Prop
  | basic {a : A} : a ∈ s → InClosure _ a
  | zero : InClosure _ 0
  | add {a b : A} : InClosure _ a → InClosure _ b → InClosure _ (a + b)
#align add_monoid.in_closure AddMonoid.InClosure

end AddMonoid

namespace Monoid

/-- The inductively defined membership predicate for the `Submonoid` generated by a subset of an
    monoid. -/
@[to_additive]
inductive InClosure (s : Set M) : M → Prop
  | basic {a : M} : a ∈ s → InClosure _ a
  | one : InClosure _ 1
  | mul {a b : M} : InClosure _ a → InClosure _ b → InClosure _ (a * b)
#align monoid.in_closure Monoid.InClosure

/-- The inductively defined submonoid generated by a subset of a monoid. -/
@[to_additive
      "The inductively defined `AddSubmonoid` genrated by a subset of an `AddMonoid`."]
def Closure (s : Set M) : Set M :=
  { a | InClosure s a }
#align monoid.closure Monoid.Closure
#align add_monoid.closure AddMonoid.Closure

@[to_additive]
theorem closure.isSubmonoid (s : Set M) : IsSubmonoid (Closure s) :=
  { one_mem := InClosure.one
    mul_mem := InClosure.mul }
#align monoid.closure.is_submonoid Monoid.closure.isSubmonoid
#align add_monoid.closure.is_add_submonoid AddMonoid.closure.isAddSubmonoid

/-- A subset of a monoid is contained in the submonoid it generates. -/
@[to_additive
    "A subset of an `AddMonoid` is contained in the `AddSubmonoid` it generates."]
theorem subset_closure {s : Set M} : s ⊆ Closure s := fun _ => InClosure.basic
#align monoid.subset_closure Monoid.subset_closure
#align add_monoid.subset_closure AddMonoid.subset_closure

/-- The submonoid generated by a set is contained in any submonoid that contains the set. -/
@[to_additive
      "The `AddSubmonoid` generated by a set is contained in any `AddSubmonoid` that
      contains the set."]
theorem closure_subset {s t : Set M} (ht : IsSubmonoid t) (h : s ⊆ t) : Closure s ⊆ t := fun a ha =>
  by induction ha <;> simp [h _, *, IsSubmonoid.one_mem, IsSubmonoid.mul_mem]
#align monoid.closure_subset Monoid.closure_subset
#align add_monoid.closure_subset AddMonoid.closure_subset

/-- Given subsets `t` and `s` of a monoid `M`, if `s ⊆ t`, the submonoid of `M` generated by `s` is
    contained in the submonoid generated by `t`. -/
@[to_additive
      "Given subsets `t` and `s` of an `AddMonoid M`, if `s ⊆ t`, the `AddSubmonoid`
      of `M` generated by `s` is contained in the `AddSubmonoid` generated by `t`."]
theorem closure_mono {s t : Set M} (h : s ⊆ t) : Closure s ⊆ Closure t :=
  closure_subset (closure.isSubmonoid t) <| Set.Subset.trans h subset_closure
#align monoid.closure_mono Monoid.closure_mono
#align add_monoid.closure_mono AddMonoid.closure_mono

/-- The submonoid generated by an element of a monoid equals the set of natural number powers of
    the element. -/
@[to_additive
      "The `AddSubmonoid` generated by an element of an `AddMonoid` equals the set of
      natural number multiples of the element."]
theorem closure_singleton {x : M} : Closure ({x} : Set M) = powers x :=
  Set.eq_of_subset_of_subset
      (closure_subset (powers.isSubmonoid x) <| Set.singleton_subset_iff.2 <| powers.self_mem) <|
    IsSubmonoid.power_subset (closure.isSubmonoid _) <|
      Set.singleton_subset_iff.1 <| subset_closure
#align monoid.closure_singleton Monoid.closure_singleton
#align add_monoid.closure_singleton AddMonoid.closure_singleton

/-- The image under a monoid hom of the submonoid generated by a set equals the submonoid generated
    by the image of the set under the monoid hom. -/
@[to_additive
      "The image under an `AddMonoid` hom of the `AddSubmonoid` generated by a set equals
      the `AddSubmonoid` generated by the image of the set under the `AddMonoid` hom."]
theorem image_closure {A : Type _} [Monoid A] {f : M → A} (hf : IsMonoidHom f) (s : Set M) :
    f '' Closure s = Closure (f '' s) :=
  le_antisymm
    (by
      rintro _ ⟨x, hx, rfl⟩
      induction' hx with z hz
      · solve_by_elim [subset_closure, Set.mem_image_of_mem]
      · rw [hf.map_one]
        apply IsSubmonoid.one_mem (closure.isSubmonoid (f '' s))
      · rw [hf.map_mul]
        solve_by_elim [(closure.isSubmonoid _).mul_mem] )
    (closure_subset (IsSubmonoid.image hf (closure.isSubmonoid _)) <|
      Set.image_subset _ subset_closure)
#align monoid.image_closure Monoid.image_closure
#align add_monoid.image_closure AddMonoid.image_closure

/-- Given an element `a` of the submonoid of a monoid `M` generated by a set `s`, there exists
a list of elements of `s` whose product is `a`. -/
@[to_additive
      "Given an element `a` of the `AddSubmonoid` of an `AddMonoid M` generated by
      a set `s`, there exists a list of elements of `s` whose sum is `a`."]
theorem exists_list_of_mem_closure {s : Set M} {a : M} (h : a ∈ Closure s) :
    ∃ l : List M, (∀ x ∈ l, x ∈ s) ∧ l.prod = a := by
  induction h
  case basic a ha => exists [a]; simp [ha]
  case one => exists []; simp
  case mul a b _ _ ha hb =>
    rcases ha with ⟨la, ha, eqa⟩
    rcases hb with ⟨lb, hb, eqb⟩
    exists la ++ lb
    simp [eqa.symm, eqb.symm, or_imp]
    exact fun a => ⟨ha a, hb a⟩
#align monoid.exists_list_of_mem_closure Monoid.exists_list_of_mem_closure
#align add_monoid.exists_list_of_mem_closure AddMonoid.exists_list_of_mem_closure

/-- Given sets `s, t` of a commutative monoid `M`, `x ∈ M` is in the submonoid of `M` generated by
    `s ∪ t` iff there exists an element of the submonoid generated by `s` and an element of the
    submonoid generated by `t` whose product is `x`. -/
@[to_additive
      "Given sets `s, t` of a commutative `AddMonoid M`, `x ∈ M` is in the `AddSubmonoid`
      of `M` generated by `s ∪ t` iff there exists an element of the `AddSubmonoid` generated by `s`
      and an element of the `AddSubmonoid` generated by `t` whose sum is `x`."]
theorem mem_closure_union_iff {M : Type _} [CommMonoid M] {s t : Set M} {x : M} :
    x ∈ Closure (s ∪ t) ↔ ∃ y ∈ Closure s, ∃ z ∈ Closure t, y * z = x :=
  ⟨fun hx =>
    let ⟨L, HL1, HL2⟩ := exists_list_of_mem_closure hx
    HL2 ▸
      List.recOn L
        (fun _ =>
          ⟨1, (closure.isSubmonoid _).one_mem, 1, (closure.isSubmonoid _).one_mem, mul_one _⟩)
        (fun hd tl ih HL1 =>
          let ⟨y, hy, z, hz, hyzx⟩ := ih (List.forall_mem_of_forall_mem_cons HL1)
          Or.casesOn (HL1 hd <| List.mem_cons_self _ _)
            (fun hs =>
              ⟨hd * y, (closure.isSubmonoid _).mul_mem (subset_closure hs) hy, z, hz, by
                rw [mul_assoc, List.prod_cons, ← hyzx]⟩)
            fun ht =>
            ⟨y, hy, z * hd, (closure.isSubmonoid _).mul_mem hz (subset_closure ht), by
              rw [← mul_assoc, List.prod_cons, ← hyzx, mul_comm hd]⟩)
        HL1,
    fun ⟨y, hy, z, hz, hyzx⟩ =>
    hyzx ▸
      (closure.isSubmonoid _).mul_mem (closure_mono (Set.subset_union_left _ _) hy)
        (closure_mono (Set.subset_union_right _ _) hz)⟩
#align monoid.mem_closure_union_iff Monoid.mem_closure_union_iff
#align add_monoid.mem_closure_union_iff AddMonoid.mem_closure_union_iff

end Monoid

/-- Create a bundled submonoid from a set `s` and `[IsSubmonoid s]`. -/
@[to_additive "Create a bundled additive submonoid from a set `s` and `[IsAddSubmonoid s]`."]
def Submonoid.of {s : Set M} (h : IsSubmonoid s) : Submonoid M :=
  ⟨⟨s, @fun _ _ => h.2⟩, h.1⟩
#align submonoid.of Submonoid.of
#align add_submonoid.of AddSubmonoid.of

@[to_additive]
theorem Submonoid.isSubmonoid (S : Submonoid M) : IsSubmonoid (S : Set M) := by
  refine' ⟨S.2, S.1.2⟩
#align submonoid.is_submonoid Submonoid.isSubmonoid
#align add_submonoid.is_add_submonoid AddSubmonoid.isAddSubmonoid


import Std.Data.List.Basic
import Mathlib.Tactic.applyFun
import Mathlib.Data.List.Basic

open Lean

def f (a:ℕ ): ℕ := sorry
lemma foo (a:ℕ): f a = 5 :=by sorry
lemma examp :f a + f b = f c + 5 := by
  simp (config := {singlePass := true})  [foo]


import home_finder
-- lemma real_big : (3000 : ℝ) + 2 > 50 := by norm_num
-- lemma a :ℕ := 7
-- lemma b :ℕ := a

#vind_home pell.xn
#vind_home pell.n_lt_a_pow

-- def recfn : ℕ → ℕ
-- | 0 := 0
-- | (n+1) := n

-- #vind_home recfn


/-
Copyright (c) 2022 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import computational_monads.constructions.product
import computational_monads.distribution_semantics.option
import computational_monads.distribution_semantics.misc
import computational_monads.simulation_semantics.oracle_append
import computational_monads.simulation_semantics.constructions.logging.random_oracle
import computational_monads.simulation_semantics.constructions.logging.seeded_oracle
import computational_monads.simulation_semantics.constructions.identity_oracle

/-!
# Forking Lemma for Oracle Computations

This file defines a version of the forking lemma, constructing a computation
that "rewinds" a computation to a particular query, and then reruns it.
The result is a pair of outputs, for which the beginning of the corresponding
computations match, in terms of the queries logged to the oracles.
-/

noncomputable theory

open oracle_comp oracle_spec

open_locale nnreal ennreal big_operators

structure forking_adversary (T U α : Type) [inhabited U] [fintype U]
  [decidable_eq T] [decidable_eq U] :=
(adv : oracle_comp (uniform_selecting ++ (T ↦ₒ U)) α) (q : ℕ)
-- Given an output and a random oracle cache, decide which part of cache should be forked.
(choose_fork : α → query_log (T ↦ₒ U) → option (fin q))
-- The adversary always makes at least one query to the random oracle.
(cache_nonempty : ∀ (a : α) (cache : query_log (T ↦ₒ U)),
  (a, (), cache) ∈ (default_simulate (idₛ ++ₛ random_oracle _) adv).support →
  ¬ (cache ()).empty)
-- If choose fork result isn't `none`, the chosen index corresponds to an actual cache entry.
(no_overflow : ∀ (a : α) (cache : query_log (T ↦ₒ U)) (i : fin q), choose_fork a cache = some i →
  (a, (), cache) ∈ (default_simulate (idₛ ++ₛ random_oracle _) adv).support →
  ↑i < (cache ()).length)

namespace forking_adversary

variables {T U α : Type} [inhabited U] [fintype U] [decidable_eq T] [decidable_eq U]
  (adv : forking_adversary T U α)

section simulate_choose_fork

/-- Just simulate to get the resulting `choose_fork` value.
  Implemented as running `simulate_with_log` and throwing out the resulting log and cache -/
def simulate_choose_fork (adv : forking_adversary T U α) :
  oracle_comp uniform_selecting (option (fin adv.q)) :=
do{ ⟨x, log, cache⟩ ← default_simulate (logging_oracle _ ++ₛ random_oracle _) adv.adv,
    return (adv.choose_fork x cache) }

end simulate_choose_fork

section simulate_with_log

/-- Simulate the adversary, returning a log of the uniform selecting oracle,
  along with the final result and final cache for the random oracle -/
def simulate_with_log (adv : forking_adversary T U α) : oracle_comp uniform_selecting
  (option (fin adv.q) × α × query_log uniform_selecting × query_log (T ↦ₒ U)) :=
do{ ⟨x, log, cache⟩ ← default_simulate (logging_oracle _ ++ₛ random_oracle _) adv.adv,
    return (adv.choose_fork x cache, x, log, cache) }

variables (o : option (fin adv.q) × α × query_log uniform_selecting × query_log (T ↦ₒ U))

end simulate_with_log

section simulate_from_seed

/-- Simulate the adversary, allowing for a seed value to the uniform select oracle,
  and a preset cache value for the random oracle, returning the final cache -/
def simulate_from_seed (adv : forking_adversary T U α)
  (seed : query_log uniform_selecting) (cache : query_log (T ↦ₒ U)) :
  oracle_comp uniform_selecting (option (fin adv.q) × α × query_log (T ↦ₒ U)) :=
do { ⟨x, log, cache⟩ ← simulate (seeded_oracle _ ++ₛ random_oracle _) adv.adv (seed, cache),
  return (adv.choose_fork x cache, x, cache) }

end simulate_from_seed

section advantage

def advantage (adv : forking_adversary T U α) : ℝ≥0∞ :=
⁅ λ x, option.is_some x | simulate_choose_fork adv ⁆

lemma advantage_eq_tsum (adv : forking_adversary T U α) :
  adv.advantage = ∑' (i : fin adv.q), ⁅simulate_choose_fork adv⁆ (some i) :=
prob_event_is_some $ simulate_choose_fork adv

lemma advantage_eq_sum (adv : forking_adversary T U α) :
  adv.advantage = ∑ i, ⁅simulate_choose_fork adv⁆ (some i) :=
trans (advantage_eq_tsum adv) (tsum_fintype _)

end advantage

end forking_adversary

variables {T U α : Type} [inhabited U] [fintype U] [decidable_eq T] [decidable_eq U]
  [decidable_eq α] {n : ℕ} (adv : forking_adversary T U α)

/-- Run computation twice, using the same random information for both,
  responding differently to a query specified by `choose_fork`,
  and returning the results if `choose_fork` makes the same choice each time -/
def fork (adv : forking_adversary T U α) : oracle_comp uniform_selecting
  ((option (fin adv.q)) × α × (query_log (T ↦ₒ U)) × α × (query_log (T ↦ₒ U))) :=
do{ -- run the adversary for the first time, logging coins and caching random oracles
    ⟨i, ⟨x, ⟨log, cache⟩⟩⟩ ← adv.simulate_with_log,
    -- run again, using the same random choices for first oracle, and newly forked cache
    -- TODO: might be off by one error with forking somewhere along the way?
    ⟨i', x', cache'⟩ ← adv.simulate_from_seed log.to_seed (cache.fork_cache () (i.map coe)),
    -- return no forking index unless `fork_cache` gives equal values for both runs.
    -- also return the side outputs and the random oracle cache for both runs
    return ⟨if i = i' then i else none, x, cache, x', cache'⟩ }

/-- Definition without the match functions used in the original definition -/
lemma fork_def : fork adv = do {o ← adv.simulate_with_log,
  o' ← adv.simulate_from_seed o.2.2.1.to_seed ((o.2.2.2.fork_cache () (o.1.map coe))),
  return (if o.1 = o'.1 then o.1 else none, o.2.1, o.2.2.2, o'.2.1, o'.2.2)} :=
begin
  unfold fork,
  congr, ext o, rcases o with ⟨i, x, log, cache⟩, rw [fork._match_2],
  congr, ext o', rcases o' with ⟨i', x', cache'⟩, rw [fork._match_1],
end

section distribution_semantics

/-- The probability of returning a given index is the independent value of getting it from both -/
lemma eval_dist_fst_map_fork_apply (i : option $ fin adv.q) :
  ⁅prod.fst <$> fork adv⁆ i = ⁅adv.simulate_choose_fork⁆ i ^ 2 :=
calc ⁅prod.fst <$> fork adv⁆ i
  = ⁅adv.simulate_choose_fork ×ₘ adv.simulate_choose_fork⁆ (i, i) : begin
    sorry
  end
  ... = ⁅adv.simulate_choose_fork⁆ i ^ 2 : begin
    rw [eval_dist_product_apply, pow_two],
  end

lemma eval_dist_fork_apply_some (i : (fin adv.q)) (x x' : α) (cache cache' : query_log (T ↦ₒ U)) :
  ⁅fork adv⁆ (some i, x, cache, x', cache') =
    ∑' (log : query_log uniform_selecting), ⁅adv.simulate_with_log⁆ (some i, x, log, cache)
      * ⁅adv.simulate_from_seed log.to_seed (cache.fork_cache () (some i))⁆ (some i, x', cache') :=
begin
  calc ⁅fork adv⁆ (some i, x, cache, x', cache')
    = ∑' (log : query_log uniform_selecting), ⁅adv.simulate_with_log⁆ (some i, x, log, cache)
        * ⁅adv.simulate_from_seed log.to_seed (cache.fork_cache () (some i))
        >>= λ o, return (ite (some i = o.fst) (some i) none, x, cache, o.snd.fst, o.snd.snd)⁆
                  (some i, x, cache, x', cache') :
    begin
      rw fork_def,
      refine (helper (λ log, (i, x, log, cache)) _ _),
      { intros o ho ho',
        simp only [support_bind_return, set.mem_image, prod.mk.inj_iff, prod.exists] at ho',
        obtain ⟨i', x'', log, ho', hi', hx', hcache, hx'', hcache'⟩ := ho',
        rw [set.mem_range],
        refine ⟨o.2.2.1, symm _⟩,
        simp only [prod.eq_iff_fst_eq_snd_eq],
        refine ⟨_, hx', rfl, hcache⟩,
        have : o.fst = i' := begin
          refine by_contra (λ hoi', option.some_ne_none i (hi'.symm.trans $ if_neg hoi')),
        end,
        refine trans (if_pos this).symm hi' },
      { simp only [],
        intros log log' h _ _,
        simp only [prod.eq_iff_fst_eq_snd_eq] at h,
        exact h.2.2.1 },
    end
    ... = ∑' (log : query_log uniform_selecting), ⁅adv.simulate_with_log⁆ (some i, x, log, cache)
      * ⁅adv.simulate_from_seed log.to_seed (cache.fork_cache () (some i))⁆ (some i, x', cache') :
    begin
      refine tsum_congr (λ log, _),
      refine congr_arg (λ x, _ * x) _,
      refine trans (eval_dist_bind_return_apply_eq_tsum_indicator _ _ _) _,
      refine trans (tsum_eq_single (some i, x', cache') _) _,
      { intros o ho,
        simp only [prod.mk.eta, set.indicator_apply_eq_zero, set.mem_preimage,
          set.mem_singleton_iff, prod.mk.inj_iff, eq_self_iff_true,
            true_and, eval_dist_eq_zero_iff, and_imp],
        intros ho' ho'',
        by_cases hi : some i = o.fst,
        { exact (ho $ prod.eq_iff_fst_eq_snd_eq.2 ⟨hi.symm, ho''⟩).elim },
        { exact (option.some_ne_none i $ by rw [← ho', if_neg hi]).elim } },
      refine set.indicator_apply_eq_self.2 _,
      simp only [set.mem_preimage, eq_self_iff_true, if_true, set.mem_singleton,
        not_true, is_empty.forall_iff]
    end
end

lemma prob_fork_eq_some : ⁅λ out, out.1.is_some | fork adv⁆ ≥ (adv.advantage ^ 2) / adv.q :=
calc ⁅λ out, out.1.is_some | fork adv⁆
  = ⁅ coe ∘ option.is_some | prod.fst <$> fork adv⁆ :
    symm ((prob_event_map _ _ _))
  ... = ∑' (j : fin adv.q), (⁅prod.fst <$> fork adv⁆ (some j)) :
    (prob_event_is_some $ prod.fst <$> fork adv)
  ... = ∑' (j : fin adv.q), (⁅adv.simulate_choose_fork⁆ (some j)) ^ 2 :
    tsum_congr (λ j, eval_dist_fst_map_fork_apply _ _)
  ... = ∑ j, (⁅adv.simulate_choose_fork⁆ (some j)) ^ 2 :
    tsum_fintype _
  ... ≥ (∑ j, ⁅adv.simulate_choose_fork⁆ (some j)) ^ 2 /
          (finset.univ : finset $ fin adv.q).card ^ 1 :
    sorry --nnreal.pow_sum_div_card_le_sum_pow ⊤ (λ j, ⁅adv.simulate_choose_fork⁆ (some j)) 1
  ... ≥ (∑ j, ⁅adv.simulate_choose_fork⁆ (some j)) ^ 2 / adv.q :
    sorry --by simp only [finset.card_fin, pow_one, ge_iff_le]
  ... = (adv.advantage ^ 2) / adv.q :
    by rw forking_adversary.advantage_eq_sum adv

end distribution_semantics

section choose_fork

/-- For any non-`none` forking result, `choose_fork` matches for both side outputs -/
lemma choose_fork_eq (i : fin adv.q) (cache cache' : query_log (T ↦ₒ U)) (x x' : α)
  (h : ((some i, x, cache, x', cache')) ∈ (fork adv).support) :
  adv.choose_fork x cache = i ∧ adv.choose_fork x' cache' = i :=
begin
  sorry
  -- simp only [fork, support_bind, set.mem_Union, exists_prop, prod.exists, return_eq_pure,
  --   support_pure_bind, support_pure, set.mem_singleton_iff] at h,
  -- obtain ⟨y, log₀, cache₀, hy, y', cache₀', hy', h⟩ := h,

  -- have : adv.choose_fork y cache₀ = adv.choose_fork y' cache₀' := begin
  --   by_contradiction h',
  --   simp only [h', if_false] at h,
  --   exact h
  -- end,
  -- simp only [← this, eq_self_iff_true, if_true] at h,

  -- rw [eq_comm, option.map_eq_some'] at h,
  -- obtain ⟨j, hj, hj'⟩ := h,

  -- simp_rw [prod.eq_iff_fst_eq_snd_eq] at hj',
  -- rw [← hj'.2.1, ← hj'.2.2.1, ← hj'.2.2.2.1, ← hj'.2.2.2.2, ← this, hj, hj'.1],
  -- exact ⟨rfl, rfl⟩,
end

lemma choose_fork_fst_eq (i : fin adv.q) (cache cache' : query_log (T ↦ₒ U)) (x x' : α)
  (h : (some i, x, cache, x', cache') ∈ (fork adv).support) :
  adv.choose_fork x cache = i :=
(choose_fork_eq adv i cache cache' x x' h).1

lemma choose_fork_snd_eq (i : fin adv.q) (cache cache' : query_log (T ↦ₒ U)) (x x' : α)
  (h : (some i, x, cache, x', cache') ∈ (fork adv).support) :
  adv.choose_fork x' cache' = i :=
(choose_fork_eq adv i cache cache' x x' h).2

lemma choose_fork_eq_choose_fork (i : fin adv.q) (cache cache' : query_log (T ↦ₒ U)) (x x' : α)
  (h : ((some i, x, cache, x', cache')) ∈ (fork adv).support) :
  adv.choose_fork x cache = adv.choose_fork x' cache' :=
by rw [choose_fork_fst_eq adv _ _ _ _ _ h, choose_fork_snd_eq adv _ _ _ _ _ h]

end choose_fork

section cache_input

/-- Because of the logging and shared cache both results of fork
  make the same query at the point specified by `choose_fork`.
  TODO: theoretically true for any `j ≤ i`, but not sure that is ever needed? -/
theorem cache_input_same_at_fork (i : fin adv.q) (cache cache' : query_log (T ↦ₒ U)) (x x' : α)
  (h : ((some i, x, cache, x', cache')) ∈ (fork adv).support) :
  query_log.query_input_same_at cache cache' () i :=
begin
  sorry
end

end cache_input

section forked_cache_differs

/- Cache values at the chosen index aren't the same. Because the cache
is forked, this only happens if both random selections are the same by pure luck. -/
def forked_cache_differs (o : option (fin n) × α × query_log (T ↦ₒ U) × α × query_log (T ↦ₒ U)) :=
query_log.query_output_diff_at o.2.2.1 o.2.2.2.2 () (option.rec_on o.1 0 coe)

section distribution_semantics

lemma prob_event_forked_cache_differs :
  ⁅forked_cache_differs | fork adv⁆ = 1 - (1 / fintype.card U) :=
sorry

lemma indep_event_forked_cache_differs_is_some :
  indep_event (fork adv) forked_cache_differs (λ o, o.1.is_some) :=
begin
  sorry
end

end distribution_semantics

end forked_cache_differs

section fork_success

/- forking algorithm succeeds if a forking point is chosen, and the query outputs differ there. -/
def fork_success (o : option (fin n) × α × query_log (T ↦ₒ U) × α × query_log (T ↦ₒ U)) :=
o.1.is_some ∧ forked_cache_differs o

/-- Probability that fork success holds is determined by adversary's initial advantage -/
theorem prob_event_fork_success : ⁅fork_success | fork adv⁆
  ≥ ((adv.advantage) ^ 2 / adv.q) - (1 / fintype.card U) :=
calc ⁅fork_success | fork adv⁆
  = ⁅λ o, o.1.is_some | fork adv⁆ * ⁅forked_cache_differs | fork adv⁆ : sorry
  ... ≥ ⁅λ o, o.1.is_some | fork adv⁆ * (1 - 1 / fintype.card U) : begin
    -- TODO: this is just an independence statement of the `is_some` and `query_output_diff_at`
    -- Slight complication in that the output diff is only well defined if a `some` index is output
    sorry
  end
  ... ≥ ⁅λ o, o.1.is_some | fork adv⁆ - (1 / fintype.card U) : begin
    sorry
  end
  ... ≥ ((adv.advantage) ^ 2 / adv.q) - (1 / fintype.card U) :
    tsub_le_tsub (prob_fork_eq_some adv) le_rfl

end fork_success


import Ipld.Multibase
namespace Multibase.Test
  set_option maxHeartbeats 0
  set_option maxRecDepth 1500

namespace Basic
#eval "yes mani !".toUTF8
def basic : List UInt8 := [121, 101, 115, 32, 109, 97, 110, 105, 32, 33]
theorem encodeBase2             : encode Base2 basic             = "001111001011001010111001100100000011011010110000101101110011010010010000000100001" := rfl
theorem encodeBase8             : encode Base8 basic             = "7362625631006654133464440102" := rfl
theorem encodeBase10            : encode Base10 basic            = "9573277761329450583662625"    := rfl
theorem encodeBase16            : encode Base16 basic            = "f796573206d616e692021"        := rfl
theorem encodeBase16Upper       : encode Base16 basic            = "f796573206d616e692021"        := rfl
theorem encodeBase32Hex         : encode Base32Hex basic         = "vf5in683dc5n6i811"            := rfl
theorem encodeBase32HexUpper    : encode Base32HexUpper basic    = "VF5IN683DC5N6I811"            := rfl
theorem encodeBase32HexPad      : encode Base32HexPad basic      = "tf5in683dc5n6i811"            := rfl
theorem encodeBase32HexPadUpper : encode Base32HexPadUpper basic = "TF5IN683DC5N6I811"            := rfl
theorem encodeBase32            : encode Base32 basic            = "bpfsxgidnmfxgsibb"            := rfl
theorem encodeBase32Upper       : encode Base32Upper basic       = "BPFSXGIDNMFXGSIBB"            := rfl
theorem encodeBase32Pad         : encode Base32Pad basic         = "cpfsxgidnmfxgsibb"            := rfl
theorem encodeBase32PadUpper    : encode Base32PadUpper basic    = "CPFSXGIDNMFXGSIBB"            := rfl
theorem encodeBase32Z           : encode Base32Z basic           = "hxf1zgedpcfzg1ebb"            := rfl
theorem encodeBase36            : encode Base36 basic            = "k2lcpzo5yikidynfl"            := rfl
theorem encodeBase36Upper       : encode Base36Upper basic       = "K2LCPZO5YIKIDYNFL"            := rfl
theorem encodeBase58Flickr      : encode Base58Flickr basic      = "Z7Pznk19XTTzBtx"              := rfl
theorem encodeBase58BTC         : encode Base58BTC basic         = "z7paNL19xttacUY"              := rfl
theorem encodeBase64            : encode Base64 basic            = "meWVzIG1hbmkgIQ"              := rfl
theorem encodeBase64Pad         : encode Base64Pad basic         = "MeWVzIG1hbmkgIQ=="            := rfl
theorem encodeBaseURL           : encode Base64URL basic         = "ueWVzIG1hbmkgIQ"              := rfl
theorem encodeBaseURLPad        : encode Base64URLPad basic      = "UeWVzIG1hbmkgIQ=="            := rfl

-- These tests are really slow in the kernel
#eval decode Base2
"001111001011001010111001100100000011011010110000101101110011010010010000000100001" == (some basic)
--theorem decodeBase2 : decode Base2 "001111001011001010111001100100000011011010110000101101110011010010010000000100001" = (some basic) := rfl
#eval decode Base8 "7362625631006654133464440102" == (some basic)
--theorem decodeBase8           : decode Base8             "7362625631006654133464440102 "  = (some basic) := rfl

theorem decodeBase10            : decode Base10            "9573277761329450583662625" = some basic := rfl
theorem decodeBase16            : decode Base16            "f796573206d616e692021"     = some basic := rfl
theorem decodeBase16Upper       : decode Base16Upper       "F796573206D616E692021"     = some basic := rfl
theorem decodeBase32Hex         : decode Base32Hex         "vf5in683dc5n6i811"         = some basic := rfl
theorem decodeBase32HexUpper    : decode Base32HexUpper    "VF5IN683DC5N6I811"         = some basic := rfl
theorem decodeBase32HexPad      : decode Base32HexPad      "tf5in683dc5n6i811"         = some basic := rfl
theorem decodeBase32HexPadUpper : decode Base32HexPadUpper "TF5IN683DC5N6I811"         = some basic := rfl
theorem decodeBase32            : decode Base32            "bpfsxgidnmfxgsibb"         = some basic := rfl
theorem decodeBase32Upper       : decode Base32Upper       "BPFSXGIDNMFXGSIBB"         = some basic := rfl
theorem decodeBase32Pad         : decode Base32Pad         "cpfsxgidnmfxgsibb"         = some basic := rfl
theorem decodeBase32PadUpper    : decode Base32PadUpper    "CPFSXGIDNMFXGSIBB"         = some basic := rfl
theorem decodeBase32Z           : decode Base32Z           "hxf1zgedpcfzg1ebb"         = some basic := rfl
theorem decodeBase36            : decode Base36            "k2lcpzo5yikidynfl"         = some basic := rfl
theorem decodeBase36Upper       : decode Base36Upper       "K2LCPZO5YIKIDYNFL"         = some basic := rfl
theorem decodeBase58Flickr      : decode Base58Flickr      "Z7Pznk19XTTzBtx"           = some basic := rfl
theorem decodeBase58BTC         : decode Base58BTC         "z7paNL19xttacUY"           = some basic := rfl
theorem decodeBase64            : decode Base64            "meWVzIG1hbmkgIQ"           = some basic := rfl
theorem decodeBase64Pad         : decode Base64Pad         "MeWVzIG1hbmkgIQ=="         = some basic := rfl
theorem decodeBaseURL           : decode Base64URL         "ueWVzIG1hbmkgIQ"           = some basic := rfl
theorem decodeBaseURLPad        : decode Base64URLPad      "UeWVzIG1hbmkgIQ=="         = some basic := rfl
end Basic

namespace CaseInsensitivity
#eval "hello world".toUTF8
def hello : List UInt8 := [104, 101, 108, 108, 111, 32, 119, 111, 114, 108, 100]

theorem caseBase16           : decode Base16                 "f68656c6c6f20776F726C64"   = some hello  := rfl
theorem caseBase16Upper      : decode Base16Upper            "F68656c6c6f20776F726C64"   = some hello  := rfl
theorem caseBase32           : decode Base32                 "bnbswy3dpeB3W64TMMQ"       = some hello  := rfl
theorem caseBase32Upper      : decode Base32Upper            "Bnbswy3dpeB3W64TMMQ"       = some hello  := rfl
theorem caseBase32Hex        : decode Base32Hex              "vd1imor3f41RMUSJCCG"       = some hello  := rfl
theorem caseBase32HexUpper   : decode Base32HexUpper         "Vd1imor3f41RMUSJCCG"       = some hello  := rfl
theorem caseBase32Pad        : decode Base32Pad              "cnbswy3dpeB3W64TMMQ======" = some hello  := rfl
theorem caseBase32PadUpper   : decode Base32PadUpper         "Cnbswy3dpeB3W64TMMQ======" = some hello  := rfl
theorem caseBase32HexPad     : decode Base32HexPad           "td1imor3f41RMUSJCCG======" = some hello  := rfl
theorem caseBase32HexPadUpper: decode Base32HexPadUpper      "Td1imor3f41RMUSJCCG======" = some hello  := rfl
theorem caseBase36           : decode Base36                 "kfUvrsIvVnfRbjWaJo"        = some hello  := rfl
theorem caseBase36Upper      : decode Base36Upper            "KfUVrSIVVnFRbJWAJo"        = some hello  := rfl

end CaseInsensitivity

namespace LeadingZero
-- leading_zero.csv
#eval "\x00yes mani !".toUTF8
def zero : List UInt8 := [0, 121, 101, 115, 32, 109, 97, 110, 105, 32, 33]

theorem encodeBase2             : encode Base2  zero            = "00000000001111001011001010111001100100000011011010110000101101110011010010010000000100001" := rfl
theorem encodeBase8             : encode Base8 zero             = "7000745453462015530267151100204" := rfl
theorem encodeBase10            : encode Base10 zero            = "90573277761329450583662625"      := rfl
theorem encodeBase16            : encode Base16 zero            = "f00796573206d616e692021"         := rfl
theorem encodeBase16Upper       : encode Base16Upper zero       = "F00796573206D616E692021"         := rfl
theorem encodeBase32            : encode Base32 zero            = "bab4wk4zanvqw42jaee"             := rfl
theorem encodeBase32Upper       : encode Base32Upper zero       = "BAB4WK4ZANVQW42JAEE"             := rfl
theorem encodeBase32Hex         : encode Base32Hex zero         = "v01smasp0dlgmsq9044"             := rfl
theorem encodeBase32HexUpper    : encode Base32HexUpper zero    = "V01SMASP0DLGMSQ9044"             := rfl
theorem encodeBase32Pad         : encode Base32Pad zero         = "cab4wk4zanvqw42jaee======"       := rfl
theorem encodeBase32PadUpper    : encode Base32PadUpper zero    = "CAB4WK4ZANVQW42JAEE======"       := rfl
theorem encodeBase32HexPad      : encode Base32HexPad zero      = "t01smasp0dlgmsq9044======"       := rfl
theorem encodeBase32HexPadUpper : encode Base32HexPadUpper zero = "T01SMASP0DLGMSQ9044======"       := rfl
theorem encodeBase32Z           : encode Base32Z zero           = "hybhskh3ypiosh4jyrr"             := rfl
theorem encodeBase36            : encode Base36 zero            = "k02lcpzo5yikidynfl"              := rfl
theorem encodeBase36Upper       : encode Base36Upper zero       = "K02LCPZO5YIKIDYNFL"              := rfl
theorem encodeBase58Flickr      : encode Base58Flickr zero      = "Z17Pznk19XTTzBtx"                := rfl
theorem encodeBase58BTC         : encode Base58BTC zero         = "z17paNL19xttacUY"                := rfl
theorem encodeBase64            : encode Base64 zero            = "mAHllcyBtYW5pICE"                := rfl
theorem encodeBase64Pad         : encode Base64Pad zero         = "MAHllcyBtYW5pICE="               := rfl
theorem encodeBase64URL         : encode Base64URL zero         = "uAHllcyBtYW5pICE"                := rfl
theorem encodeBase64URLPad      : encode Base64URLPad zero      = "UAHllcyBtYW5pICE="               := rfl

-- Slow in kernel
#eval decode Base2 "00000000001111001011001010111001100100000011011010110000101101110011010010010000000100001" == (some zero)
#eval decode Base8 "7000745453462015530267151100204" == (some zero)
--theorem decodeBase2
--  : decode Base2  "00000000001111001011001010111001100100000011011010110000101101110011010010010000000100001" = (some zero)
--  := rfl
--theorem decodeBase8
--  : decode Base8 "7000745453462015530267151100204" = (some zero)
--  := rfl

theorem decodeBase10            : decode Base10            "90573277761329450583662625" = some zero := rfl
theorem decodeBase16            : decode Base16            "f00796573206d616e692021"    = some zero := rfl
theorem decodeBase16Upper       : decode Base16Upper       "F00796573206D616E692021"    = some zero := rfl
theorem decodeBase32            : decode Base32            "bab4wk4zanvqw42jaee"        = some zero := rfl
theorem decodeBase32Upper       : decode Base32Upper       "BAB4WK4ZANVQW42JAEE"        = some zero := rfl
theorem decodeBase32Hex         : decode Base32Hex         "v01smasp0dlgmsq9044"        = some zero := rfl
theorem decodeBase32HexUpper    : decode Base32HexUpper    "V01SMASP0DLGMSQ9044"        = some zero := rfl
theorem decodeBase32Pad         : decode Base32Pad         "cab4wk4zanvqw42jaee======"  = some zero := rfl
theorem decodeBase32PadUpper    : decode Base32PadUpper    "CAB4WK4ZANVQW42JAEE======"  = some zero := rfl
theorem decodeBase32HexPad      : decode Base32HexPad      "t01smasp0dlgmsq9044======"  = some zero := rfl
theorem decodeBase32HexPadUpper : decode Base32HexPadUpper "T01SMASP0DLGMSQ9044======"  = some zero := rfl
theorem decodeBase32Z           : decode Base32Z           "hybhskh3ypiosh4jyrr"        = some zero := rfl
theorem decodeBase36            : decode Base36            "k02lcpzo5yikidynfl"         = some zero := rfl
theorem decodeBase36Upper       : decode Base36Upper       "K02LCPZO5YIKIDYNFL"         = some zero := rfl
theorem decodeBase58Flickr      : decode Base58Flickr      "Z17Pznk19XTTzBtx"           = some zero := rfl
theorem decodeBase58BTC         : decode Base58BTC         "z17paNL19xttacUY"           = some zero := rfl
theorem decodeBase64            : decode Base64            "mAHllcyBtYW5pICE"           = some zero := rfl
theorem decodeBase64Pad         : decode Base64Pad         "MAHllcyBtYW5pICE="          = some zero := rfl
theorem decodeBase64URL         : decode Base64URL         "uAHllcyBtYW5pICE"           = some zero := rfl
theorem decodeBase64URLPad      : decode Base64URLPad      "UAHllcyBtYW5pICE="          = some zero := rfl
end LeadingZero

namespace TwoLeadingZeros
  -- two_leading_zeros.csv
  #eval "\x00\x00yes mani !".toUTF8
  def zeros : List UInt8 := [0, 0, 121, 101, 115, 32, 109, 97, 110, 105, 32, 33]

theorem encodeBase2            : encode Base2 zeros              = "0000000000000000001111001011001010111001100100000011011010110000101101110011010010010000000100001" := rfl
theorem encodeBase8            : encode Base8 zeros              = "700000171312714403326055632220041" := rfl
theorem encodeBase10           : encode Base10 zeros             = "900573277761329450583662625"       := rfl
theorem encodeBase16           : encode Base16 zeros             = "f0000796573206d616e692021"         := rfl
theorem encodeBase16Upper      : encode Base16Upper zeros        = "F0000796573206D616E692021"         := rfl
theorem encodeBase32           : encode Base32 zeros             = "baaahszltebwwc3tjeaqq"             := rfl
theorem encodeBase32Upper      : encode Base32Upper zeros        = "BAAAHSZLTEBWWC3TJEAQQ"             := rfl
theorem encodeBase32Hex        : encode Base32Hex zeros          = "v0007ipbj41mm2rj940gg"             := rfl
theorem encodeBase32HexUpper   : encode Base32HexUpper zeros     = "V0007IPBJ41MM2RJ940GG"             := rfl
theorem encodeBase32Pad        : encode Base32Pad zeros          = "caaahszltebwwc3tjeaqq===="         := rfl
theorem encodeBase32PadUpper   : encode Base32PadUpper zeros     = "CAAAHSZLTEBWWC3TJEAQQ===="         := rfl
theorem encodeBase32HexPad     : encode Base32HexPad zeros       = "t0007ipbj41mm2rj940gg===="         := rfl
theorem encodeBase32HexPadUpper: encode Base32HexPadUpper zeros  = "T0007IPBJ41MM2RJ940GG===="         := rfl
theorem encodeBase32Z          : encode Base32Z zeros            = "hyyy813murbssn5ujryoo"             := rfl
theorem encodeBase36           : encode Base36 zeros             = "k002lcpzo5yikidynfl"               := rfl
theorem encodeBase36Upper      : encode Base36Upper zeros        = "K002LCPZO5YIKIDYNFL"               := rfl
theorem encodeBase58Flickr     : encode Base58Flickr zeros       = "Z117Pznk19XTTzBtx"                 := rfl
theorem encodeBase58BTC        : encode Base58BTC zeros          = "z117paNL19xttacUY"                 := rfl
theorem encodeBase64           : encode Base64 zeros             = "mAAB5ZXMgbWFuaSAh"                 := rfl
theorem encodeBase64Pad        : encode Base64Pad zeros          = "MAAB5ZXMgbWFuaSAh"                 := rfl
theorem encodeBase64URL        : encode Base64URL zeros          = "uAAB5ZXMgbWFuaSAh"                 := rfl
theorem encodeBase64URLPad     : encode Base64URLPad zeros       = "UAAB5ZXMgbWFuaSAh"                 := rfl

--theorem decodeBase2            : decode Base2 "0000000000000000001111001011001010111001100100000011011010110000101101110011010010010000000100001" = some zeros := rfl
--theorem decodeBase8            : decode Base8             "700000171312714403326055632220041"  = some zeros := rfl

theorem decodeBase10           : decode Base10            "900573277761329450583662625"        = some zeros := rfl
theorem decodeBase16           : decode Base16            "f0000796573206d616e692021"          = some zeros := rfl
theorem decodeBase16Upper      : decode Base16Upper       "F0000796573206D616E692021"          = some zeros := rfl
theorem decodeBase32           : decode Base32            "baaahszltebwwc3tjeaqq"              = some zeros := rfl
theorem decodeBase32Upper      : decode Base32Upper       "BAAAHSZLTEBWWC3TJEAQQ"              = some zeros := rfl
theorem decodeBase32Hex        : decode Base32Hex         "v0007ipbj41mm2rj940gg"              = some zeros := rfl
theorem decodeBase32HexUpper   : decode Base32HexUpper    "V0007IPBJ41MM2RJ940GG"              = some zeros := rfl
theorem decodeBase32Pad        : decode Base32Pad         "caaahszltebwwc3tjeaqq===="          = some zeros := rfl
theorem decodeBase32PadUpper   : decode Base32PadUpper    "CAAAHSZLTEBWWC3TJEAQQ===="          = some zeros := rfl
theorem decodeBase32HexPad     : decode Base32HexPad      "t0007ipbj41mm2rj940gg===="          = some zeros := rfl
theorem decodeBase32HexPadUpper: decode Base32HexPadUpper "T0007IPBJ41MM2RJ940GG===="          = some zeros := rfl
theorem decodeBase32Z          : decode Base32Z           "hyyy813murbssn5ujryoo"              = some zeros := rfl
theorem decodeBase36           : decode Base36            "k002lcpzo5yikidynfl"                = some zeros := rfl
theorem decodeBase36Upper      : decode Base36Upper       "K002LCPZO5YIKIDYNFL"                = some zeros := rfl
theorem decodeBase58Flickr     : decode Base58Flickr      "Z117Pznk19XTTzBtx"                  = some zeros := rfl
theorem decodeBase58BTC        : decode Base58BTC         "z117paNL19xttacUY"                  = some zeros := rfl
theorem decodeBase64           : decode Base64            "mAAB5ZXMgbWFuaSAh"                  = some zeros := rfl
theorem decodeBase64Pad        : decode Base64Pad         "MAAB5ZXMgbWFuaSAh"                  = some zeros := rfl
theorem decodeBase64URL        : decode Base64URL         "uAAB5ZXMgbWFuaSAh"                  = some zeros := rfl
theorem decodeBase64URLPad     : decode Base64URLPad      "UAAB5ZXMgbWFuaSAh"                  = some zeros := rfl
end TwoLeadingZeros

namespace RFC4648
-- RFC4648 Test Vectors: https://datatracker.ietf.org/doc/html/rfc4648#section-10
-- test vector `i` is the first `i` letters of the string "foobar" as UTF8
#eval "foobar".toUTF8
def rfc0 : List UInt8 := []
def rfc1 : List UInt8 := [102]
def rfc2 : List UInt8 := [102, 111]
def rfc3 : List UInt8 := [102, 111, 111]
def rfc4 : List UInt8 := [102, 111, 111, 98]
def rfc5 : List UInt8 := [102, 111, 111, 98, 97]
def rfc6 : List UInt8 := [102, 111, 111, 98, 97, 114]

theorem encodeBase16Rfc0 : encode Base16 rfc0 = "f"             := rfl
theorem encodeBase16Rfc1 : encode Base16 rfc1 = "f66"           := rfl
theorem encodeBase16Rfc2 : encode Base16 rfc2 = "f666f"         := rfl
theorem encodeBase16Rfc3 : encode Base16 rfc3 = "f666f6f"       := rfl
theorem encodeBase16Rfc4 : encode Base16 rfc4 = "f666f6f62"     := rfl
theorem encodeBase16Rfc5 : encode Base16 rfc5 = "f666f6f6261"   := rfl
theorem encodeBase16Rfc6 : encode Base16 rfc6 = "f666f6f626172" := rfl

theorem decodeBase16Rfc0 : decode Base16 "f"             = some rfc0       := rfl
theorem decodeBase16Rfc1 : decode Base16 "f66"           = some rfc1       := rfl
theorem decodeBase16Rfc2 : decode Base16 "f666f"         = some rfc2       := rfl
theorem decodeBase16Rfc3 : decode Base16 "f666f6f"       = some rfc3       := rfl
theorem decodeBase16Rfc4 : decode Base16 "f666f6f62"     = some rfc4       := rfl
theorem decodeBase16Rfc5 : decode Base16 "f666f6f6261"   = some rfc5       := rfl
theorem decodeBase16Rfc6 : decode Base16 "f666f6f626172" = some rfc6       := rfl

theorem encodeBase16UpperRfc0 : encode Base16Upper rfc0 = "F"              := rfl
theorem encodeBase16UpperRfc1 : encode Base16Upper rfc1 = "F66"            := rfl
theorem encodeBase16UpperRfc2 : encode Base16Upper rfc2 = "F666F"          := rfl
theorem encodeBase16UpperRfc3 : encode Base16Upper rfc3 = "F666F6F"        := rfl
theorem encodeBase16UpperRfc4 : encode Base16Upper rfc4 = "F666F6F62"      := rfl
theorem encodeBase16UpperRfc5 : encode Base16Upper rfc5 = "F666F6F6261"    := rfl
theorem encodeBase16UpperRfc6 : encode Base16Upper rfc6 = "F666F6F626172"  := rfl

theorem decodeBase16UpperRfc0 : decode Base16Upper "F"             = some rfc0 := rfl
theorem decodeBase16UpperRfc1 : decode Base16Upper "F66"           = some rfc1 := rfl
theorem decodeBase16UpperRfc2 : decode Base16Upper "F666F"         = some rfc2 := rfl
theorem decodeBase16UpperRfc3 : decode Base16Upper "F666F6F"       = some rfc3 := rfl
theorem decodeBase16UpperRfc4 : decode Base16Upper "F666F6F62"     = some rfc4 := rfl
theorem decodeBase16UpperRfc5 : decode Base16Upper "F666F6F6261"   = some rfc5 := rfl
theorem decodeBase16UpperRfc6 : decode Base16Upper "F666F6F626172" = some rfc6 := rfl

theorem encodeBase32HexRfc0 : encode Base32Hex rfc0 = "v"           := rfl
theorem encodeBase32HexRfc1 : encode Base32Hex rfc1 = "vco"         := rfl
theorem encodeBase32HexRfc2 : encode Base32Hex rfc2 = "vcpng"       := rfl
theorem encodeBase32HexRfc3 : encode Base32Hex rfc3 = "vcpnmu"      := rfl
theorem encodeBase32HexRfc4 : encode Base32Hex rfc4 = "vcpnmuog"    := rfl
theorem encodeBase32HexRfc5 : encode Base32Hex rfc5 = "vcpnmuoj1"   := rfl
theorem encodeBase32HexRfc6 : encode Base32Hex rfc6 = "vcpnmuoj1e8" := rfl

theorem decodeBase32HexRfc0 : decode Base32Hex "v"           = some rfc0 := rfl
theorem decodeBase32HexRfc1 : decode Base32Hex "vco"         = some rfc1 := rfl
theorem decodeBase32HexRfc2 : decode Base32Hex "vcpng"       = some rfc2 := rfl
theorem decodeBase32HexRfc3 : decode Base32Hex "vcpnmu"      = some rfc3 := rfl
theorem decodeBase32HexRfc4 : decode Base32Hex "vcpnmuog"    = some rfc4 := rfl
theorem decodeBase32HexRfc5 : decode Base32Hex "vcpnmuoj1"   = some rfc5 := rfl
theorem decodeBase32HexRfc6 : decode Base32Hex "vcpnmuoj1e8" = some rfc6 := rfl

theorem encodeBase32HexUpperRfc0 : encode Base32HexUpper rfc0 = "V"           := rfl
theorem encodeBase32HexUpperRfc1 : encode Base32HexUpper rfc1 = "VCO"         := rfl
theorem encodeBase32HexUpperRfc2 : encode Base32HexUpper rfc2 = "VCPNG"       := rfl
theorem encodeBase32HexUpperRfc3 : encode Base32HexUpper rfc3 = "VCPNMU"      := rfl
theorem encodeBase32HexUpperRfc4 : encode Base32HexUpper rfc4 = "VCPNMUOG"    := rfl
theorem encodeBase32HexUpperRfc5 : encode Base32HexUpper rfc5 = "VCPNMUOJ1"   := rfl
theorem encodeBase32HexUpperRfc6 : encode Base32HexUpper rfc6 = "VCPNMUOJ1E8" := rfl

theorem decodeBase32HexUpperRfc0 : decode Base32HexUpper "V"           = some rfc0  := rfl
theorem decodeBase32HexUpperRfc1 : decode Base32HexUpper "VCO"         = some rfc1  := rfl
theorem decodeBase32HexUpperRfc2 : decode Base32HexUpper "VCPNG"       = some rfc2  := rfl
theorem decodeBase32HexUpperRfc3 : decode Base32HexUpper "VCPNMU"      = some rfc3  := rfl
theorem decodeBase32HexUpperRfc4 : decode Base32HexUpper "VCPNMUOG"    = some rfc4  := rfl
theorem decodeBase32HexUpperRfc5 : decode Base32HexUpper "VCPNMUOJ1"   = some rfc5  := rfl
theorem decodeBase32HexUpperRfc6 : decode Base32HexUpper "VCPNMUOJ1E8" = some rfc6  := rfl

theorem encodeBase32HexPadRfc0 : encode Base32HexPad rfc0 = "t"                 := rfl
theorem encodeBase32HexPadRfc1 : encode Base32HexPad rfc1 = "tco======"         := rfl
theorem encodeBase32HexPadRfc2 : encode Base32HexPad rfc2 = "tcpng===="         := rfl
theorem encodeBase32HexPadRfc3 : encode Base32HexPad rfc3 = "tcpnmu==="         := rfl
theorem encodeBase32HexPadRfc4 : encode Base32HexPad rfc4 = "tcpnmuog="         := rfl
theorem encodeBase32HexPadRfc5 : encode Base32HexPad rfc5 = "tcpnmuoj1"         := rfl
theorem encodeBase32HexPadRfc6 : encode Base32HexPad rfc6 = "tcpnmuoj1e8======" := rfl

theorem decodeBase32HexPadRfc0 : decode Base32HexPad "t"                 = some rfc0  := rfl
theorem decodeBase32HexPadRfc1 : decode Base32HexPad "tco======"         = some rfc1  := rfl
theorem decodeBase32HexPadRfc2 : decode Base32HexPad "tcpng===="         = some rfc2  := rfl
theorem decodeBase32HexPadRfc3 : decode Base32HexPad "tcpnmu==="         = some rfc3  := rfl
theorem decodeBase32HexPadRfc4 : decode Base32HexPad "tcpnmuog="         = some rfc4  := rfl
theorem decodeBase32HexPadRfc5 : decode Base32HexPad "tcpnmuoj1"         = some rfc5  := rfl
theorem decodeBase32HexPadRfc6 : decode Base32HexPad "tcpnmuoj1e8======" = some rfc6  := rfl

theorem encodeBase32HexPadUpperRfc0 : encode Base32HexPadUpper rfc0 = "T"                 := rfl
theorem encodeBase32HexPadUpperRfc1 : encode Base32HexPadUpper rfc1 = "TCO======"         := rfl
theorem encodeBase32HexPadUpperRfc2 : encode Base32HexPadUpper rfc2 = "TCPNG===="         := rfl
theorem encodeBase32HexPadUpperRfc3 : encode Base32HexPadUpper rfc3 = "TCPNMU==="         := rfl
theorem encodeBase32HexPadUpperRfc4 : encode Base32HexPadUpper rfc4 = "TCPNMUOG="         := rfl
theorem encodeBase32HexPadUpperRfc5 : encode Base32HexPadUpper rfc5 = "TCPNMUOJ1"         := rfl
theorem encodeBase32HexPadUpperRfc6 : encode Base32HexPadUpper rfc6 = "TCPNMUOJ1E8======" := rfl

theorem decodeBase32HexPadUpperRfc0 : decode Base32HexPadUpper "T" = some rfc0                 := rfl
theorem decodeBase32HexPadUpperRfc1 : decode Base32HexPadUpper "TCO======" = some rfc1         := rfl
theorem decodeBase32HexPadUpperRfc2 : decode Base32HexPadUpper "TCPNG====" = some rfc2         := rfl
theorem decodeBase32HexPadUpperRfc3 : decode Base32HexPadUpper "TCPNMU===" = some rfc3         := rfl
theorem decodeBase32HexPadUpperRfc4 : decode Base32HexPadUpper "TCPNMUOG=" = some rfc4         := rfl
theorem decodeBase32HexPadUpperRfc5 : decode Base32HexPadUpper "TCPNMUOJ1" = some rfc5         := rfl
theorem decodeBase32HexPadUpperRfc6 : decode Base32HexPadUpper "TCPNMUOJ1E8======" = some rfc6 := rfl

theorem encodeBase32Rfc0 : encode Base32 rfc0 = "b"           := rfl
theorem encodeBase32Rfc1 : encode Base32 rfc1 = "bmy"         := rfl
theorem encodeBase32Rfc2 : encode Base32 rfc2 = "bmzxq"       := rfl
theorem encodeBase32Rfc3 : encode Base32 rfc3 = "bmzxw6"      := rfl
theorem encodeBase32Rfc4 : encode Base32 rfc4 = "bmzxw6yq"    := rfl
theorem encodeBase32Rfc5 : encode Base32 rfc5 = "bmzxw6ytb"   := rfl
theorem encodeBase32Rfc6 : encode Base32 rfc6 = "bmzxw6ytboi" := rfl

theorem decodeBase32Rfc0 : decode Base32 "b"            = some rfc0 := rfl
theorem decodeBase32Rfc1 : decode Base32 "bmy"          = some rfc1 := rfl
theorem decodeBase32Rfc2 : decode Base32 "bmzxq"        = some rfc2 := rfl
theorem decodeBase32Rfc3 : decode Base32 "bmzxw6"       = some rfc3 := rfl
theorem decodeBase32Rfc4 : decode Base32 "bmzxw6yq"     = some rfc4 := rfl
theorem decodeBase32Rfc5 : decode Base32 "bmzxw6ytb"    = some rfc5 := rfl
theorem decodeBase32Rfc6 : decode Base32 "bmzxw6ytboi"  = some rfc6 := rfl

theorem encodeBase32UpperRfc0 : encode Base32Upper rfc0 = "B"           := rfl
theorem encodeBase32UpperRfc1 : encode Base32Upper rfc1 = "BMY"         := rfl
theorem encodeBase32UpperRfc2 : encode Base32Upper rfc2 = "BMZXQ"       := rfl
theorem encodeBase32UpperRfc3 : encode Base32Upper rfc3 = "BMZXW6"      := rfl
theorem encodeBase32UpperRfc4 : encode Base32Upper rfc4 = "BMZXW6YQ"    := rfl
theorem encodeBase32UpperRfc5 : encode Base32Upper rfc5 = "BMZXW6YTB"   := rfl
theorem encodeBase32UpperRfc6 : encode Base32Upper rfc6 = "BMZXW6YTBOI" := rfl

theorem encodeBase32PadRfc0 : encode Base32Pad rfc0 = "c"                 := rfl
theorem encodeBase32PadRfc1 : encode Base32Pad rfc1 = "cmy======"         := rfl
theorem encodeBase32PadRfc2 : encode Base32Pad rfc2 = "cmzxq===="         := rfl
theorem encodeBase32PadRfc3 : encode Base32Pad rfc3 = "cmzxw6==="         := rfl
theorem encodeBase32PadRfc4 : encode Base32Pad rfc4 = "cmzxw6yq="         := rfl
theorem encodeBase32PadRfc5 : encode Base32Pad rfc5 = "cmzxw6ytb"         := rfl
theorem encodeBase32PadRfc6 : encode Base32Pad rfc6 = "cmzxw6ytboi======" := rfl

theorem encodeBase32PadUpperRfc0 : encode Base32PadUpper rfc0 = "C"                 := rfl
theorem encodeBase32PadUpperRfc1 : encode Base32PadUpper rfc1 = "CMY======"         := rfl
theorem encodeBase32PadUpperRfc2 : encode Base32PadUpper rfc2 = "CMZXQ===="         := rfl
theorem encodeBase32PadUpperRfc3 : encode Base32PadUpper rfc3 = "CMZXW6==="         := rfl
theorem encodeBase32PadUpperRfc4 : encode Base32PadUpper rfc4 = "CMZXW6YQ="         := rfl
theorem encodeBase32PadUpperRfc5 : encode Base32PadUpper rfc5 = "CMZXW6YTB"         := rfl
theorem encodeBase32PadUpperRfc6 : encode Base32PadUpper rfc6 = "CMZXW6YTBOI======" := rfl

theorem encodeBase64Rfc0 : encode Base64 rfc0 = "m"         := rfl
theorem encodeBase64Rfc1 : encode Base64 rfc1 = "mZg"       := rfl
theorem encodeBase64Rfc2 : encode Base64 rfc2 = "mZm8"      := rfl
theorem encodeBase64Rfc3 : encode Base64 rfc3 = "mZm9v"     := rfl
theorem encodeBase64Rfc4 : encode Base64 rfc4 = "mZm9vYg"   := rfl
theorem encodeBase64Rfc5 : encode Base64 rfc5 = "mZm9vYmE"  := rfl
theorem encodeBase64Rfc6 : encode Base64 rfc6 = "mZm9vYmFy" := rfl

theorem decodeBase64Rfc0 : decode Base64 "m"          = some rfc0 := rfl
theorem decodeBase64Rfc1 : decode Base64 "mZg"        = some rfc1 := rfl
theorem decodeBase64Rfc2 : decode Base64 "mZm8"       = some rfc2 := rfl
theorem decodeBase64Rfc3 : decode Base64 "mZm9v"      = some rfc3 := rfl
theorem decodeBase64Rfc4 : decode Base64 "mZm9vYg"    = some rfc4 := rfl
theorem decodeBase64Rfc5 : decode Base64 "mZm9vYmE"   = some rfc5 := rfl
theorem decodeBase64Rfc6 : decode Base64 "mZm9vYmFy"  = some rfc6 := rfl

theorem encodeBase64PadRfc0 : encode Base64Pad rfc0 = "M"         := rfl
theorem encodeBase64PadRfc1 : encode Base64Pad rfc1 = "MZg=="     := rfl
theorem encodeBase64PadRfc2 : encode Base64Pad rfc2 = "MZm8="     := rfl
theorem encodeBase64PadRfc3 : encode Base64Pad rfc3 = "MZm9v"     := rfl
theorem encodeBase64PadRfc4 : encode Base64Pad rfc4 = "MZm9vYg==" := rfl
theorem encodeBase64PadRfc5 : encode Base64Pad rfc5 = "MZm9vYmE=" := rfl
theorem encodeBase64PadRfc6 : encode Base64Pad rfc6 = "MZm9vYmFy" := rfl

theorem encodeBase64URLPadRfc0 : encode Base64URLPad rfc0 = "U"         := rfl
theorem encodeBase64URLPadRfc1 : encode Base64URLPad rfc1 = "UZg=="     := rfl
theorem encodeBase64URLPadRfc2 : encode Base64URLPad rfc2 = "UZm8="     := rfl
theorem encodeBase64URLPadRfc3 : encode Base64URLPad rfc3 = "UZm9v"     := rfl
theorem encodeBase64URLPadRfc4 : encode Base64URLPad rfc4 = "UZm9vYg==" := rfl
theorem encodeBase64URLPadRfc5 : encode Base64URLPad rfc5 = "UZm9vYmE=" := rfl
theorem encodeBase64URLPadRfc6 : encode Base64URLPad rfc6 = "UZm9vYmFy" := rfl

end RFC4648

end Multibase.Test


@[noinline] def f (x : Bool)   := x
@[noinline] def g (x y : Bool) := x

def h (x : Bool) (xs : List Nat) : List Bool :=
  match x with
  | true =>
    let z := f true
    let y := f false
    xs.map fun x => g y z
  | false =>
    let y := f false
    let z := f true
    xs.map fun x => g y z

theorem ex1 : h true [1] = h false [1] := rfl

#eval h true [1]
#eval h false [1]

theorem ex2 : (h true [1] == h false [1]) = true :=
  by native_decide

@[noinline] def f2 (a : String) := a
@[noinline] def g2 (a : String) (x : Bool) := a

def h2 (x : Bool) (xs : List Nat) : List String :=
  match x with
  | false =>
    let a := f2 "a"
    let y := f false
    xs.map fun x => g2 a y
  | true =>
    let y := f false
    let a := f2 "a"
    xs.map fun x => g2 a y

#eval h2 true [1]
#eval h2 false [1]


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.monad.basic
import Mathlib.category_theory.adjunction.basic
import Mathlib.category_theory.reflects_isomorphisms
import Mathlib.PostPort

universes v₁ u₁ l

namespace Mathlib

/-!
# Eilenberg-Moore (co)algebras for a (co)monad

This file defines Eilenberg-Moore (co)algebras for a (co)monad,
and provides the category instance for them.

Further it defines the adjoint pair of free and forgetful functors, respectively
from and to the original category, as well as the adjoint pair of forgetful and
cofree functors, respectively from and to the original category.

## References
* [Riehl, *Category theory in context*, Section 5.2.4][riehl2017]
-/

namespace category_theory

namespace monad

/-- An Eilenberg-Moore algebra for a monad `T`.
    cf Definition 5.2.3 in [Riehl][riehl2017]. -/
structure algebra {C : Type u₁} [category C] (T : C ⥤ C) [monad T] where
  A : C
  a : functor.obj T A ⟶ A
  unit' :
    autoParam (nat_trans.app η_ A ≫ a = 𝟙)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  assoc' :
    autoParam (nat_trans.app μ_ A ≫ a = functor.map T a ≫ a)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

theorem algebra.unit {C : Type u₁} [category C] {T : C ⥤ C} [monad T] (c : algebra T) :
    nat_trans.app η_ (algebra.A c) ≫ algebra.a c = 𝟙 :=
  sorry

theorem algebra.assoc {C : Type u₁} [category C] {T : C ⥤ C} [monad T] (c : algebra T) :
    nat_trans.app μ_ (algebra.A c) ≫ algebra.a c = functor.map T (algebra.a c) ≫ algebra.a c :=
  sorry

theorem algebra.assoc_assoc {C : Type u₁} [category C] {T : C ⥤ C} [monad T] (c : algebra T)
    {X' : C} (f' : algebra.A c ⟶ X') :
    nat_trans.app μ_ (algebra.A c) ≫ algebra.a c ≫ f' =
        functor.map T (algebra.a c) ≫ algebra.a c ≫ f' :=
  sorry

namespace algebra

/-- A morphism of Eilenberg–Moore algebras for the monad `T`. -/
structure hom {C : Type u₁} [category C] {T : C ⥤ C} [monad T] (A : algebra T) (B : algebra T) where
  f : A A ⟶ A B
  h' :
    autoParam (functor.map T f ≫ a B = a A ≫ f)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

@[simp] theorem hom.h {C : Type u₁} [category C] {T : C ⥤ C} [monad T] {A : algebra T}
    {B : algebra T} (c : hom A B) : functor.map T (hom.f c) ≫ a B = a A ≫ hom.f c :=
  sorry

@[simp] theorem hom.h_assoc {C : Type u₁} [category C] {T : C ⥤ C} [monad T] {A : algebra T}
    {B : algebra T} (c : hom A B) {X' : C} (f' : A B ⟶ X') :
    functor.map T (hom.f c) ≫ a B ≫ f' = a A ≫ hom.f c ≫ f' :=
  sorry

namespace hom

/-- The identity homomorphism for an Eilenberg–Moore algebra. -/
def id {C : Type u₁} [category C] {T : C ⥤ C} [monad T] (A : algebra T) : hom A A := mk 𝟙

protected instance inhabited {C : Type u₁} [category C] {T : C ⥤ C} [monad T] (A : algebra T) :
    Inhabited (hom A A) :=
  { default := mk 𝟙 }

/-- Composition of Eilenberg–Moore algebra homomorphisms. -/
def comp {C : Type u₁} [category C] {T : C ⥤ C} [monad T] {P : algebra T} {Q : algebra T}
    {R : algebra T} (f : hom P Q) (g : hom Q R) : hom P R :=
  mk (f f ≫ f g)

end hom

protected instance category_theory.category_struct {C : Type u₁} [category C] {T : C ⥤ C}
    [monad T] : category_struct (algebra T) :=
  category_struct.mk hom.id hom.comp

@[simp] theorem comp_eq_comp {C : Type u₁} [category C] {T : C ⥤ C} [monad T] {A : algebra T}
    {A' : algebra T} {A'' : algebra T} (f : A ⟶ A') (g : A' ⟶ A'') : hom.comp f g = f ≫ g :=
  rfl

@[simp] theorem id_eq_id {C : Type u₁} [category C] {T : C ⥤ C} [monad T] (A : algebra T) :
    hom.id A = 𝟙 :=
  rfl

@[simp] theorem id_f {C : Type u₁} [category C] {T : C ⥤ C} [monad T] (A : algebra T) :
    hom.f 𝟙 = 𝟙 :=
  rfl

@[simp] theorem comp_f {C : Type u₁} [category C] {T : C ⥤ C} [monad T] {A : algebra T}
    {A' : algebra T} {A'' : algebra T} (f : A ⟶ A') (g : A' ⟶ A'') :
    hom.f (f ≫ g) = hom.f f ≫ hom.f g :=
  rfl

/-- The category of Eilenberg-Moore algebras for a monad.
    cf Definition 5.2.4 in [Riehl][riehl2017]. -/
protected instance EilenbergMoore {C : Type u₁} [category C] {T : C ⥤ C} [monad T] :
    category (algebra T) :=
  category.mk

/--
To construct an isomorphism of algebras, it suffices to give an isomorphism of the carriers which
commutes with the structure morphisms.
-/
@[simp] theorem iso_mk_hom_f {C : Type u₁} [category C] {T : C ⥤ C} [monad T] {A : algebra T}
    {B : algebra T} (h : A A ≅ A B) (w : functor.map T (iso.hom h) ≫ a B = a A ≫ iso.hom h) :
    hom.f (iso.hom (iso_mk h w)) = iso.hom h :=
  Eq.refl (hom.f (iso.hom (iso_mk h w)))

end algebra

/-- The forgetful functor from the Eilenberg-Moore category, forgetting the algebraic structure. -/
@[simp] theorem forget_map {C : Type u₁} [category C] (T : C ⥤ C) [monad T] (A : algebra T)
    (B : algebra T) (f : A ⟶ B) : functor.map (forget T) f = algebra.hom.f f :=
  Eq.refl (functor.map (forget T) f)

/-- The free functor from the Eilenberg-Moore category, constructing an algebra for any object. -/
@[simp] theorem free_obj_A {C : Type u₁} [category C] (T : C ⥤ C) [monad T] (X : C) :
    algebra.A (functor.obj (free T) X) = functor.obj T X :=
  Eq.refl (algebra.A (functor.obj (free T) X))

protected instance algebra.inhabited {C : Type u₁} [category C] (T : C ⥤ C) [monad T]
    [Inhabited C] : Inhabited (algebra T) :=
  { default := functor.obj (free T) Inhabited.default }

/-- The adjunction between the free and forgetful constructions for Eilenberg-Moore algebras for a monad.
    cf Lemma 5.2.8 of [Riehl][riehl2017]. -/
-- The other two `simps` projection lemmas can be derived from these two, so `simp_nf` complains if

-- those are added too

@[simp] theorem adj_counit {C : Type u₁} [category C] (T : C ⥤ C) [monad T] :
    adjunction.counit (adj T) =
        nat_trans.mk
          fun (Y : algebra T) =>
            equiv.inv_fun
              (adjunction.core_hom_equiv.hom_equiv
                (adjunction.core_hom_equiv.mk
                  fun (X : C) (Y : algebra T) =>
                    equiv.mk
                      (fun (f : functor.obj (free T) X ⟶ Y) => nat_trans.app η_ X ≫ algebra.hom.f f)
                      (fun (f : X ⟶ functor.obj (forget T) Y) =>
                        algebra.hom.mk (functor.map T f ≫ algebra.a Y))
                      (adj._proof_2 T X Y) (adj._proof_3 T X Y))
                (functor.obj (forget T) Y) (functor.obj 𝟭 Y))
              𝟙 :=
  Eq.refl (adjunction.counit (adj T))

/--
Given an algebra morphism whose carrier part is an isomorphism, we get an algebra isomorphism.
-/
def algebra_iso_of_iso {C : Type u₁} [category C] (T : C ⥤ C) [monad T] {A : algebra T}
    {B : algebra T} (f : A ⟶ B) [is_iso (algebra.hom.f f)] : is_iso f :=
  is_iso.mk (algebra.hom.mk (inv (algebra.hom.f f)))

protected instance forget_reflects_iso {C : Type u₁} [category C] (T : C ⥤ C) [monad T] :
    reflects_isomorphisms (forget T) :=
  reflects_isomorphisms.mk fun (A B : algebra T) => algebra_iso_of_iso T

protected instance forget_faithful {C : Type u₁} [category C] (T : C ⥤ C) [monad T] :
    faithful (forget T) :=
  faithful.mk

end monad

namespace comonad

/-- An Eilenberg-Moore coalgebra for a comonad `T`. -/
structure coalgebra {C : Type u₁} [category C] (G : C ⥤ C) [comonad G] where
  A : C
  a : A ⟶ functor.obj G A
  counit' :
    autoParam (a ≫ nat_trans.app ε_ A = 𝟙)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  coassoc' :
    autoParam (a ≫ nat_trans.app δ_ A = a ≫ functor.map G a)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

theorem coalgebra.counit {C : Type u₁} [category C] {G : C ⥤ C} [comonad G] (c : coalgebra G) :
    coalgebra.a c ≫ nat_trans.app ε_ (coalgebra.A c) = 𝟙 :=
  sorry

theorem coalgebra.coassoc {C : Type u₁} [category C] {G : C ⥤ C} [comonad G] (c : coalgebra G) :
    coalgebra.a c ≫ nat_trans.app δ_ (coalgebra.A c) =
        coalgebra.a c ≫ functor.map G (coalgebra.a c) :=
  sorry

theorem coalgebra.counit_assoc {C : Type u₁} [category C] {G : C ⥤ C} [comonad G] (c : coalgebra G)
    {X' : C} (f' : coalgebra.A c ⟶ X') :
    coalgebra.a c ≫ nat_trans.app ε_ (coalgebra.A c) ≫ f' = f' :=
  sorry

namespace coalgebra

/-- A morphism of Eilenberg-Moore coalgebras for the comonad `G`. -/
structure hom {C : Type u₁} [category C] {G : C ⥤ C} [comonad G] (A : coalgebra G) (B : coalgebra G)
    where
  f : A A ⟶ A B
  h' :
    autoParam (a A ≫ functor.map G f = f ≫ a B)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

@[simp] theorem hom.h {C : Type u₁} [category C] {G : C ⥤ C} [comonad G] {A : coalgebra G}
    {B : coalgebra G} (c : hom A B) : a A ≫ functor.map G (hom.f c) = hom.f c ≫ a B :=
  sorry

@[simp] theorem hom.h_assoc {C : Type u₁} [category C] {G : C ⥤ C} [comonad G] {A : coalgebra G}
    {B : coalgebra G} (c : hom A B) {X' : C} (f' : functor.obj G (A B) ⟶ X') :
    a A ≫ functor.map G (hom.f c) ≫ f' = hom.f c ≫ a B ≫ f' :=
  sorry

namespace hom

/-- The identity homomorphism for an Eilenberg–Moore coalgebra. -/
def id {C : Type u₁} [category C] {G : C ⥤ C} [comonad G] (A : coalgebra G) : hom A A := mk 𝟙

/-- Composition of Eilenberg–Moore coalgebra homomorphisms. -/
def comp {C : Type u₁} [category C] {G : C ⥤ C} [comonad G] {P : coalgebra G} {Q : coalgebra G}
    {R : coalgebra G} (f : hom P Q) (g : hom Q R) : hom P R :=
  mk (f f ≫ f g)

end hom

/-- The category of Eilenberg-Moore coalgebras for a comonad. -/
protected instance category_theory.category_struct {C : Type u₁} [category C] {G : C ⥤ C}
    [comonad G] : category_struct (coalgebra G) :=
  category_struct.mk hom.id hom.comp

@[simp] theorem comp_eq_comp {C : Type u₁} [category C] {G : C ⥤ C} [comonad G] {A : coalgebra G}
    {A' : coalgebra G} {A'' : coalgebra G} (f : A ⟶ A') (g : A' ⟶ A'') : hom.comp f g = f ≫ g :=
  rfl

@[simp] theorem id_eq_id {C : Type u₁} [category C] {G : C ⥤ C} [comonad G] (A : coalgebra G) :
    hom.id A = 𝟙 :=
  rfl

@[simp] theorem id_f {C : Type u₁} [category C] {G : C ⥤ C} [comonad G] (A : coalgebra G) :
    hom.f 𝟙 = 𝟙 :=
  rfl

@[simp] theorem comp_f {C : Type u₁} [category C] {G : C ⥤ C} [comonad G] {A : coalgebra G}
    {A' : coalgebra G} {A'' : coalgebra G} (f : A ⟶ A') (g : A' ⟶ A'') :
    hom.f (f ≫ g) = hom.f f ≫ hom.f g :=
  rfl

/-- The category of Eilenberg-Moore coalgebras for a comonad. -/
protected instance EilenbergMoore {C : Type u₁} [category C] {G : C ⥤ C} [comonad G] :
    category (coalgebra G) :=
  category.mk

/--
To construct an isomorphism of coalgebras, it suffices to give an isomorphism of the carriers which
commutes with the structure morphisms.
-/
@[simp] theorem iso_mk_hom_f {C : Type u₁} [category C] {G : C ⥤ C} [comonad G] {A : coalgebra G}
    {B : coalgebra G} (h : A A ≅ A B) (w : a A ≫ functor.map G (iso.hom h) = iso.hom h ≫ a B) :
    hom.f (iso.hom (iso_mk h w)) = iso.hom h :=
  Eq.refl (hom.f (iso.hom (iso_mk h w)))

end coalgebra

/-- The forgetful functor from the Eilenberg-Moore category, forgetting the coalgebraic structure. -/
def forget {C : Type u₁} [category C] (G : C ⥤ C) [comonad G] : coalgebra G ⥤ C :=
  functor.mk (fun (A : coalgebra G) => coalgebra.A A)
    fun (A B : coalgebra G) (f : A ⟶ B) => coalgebra.hom.f f

/--
Given a coalgebra morphism whose carrier part is an isomorphism, we get a coalgebra isomorphism.
-/
def coalgebra_iso_of_iso {C : Type u₁} [category C] (G : C ⥤ C) [comonad G] {A : coalgebra G}
    {B : coalgebra G} (f : A ⟶ B) [is_iso (coalgebra.hom.f f)] : is_iso f :=
  is_iso.mk (coalgebra.hom.mk (inv (coalgebra.hom.f f)))

protected instance forget_reflects_iso {C : Type u₁} [category C] (G : C ⥤ C) [comonad G] :
    reflects_isomorphisms (forget G) :=
  reflects_isomorphisms.mk fun (A B : coalgebra G) => coalgebra_iso_of_iso G

/-- The cofree functor from the Eilenberg-Moore category, constructing a coalgebra for any object. -/
@[simp] theorem cofree_map_f {C : Type u₁} [category C] (G : C ⥤ C) [comonad G] (X : C) (Y : C)
    (f : X ⟶ Y) : coalgebra.hom.f (functor.map (cofree G) f) = functor.map G f :=
  Eq.refl (coalgebra.hom.f (functor.map (cofree G) f))

/--
The adjunction between the cofree and forgetful constructions for Eilenberg-Moore coalgebras
for a comonad.
-/
-- The other two `simps` projection lemmas can be derived from these two, so `simp_nf` complains if

-- those are added too

@[simp] theorem adj_counit {C : Type u₁} [category C] (G : C ⥤ C) [comonad G] :
    adjunction.counit (adj G) = nat_trans.mk (nat_trans.app ε_) :=
  sorry

protected instance forget_faithful {C : Type u₁} [category C] (G : C ⥤ C) [comonad G] :
    faithful (forget G) :=
  faithful.mk

end Mathlib


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors : Aaron Anderson
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.linear_algebra.basic
import Mathlib.order.atoms
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

/-!
# Simple Modules

## Main Definitions
  * `is_simple_module` indicates that a module has no proper submodules
  (the only submodules are `⊥` and `⊤`).
  * A `division_ring` structure on the endomorphism ring of a simple module.

## Main Results
  * Schur's Lemma: `bijective_or_eq_zero` shows that a linear map between simple modules
  is either bijective or 0, leading to a `division_ring` structure on the endomorphism ring.

## TODO
  * Semisimple modules, Artin-Wedderburn Theory
  * Unify with the work on Schur's Lemma in a category theory context

-/

/-- A module is simple when it has only two submodules, `⊥` and `⊤`. -/
def is_simple_module (R : Type u_1) [comm_ring R] (M : Type u_2) [add_comm_group M] [module R M] :=
  is_simple_lattice (submodule R M)

-- Making this an instance causes the linter to complain of "dangerous instances"

theorem is_simple_module.nontrivial (R : Type u_1) [comm_ring R] (M : Type u_2) [add_comm_group M] [module R M] [is_simple_module R M] : nontrivial M := sorry

namespace linear_map

theorem injective_or_eq_zero {R : Type u_1} [comm_ring R] {M : Type u_2} [add_comm_group M] [module R M] {N : Type u_3} [add_comm_group N] [module R N] [is_simple_module R M] (f : linear_map R M N) : function.injective ⇑f ∨ f = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (function.injective ⇑f ∨ f = 0)) (Eq.symm (propext ker_eq_bot))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (ker f = ⊥ ∨ f = 0)) (Eq.symm (propext ker_eq_top)))) (eq_bot_or_eq_top (ker f)))

theorem injective_of_ne_zero {R : Type u_1} [comm_ring R] {M : Type u_2} [add_comm_group M] [module R M] {N : Type u_3} [add_comm_group N] [module R N] [is_simple_module R M] {f : linear_map R M N} (h : f ≠ 0) : function.injective ⇑f :=
  or.resolve_right (injective_or_eq_zero f) h

theorem surjective_or_eq_zero {R : Type u_1} [comm_ring R] {M : Type u_2} [add_comm_group M] [module R M] {N : Type u_3} [add_comm_group N] [module R N] [is_simple_module R N] (f : linear_map R M N) : function.surjective ⇑f ∨ f = 0 := sorry

theorem surjective_of_ne_zero {R : Type u_1} [comm_ring R] {M : Type u_2} [add_comm_group M] [module R M] {N : Type u_3} [add_comm_group N] [module R N] [is_simple_module R N] {f : linear_map R M N} (h : f ≠ 0) : function.surjective ⇑f :=
  or.resolve_right (surjective_or_eq_zero f) h

/-- Schur's Lemma for linear maps between (possibly distinct) simple modules -/
theorem bijective_or_eq_zero {R : Type u_1} [comm_ring R] {M : Type u_2} [add_comm_group M] [module R M] {N : Type u_3} [add_comm_group N] [module R N] [is_simple_module R M] [is_simple_module R N] (f : linear_map R M N) : function.bijective ⇑f ∨ f = 0 :=
  dite (f = 0) (fun (h : f = 0) => Or.inr h)
    fun (h : ¬f = 0) => or.intro_left (f = 0) { left := injective_of_ne_zero h, right := surjective_of_ne_zero h }

theorem bijective_of_ne_zero {R : Type u_1} [comm_ring R] {M : Type u_2} [add_comm_group M] [module R M] {N : Type u_3} [add_comm_group N] [module R N] [is_simple_module R M] [is_simple_module R N] {f : linear_map R M N} (h : f ≠ 0) : function.bijective ⇑f :=
  or.resolve_right (bijective_or_eq_zero f) h

/-- Schur's Lemma makes the endomorphism ring of a simple module a division ring. -/
protected instance module.End.division_ring {R : Type u_1} [comm_ring R] {M : Type u_2} [add_comm_group M] [module R M] [DecidableEq (module.End R M)] [is_simple_module R M] : division_ring (module.End R M) :=
  division_ring.mk ring.add sorry ring.zero sorry sorry ring.neg ring.sub sorry sorry ring.mul sorry ring.one sorry sorry
    sorry sorry
    (fun (f : module.End R M) =>
      dite (f = 0) (fun (h : f = 0) => 0)
        fun (h : ¬f = 0) => inverse f (equiv.inv_fun (equiv.of_bijective (⇑f) (bijective_of_ne_zero h))) sorry sorry)
    (div_inv_monoid.div._default ring.mul sorry ring.one sorry sorry
      fun (f : module.End R M) =>
        dite (f = 0) (fun (h : f = 0) => 0)
          fun (h : ¬f = 0) => inverse f (equiv.inv_fun (equiv.of_bijective (⇑f) (bijective_of_ne_zero h))) sorry sorry)
    sorry sorry sorry


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

/-!
# Cartesian products of categories

We define the category instance on `C × D` when `C` and `D` are categories.

We define:
* `sectl C Z` : the functor `C ⥤ C × D` given by `X ↦ ⟨X, Z⟩`
* `sectr Z D` : the functor `D ⥤ C × D` given by `Y ↦ ⟨Z, Y⟩`
* `fst`       : the functor `⟨X, Y⟩ ↦ X`
* `snd`       : the functor `⟨X, Y⟩ ↦ Y`
* `swap`      : the functor `C × D ⥤ D × C` given by `⟨X, Y⟩ ↦ ⟨Y, X⟩`
    (and the fact this is an equivalence)

We further define `evaluation : C ⥤ (C ⥤ D) ⥤ D` and `evaluation_uncurried : C × (C ⥤ D) ⥤ D`,
and products of functors and natural transformations, written `F.prod G` and `α.prod β`.
-/

namespace category_theory

-- declare the `v`'s first; see `category_theory.category` for an explanation
universes v₁ v₂ v₃ v₄ u₁ u₂ u₃ u₄

section
variables (C : Type u₁) [category.{v₁} C] (D : Type u₂) [category.{v₂} D]

/--
`prod C D` gives the cartesian product of two categories.

See https://stacks.math.columbia.edu/tag/001K.
-/
instance prod : category.{max v₁ v₂} (C × D) :=
{ hom     := λ X Y, ((X.1) ⟶ (Y.1)) × ((X.2) ⟶ (Y.2)),
  id      := λ X, ⟨ 𝟙 (X.1), 𝟙 (X.2) ⟩,
  comp    := λ _ _ _ f g, (f.1 ≫ g.1, f.2 ≫ g.2) }

-- rfl lemmas for category.prod
@[simp]

section
variables (C : Type u₁) [category.{v₁} C] (D : Type u₁) [category.{v₁} D]
/--
`prod.category.uniform C D` is an additional instance specialised so both factors have the same
universe levels. This helps typeclass resolution.
-/
instance uniform_prod : category (C × D) := category_theory.prod C D
end

-- Next we define the natural functors into and out of product categories. For now this doesn't
-- address the universal properties.
namespace prod

/-- `sectl C Z` is the functor `C ⥤ C × D` given by `X ↦ (X, Z)`. -/
@[simps] def sectl
  (C : Type u₁) [category.{v₁} C] {D : Type u₂} [category.{v₂} D] (Z : D) : C ⥤ C × D :=
{ obj := λ X, (X, Z),
  map := λ X Y f, (f, 𝟙 Z) }

/-- `sectr Z D` is the functor `D ⥤ C × D` given by `Y ↦ (Z, Y)` . -/
@[simps] def sectr
  {C : Type u₁} [category.{v₁} C] (Z : C) (D : Type u₂) [category.{v₂} D] : D ⥤ C × D :=
{ obj := λ X, (Z, X),
  map := λ X Y f, (𝟙 Z, f) }

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

/-- `fst` is the functor `(X, Y) ↦ X`. -/
@[simps] def fst : C × D ⥤ C :=
{ obj := λ X, X.1,
  map := λ X Y f, f.1 }

/-- `snd` is the functor `(X, Y) ↦ Y`. -/
@[simps] def snd : C × D ⥤ D :=
{ obj := λ X, X.2,
  map := λ X Y f, f.2 }

/-- The functor swapping the factors of a cartesian product of categories, `C × D ⥤ D × C`. -/
@[simps] def swap : C × D ⥤ D × C :=
{ obj := λ X, (X.2, X.1),
  map := λ _ _ f, (f.2, f.1) }

/--
Swapping the factors of a cartesion product of categories twice is naturally isomorphic
to the identity functor.
-/
@[simps] def symmetry : swap C D ⋙ swap D C ≅ 𝟭 (C × D) :=
{ hom := { app := λ X, 𝟙 X },
  inv := { app := λ X, 𝟙 X } }

/--
The equivalence, given by swapping factors, between `C × D` and `D × C`.
-/
@[simps]
def braiding : C × D ≌ D × C :=
equivalence.mk (swap C D) (swap D C)
  (nat_iso.of_components (λ X, eq_to_iso (by simp)) (by tidy))
  (nat_iso.of_components (λ X, eq_to_iso (by simp)) (by tidy))

instance swap_is_equivalence : is_equivalence (swap C D) :=
(by apply_instance : is_equivalence (braiding C D).functor)

end prod

section
variables (C : Type u₁) [category.{v₁} C] (D : Type u₂) [category.{v₂} D]

/--
The "evaluation at `X`" functor, such that
`(evaluation.obj X).obj F = F.obj X`,
which is functorial in both `X` and `F`.
-/
@[simps] def evaluation : C ⥤ (C ⥤ D) ⥤ D :=
{ obj := λ X,
  { obj := λ F, F.obj X,
    map := λ F G α, α.app X, },
  map := λ X Y f,
  { app := λ F, F.map f,
    naturality' := λ F G α, eq.symm (α.naturality f) } }

/--
The "evaluation of `F` at `X`" functor,
as a functor `C × (C ⥤ D) ⥤ D`.
-/
@[simps] def evaluation_uncurried : C × (C ⥤ D) ⥤ D :=
{ obj := λ p, p.2.obj p.1,
  map := λ x y f, (x.2.map f.1) ≫ (f.2.app y.1),
  map_comp' := λ X Y Z f g,
  begin
    cases g, cases f, cases Z, cases Y, cases X,
    simp only [prod_comp, nat_trans.comp_app, functor.map_comp, category.assoc],
    rw [←nat_trans.comp_app, nat_trans.naturality, nat_trans.comp_app,
        category.assoc, nat_trans.naturality],
  end }

end

variables {A : Type u₁} [category.{v₁} A]
          {B : Type u₂} [category.{v₂} B]
          {C : Type u₃} [category.{v₃} C]
          {D : Type u₄} [category.{v₄} D]

namespace functor
/-- The cartesian product of two functors. -/
@[simps] def prod (F : A ⥤ B) (G : C ⥤ D) : A × C ⥤ B × D :=
{ obj := λ X, (F.obj X.1, G.obj X.2),
  map := λ _ _ f, (F.map f.1, G.map f.2) }

/- Because of limitations in Lean 3's handling of notations, we do not setup a notation `F × G`.
   You can use `F.prod G` as a "poor man's infix", or just write `functor.prod F G`. -/

end functor

namespace nat_trans

/-- The cartesian product of two natural transformations. -/
@[simps] def prod {F G : A ⥤ B} {H I : C ⥤ D} (α : F ⟶ G) (β : H ⟶ I) :
  F.prod H ⟶ G.prod I :=
{ app         := λ X, (α.app X.1, β.app X.2),
  naturality' := λ X Y f,
  begin
    cases X, cases Y,
    simp only [functor.prod_map, prod.mk.inj_iff, prod_comp],
    split; rw naturality
  end }

/- Again, it is inadvisable in Lean 3 to setup a notation `α × β`;
   use instead `α.prod β` or `nat_trans.prod α β`. -/

end nat_trans

end category_theory