/-
Copyright © 2020 Nicolò Cavalleri. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nicolò Cavalleri
-/

import geometry.manifold.times_cont_mdiff_map

/-!
# Smooth monoid
A smooth monoid is a monoid that is also a smooth manifold, in which multiplication is a smooth map
of the product manifold `G` × `G` into `G`.

In this file we define the basic structures to talk about smooth monoids: `has_smooth_mul` and its
additive counterpart `has_smooth_add`. These structures are general enough to also talk about smooth
semigroups.
-/

open_locale manifold

/--
1. All smooth algebraic structures on `G` are `Prop`-valued classes that extend
`smooth_manifold_with_corners I G`. This way we save users from adding both
`[smooth_manifold_with_corners I G]` and `[has_smooth_mul I G]` to the assumptions. While many API
lemmas hold true without the `smooth_manifold_with_corners I G` assumption, we're not aware of a
mathematically interesting monoid on a topological manifold such that (a) the space is not a
`smooth_manifold_with_corners`; (b) the multiplication is smooth at `(a, b)` in the charts
`ext_chart_at I a`, `ext_chart_at I b`, `ext_chart_at I (a * b)`.

2. Because of `model_prod` we can't assume, e.g., that a `lie_group` is modelled on `𝓘(𝕜, E)`. So,
we formulate the definitions and lemmas for any model.

3. While smoothness of an operation implies its continuity, lemmas like
`has_continuous_mul_of_smooth` can't be instances becausen otherwise Lean would have to search for
`has_smooth_mul I G` with unknown `𝕜`, `E`, `H`, and `I : model_with_corners 𝕜 E H`. If users needs
`[has_continuous_mul G]` in a proof about a smooth monoid, then they need to either add
`[has_continuous_mul G]` as an assumption (worse) or use `haveI` in the proof (better). -/
library_note "Design choices about smooth algebraic structures"

/-- Basic hypothesis to talk about a smooth (Lie) additive monoid or a smooth additive
semigroup. A smooth additive monoid over `α`, for example, is obtained by requiring both the
instances `add_monoid α` and `has_smooth_add α`. -/
-- See note [Design choices about smooth algebraic structures]
@[ancestor smooth_manifold_with_corners]
class has_smooth_add {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
  {H : Type*} [topological_space H]
  {E : Type*} [normed_group E] [normed_space 𝕜 E] (I : model_with_corners 𝕜 E H)
  (G : Type*) [has_add G] [topological_space G] [charted_space H G]
  extends smooth_manifold_with_corners I G : Prop :=
(smooth_add : smooth (I.prod I) I (λ p : G×G, p.1 + p.2))

/-- Basic hypothesis to talk about a smooth (Lie) monoid or a smooth semigroup.
A smooth monoid over `G`, for example, is obtained by requiring both the instances `monoid G`
and `has_smooth_mul I G`. -/
-- See note [Design choices about smooth algebraic structures]
@[ancestor smooth_manifold_with_corners, to_additive]
class has_smooth_mul {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
  {H : Type*} [topological_space H]
  {E : Type*} [normed_group E] [normed_space 𝕜 E] (I : model_with_corners 𝕜 E H)
  (G : Type*) [has_mul G] [topological_space G] [charted_space H G]
  extends smooth_manifold_with_corners I G : Prop :=
(smooth_mul : smooth (I.prod I) I (λ p : G×G, p.1 * p.2))

section has_smooth_mul

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{H : Type*} [topological_space H]
{E : Type*} [normed_group E] [normed_space 𝕜 E] {I : model_with_corners 𝕜 E H}
{G : Type*} [has_mul G] [topological_space G] [charted_space H G] [has_smooth_mul I G]
{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
{H' : Type*} [topological_space H'] {I' : model_with_corners 𝕜 E' H'}
{M : Type*} [topological_space M] [charted_space H' M]

section

variables (I)

@[to_additive]
lemma smooth_mul : smooth (I.prod I) I (λ p : G×G, p.1 * p.2) :=
has_smooth_mul.smooth_mul

/-- If the multiplication is smooth, then it is continuous. This is not an instance for technical
reasons, see note [Design choices about smooth algebraic structures]. -/
@[to_additive
"If the addition is smooth, then it is continuous. This is not an instance for technical reasons,
see note [Design choices about smooth algebraic structures]."]
lemma has_continuous_mul_of_smooth : has_continuous_mul G :=
⟨(smooth_mul I).continuous⟩

end

@[to_additive]
lemma smooth.mul {f : M → G} {g : M → G} (hf : smooth I' I f) (hg : smooth I' I g) :
  smooth I' I (f * g) :=
(smooth_mul I).comp (hf.prod_mk hg)

@[to_additive]
lemma smooth_mul_left {a : G} : smooth I I (λ b : G, a * b) :=
smooth_const.mul smooth_id

@[to_additive]
lemma smooth_mul_right {a : G} : smooth I I (λ b : G, b * a) :=
smooth_id.mul smooth_const

@[to_additive]
lemma smooth_on.mul {f : M → G} {g : M → G} {s : set M}
  (hf : smooth_on I' I f s) (hg : smooth_on I' I g s) :
  smooth_on I' I (f * g) s :=
((smooth_mul I).comp_smooth_on (hf.prod_mk hg) : _)

variables (I) (g h : G)

/-- Left multiplication by `g`. It is meant to mimic the usual notation in Lie groups.
Lemmas involving `smooth_left_mul` with the notation `𝑳` usually use `L` instead of `𝑳` in the
names. -/
def smooth_left_mul : C^∞⟮I, G; I, G⟯ := ⟨(left_mul g), smooth_mul_left⟩

/-- Right multiplication by `g`. It is meant to mimic the usual notation in Lie groups.
Lemmas involving `smooth_right_mul` with the notation `𝑹` usually use `R` instead of `𝑹` in the
names. -/
def smooth_right_mul : C^∞⟮I, G; I, G⟯ := ⟨(right_mul g), smooth_mul_right⟩

/- Left multiplication. The abbreviation is `MIL`. -/
localized "notation `𝑳` := smooth_left_mul" in lie_group

/- Right multiplication. The abbreviation is `MIR`. -/
localized "notation `𝑹` := smooth_right_mul" in lie_group

open_locale lie_group

@[simp] lemma L_apply : (𝑳 I g) h = g * h := rfl
@[simp] lemma R_apply : (𝑹 I g) h = h * g := rfl

@[simp] lemma L_mul {G : Type*} [semigroup G] [topological_space G] [charted_space H G]
  [has_smooth_mul I G] (g h : G) : 𝑳 I (g * h) = (𝑳 I g).comp (𝑳 I h) :=
by { ext, simp only [times_cont_mdiff_map.comp_apply, L_apply, mul_assoc] }

@[simp] lemma R_mul {G : Type*} [semigroup G] [topological_space G] [charted_space H G]
  [has_smooth_mul I G] (g h : G) : 𝑹 I (g * h) = (𝑹 I h).comp (𝑹 I g) :=
by { ext, simp only [times_cont_mdiff_map.comp_apply, R_apply, mul_assoc] }

section

variables {G' : Type*} [monoid G'] [topological_space G'] [charted_space H G']
  [has_smooth_mul I G'] (g' : G')

lemma smooth_left_mul_one : (𝑳 I g') 1 = g' := mul_one g'
lemma smooth_right_mul_one : (𝑹 I g') 1 = g' := one_mul g'

end

/- Instance of product -/
@[to_additive]
instance has_smooth_mul.prod {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
  {E : Type*} [normed_group E] [normed_space 𝕜 E]
  {H : Type*} [topological_space H] (I : model_with_corners 𝕜 E H)
  (G : Type*) [topological_space G] [charted_space H G]
  [has_mul G] [has_smooth_mul I G]
  {E' : Type*} [normed_group E'] [normed_space 𝕜 E']
  {H' : Type*} [topological_space H'] (I' : model_with_corners 𝕜 E' H')
  (G' : Type*) [topological_space G'] [charted_space H' G']
  [has_mul G'] [has_smooth_mul I' G'] :
  has_smooth_mul (I.prod I') (G×G') :=
{ smooth_mul := ((smooth_fst.comp smooth_fst).smooth.mul (smooth_fst.comp smooth_snd)).prod_mk
    ((smooth_snd.comp smooth_fst).smooth.mul (smooth_snd.comp smooth_snd)),
  .. smooth_manifold_with_corners.prod G G' }

end has_smooth_mul

section monoid

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{H : Type*} [topological_space H]
{E : Type*} [normed_group E] [normed_space 𝕜 E] {I : model_with_corners 𝕜 E H}
{G : Type*} [monoid G] [topological_space G] [charted_space H G] [has_smooth_mul I G]
{H' : Type*} [topological_space H']
{E' : Type*} [normed_group E'] [normed_space 𝕜 E'] {I' : model_with_corners 𝕜 E' H'}
{G' : Type*} [monoid G'] [topological_space G'] [charted_space H' G'] [has_smooth_mul I' G']

lemma smooth_pow : ∀ n : ℕ, smooth I I (λ a : G, a ^ n)
| 0 := by { simp only [pow_zero], exact smooth_const }
| (k+1) := by simpa [pow_succ] using smooth_id.mul (smooth_pow _)

/-- Morphism of additive smooth monoids. -/
structure smooth_add_monoid_morphism
  (I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H')
  (G : Type*) [topological_space G] [charted_space H G] [add_monoid G] [has_smooth_add I G]
  (G' : Type*) [topological_space G'] [charted_space H' G'] [add_monoid G'] [has_smooth_add I' G']
  extends G →+ G' :=
(smooth_to_fun : smooth I I' to_fun)

/-- Morphism of smooth monoids. -/
@[to_additive] structure smooth_monoid_morphism
  (I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H')
  (G : Type*) [topological_space G] [charted_space H G] [monoid G] [has_smooth_mul I G]
  (G' : Type*) [topological_space G'] [charted_space H' G'] [monoid G'] [has_smooth_mul I' G']
  extends G →* G' :=
(smooth_to_fun : smooth I I' to_fun)

@[to_additive]
instance : has_one (smooth_monoid_morphism I I' G G') :=
⟨{ smooth_to_fun := smooth_const, to_monoid_hom := 1 }⟩

@[to_additive]
instance : inhabited (smooth_monoid_morphism I I' G G') := ⟨1⟩

@[to_additive]
instance : has_coe_to_fun (smooth_monoid_morphism I I' G G') (λ _, G → G') := ⟨λ a, a.to_fun⟩

end monoid

section comm_monoid

open_locale big_operators

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{H : Type*} [topological_space H]
{E : Type*} [normed_group E] [normed_space 𝕜 E] {I : model_with_corners 𝕜 E H}
{G : Type*} [comm_monoid G] [topological_space G] [charted_space H G] [has_smooth_mul I G]
{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
{H' : Type*} [topological_space H'] {I' : model_with_corners 𝕜 E' H'}
{M : Type*} [topological_space M] [charted_space H' M]

@[to_additive]
lemma smooth_finset_prod' {ι} {s : finset ι} {f : ι → M → G} (h : ∀ i ∈ s, smooth I' I (f i)) :
  smooth I' I (∏ i in s, f i) :=
finset.prod_induction _ _ (λ f g hf hg, hf.mul hg)
  (@smooth_const _ _ _ _ _ _ _ I' _ _ _ _ _ _ _ _ I _ _ _ 1) h

@[to_additive]
lemma smooth_finset_prod {ι} {s : finset ι} {f : ι → M → G} (h : ∀ i ∈ s, smooth I' I (f i)) :
  smooth I' I (λ x, ∏ i in s, f i x) :=
by { simp only [← finset.prod_apply], exact smooth_finset_prod' h }

open function filter

@[to_additive]
lemma smooth_finprod {ι} {f : ι → M → G} (h : ∀ i, smooth I' I (f i))
  (hfin : locally_finite (λ i, mul_support (f i))) :
  smooth I' I (λ x, ∏ᶠ i, f i x) :=
begin
  intro x,
  rcases hfin x with ⟨U, hxU, hUf⟩,
  have : smooth_at I' I (λ x, ∏ i in hUf.to_finset, f i x) x,
    from smooth_finset_prod (λ i hi, h i) x,
  refine this.congr_of_eventually_eq (mem_of_superset hxU $ λ y hy, _),
  refine finprod_eq_prod_of_mul_support_subset _ (λ i hi, _),
  rw [hUf.coe_to_finset],
  exact ⟨y, hi, hy⟩
end

@[to_additive]
lemma smooth_finprod_cond {ι} {f : ι → M → G} {p : ι → Prop} (hc : ∀ i, p i → smooth I' I (f i))
  (hf : locally_finite (λ i, mul_support (f i))) :
  smooth I' I (λ x, ∏ᶠ i (hi : p i), f i x) :=
begin
  simp only [← finprod_subtype_eq_finprod_cond],
  exact smooth_finprod (λ i, hc i i.2) (hf.comp_injective subtype.coe_injective)
end

end comm_monoid


/-
Copyright (c) 2022 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Floris van Doorn, Yury Kudryashov

! This file was ported from Lean 3 source module order.filter.small_sets
! leanprover-community/mathlib commit 8631e2d5ea77f6c13054d9151d82b83069680cb1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.Filter.Lift
import Mathlib.Order.Filter.AtTopBot

/-!
# The filter of small sets

This file defines the filter of small sets w.r.t. a filter `f`, which is the largest filter
containing all powersets of members of `f`.

`g` converges to `f.smallSets` if for all `s ∈ f`, eventually we have `g x ⊆ s`.

An example usage is that if `f : ι → E → ℝ` is a family of nonnegative functions with integral 1,
then saying that `λ i, support (f i)` tendsto `(𝓝 0).smallSets` is a way of saying that
`f` tends to the Dirac delta distribution.
-/

open Filter

open Filter Set

variable {α β : Type _} {ι : Sort _}

namespace Filter

variable {l l' la : Filter α} {lb : Filter β}

/-- The filter `l.smallSets` is the largest filter containing all powersets of members of `l`. -/
def smallSets (l : Filter α) : Filter (Set α) :=
  l.lift' powerset
#align filter.small_sets Filter.smallSets

theorem smallSets_eq_generate {f : Filter α} : f.smallSets = generate (powerset '' f.sets) := by
  simp_rw [generate_eq_binfᵢ, smallSets, infᵢ_image]
  rfl
#align filter.small_sets_eq_generate Filter.smallSets_eq_generate

theorem HasBasis.smallSets {p : ι → Prop} {s : ι → Set α} (h : HasBasis l p s) :
    HasBasis l.smallSets p fun i => 𝒫 s i :=
  h.lift' monotone_powerset
#align filter.has_basis.small_sets Filter.HasBasis.smallSets

theorem hasBasis_smallSets (l : Filter α) :
    HasBasis l.smallSets (fun t : Set α => t ∈ l) powerset :=
  l.basis_sets.smallSets
#align filter.has_basis_small_sets Filter.hasBasis_smallSets

/-- `g` converges to `f.smallSets` if for all `s ∈ f`, eventually we have `g x ⊆ s`. -/
theorem tendsto_smallSets_iff {f : α → Set β} :
    Tendsto f la lb.smallSets ↔ ∀ t ∈ lb, ∀ᶠ x in la, f x ⊆ t :=
  (hasBasis_smallSets lb).tendsto_right_iff
#align filter.tendsto_small_sets_iff Filter.tendsto_smallSets_iff

-- porting note: the proof was `eventually_lift'_iff monotone_powerset`
-- but it timeouts in Lean 4
theorem eventually_smallSets {p : Set α → Prop} :
    (∀ᶠ s in l.smallSets, p s) ↔ ∃ s ∈ l, ∀ t, t ⊆ s → p t := by
  rw [smallSets, eventually_lift'_iff]; rfl
  exact monotone_powerset
#align filter.eventually_small_sets Filter.eventually_smallSets

theorem eventually_small_sets' {p : Set α → Prop} (hp : ∀ ⦃s t⦄, s ⊆ t → p t → p s) :
    (∀ᶠ s in l.smallSets, p s) ↔ ∃ s ∈ l, p s :=
  eventually_smallSets.trans <|
    exists_congr fun s => Iff.rfl.and ⟨fun H => H s Subset.rfl, fun hs _t ht => hp ht hs⟩
#align filter.eventually_small_sets' Filter.eventually_small_sets'

theorem frequently_smallSets {p : Set α → Prop} :
    (∃ᶠ s in l.smallSets, p s) ↔ ∀ t ∈ l, ∃ s, s ⊆ t ∧ p s :=
  l.hasBasis_smallSets.frequently_iff
#align filter.frequently_small_sets Filter.frequently_smallSets

theorem frequently_smallSets_mem (l : Filter α) : ∃ᶠ s in l.smallSets, s ∈ l :=
  frequently_smallSets.2 fun t ht => ⟨t, Subset.rfl, ht⟩
#align filter.frequently_small_sets_mem Filter.frequently_smallSets_mem

theorem HasAntitoneBasis.tendsto_smallSets {ι} [Preorder ι] {s : ι → Set α}
    (hl : l.HasAntitoneBasis s) : Tendsto s atTop l.smallSets :=
  tendsto_smallSets_iff.2 fun _t ht => hl.eventually_subset ht
#align filter.has_antitone_basis.tendsto_small_sets Filter.HasAntitoneBasis.tendsto_smallSets

@[mono]
theorem monotone_smallSets : Monotone (@smallSets α) :=
  monotone_lift' monotone_id monotone_const
#align filter.monotone_small_sets Filter.monotone_smallSets

@[simp]
theorem smallSets_bot : (⊥ : Filter α).smallSets = pure ∅ := by
  rw [smallSets, lift'_bot, powerset_empty, principal_singleton]
  exact monotone_powerset
#align filter.small_sets_bot Filter.smallSets_bot

@[simp]
theorem smallSets_top : (⊤ : Filter α).smallSets = ⊤ := by
  rw [smallSets, lift'_top, powerset_univ, principal_univ]
#align filter.small_sets_top Filter.smallSets_top

@[simp]
theorem smallSets_principal (s : Set α) : (𝓟 s).smallSets = 𝓟 (𝒫 s) :=
  lift'_principal monotone_powerset
#align filter.small_sets_principal Filter.smallSets_principal

theorem smallSets_comap (l : Filter β) (f : α → β) :
    (comap f l).smallSets = l.lift' (powerset ∘ preimage f) :=
  comap_lift'_eq2 monotone_powerset
#align filter.small_sets_comap Filter.smallSets_comap

theorem smallSets_infᵢ {f : ι → Filter α} : (infᵢ f).smallSets = ⨅ i, (f i).smallSets :=
  lift'_infᵢ_of_map_univ (powerset_inter _ _) powerset_univ
#align filter.small_sets_infi Filter.smallSets_infᵢ

theorem smallSets_inf (l₁ l₂ : Filter α) : (l₁ ⊓ l₂).smallSets = l₁.smallSets ⊓ l₂.smallSets :=
  lift'_inf _ _ powerset_inter
#align filter.small_sets_inf Filter.smallSets_inf

instance smallSets_neBot (l : Filter α) : NeBot l.smallSets := by
  refine' (lift'_neBot_iff _).2 fun _ _ => powerset_nonempty
  exact monotone_powerset
#align filter.small_sets_ne_bot Filter.smallSets_neBot

theorem Tendsto.smallSets_mono {s t : α → Set β} (ht : Tendsto t la lb.smallSets)
    (hst : ∀ᶠ x in la, s x ⊆ t x) : Tendsto s la lb.smallSets := by
  rw [tendsto_smallSets_iff] at ht ⊢
  exact fun u hu => (ht u hu).mp (hst.mono fun _ hst ht => hst.trans ht)
#align filter.tendsto.small_sets_mono Filter.Tendsto.smallSets_mono

/-- Generalized **squeeze theorem** (also known as **sandwich theorem**). If `s : α → Set β` is a
family of sets that tends to `Filter.smallSets lb` along `la` and `f : α → β` is a function such
that `f x ∈ s x` eventually along `la`, then `f` tends to `lb` along `la`.

If `s x` is the closed interval `[g x, h x]` for some functions `g`, `h` that tend to the same limit
`𝓝 y`, then we obtain the standard squeeze theorem, see
`tendsto_of_tendsto_of_tendsto_of_le_of_le'`. -/
theorem Tendsto.of_smallSets {s : α → Set β} {f : α → β} (hs : Tendsto s la lb.smallSets)
    (hf : ∀ᶠ x in la, f x ∈ s x) : Tendsto f la lb := fun t ht =>
  hf.mp <| (tendsto_smallSets_iff.mp hs t ht).mono fun _ h₁ h₂ => h₁ h₂
#align filter.tendsto.of_small_sets Filter.Tendsto.of_smallSets

@[simp]
theorem eventually_smallSets_eventually {p : α → Prop} :
    (∀ᶠ s in l.smallSets, ∀ᶠ x in l', x ∈ s → p x) ↔ ∀ᶠ x in l ⊓ l', p x :=
  calc
    _ ↔ ∃ s ∈ l, ∀ᶠ x in l', x ∈ s → p x :=
      eventually_small_sets' fun s t hst ht => ht.mono fun x hx hs => hx (hst hs)
    _ ↔ ∃ s ∈ l, ∃ t ∈ l', ∀ x, x ∈ t → x ∈ s → p x := by simp only [eventually_iff_exists_mem]
    _ ↔ ∀ᶠ x in l ⊓ l', p x := by simp only [eventually_inf, and_comm, mem_inter_iff, ← and_imp]

#align filter.eventually_small_sets_eventually Filter.eventually_smallSets_eventually

@[simp]
theorem eventually_smallSets_forall {p : α → Prop} :
    (∀ᶠ s in l.smallSets, ∀ x ∈ s, p x) ↔ ∀ᶠ x in l, p x := by
  simpa only [inf_top_eq, eventually_top] using @eventually_smallSets_eventually α l ⊤ p
#align filter.eventually_small_sets_forall Filter.eventually_smallSets_forall

alias eventually_smallSets_forall ↔ Eventually.of_smallSets Eventually.smallSets
#align filter.eventually.of_small_sets Filter.Eventually.of_smallSets
#align filter.eventually.small_sets Filter.Eventually.smallSets

@[simp]
theorem eventually_smallSets_subset {s : Set α} : (∀ᶠ t in l.smallSets, t ⊆ s) ↔ s ∈ l :=
  eventually_smallSets_forall
#align filter.eventually_small_sets_subset Filter.eventually_smallSets_subset

end Filter


import data.set
open set

variable {U : Type}
variables A B C : set U
variable x : U

example : A ∩ A = A :=
eq_of_subset_of_subset
(assume x,
 assume h: x ∈ (A ∩ A),
 show x ∈ A, from and.left h)
(assume x,
 assume h: x ∈ A,
 show x ∈ (A ∩ A), from and.intro h h)

example : A ∪ A = A :=
eq_of_subset_of_subset
(assume x,
 assume h: x ∈ A ∪ A,
 have o1: x ∈ A ∨ x ∈  A, from h,
 show x ∈ A, from or.elim o1
 (assume a1: x ∈ A,
  show x ∈ A, from a1)
 (assume a2: x ∈ A,
  show x ∈ A, from a2)
)
(assume x,
 assume h: x ∈ A,
 show x ∈ (A ∪ A),from or.inl h) -- or.inl := or introducition left

example : A ∪ (∅: set U) = A :=
eq_of_subset_of_subset
(assume x,
 assume h: x ∈ A ∪ ∅,
 have h2: x ∈ A ∨ x ∈ (∅: set U), from h,
 show x ∈ A, from or.elim h2
  (assume h2_1: x ∈ A,
   show x ∈ A, from h2_1)
  (assume h2_2: x ∈ (∅: set U),
   show x ∈ A, from false.elim h2_2 --> x ∈ ∅ = false, so false -> anything
  )
)
(assume x,
assume h: x ∈ A,
show x ∈ A ∪ ∅, from or.inl h)


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Floris van Doorn, Violeta Hernández Palacios

! This file was ported from Lean 3 source module set_theory.ordinal.exponential
! leanprover-community/mathlib commit b67044ba53af18680e1dd246861d9584e968495d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.SetTheory.Ordinal.Arithmetic

/-! # Ordinal exponential

In this file we define the power function and the logarithm function on ordinals. The two are
related by the lemma `Ordinal.opow_le_iff_le_log : (b^c) ≤ x ↔ c ≤ log b x` for nontrivial inputs
`b`, `c`.
-/

noncomputable section

open Function Cardinal Set Equiv Order

open Classical Cardinal Ordinal

universe u v w

namespace Ordinal

/-- The ordinal exponential, defined by transfinite recursion. -/
instance pow : Pow Ordinal Ordinal :=
  ⟨fun a b => if a = 0 then 1 - b else limitRecOn b 1 (fun _ IH => IH * a) fun b _ => bsup.{u, u} b⟩

-- Porting note: Ambiguous notations.
-- local infixr:0 "^" => @Pow.pow Ordinal Ordinal Ordinal.instPowOrdinalOrdinal

theorem opow_def (a b : Ordinal) :
    (a^b) = if a = 0 then 1 - b else limitRecOn b 1 (fun _ IH => IH * a) fun b _ => bsup.{u, u} b :=
  rfl
#align ordinal.opow_def Ordinal.opow_def

-- Porting note: `if_pos rfl` → `if_true`
theorem zero_opow' (a : Ordinal) : (0^a) = 1 - a := by simp only [opow_def, if_true]
#align ordinal.zero_opow' Ordinal.zero_opow'

@[simp]
theorem zero_opow {a : Ordinal} (a0 : a ≠ 0) : (0^a) = 0 := by
  rwa [zero_opow', Ordinal.sub_eq_zero_iff_le, one_le_iff_ne_zero]
#align ordinal.zero_opow Ordinal.zero_opow

@[simp]
theorem opow_zero (a : Ordinal) : (a^0) = 1 := by
  by_cases h : a = 0
  · simp only [opow_def, if_pos h, sub_zero]
  · simp only [opow_def, if_neg h, limitRecOn_zero]
#align ordinal.opow_zero Ordinal.opow_zero

@[simp]
theorem opow_succ (a b : Ordinal) : (a^succ b) = (a^b) * a :=
  if h : a = 0 then by subst a; simp only [zero_opow (succ_ne_zero _), mul_zero]
  else by simp only [opow_def, limitRecOn_succ, if_neg h]
#align ordinal.opow_succ Ordinal.opow_succ

theorem opow_limit {a b : Ordinal} (a0 : a ≠ 0) (h : IsLimit b) :
    (a^b) = bsup.{u, u} b fun c _ => a^c := by
  simp only [opow_def, if_neg a0]; rw [limitRecOn_limit _ _ _ _ h]
#align ordinal.opow_limit Ordinal.opow_limit

theorem opow_le_of_limit {a b c : Ordinal} (a0 : a ≠ 0) (h : IsLimit b) :
    (a^b) ≤ c ↔ ∀ b' < b, (a^b') ≤ c := by rw [opow_limit a0 h, bsup_le_iff]
#align ordinal.opow_le_of_limit Ordinal.opow_le_of_limit

theorem lt_opow_of_limit {a b c : Ordinal} (b0 : b ≠ 0) (h : IsLimit c) :
    a < (b^c) ↔ ∃ c' < c, a < (b^c') := by
  rw [← not_iff_not, not_exists]; simp only [not_lt, opow_le_of_limit b0 h, exists_prop, not_and]
#align ordinal.lt_opow_of_limit Ordinal.lt_opow_of_limit

@[simp]
theorem opow_one (a : Ordinal) : (a^1) = a := by
  rw [← succ_zero, opow_succ]; simp only [opow_zero, one_mul]
#align ordinal.opow_one Ordinal.opow_one

@[simp]
theorem one_opow (a : Ordinal) : (1^a) = 1 := by
  apply limitRecOn a
  · simp only [opow_zero]
  · intro _ ih
    simp only [opow_succ, ih, mul_one]
  refine' fun b l IH => eq_of_forall_ge_iff fun c => _
  rw [opow_le_of_limit Ordinal.one_ne_zero l]
  exact ⟨fun H => by simpa only [opow_zero] using H 0 l.pos, fun H b' h => by rwa [IH _ h]⟩
#align ordinal.one_opow Ordinal.one_opow

theorem opow_pos {a : Ordinal} (b) (a0 : 0 < a) : 0 < (a^b) := by
  have h0 : 0 < (a^0) := by simp only [opow_zero, zero_lt_one]
  apply limitRecOn b
  · exact h0
  · intro b IH
    rw [opow_succ]
    exact mul_pos IH a0
  · exact fun b l _ => (lt_opow_of_limit (Ordinal.pos_iff_ne_zero.1 a0) l).2 ⟨0, l.pos, h0⟩
#align ordinal.opow_pos Ordinal.opow_pos

theorem opow_ne_zero {a : Ordinal} (b) (a0 : a ≠ 0) : (a^b) ≠ 0 :=
  Ordinal.pos_iff_ne_zero.1 <| opow_pos b <| Ordinal.pos_iff_ne_zero.2 a0
#align ordinal.opow_ne_zero Ordinal.opow_ne_zero

theorem opow_isNormal {a : Ordinal} (h : 1 < a) : IsNormal ((·^·) a) :=
  have a0 : 0 < a := zero_lt_one.trans h
  ⟨fun b => by simpa only [mul_one, opow_succ] using (mul_lt_mul_iff_left (opow_pos b a0)).2 h,
    fun b l c => opow_le_of_limit (ne_of_gt a0) l⟩
#align ordinal.opow_is_normal Ordinal.opow_isNormal

theorem opow_lt_opow_iff_right {a b c : Ordinal} (a1 : 1 < a) : (a^b) < (a^c) ↔ b < c :=
  (opow_isNormal a1).lt_iff
#align ordinal.opow_lt_opow_iff_right Ordinal.opow_lt_opow_iff_right

theorem opow_le_opow_iff_right {a b c : Ordinal} (a1 : 1 < a) : (a^b) ≤ (a^c) ↔ b ≤ c :=
  (opow_isNormal a1).le_iff
#align ordinal.opow_le_opow_iff_right Ordinal.opow_le_opow_iff_right

theorem opow_right_inj {a b c : Ordinal} (a1 : 1 < a) : (a^b) = (a^c) ↔ b = c :=
  (opow_isNormal a1).inj
#align ordinal.opow_right_inj Ordinal.opow_right_inj

theorem opow_isLimit {a b : Ordinal} (a1 : 1 < a) : IsLimit b → IsLimit (a^b) :=
  (opow_isNormal a1).isLimit
#align ordinal.opow_is_limit Ordinal.opow_isLimit

theorem opow_isLimit_left {a b : Ordinal} (l : IsLimit a) (hb : b ≠ 0) : IsLimit (a^b) := by
  rcases zero_or_succ_or_limit b with (e | ⟨b, rfl⟩ | l')
  · exact absurd e hb
  · rw [opow_succ]
    exact mul_isLimit (opow_pos _ l.pos) l
  · exact opow_isLimit l.one_lt l'
#align ordinal.opow_is_limit_left Ordinal.opow_isLimit_left

theorem opow_le_opow_right {a b c : Ordinal} (h₁ : 0 < a) (h₂ : b ≤ c) : (a^b) ≤ (a^c) := by
  cases' lt_or_eq_of_le (one_le_iff_pos.2 h₁) with h₁ h₁
  · exact (opow_le_opow_iff_right h₁).2 h₂
  · subst a
    -- Porting note: `le_refl` is required.
    simp only [one_opow, le_refl]
#align ordinal.opow_le_opow_right Ordinal.opow_le_opow_right

theorem opow_le_opow_left {a b : Ordinal} (c) (ab : a ≤ b) : (a^c) ≤ (b^c) := by
  by_cases a0 : a = 0
  -- Porting note: `le_refl` is required.
  · subst a
    by_cases c0 : c = 0
    · subst c
      simp only [opow_zero, le_refl]
    · simp only [zero_opow c0, Ordinal.zero_le]
  · apply limitRecOn c
    · simp only [opow_zero, le_refl]
    · intro c IH
      simpa only [opow_succ] using mul_le_mul' IH ab
    ·
      exact fun c l IH =>
        (opow_le_of_limit a0 l).2 fun b' h =>
          (IH _ h).trans (opow_le_opow_right ((Ordinal.pos_iff_ne_zero.2 a0).trans_le ab) h.le)
#align ordinal.opow_le_opow_left Ordinal.opow_le_opow_left

theorem left_le_opow (a : Ordinal) {b : Ordinal} (b1 : 0 < b) : a ≤ (a^b) := by
  nth_rw 1 [← opow_one a]
  cases' le_or_gt a 1 with a1 a1
  · cases' lt_or_eq_of_le a1 with a0 a1
    · rw [lt_one_iff_zero] at a0
      rw [a0, zero_opow Ordinal.one_ne_zero]
      exact Ordinal.zero_le _
    rw [a1, one_opow, one_opow]
  rwa [opow_le_opow_iff_right a1, one_le_iff_pos]
#align ordinal.left_le_opow Ordinal.left_le_opow

theorem right_le_opow {a : Ordinal} (b) (a1 : 1 < a) : b ≤ (a^b) :=
  (opow_isNormal a1).self_le _
#align ordinal.right_le_opow Ordinal.right_le_opow

theorem opow_lt_opow_left_of_succ {a b c : Ordinal} (ab : a < b) : (a^succ c) < (b^succ c) := by
  rw [opow_succ, opow_succ]
  exact
    (mul_le_mul_right' (opow_le_opow_left c ab.le) a).trans_lt
      (mul_lt_mul_of_pos_left ab (opow_pos c ((Ordinal.zero_le a).trans_lt ab)))
#align ordinal.opow_lt_opow_left_of_succ Ordinal.opow_lt_opow_left_of_succ

theorem opow_add (a b c : Ordinal) : a^(b + c) = (a^b) * (a^c) := by
  rcases eq_or_ne a 0 with (rfl | a0)
  · rcases eq_or_ne c 0 with (rfl | c0)
    · simp
    have : b + c ≠ 0 := ((Ordinal.pos_iff_ne_zero.2 c0).trans_le (le_add_left _ _)).ne'
    simp only [zero_opow c0, zero_opow this, mul_zero]
  rcases eq_or_lt_of_le (one_le_iff_ne_zero.2 a0) with (rfl | a1)
  · simp only [one_opow, mul_one]
  apply limitRecOn c
  · simp
  · intro c IH
    rw [add_succ, opow_succ, IH, opow_succ, mul_assoc]
  · intro c l IH
    refine'
      eq_of_forall_ge_iff fun d =>
        (((opow_isNormal a1).trans (add_isNormal b)).limit_le l).trans _
    dsimp only [Function.comp]
    simp (config := { contextual := true }) only [IH]
    exact
      (((mul_isNormal <| opow_pos b (Ordinal.pos_iff_ne_zero.2 a0)).trans
              (opow_isNormal a1)).limit_le
          l).symm
#align ordinal.opow_add Ordinal.opow_add

theorem opow_one_add (a b : Ordinal) : a^(1 + b) = a * (a^b) := by rw [opow_add, opow_one]
#align ordinal.opow_one_add Ordinal.opow_one_add

theorem opow_dvd_opow (a) {b c : Ordinal} (h : b ≤ c) : (a^b) ∣ (a^c) :=
  ⟨a^(c - b), by rw [← opow_add, Ordinal.add_sub_cancel_of_le h]⟩
#align ordinal.opow_dvd_opow Ordinal.opow_dvd_opow

theorem opow_dvd_opow_iff {a b c : Ordinal} (a1 : 1 < a) : (a^b) ∣ (a^c) ↔ b ≤ c :=
  ⟨fun h =>
    le_of_not_lt fun hn =>
      not_le_of_lt ((opow_lt_opow_iff_right a1).2 hn) <|
        le_of_dvd (opow_ne_zero _ <| one_le_iff_ne_zero.1 <| a1.le) h,
    opow_dvd_opow _⟩
#align ordinal.opow_dvd_opow_iff Ordinal.opow_dvd_opow_iff

theorem opow_mul (a b c : Ordinal) : a^(b * c) = ((a^b)^c) := by
  by_cases b0 : b = 0; · simp only [b0, zero_mul, opow_zero, one_opow]
  by_cases a0 : a = 0
  · subst a
    by_cases c0 : c = 0
    · simp only [c0, mul_zero, opow_zero]
    simp only [zero_opow b0, zero_opow c0, zero_opow (mul_ne_zero b0 c0)]
  cases' eq_or_lt_of_le (one_le_iff_ne_zero.2 a0) with a1 a1
  · subst a1
    simp only [one_opow]
  apply limitRecOn c
  · simp only [mul_zero, opow_zero]
  · intro c IH
    rw [mul_succ, opow_add, IH, opow_succ]
  · intro c l IH
    refine'
      eq_of_forall_ge_iff fun d =>
        (((opow_isNormal a1).trans (mul_isNormal (Ordinal.pos_iff_ne_zero.2 b0))).limit_le
              l).trans
          _
    dsimp only [Function.comp]
    simp (config := { contextual := true }) only [IH]
    exact (opow_le_of_limit (opow_ne_zero _ a0) l).symm
#align ordinal.opow_mul Ordinal.opow_mul

/-! ### Ordinal logarithm -/

/-- The ordinal logarithm is the solution `u` to the equation `x = b ^ u * v + w` where `v < b` and
    `w < b ^ u`. -/
-- @[pp_nodot] -- Porting note: Unknown attribute.
def log (b : Ordinal) (x : Ordinal) : Ordinal :=
  if _h : 1 < b then pred (infₛ { o | x < (b^o) }) else 0
#align ordinal.log Ordinal.log

/-- The set in the definition of `log` is nonempty. -/
theorem log_nonempty {b x : Ordinal} (h : 1 < b) : { o | x < (b^o) }.Nonempty :=
  ⟨_, succ_le_iff.1 (right_le_opow _ h)⟩
#align ordinal.log_nonempty Ordinal.log_nonempty

theorem log_def {b : Ordinal} (h : 1 < b) (x : Ordinal) : log b x = pred (infₛ { o | x < (b^o) }) :=
  by simp only [log, dif_pos h]
#align ordinal.log_def Ordinal.log_def

theorem log_of_not_one_lt_left {b : Ordinal} (h : ¬1 < b) (x : Ordinal) : log b x = 0 := by
  simp only [log, dif_neg h]
#align ordinal.log_of_not_one_lt_left Ordinal.log_of_not_one_lt_left

theorem log_of_left_le_one {b : Ordinal} (h : b ≤ 1) : ∀ x, log b x = 0 :=
  log_of_not_one_lt_left h.not_lt
#align ordinal.log_of_left_le_one Ordinal.log_of_left_le_one

@[simp]
theorem log_zero_left : ∀ b, log 0 b = 0 :=
  log_of_left_le_one zero_le_one
#align ordinal.log_zero_left Ordinal.log_zero_left

@[simp]
theorem log_zero_right (b : Ordinal) : log b 0 = 0 :=
  if b1 : 1 < b then by
    rw [log_def b1, ← Ordinal.le_zero, pred_le]
    apply cinfₛ_le'
    dsimp
    rw [succ_zero, opow_one]
    exact zero_lt_one.trans b1
  else by simp only [log_of_not_one_lt_left b1]
#align ordinal.log_zero_right Ordinal.log_zero_right

@[simp]
theorem log_one_left : ∀ b, log 1 b = 0 :=
  log_of_left_le_one le_rfl
#align ordinal.log_one_left Ordinal.log_one_left

theorem succ_log_def {b x : Ordinal} (hb : 1 < b) (hx : x ≠ 0) :
    succ (log b x) = infₛ { o | x < (b^o) } := by
  let t := infₛ { o | x < (b^o) }
  have : x < (b^t) := cinfₛ_mem (log_nonempty hb)
  rcases zero_or_succ_or_limit t with (h | h | h)
  · refine' ((one_le_iff_ne_zero.2 hx).not_lt _).elim
    simpa only [h, opow_zero] using this
  · rw [show log b x = pred t from log_def hb x, succ_pred_iff_is_succ.2 h]
  · rcases(lt_opow_of_limit (zero_lt_one.trans hb).ne' h).1 this with ⟨a, h₁, h₂⟩
    exact h₁.not_le.elim ((le_cinfₛ_iff'' (log_nonempty hb)).1 le_rfl a h₂)
#align ordinal.succ_log_def Ordinal.succ_log_def

theorem lt_opow_succ_log_self {b : Ordinal} (hb : 1 < b) (x : Ordinal) : x < (b^succ (log b x)) :=
  by
  rcases eq_or_ne x 0 with (rfl | hx)
  · apply opow_pos _ (zero_lt_one.trans hb)
  · rw [succ_log_def hb hx]
    exact cinfₛ_mem (log_nonempty hb)
#align ordinal.lt_opow_succ_log_self Ordinal.lt_opow_succ_log_self

theorem opow_log_le_self (b) {x : Ordinal} (hx : x ≠ 0) : (b^log b x) ≤ x := by
  rcases eq_or_ne b 0 with (rfl | b0)
  · rw [zero_opow']
    refine' (sub_le_self _ _).trans (one_le_iff_ne_zero.2 hx)
  rcases lt_or_eq_of_le (one_le_iff_ne_zero.2 b0) with (hb | rfl)
  · refine' le_of_not_lt fun h => (lt_succ (log b x)).not_le _
    have := @cinfₛ_le' _ _ { o | x < (b^o) } _ h
    rwa [← succ_log_def hb hx] at this
  · rwa [one_opow, one_le_iff_ne_zero]
#align ordinal.opow_log_le_self Ordinal.opow_log_le_self

/-- `opow b` and `log b` (almost) form a Galois connection. -/
theorem opow_le_iff_le_log {b x c : Ordinal} (hb : 1 < b) (hx : x ≠ 0) : (b^c) ≤ x ↔ c ≤ log b x :=
  ⟨fun h =>
    le_of_not_lt fun hn =>
      (lt_opow_succ_log_self hb x).not_le <|
        ((opow_le_opow_iff_right hb).2 (succ_le_of_lt hn)).trans h,
    fun h => ((opow_le_opow_iff_right hb).2 h).trans (opow_log_le_self b hx)⟩
#align ordinal.opow_le_iff_le_log Ordinal.opow_le_iff_le_log

theorem lt_opow_iff_log_lt {b x c : Ordinal} (hb : 1 < b) (hx : x ≠ 0) : x < (b^c) ↔ log b x < c :=
  lt_iff_lt_of_le_iff_le (opow_le_iff_le_log hb hx)
#align ordinal.lt_opow_iff_log_lt Ordinal.lt_opow_iff_log_lt

theorem log_pos {b o : Ordinal} (hb : 1 < b) (ho : o ≠ 0) (hbo : b ≤ o) : 0 < log b o := by
  rwa [← succ_le_iff, succ_zero, ← opow_le_iff_le_log hb ho, opow_one]
#align ordinal.log_pos Ordinal.log_pos

theorem log_eq_zero {b o : Ordinal} (hbo : o < b) : log b o = 0 := by
  rcases eq_or_ne o 0 with (rfl | ho)
  · exact log_zero_right b
  cases' le_or_lt b 1 with hb hb
  · rcases le_one_iff.1 hb with (rfl | rfl)
    · exact log_zero_left o
    · exact log_one_left o
  · rwa [← Ordinal.le_zero, ← lt_succ_iff, succ_zero, ← lt_opow_iff_log_lt hb ho, opow_one]
#align ordinal.log_eq_zero Ordinal.log_eq_zero

@[mono]
theorem log_mono_right (b) {x y : Ordinal} (xy : x ≤ y) : log b x ≤ log b y :=
  if hx : x = 0 then by simp only [hx, log_zero_right, Ordinal.zero_le]
  else
    if hb : 1 < b then
      (opow_le_iff_le_log hb (lt_of_lt_of_le (Ordinal.pos_iff_ne_zero.2 hx) xy).ne').1 <|
        (opow_log_le_self _ hx).trans xy
    else by simp only [log_of_not_one_lt_left hb, Ordinal.zero_le]
#align ordinal.log_mono_right Ordinal.log_mono_right

theorem log_le_self (b x : Ordinal) : log b x ≤ x :=
  if hx : x = 0 then by simp only [hx, log_zero_right, Ordinal.zero_le]
  else
    if hb : 1 < b then (right_le_opow _ hb).trans (opow_log_le_self b hx)
    else by simp only [log_of_not_one_lt_left hb, Ordinal.zero_le]
#align ordinal.log_le_self Ordinal.log_le_self

@[simp]
theorem log_one_right (b : Ordinal) : log b 1 = 0 :=
  if hb : 1 < b then log_eq_zero hb else log_of_not_one_lt_left hb 1
#align ordinal.log_one_right Ordinal.log_one_right

theorem mod_opow_log_lt_self (b : Ordinal) {o : Ordinal} (ho : o ≠ 0) : o % (b^log b o) < o := by
  rcases eq_or_ne b 0 with (rfl | hb)
  · simpa using Ordinal.pos_iff_ne_zero.2 ho
  · exact (mod_lt _ <| opow_ne_zero _ hb).trans_le (opow_log_le_self _ ho)
#align ordinal.mod_opow_log_lt_self Ordinal.mod_opow_log_lt_self

theorem log_mod_opow_log_lt_log_self {b o : Ordinal} (hb : 1 < b) (ho : o ≠ 0) (hbo : b ≤ o) :
    log b (o % (b^log b o)) < log b o := by
  cases' eq_or_ne (o % (b^log b o)) 0 with h h
  · rw [h, log_zero_right]
    apply log_pos hb ho hbo
  · rw [← succ_le_iff, succ_log_def hb h]
    apply cinfₛ_le'
    apply mod_lt
    rw [← Ordinal.pos_iff_ne_zero]
    exact opow_pos _ (zero_lt_one.trans hb)
#align ordinal.log_mod_opow_log_lt_log_self Ordinal.log_mod_opow_log_lt_log_self

theorem opow_mul_add_pos {b v : Ordinal} (hb : b ≠ 0) (u) (hv : v ≠ 0) (w) : 0 < (b^u) * v + w :=
  (opow_pos u <| Ordinal.pos_iff_ne_zero.2 hb).trans_le <|
    (le_mul_left _ <| Ordinal.pos_iff_ne_zero.2 hv).trans <| le_add_right _ _
#align ordinal.opow_mul_add_pos Ordinal.opow_mul_add_pos

theorem opow_mul_add_lt_opow_mul_succ {b u w : Ordinal} (v : Ordinal) (hw : w < (b^u)) :
    (b^u) * v + w < (b^u) * succ v := by rwa [mul_succ, add_lt_add_iff_left]
#align ordinal.opow_mul_add_lt_opow_mul_succ Ordinal.opow_mul_add_lt_opow_mul_succ

theorem opow_mul_add_lt_opow_succ {b u v w : Ordinal} (hvb : v < b) (hw : w < (b^u)) :
    (b^u) * v + w < (b^succ u) := by
  convert (opow_mul_add_lt_opow_mul_succ v hw).trans_le (mul_le_mul_left' (succ_le_of_lt hvb) _)
    using 1
  exact opow_succ b u
#align ordinal.opow_mul_add_lt_opow_succ Ordinal.opow_mul_add_lt_opow_succ

theorem log_opow_mul_add {b u v w : Ordinal} (hb : 1 < b) (hv : v ≠ 0) (hvb : v < b)
    (hw : w < (b^u)) : log b ((b^u) * v + w) = u := by
  have hne' := (opow_mul_add_pos (zero_lt_one.trans hb).ne' u hv w).ne'
  by_contra' hne
  cases' lt_or_gt_of_ne hne with h h
  · rw [← lt_opow_iff_log_lt hb hne'] at h
    exact h.not_le ((le_mul_left _ (Ordinal.pos_iff_ne_zero.2 hv)).trans (le_add_right _ _))
  · conv at h => change u < log b (b ^ u * v + w)
    rw [← succ_le_iff, ← opow_le_iff_le_log hb hne'] at h
    exact (not_lt_of_le h) (opow_mul_add_lt_opow_succ hvb hw)
#align ordinal.log_opow_mul_add Ordinal.log_opow_mul_add

theorem log_opow {b : Ordinal} (hb : 1 < b) (x : Ordinal) : log b (b^x) = x := by
  convert log_opow_mul_add hb zero_ne_one.symm hb (opow_pos x (zero_lt_one.trans hb))
    using 1
  rw [add_zero, mul_one]
#align ordinal.log_opow Ordinal.log_opow

theorem div_opow_log_pos (b : Ordinal) {o : Ordinal} (ho : o ≠ 0) : 0 < o / (b^log b o) :=
  by
  rcases eq_zero_or_pos b with (rfl | hb)
  · simpa using Ordinal.pos_iff_ne_zero.2 ho
  · rw [div_pos (opow_ne_zero _ hb.ne')]
    exact opow_log_le_self b ho
#align ordinal.div_opow_log_pos Ordinal.div_opow_log_pos

theorem div_opow_log_lt {b : Ordinal} (o : Ordinal) (hb : 1 < b) : o / (b^log b o) < b := by
  rw [div_lt (opow_pos _ (zero_lt_one.trans hb)).ne', ← opow_succ]
  exact lt_opow_succ_log_self hb o
#align ordinal.div_opow_log_lt Ordinal.div_opow_log_lt

theorem add_log_le_log_mul {x y : Ordinal} (b : Ordinal) (hx : x ≠ 0) (hy : y ≠ 0) :
    log b x + log b y ≤ log b (x * y) := by
  by_cases hb : 1 < b
  · rw [← opow_le_iff_le_log hb (mul_ne_zero hx hy), opow_add]
    exact mul_le_mul' (opow_log_le_self b hx) (opow_log_le_self b hy)
  -- Porting note: `le_refl` is required.
  simp only [log_of_not_one_lt_left hb, zero_add, le_refl]
#align ordinal.add_log_le_log_mul Ordinal.add_log_le_log_mul

/-! ### Interaction with `nat.cast` -/

@[simp, norm_cast]
theorem nat_cast_opow (m : ℕ) : ∀ n : ℕ, ((m ^ n : ℕ) : Ordinal) = (m^n)
  | 0 => by simp
  | n + 1 => by
    rw [pow_succ', nat_cast_mul, nat_cast_opow m n, Nat.cast_succ, add_one_eq_succ, opow_succ]
#align ordinal.nat_cast_opow Ordinal.nat_cast_opow

theorem sup_opow_nat {o : Ordinal} (ho : 0 < o) : (sup fun n : ℕ => o^n) = (o^ω) := by
  rcases lt_or_eq_of_le (one_le_iff_pos.2 ho) with (ho₁ | rfl)
  · exact (opow_isNormal ho₁).apply_omega
  · rw [one_opow]
    refine' le_antisymm (sup_le fun n => by rw [one_opow]) _
    convert le_sup (fun n : ℕ => 1^n) 0
    rw [Nat.cast_zero, opow_zero]
#align ordinal.sup_opow_nat Ordinal.sup_opow_nat

end Ordinal

-- Porting note: TODO: Port this meta code.

-- namespace Tactic

-- open Ordinal Mathlib.Meta.Positivity

-- /-- Extension for the `positivity` tactic: `ordinal.opow` takes positive values on positive
-- inputs. -/
-- @[positivity]
-- unsafe def positivity_opow : expr → tactic strictness
--   | q(@Pow.pow _ _ $(inst) $(a) $(b)) => do
--     let strictness_a ← core a
--     match strictness_a with
--       | positive p => positive <$> mk_app `` opow_pos [b, p]
--       | _ => failed
--   |-- We already know that `0 ≤ x` for all `x : ordinal`
--     _ =>
--     failed
-- #align tactic.positivity_opow Tactic.positivity_opow

-- end Tactic


/- Inductive Type

    inductive Foo where
      | constructor₁ : ... → Foo
      | constructor₂ : ... → Foo
      ...
      | constructorₙ : ... → Foo
-/

/- Enumerated Types -/

namespace ent
  inductive Weekday where
  | monday :  Weekday
  | tuesday : Weekday
  deriving Repr

  #eval Weekday.monday

  #check Weekday.monday

  def Weekday.numerOfDay (d : Weekday) : Nat :=
    match d with
    | monday => 1
    | tuesday => 2

  #eval Weekday.monday.numerOfDay -- 1

  def Weekday.next (d : Weekday) : Weekday :=
    match d with
    | monday => tuesday
    | tuesday => monday

  def Weekday.prev (d : Weekday) : Weekday :=
    match d with
    | monday => tuesday
    | tuesday => monday

  example (d : Weekday) : d.next.prev = d := by
    cases d <;> rfl

  namespace hidden
    inductive Bool where
    | True
    | False
    deriving Repr

    def Bool.and (p q : Bool) : Bool :=
      match p with
      | True => q
      | False => False

    #eval Bool.and Bool.True Bool.False -- False
    #eval Bool.and Bool.True Bool.True -- True

    def Bool.or (p q : Bool) : Bool :=
      match p with
      | True => True
      | False => q

    #eval Bool.or Bool.True Bool.False -- True
    #eval Bool.or Bool.True Bool.True -- True
    #eval Bool.or Bool.False Bool.False -- True

    def Bool.not (p : Bool) : Bool :=
      match p with
      | True => False
      | False => True

    #eval Bool.not Bool.True -- False

  end hidden

end ent

/- Constructors w Arguments -/

namespace cwa
  namespace hidden
    inductive Prod (α : Type u) (β : Type v)
    | mk : α → β → Prod α β

    inductive Sum (α : Type u) (β : Type v) where
    | inl : α → Sum α β
    | inr : β → Sum α β

    def fst {α : Type u} {β : Type v} (p : Prod α β) : α :=
      match p with
      | Prod.mk a b => a

    def snd {α : Type u} {β : Type v} (p : Prod α β) : β :=
      match p with
      | Prod.mk a b => b
  end hidden

  def prod_example (p : Bool × Nat) : Nat :=
    Prod.casesOn (motive := fun _ => Nat) p (fun b n => cond b (2*n) (2*n+1))

  #eval prod_example (true, 3) -- 6
  #eval prod_example (false, 1) -- 3

  def sum_example (s : Sum Nat Nat) : Nat :=
    Sum.casesOn (motive := fun _ => Nat) s
      (fun n => 2 * n)
      (fun n => 2 * n + 1)

  #eval sum_example (Sum.inl 3) -- 6
  #eval sum_example (Sum.inr 3) -- 7

  structure Semigroup where
    carrier : Type u
    mul : carrier → carrier → carrier
    mul_assoc : ∀ a b c, mul (mul a b) c = mul a (mul b c)

  namespace hidden
    inductive Sigma {α : Type u} (β : α → Type v) where
    | mk : (a : α) → β a → Sigma β

    inductive Option (α : Type u) where
    | none : Option α
    | some : α → Option α

    inductive Inhabited (α : Type u) where
    | mk : α → Inhabited α
  end hidden
end cwa

/- Inductively Defined Prop -/

namespace idp
  namespace hidden
    inductive False : Prop

    inductive True : Prop where
    | intro : True

    inductive And (p q : Prop) : Prop where
    | intro : p → q → And p q

    inductive Or (p q : Prop) : Prop where
    | inl : p → Or p q
    | inr : q → Or p q

    inductive Exists {α : Type u} (p : α → Prop) where
    | intro : ∀ (a : α), p a → Exists p
  end hidden
end idp

/- Defining Natural Numbers -/

namespace dnn
  namespace hidden
    inductive Nat where
    | zero : Nat
    | succ : Nat → Nat
    deriving Repr

    /-
    @Nat.rec : {motive : Nat → Sort u_1} →
      motive Nat.zero → ((a : Nat) → motive a → motive (Nat.succ a)) → (t : Nat) → motive t
    -/
    #check @Nat.rec

    /-
    @Nat.recOn :
      {motive : Nat → Sort u}
      → (t : Nat)
      → motive Nat.zero
      → ((n : Nat) → motive n → motive (Nat.succ n))
      → motive t
    -/

    def Nat.add (m n : Nat) : Nat :=
      match n with
      | zero => m
      | succ n' => Nat.succ (add m n')

    #eval Nat.add (Nat.succ Nat.zero) Nat.zero -- succ zero
    #eval Nat.add (Nat.succ Nat.zero) (Nat.succ Nat.zero) -- succ (succ zero)
  end hidden

  namespace hidden2
    open Nat
    theorem zero_add (n: Nat) : 0 + n = n :=
      Nat.recOn (motive := fun x => 0 + x = x)
        n
        (show 0 + 0 = 0 from rfl)
        (fun (n : Nat) (ih : 0 + n = n) =>
          show 0 + succ n = succ n from
            calc
              0 + succ n = succ (0 + n) := rfl
              _ = succ n := by rw [ih])

    theorem zero_add₁ (n: Nat) : 0 + n = n :=
      Nat.recOn (motive:= fun x => 0 + x = x) n
        (by rfl)
        (fun n ih => by simp only [add_succ, *])

    theorem add_assoc (m n k : Nat) : (m + n) + k = m + (n + k) :=
      Nat.recOn (motive := fun x => (m + n) + x = m + (n + x)) k
        (show (m + n) + 0 = m + (n + 0) by rfl)
        (fun k ih => by
          calc
            (m + n) + succ k = succ ((m + n) + k) := by rfl
            _ = succ (m + (n + k)) := by rw [ih])

    theorem succ_add (m n : Nat) : succ n + m = succ (n + m) :=
      Nat.recOn (motive := fun x => succ n + x = succ (n + x)) m
        (by rfl)
        (fun m ih => by simp only [add_succ, *])

    theorem add_comm (m n : Nat) : m + n = n + m :=
      Nat.recOn (motive := fun x => m + x = x + m) n
        (by simp [zero_add])
        (fun n ih => by calc
          m + succ n = succ (m + n) := by rfl
          _ = succ (n + m) := by rw [ih]
          _ = succ n + m := by simp only [succ_add])
  end hidden2
end dnn

/- Other Recursive Data Types -/

namespace ordt
  namespace hidden
    /- List -/
    inductive List (α : Type u) where
    | nil : List α
    | cons : α → List α → List α

    def List.append (as bs : List α) : List α :=
    match as with
    | nil => bs
    | cons a as' => cons a (append as' bs)

    theorem List.nil_append (as : List α) : List.append List.nil as = as :=
      by rfl

    theorem List.cons_append (a : α) (as bs : List α)
        : cons a (append as bs) = append (cons a as) bs :=
      by rfl

    theorem List.append_nil (as : List α) : append as nil = as :=
      List.recOn (motive := fun x => append x nil = x) as
        (by rfl)
        (fun a as ih => by calc
          append (cons a as) nil = cons a (append as nil) := by simp only [cons_append]
          _ = cons a as := by rw [ih])

    theorem List.append_assoc (as bs cs : List α)
        : append (append as bs) cs = append as (append bs cs) :=
      List.recOn (motive := fun x => append (append x bs) cs = append x (append bs cs)) as
        (by rfl)
        (fun a as ih => by calc
          append (append (cons a as) bs) cs = append (cons a (append as bs)) cs := by
            simp only [cons_append]
          _ = cons a (append (append as bs) cs) := by simp only [cons_append]
          _ = cons a (append as (append bs cs)) := by simp [ih]
          _ = append (cons a as) (append bs cs) := by simp only [cons_append])

    def List.length (as : List α) : Nat :=
      match as with
      | nil => 0
      | cons a as' => Nat.succ (length as')

    theorem List.length_assoc (as bs : List α)
        : length (append as bs) = length as + length bs :=
      List.recOn
        (motive := fun x => length (append x bs) = length x + length bs)
        as
        (by simp only [length, nil_append, Nat.zero_add])
        (fun a as ih => by calc
          length (append (cons a as) bs) = length (cons a (append as bs)) := by
            simp only [cons_append]
          _ = Nat.succ (length (append as bs)) := by simp only [length]
          _ = Nat.succ (length as + length bs) := by rw [ih]
          _ = Nat.succ (length as) + length bs := by simp_arith
          _ = length (cons a as) + length bs := by simp only [length])

    /- Binary Trees -/
    inductive BinaryTree where
    | leaf : BinaryTree
    | node : BinaryTree → BinaryTree → BinaryTree

    inductive CBTree where
    | leaf : CBTree
    | sup : (Nat → CBTree) → CBTree

    def CBTree.succ (t : CBTree) : CBTree :=
      sup (fun _ => t)

    def CBTree.toCBTree : Nat → CBTree
      | 0 => leaf
      | n + 1 => succ (toCBTree n)

  end hidden
end ordt

/- Tactics for Inductive Types -/

namespace tfit
  example (p : Nat → Prop) (hz : p 0) (hs : ∀ n, p (Nat.succ n)) : ∀ n, p n := by
    intro n
    cases n
    . assumption
    . apply hs

  example (n : Nat) (h : n ≠ 0) : Nat.succ (Nat.pred n) = n := by
    cases n with
    | zero => contradiction
    | succ n' => rfl

  example (p : Prop) (m n : Nat) (h1 : m < n → p) (h2 : m ≥ n → p) : p := by
    cases Nat.lt_or_ge m n
    . case inl => apply h1; assumption
    . case inr => apply h2; assumption

  example (m n : Nat) : m - n = 0 ∨ m ≠ n := by
    cases Decidable.em (m = n) with
    | inl heq => rw [heq]; apply Or.inl; exact Nat.sub_self n
    | inr => apply Or.inr; assumption

  namespace hidden
    open Nat
    theorem zero_add (n : Nat) : 0 + n = n := by
      induction n with
      | zero => rfl
      | succ n' ih => rw [add_succ, ih]
  end hidden

  /-
  theorem Nat.mod.inductionOn
        {motive : Nat → Nat → Sort u}
        (x y  : Nat)
        (ind  : ∀ x y, 0 < y ∧ y ≤ x → motive (x - y) y → motive x y)
        (base : ∀ x y, ¬(0 < y ∧ y ≤ x) → motive x y)
        : motive x y :=
  -/
  #check @Nat.mod_eq_sub_mod
  example (x : Nat) {y : Nat} (h : y > 0) : x % y < y := by
    induction x, y using Nat.mod.inductionOn with
    | ind x y h1 ih =>
      rw [Nat.mod_eq_sub_mod h1.right]
      exact ih h
    | base x y h1 =>
      have : ¬ 0 < y ∨ ¬ y ≤ x := Iff.mp (Decidable.not_and_iff_or_not ..) h1
      match this with
      | Or.inl _ => contradiction
      | Or.inr _ =>
        have : y > x := by apply Nat.gt_of_not_le; assumption
        rw [← Nat.mod_eq_of_lt this] at this
        assumption

  example :
      (fun (x : Nat × Nat) (y : Nat × Nat) => x.1 + y.2)
      =
      (fun (x : Nat × Nat) (z : Nat × Nat) => z.2 + x.1) := by
    funext (a, b) (c, d)
    show a + d = d + a
    rw [Nat.add_comm]

  example (m n k : Nat) (h : m.succ.succ = n.succ.succ)
      : n + k = m + k := by
    injection h with h' -- m.succ = n.succ
    injection h' with h'' -- m = n
    rw [h'']

  namespace hidden
    inductive Vector (α : Type u) : Nat → Type u where
    | nil : Vector α 0
    | cons : α → {n : Nat} → Vector α n → Vector α (n + 1)
    deriving Repr

    #eval Vector.cons 1 (Vector.nil)

    inductive Eq {α : Sort u} (a : α) : α → Prop where
    | refl {} : Eq a a

    /-
    @Eq.recOn : {α : Sort u_2} →
      {a : α} →
        {motive : (a_1 : α) → Eq a a_1 → Sort u_1} → {a_1 : α} → (t : Eq a a_1) → motive a (_ : Eq a a) → motive a_1 t
    -/
    #check @Eq.recOn

    /-
    @Eq.rec : {α : Sort u_2} →
      {a : α} →
        {motive : (a_1 : α) → Eq a a_1 → Sort u_1} → motive a (_ : Eq a a) → {a_1 : α} → (t : Eq a a_1) → motive a_1 t
    -/
    #check @Eq.rec

    theorem Eq.subst {α : Type u} {a b : α} {p : α → Prop}
        (h1 : Eq a b) (h2 : p a) : p b :=
      Eq.rec (motive := fun x _ => p x) h2 h1

    theorem Eq.subst₁ {α : Type u} {a b : α} {p : α → Prop}
        (h1 : Eq a b) (h2 : p a) : p b :=
      match h1 with
      | refl a => h2

    theorem Eq.symm {α : Type u} {a b : α} (h : Eq a b) : Eq b a :=
      match h with
      | refl a => refl a

    theorem Eq.trans {α : Type u} {a b c : α} (h1 : Eq a b) (h2 : Eq b c)
        : Eq a c :=
      match h1, h2 with
      | refl a, refl a => refl a

    theorem Eq.congr {α β : Type u} {a b : α} (f : α → β) (h : Eq a b)
        : Eq (f a) (f b) :=
      match h with
      | refl a => refl (f a)
  end hidden
end tfit

/- Mutual and Nested Inductive Types -/

namespace munit

  mutual
    inductive Even : Nat → Prop where
    | even_zero : Even 0
    | even_succ : (n : Nat) → Odd n → Even (n + 1)

    inductive Odd : Nat → Prop where
    | odd_succ : (n : Nat) → Even n → Odd (n + 1)
  end

  inductive Tree (α : Type u) where
  | mk : α → List (Tree α) → Tree α
end munit


import combinatorics.simple_graph.coloring

--OUTPUT 1
theorem bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) :=
begin
  -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color.
  have h1 : (G.colorable 2) → (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)), from
    begin
      -- Let $G$ be a 2-colorable graph
      assume h2 : (G.colorable 2),
      -- which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color.
      have h3 : ∃ (c : V → fin 2), (∀ v w : V, G.E v w → c v ≠ c w), from by auto [h2, simple_graph.colorable],
      obtain (c : V → fin 2) (h3 : (∀ v w : V, G.E v w → c v ≠ c w)), from h3,
      -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
      -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
      have h4 : (∀ (v : V), (c v = 0) → (∀ (w : V), (c w = 0) → (G.E v w → false))) ∧ (∀ (v : V), (c v = 1) → (∀ (w : V), (c w = 1) → (G.E v w → false))), from by auto [h3],
      obtain (h4 : (∀ (v : V), (c v = 0) → (∀ (w : V), (c w = 0) → (G.E v w → false))) ∧ (∀ (v : V), (c v = 1) → (∀ (w : V), (c w = 1) → (G.E v w → false)))), from h4,
      -- This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
      have h5 : ∀ (v w : V), (G.E v w → (c v ≠ c w)), from by auto [h3],
      have h6 : ∀ (v w : V), (G.E v w → (c v = 0 → c w = 1)), from by auto [h5],
      have h7 : ∀ (v w : V), (G.E v w → (c v = 1 → c w = 0)), from by auto [h5],
      -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
      let A := {v : V | c v = 0},
      let B := {v : V | c v = 1},
      -- This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
      have h8 : ∀ (v w : V), (G.E v w → ((v ∈ A) ∧ (w ∈ B) ∨ (v ∈ B) ∧ (w ∈ A))), from by auto [h6, h7],
      have h9 : G ≤ complete_bipartite_graph A B, from by auto [h8],
      have h10 : (A ⊕ B) = V, from by auto [set.ext, sum.ext],
      show ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by auto [h10, h9],
    end,

  --Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$.
  have h2 : (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) → (G.colorable 2), from
    begin
      -- Suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$.
      assume h3 : (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)),
      obtain (A B : Type*) (h : (A ⊕ B) = V) (h3 : G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)), from h3,
      have h4 : ∀ (v w : V), (G.E v w → ((v ∈ A) ∧ (w ∈ B) ∨ (v ∈ B) ∧ (w ∈ A))), from by auto [h3],
      -- Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.
      let c : V → fin 2 := λ (v : V), if v ∈ A then 0 else 1,
      have h5 : ∀ (v w : V), (G.E v w → (c v ≠ c w)), from by auto [h4],
      show (G.colorable 2), from by auto [h5, simple_graph.colorable],
    end,

  show (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)), from by auto [h1, h2],
end

--OUTPUT 2
theorem bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) :=
begin
  -- Suppose $G$ is 2-colorable, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color. Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue. Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$. This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
  assume h1 : G.colorable 2,
  have h2 : ∃ A B : Type*, (A ⊕ B) = V ∧ G ≤ cast (congr_arg _ (decidable.by_cases (λ (x : V), x ∈ A) (λ (h3 : V), ⟨λ (h4 : V), (λ (x : V), x ∈ A) (fintype.complete.1 (fintype.of_equiv_card_of_injective (equiv.decidable_eq V) (λ (h5 : V), (λ (h6 : A) (h7 : B), (λ (h8 : A ⊕ B), h5) (sum.inl h6)) (λ (h5 : V), (λ (h6 : A) (h7 : B), (λ (h8 : A ⊕ B), h5) (sum.inr h7)))) h3))) (λ (x : V), x ∈ B) (λ (h3 : V), ⟨λ (h4 : V), (λ (x : V), x ∈ B) (fintype.complete.1 (fintype.of_equiv_card_of_injective (equiv.decidable_eq V) (λ (h5 : V), (λ (h6 : A) (h7 : B), (λ (h8 : A ⊕ B), h5) (sum.inl h6)) (λ (h5 : V), (λ (h6 : A) (h7 : B), (λ (h8 : A ⊕ B), h5) (sum.inr h7)))) h3))) (λ (h3 : V), ⟨λ (h4 : V), (λ (x : V), x ∈ A) (fintype.complete.1 (fintype.of_equiv_card_of_injective (equiv.decidable_eq V) (λ (h5 : V), (λ (h6 : A) (h7 : B), (λ (h8 : A ⊕ B), h5) (sum.inl h6)) (λ (h5 : V), (λ (h6 : A) (h7 : B), (λ (h8 : A ⊕ B), h5) (sum.inr h7)))) h3)) (λ (h3 : V), ⟨λ (h4 : V), (λ (x : V), x ∈ B) (fintype.complete.1 (fintype.of_equiv_card_of_injective (equiv.decidable_eq V) (λ (h5 : V), (λ (h6 : A) (h7 : B), (λ (h8 : A ⊕ B), h5) (sum.inl h6)) (λ (h5 : V), (λ (h6 : A) (h7 : B), (λ (h8 : A ⊕ B), h5) (sum.inr h7)))) h3)) (λ (h3 : V), ⟨λ (h4 : V), (λ (x : V), x ∈ A) (fintype.complete.1 (fintype.of_equiv_card_of_injective (equiv.decidable_eq V) (λ (h5 : V), (λ (h6 : A) (h7 : B), (λ (h8 : A ⊕ B), h5) (sum.inl h6)) (λ (h5 : V), (λ (h6 : A) (h7 : B), (λ (h8 : A ⊕ B), h5) (sum.inr h7)))) h3)) (λ (h3 : V), ⟨λ (h4 : V), (λ (x : V), x ∈ B) (fintype.complete.1 (fintype.of_equiv_card_of_injective (equiv.decidable_eq V) (λ (h5 : V), (λ (h6 : A) (h7 : B), (λ (h8 : A ⊕ B), h5) (sum.inl h6)) (λ (h5 : V), (λ (h6 : A) (h7 : B), (λ (h8 : A ⊕ B), h5) (sum.inr h7)))) h3)) (λ (h3 : V), ⟨λ (h4 : V), (λ (x : V), x ∈ A) (fintype.complete.1 (fintype.of_equiv_card_of_injective (equiv.decidable_eq V) (λ (h5 : V), (λ (h6 : A) (h7 : B), (λ (h8 : A ⊕ B), h5) (sum.inl h6)) (λ (h5 : V), (λ (h6 : A) (h7 : B), (λ (h8 : A ⊕ B), h5) (sum.inr h7)))) h3)) (λ (h3 : V), ⟨λ (h4 : V), (λ (x : V), x ∈ B) (fintype.complete.1 (fintype.of_equiv_card_of_injective (equiv.decidable_eq V) (λ (h5 : V), (λ (h6 : A) (h7 : B), (λ (h8 : A ⊕ B), h5) (sum.inl h6)) (λ (h5 : V), (λ (h6 : A) (h7 : B), (λ (h8 : A ⊕ B), h5) (sum.inr h7)))) h3)) (λ (h3 : V), ⟨λ (h4 : V), (λ (x : V), x ∈ A) (fintype.complete.1 (fintype.of_equiv_card_of_injective (equiv.decidable_eq V) (λ (h5 : V), (λ (h6 : A) (h7 : B), (λ (h8 : A ⊕ B), h5) (sum.inl h6)) (λ (h5 : V), (λ (h6 : A) (h7 : B), (λ (h8 : A ⊕ B), h5) (sum.inr h7)))) h3)) (λ (h3 : V), ⟨λ (h4 : V), (λ (x : V), x ∈ B) (fintype.complete.1 (fintype.of_equiv_card_of_injective (equiv.decidable_eq V) (λ (h5 : V), (λ (h6 : A) (h7 : B), (λ (h8 : A ⊕ B), h5) (sum.inl h6)) (λ (h5 : V), (λ (h6 : A) (h7 : B), (λ (h8 : A ⊕ B), h5) (sum.inr h7)))) h3)) (λ (h3 : V), ⟨λ (h4 : V), (λ (x : V), x ∈ A) (fintype.complete.1 (fintype.of_equiv_card_of_injective (equiv.decidable_eq V) (λ (h5 : V), (λ (h6 : A) (h7 : B), (λ (h8 : A ⊕ B), h5) (sum.inl h6)) (λ (h5 : V), (λ (h6 : A) (h7 : B), (λ (h8 : A ⊕ B), h5) (sum.inr h7)))) h3)) (λ (h3 : V), ⟨λ (h4 : V), (λ (x : V), x ∈ B) (fintype.complete.1 (fintype.of_equiv_card_of_injective (equiv.decidable_eq V)
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) :=
begin
  -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color. Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue. Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$. This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
  have h1 : (G.colorable 2) → (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)), from begin
    assume h,
    -- coloring every vertex of $V$ as red or blue
    let κ : V → fin 2 := λ v, (if (∃ (w : V), G.adj v w) then 1 else 0),
    -- coloring every vertex of $V$ as red or blue
    have h1 : ∀ v : V, κ v = 0 ∨ κ v = 1, from by auto [nat.one_le_iff_ne_zero],
    -- coloring every vertex of $V$ as red or blue
    have h2 : ∀ v : V, κ v < 2, from by auto [lt_succ_self, nat.one_le_iff_ne_zero],
    have h3 : ∀ v : V, κ v ∈ finset.range 2, from by auto [h2],
    have h4 : (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)), from begin
      let κ1 : fin 2 → V := λ f, finset.choose (finset.range 2) f,
      have h5 : ∀ f : fin 2, κ1 f ∈ finset.range 2, from by auto [finset.choose_mem],
      have h6 : ∀ v : V, κ v = 0 ∧ κ1 (0 : fin 2) = v ∨ κ v = 1 ∧ κ1 (1 : fin 2) = v, from by auto [h1, h5],
      have h7 : ∀ v : V, κ v = 0 → κ1 (0 : fin 2) = v, from by auto [h6],
      have h8 : ∀ v : V, κ v = 1 → κ1 (1 : fin 2) = v, from by auto [h6],
      have h9 : ∀ v : V, κ v = 0 → ∀ w : V, G.adj v w → κ1 (0 : fin 2) ≠ w, from begin
        assume v : V,
        assume h9 : κ v = 0,
        assume w : V,
        assume h10 : G.adj v w,
        have h11 : κ w = 1, from by auto [h],
        have h12 : κ1 (1 : fin 2) = w, from by auto [h8],
        have h13 : κ1 (0 : fin 2) ≠ κ1 (1 : fin 2), from by auto [finset.choose_eq_of_mem finset.mem_range_self finset.mem_range_self],
        show κ1 (0 : fin 2) ≠ w, from by auto [h13, h12],
      end,
      have h10 : ∀ v : V, κ v = 1 → ∀ w : V, G.adj v w → κ1 (1 : fin 2) ≠ w, from begin
        assume v : V,
        assume h9 : κ v = 1,
        assume w : V,
        assume h10 : G.adj v w,
        have h11 : κ w = 0, from by auto [h],
        have h12 : κ1 (0 : fin 2) = w, from by auto [h7],
        have h13 : κ1 (0 : fin 2) ≠ κ1 (1 : fin 2), from by auto [finset.choose_eq_of_mem finset.mem_range_self finset.mem_range_self],
        show κ1 (1 : fin 2) ≠ w, from by auto [h13, h12],
      end,
      have h11 : ∀ v w : V, G.adj v w → κ v ≠ κ w, from by auto [h9, h10],
      have h12 : ∀ (v w : V) (f : fin 2), κ v = f → κ w = f → (v = w), from begin
        assume v w : V,
        assume f : fin 2,
        assume h12 : κ v = f,
        assume h13 : κ w = f,
        have h14 : κ v ≠ κ w, from by auto [h11, G.adj_symm],
        show v = w, from by auto [h12, h13, h14],
      end,
      have h13 : ∀ v : V, κ v = 0 → κ1 (0 : fin 2) = v, from by auto [h7],
      have h14 : ∀ v : V, κ v = 1 → κ1 (1 : fin 2) = v, from by auto [h8],
      have h15 : ∀ v : V, κ v = 0 → κ v ≠ 1, from by auto [nat.one_le_iff_ne_zero],
      have h16 : ∀ v : V, κ v = 1 → κ v ≠ 0, from by auto [nat.one_le_iff_ne_zero],
      have h17 : ∀ v : V, κ v ≠ 1 → κ v = 0, from by auto [h15],
      have h18 : ∀ v : V, κ v ≠ 0 → κ v = 1, from by auto [h16],
      have h19 : ∀ v : V, κ v = 0 → κ1 (0 : fin 2) = v ∧ κ1 (1 : fin 2) ≠ v, from by auto [h13, h18],
      have h20 : ∀ v : V, κ v = 1 → κ1 (1 : fin 2) = v ∧ κ1 (0 : fin 2) ≠ v, from by auto [h14, h17],
      have h21 : ∀ v : V, κ v = 0 ∧ κ1 (1 : fin 2) ≠ v ∨ κ v = 1 ∧ κ1 (0 : fin 2) ≠ v, from by auto [h19, h20],
      have h22 : ∀ v : V, κ1 (0 : fin 2) ≠ v → κ v = 1, from by auto [h21],
      have h23 : ∀ v : V, κ1 (1 : fin 2) ≠ v → κ v = 0, from by auto [h21],
      have h24 : ∀ v : V, κ v = 0 → κ1 (0 : fin 2) = v ∧ κ1 (1 : fin 2) ≠ v, from by auto [h19],
      have h25 : ∀ v : V, κ v = 1 → κ1 (1 : fin 2) = v ∧ κ1 (0 : fin 2) ≠ v, from by auto [h20],
      have h26 : ∀ v : V, κ v = 0 ∧ κ1 (1 : fin 2) ≠ v ∨ κ v = 1 ∧ κ1 (0 : fin 2) ≠ v, from by auto [h24, h25],
      have h27 : ∀ v : V, κ1 (0 : fin 2) ≠ v → κ v = 1, from by auto [h26],
      have h28 : ∀ v : V, κ1 (1 : fin 2) ≠ v → κ v = 0, from by auto [h26],
      have h29 : ∀ v : V, κ v = 0 → κ1 (0 : fin 2) = v ∧ κ1 (1 : fin 2) ≠ v, from by auto [h19],
      have h30
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) :=
begin
  -- A simple graph G is 2-colorable if and only if G is bipartite
  have h1 : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)), from by auto,
  show (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)), from by auto [h1],
end

--OUTPUT 5
theorem bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) :=
begin
  assume h1,
  -- $G$ is 2-colorable
  from ⟨_, _, _, _, _⟩,
  { -- Let $A$ denote the subset of vertices colored red and let $B$ denote the subset of vertices colored blue
    let A : Type* := {v : V | (G.is_vertex v) ∧ (G.color v = 0)},
    let B : Type* := {v : V | (G.is_vertex v) ∧ (G.color v = 1)},
    -- Then $A ⊕ B = V$
    have h2 : (A ⊕ B) = V, from by auto [subtype.eq, set.subset_def, set.ext],
    -- Then $A$ and $B$ are disjoint
    have h3 : ∀ x y : V, x ∈ A → y ∈ B → x ≠ y, from by auto [subtype.ext, G.color_prop, G.is_vertex_prop, G.not_adjacent, G.adj_iff_adj'],
    -- Then $G ≤ cast (congr_arg _ h2) (complete_bipartite_graph A B)$
    have h4 : G ≤ cast (congr_arg _ h2) (complete_bipartite_graph A B), from by auto [G.adj_iff_adj', complete_bipartite_graph_def, G.color_prop, G.is_vertex_prop, G.not_adjacent, G.adj_iff_adj', complete_bipartite_graph_def, G.is_vertex_prop, G.color_prop, h3, complete_bipartite_graph_def, h2, cast_congr],
    -- Hence $G$ is a bipartite graph
    show ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by auto [h2, h4],
  },
  { -- Let $A$ and $B$ be disjoint subsets of $V$
    assume (A : Type*) (B : Type*) (h2 : (A ⊕ B) = V),
    assume h3 : G ≤ cast (congr_arg _ h2) (complete_bipartite_graph A B),
    -- Then $G$ is bipartite
    -- Then coloring every vertex of $A$ red and every vertex of $B$ blue yields a valid coloring, so $G$ is 2-colorable
    have h4 : ∀ v : V, (∃ (c : fin 2) (h4 : G.color v = c), true), from by auto [G.color_prop, h3, complete_bipartite_graph_def, G.color_prop, G.is_vertex_prop, G.not_adjacent, G.adj_iff_adj', complete_bipartite_graph_def, G.is_vertex_prop, G.color_prop, h3, complete_bipartite_graph_def, h2, cast_congr],
    show G.colorable 2, from by auto [G.colorable_def, h4],
  },
end

--OUTPUT 6
theorem bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) :=
begin
  -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color.
  have h1 : (G.colorable 2) → (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)), from sorry,
  -- Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$. Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.
  have h2 : (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) → (G.colorable 2), from sorry,
  from iff.intro h1 h2,
end

--OUTPUT 7
theorem bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) :=
begin
  -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color. Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue. Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$. This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
  sorry
end

--OUTPUT 8
theorem bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) :=
begin
  -- if G is 2-colorable then G is bipartite
  have h1 : (G.colorable 2) → (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)), from
  begin
    assume h,
    -- coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable
    have h1 : ∃ (V1 V2 : Type*) (h : (V1 ⊕ V2) = V), (G.colorable 2), from by auto [h],
    -- let A denote the subset of vertices colored red, and let B denote the subset of vertices colored blue
    have h2 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by auto [h1],
    show ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by auto [h2],
  end,
  -- if G is bipartite then G is 2-colorable
  have h2 : (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) → (G.colorable 2), from
  begin
    assume h,
    -- let V1, V2 denote the subsets of vertices of A, B
    have h1 : ∃ (V1 V2 : Type*) (h : (V1 ⊕ V2) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph V1 V2), from by auto [h],
    -- coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable
    have h2 : (G.colorable 2), from by auto [h1],
    show (G.colorable 2), from by auto [h2],
  end,
  show (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)), from by auto [h1, h2, iff.intro],
end

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

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

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

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

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

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

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

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

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

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

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

Setting $b = a$, this becomes:

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

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

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

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

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

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

/--`theorem`
Bipartite Graph is two colorable
Let $G$ be a graph. Then $G$ is 2-colorable if and only if $G$ is bipartite.
`proof`
Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color. Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue. Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$. This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.

Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$. Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.

QED

-/
theorem  bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) :=
FEW SHOT PROMPTS TO CODEX(END)-/


variable {p q r s: Prop}
#check And p q
#check Or (And p q) r
#check p → r

theorem t1' : p → q → p :=
fun hp : p =>
fun hq : q =>
show p from hp

#print t1'

theorem t1 (p q : Prop)(hp: p) (hq : q) : p := hp

axiom hp : p

axiom unsound : False
-- Everything follows from false (principle of explosion)
theorem ex : 1 = 0 :=
  False.elim unsound

#check t1 p q
#check t1 (r → p) (p → q)

variable (h : r → s)
#check t1 (r → s) (s → r) h

theorem t2 (h₁ : q → r) (h₂ : p → q) : p → r :=
  fun h₃ : p =>
  show r from h₁ (h₂ h₃)


import data.nat.basic
import data.nat.parity
import tactic

open nat

example : ∀ m n : ℕ, even n → even (m * n) :=
  assume m n ⟨k, (hk : n = k + k)⟩,
  have hmn : m * n = (m * k) + (m * k) := by
    simp [hk, mul_left_comm, mul_add],
  show ∃ l, m * n = l + l,
    from Exists.intro _ hmn

example : ∀ m n : ℕ, even n → even (m * n) :=
  λ m n ⟨k, hk⟩, ⟨m * k, by rw [hk, mul_add]⟩

example : ∀ m n : ℕ, even n → even (m * n) :=
begin
  rintros m n ⟨k, hk⟩,
  -- ⊢ even (m * k)
  use m * k,
  -- ⊢ m * n = m * k + m + k
  rw hk,
  -- ⊢ m * (k + k) = m * k + m * k
  ring -- conmutative (semi)rings
end

example : ∀ m n : ℕ, even n → even (m * n) :=
  by intros; simp * with parity_simps


/-
Copyright (c) 2022 Julian Kuelshammer. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Julian Kuelshammer
-/

import hard_mode.sheet02

/-! Real vector spaces

This file defines the concept of a real vector space (as is discussed in the first lecture of Linear Algebra II
and proves that ℝ² and Mat₂ are instances of it.)

One further ingredient could be useful:

calc expr_1 = expr_2 : begin sorry end
       ...  = expr_3 : begin sorry end
       ...  = expr_4 : begin sorry end

Fun fact: If you only work with calc, you don't have to switch to tactic mode, i.e. you can leave out the
begin ... end

rw : rewrite one expression by another using a lemma.

apply : Apply a statement to reduce the goal. In ordinary mathematics you would read this as. By this theorem,
        it suffices to prove the following ...

exact : The goal that is to show is exactly the following lemma/theorem.

nth_rewrite i _ : If you use rw, it will change the every occurrence of the term. Sometimes you only want to
                  do that on a certain occurrence, that you can use nth_rewrite i to change it on the ith
                  occurrence (starting counting with 0).

conv_lhs begin ... end
conv_rhs begin ... end : Solve a similar problem to the one before, they allow you to only rewrite the left or
                         the right hand side of an equation.

norm_num : Similar to ring, but only calculates explicit expressions (with actual numbers.)
-/

/-- `real_vector_space V` is the type of real vector space structures on the type `V`. -/
class real_vector_space (V : Type)
  extends has_zero V, has_add V, has_neg V, has_scalar ℝ V : Type :=
(add_assoc : ∀ u v w : V, (u + v) + w = u + (v + w))
(add_comm : ∀ u v : V, u + v = v + u)
(add_zero : ∀ v : V, v + 0 = v)
(zero_add : ∀ v : V, 0 + v = v)
(add_neg : ∀ v : V, v + (-v) = 0)
(neg_add : ∀ v : V, (-v) + v = 0)
(smul_assoc : ∀ (a b : ℝ) (v : V), (a * b) • v = a • (b • v))
(one_smul : ∀ v : V, (1 : ℝ) • v = v)
(add_smul : ∀ (a b : ℝ) (v : V), (a + b) • v = a • v + b • v)
(smul_add : ∀ (a : ℝ) (v w : V), a • (v + w) = a • v + a • w)

namespace real_vector_space

/- We can also add the simp attribute to statements later. -/
attribute [simp] add_assoc add_zero zero_add add_neg neg_add smul_assoc one_smul add_smul smul_add

variables {V : Type} [real_vector_space V] {u v w : V} {a b : ℝ}

/-
Let's first let Lean know that the plane and the 2x2-matrices are real vector spaces. We have proved
everything on the previous two sheets, we just have to package it nicely.
-/

instance : real_vector_space ℝ² :=
_

instance : real_vector_space Mat₂ :=
_

/-
We continue by proving some well-known properties which hold in (real) vector spaces.
-/

lemma zero_unique_right_neutral (h : v + w = v)  :  w = 0 :=
begin
  sorry
end

lemma zero_unique_left_neutral (h : w + v = v) : w = 0 :=
begin
  sorry
end

lemma zero_smul_eq_zero_vector (v : V) : (0 : ℝ) • v = 0 :=
begin
  sorry
end

lemma neg_unique_right_add_inv (h : v + w = 0) :  w = -v :=
begin
  sorry
end

lemma neg_unique_left_add_inv (h : w + v = 0) : w = -v :=
begin
  sorry
end

lemma minus_one_smul_eq_neg : (-1 : ℝ) • v = -v :=
begin
  sorry
end

end real_vector_space

/- It has been realised that the vector space axioms are not minimal, you can remove some of them and still
  get the same structure. Here is a minimal list that has been found (which is quite similar to the standard
  list, only the second axiom seems kind of weird.)-/
class minimal_vector_space_axioms (V : Type)
  extends has_add V, has_scalar ℝ V : Type :=
(add_assoc : ∀ u v w : V, (u + v) + w = u + (v + w))
(zero_smul_eq : ∀ v w : V, (0 : ℝ) • v = (0 : ℝ) • w)
(one_smul : ∀ v : V, (1 : ℝ) • v = v)
(smul_assoc : ∀ (a b : ℝ) (v : V), (a * b) • v = a • (b • v))
(add_smul : ∀ (a b : ℝ) (v : V), (a + b) • v = a • v + b • v)
(smul_add : ∀ (a : ℝ) (v w : V), a • (v + w) = a • v + a • w)

/- Note that in contrast to the vector space axioms, the axiom about the zero vector is omitted from these
  minimal vector space axioms. However this means that there is no reason for any vector at all to exist
  in `V`. So let's prove that the empty set satisfies these axioms. -/
instance : minimal_vector_space_axioms empty :=
_

/- Let's prove that any real_vector_space satisfies the minimal vector space axioms, which is not too difficult, '
  there is only one axiom which is already included in the axioms and that is immediately true. -/
def to_minimal_vector_space_axioms (V : Type) [real_vector_space V] : minimal_vector_space_axioms V :=
_

/- In the other direction, the difference seems larger, so let's try to prove some of the axioms which are missing. -/

lemma minimal_vector_space_axioms.add_zero (V : Type) [minimal_vector_space_axioms V] (v w : V) : v + (0 : ℝ) • w = v :=
begin
  sorry
end

lemma minimal_vector_space_axioms.zero_add (V : Type) [minimal_vector_space_axioms V] (v w : V) : (0 : ℝ) • w + v = v :=
begin
  sorry
end

lemma minimal_vector_space_axioms.add_neg (V : Type) [minimal_vector_space_axioms V] (v : V) : v + (-1 : ℝ) • v = (0 : ℝ) • v :=
begin
  sorry
end

lemma minimal_vector_space_axioms.neg_add (V : Type) [minimal_vector_space_axioms V] (v : V) : (-1 : ℝ) • v + v = (0 : ℝ) • v :=
begin
  sorry
end

/- The following is probably the most challenging one. Consider trying to prove it on paper first. -/
lemma minimal_vector_space_axioms.add_comm (V : Type) [minimal_vector_space_axioms V] (v w : V) : v + w = w + v :=
begin
  sorry
end

/- However if we demand that the set V is nonempty, the axioms are in fact equivalent as we show with the
  following two results. These are `definitions` as they transport data. Often in a maths lecture we would
  instead say `proposition` for this, or if one is very careful `definition-proposition`. The definition is
  marked as `noncomputable` as it relies on choosing an arbitrary element `v` from the nonempty type `V`,
  for which there might not be an algorithm. -/
noncomputable def to_real_vector_space (V : Type) [minimal_vector_space_axioms V] (h : nonempty V) : real_vector_space V :=
_


import tactic.ring

-- intermediate lemmas, many of which probably already existed
-- always made inputs of type k explicit for clarity
-- naming very random

theorem mul_eq_implies_mul_mul {k : Type} [field k] (a b c : k):
a=b → a*c = b*c := begin
intro H, rw H
end

theorem add_eq_implies_add_add {k : Type} [field k] (a b c : k):
a=b → a+c = b+c := begin
intro H, rw H
end

theorem move_sides {k : Type} [field k] (a b : k) :
a + b = 0 → a = - b :=
begin
intro H,
have H₁ := @eq_of_add_eq_add_left k _ b a (-b),
rw H₁, simp, exact H
end

theorem eq_implies_sq_eq {k : Type} [field k] (a b : k) :
a = b ∨ a = -b → a^2 = b^2 := begin

intro H,
unfold pow monoid.pow, simp,
cases H;rw H,
simp

end

theorem factorise_a_sq_minus_b_sq {k : Type} [field k] (a b : k) :
a^2 - b^2 = (a-b) * (a+b) := begin
ring
end

theorem add_neg_eq_sub {k : Type} [field k] (a b : k) :
a + - (b) = a - b := begin
refl
end

theorem sq_eq_implies_eq_or_neg_eq {k : Type} [field k] (a b : k) :
a^2 = b^2 → a = b ∨ a = -b := begin

intro H,
have rearrange_H := @add_eq_of_eq_add_neg k _ (a*a) (-(b*b)) 0,
simp at rearrange_H,

rw ←pow_two at rearrange_H, rw ←pow_two at rearrange_H,

rw add_neg_eq_sub (a^2) (b^2) at rearrange_H,
rw factorise_a_sq_minus_b_sq at rearrange_H,

rw H at rearrange_H, simp at rearrange_H,

have H_zero := @mul_eq_zero k _ (a +- b) (a + b),
rw rearrange_H at H_zero, simp at H_zero,
cases H_zero,
{
    rw add_neg_eq_zero at H_zero,
    exact or.inl H_zero,
},
{
    rw add_comm at H_zero,
    rw add_eq_zero_iff_neg_eq at H_zero,
    right,
    exact H_zero.symm
}

end

theorem multiply_out_divide {k : Type} [field k] (a b c: k) (H_neq : c ≠ 0) :
a * c = b → a = b / c := begin
intro H,
have H₁ :=  @eq_of_mul_eq_mul_left k _ c a (b/c) H_neq,
rw H₁,
--rw mul_comm c (b/c),
rw mul_div_cancel' b H_neq,
rw ←H,
exact mul_comm c a

end

theorem quad (k : Type) [field k] (a b c x S : k)
(HS : S*S = b*b - 4*a*c) (char_not_2 : (2:k) ≠ 0) (a_not_0 : a ≠ 0) :
a * x*x + b * x + c = 0 ↔
(x = (-b + S ) / (2*a) ∨
 x = (-b - S ) / (2*a)) := begin

have H₁  := @eq_zero_or_eq_zero_of_mul_eq_zero _ _ 2 a,
have H₂  : 2 * a ≠ 0,
{
    intro H₃,
    cases H₁ H₃,
    {
        revert h,
        exact char_not_2
    },
    {
        revert h, exact a_not_0
    }
},

clear H₁, clear a_not_0,

split,
-- ax^2 + bx + c = 0 → x=...
{
    intro H_main,

    have H_equate_squares : (2*a*x + b)^2 = S^2,
    {
        rw pow_two,
        rw pow_two,

        rw HS,
        repeat {rw mul_add},
        repeat {rw add_mul},

        simp,
        have H_mul_comm : b * (2 * a * x) = 2 * a * x * b,{rw mul_comm},
        rw H_mul_comm,
        rw ←add_assoc,
        rw ←mul_two (2*a*x*b),
        ring,
        have H_neg_mul_comm : -(4 * c * a) = -(4 * c) * a,{ring},
        rw H_neg_mul_comm, clear H_neg_mul_comm,

        have H_cancel_a :=
        mul_eq_implies_mul_mul (4 * x ^ 2 * a + 4 * x * b) (-(4 * c)) a,

        apply H_cancel_a, clear H_cancel_a,

        rw ←mul_neg_eq_neg_mul_symm 4 c,
        rw mul_assoc 4 x b,
        rw mul_assoc 4 (x^2) a,
        rw ←mul_add 4 (x^2*a) (x*b),
        congr,
        unfold pow monoid.pow, simp,

        have H_move_sides :=
        move_sides (x * b + x * x * a) c,
        rw H_move_sides, clear H_move_sides,

        --lots of shuffling about to get the goal to look like H_main

        rw add_comm,
        rw ←pow_two,
        rw mul_comm,
        rw mul_comm (x^2) a,

        simp at H_main,

        rw pow_two,

        rw mul_assoc a x x at H_main,
        exact H_main
    },

    have H_sq_eq := sq_eq_implies_eq_or_neg_eq (2 * a * x + b) S,
    rw H_equate_squares at H_sq_eq, simp at H_sq_eq,
    rw add_comm at H_sq_eq,

    cases H_sq_eq,
    {
        left,
        have H_mul_out_1 := multiply_out_divide x (-b + S) (2*a) H₂,
        rw H_mul_out_1, clear H_mul_out_1,
        rw mul_comm,

        suffices H_add_b : 2*a*x + b = S,
        {
            rw ←H_add_b,simp
        },

        exact H_sq_eq
    },
    {
        right,
        have H_mul_out_2 := multiply_out_divide x (-b - S) (2*a) H₂,
        rw H_mul_out_2, clear H_mul_out_2,
        rw mul_comm,

        suffices H_add_b : 2*a*x + b = -S,
        {
            rw ←add_neg_eq_sub,
            rw ←H_add_b,simp
        },

        exact H_sq_eq
    }

},
-- x=... → ax^2 + bx + c
{
    intro H,
    cases H,

    repeat --works for both cases -b - S and - b + S
    {
        subst H,

        apply eq_of_mul_eq_mul_right H₂,
        simp [add_mul],

        repeat {rw ←mul_div_assoc},
        repeat {rw div_mul_cancel _ H₂},

        apply eq_of_mul_eq_mul_right H₂,
        simp [add_mul],

        rw ←add_assoc,

        rw div_mul_eq_mul_div,

        rw div_mul_cancel _ H₂,
        ring,
        rw pow_two S,
        rw HS,
        ring
    },

}

end


import GMLInit.Data.Nat.Basic
import GMLInit.Data.Nat.IsPos
import GMLInit.Data.Nat.Order
import GMLInit.Data.Nat.Succ

namespace Nat

-- assert theorem add_zero (x : Nat) : x + 0 = x

-- assert theorem zero_add (x : Nat) : 0 + x = x

protected theorem add_succ' (x y : Nat) : x + (y + 1) = (x + y) + 1 := Nat.add_succ x y

protected theorem succ_add' (x y : Nat) : (x + 1) + y = (x + y) + 1 := Nat.succ_add x y

protected theorem one_add' (x : Nat) : 1 + x = x + 1 := by
  rw [Nat.succ_add, Nat.zero_add]

-- assert theorem add_comm (x y : Nat) : x + y = y + x := core

-- assert theorem add_assoc (x y z : Nat) : (x + y) + z = x + (y + z)

-- assert theorem add_left_comm (x y z : Nat) : x + (y + z) = y + (x + z) := rfl

-- assert theorem add_right_comm (x y z : Nat) : (x + y) + z = (x + z) + y := rfl

protected theorem add_cross_comm (x₁ x₂ y₁ y₂ : Nat) : (x₁ + x₂) + (y₁ + y₂) = (x₁ + y₁) + (x₂ + y₂) :=
  calc
  _ = x₁ + (x₂ + (y₁ + y₂)) := by rw [Nat.add_assoc]
  _ = x₁ + (y₁ + (x₂ + y₂)) := by rw [Nat.add_left_comm x₂ y₁ y₂]
  _ = (x₁ + y₁) + (x₂ + y₂) := by rw [Nat.add_assoc]

protected theorem add_left_cancel' (x : Nat) {y z : Nat} : x + y = x + z → y = z := Nat.add_left_cancel

protected theorem add_right_cancel' (x : Nat) {y z : Nat} : y + x = z + x → y = z := Nat.add_right_cancel

-- assert theorem le_add_left (x y : Nat) : x ≤ y + x

-- assert theorem le_add_right (x y : Nat) : x ≤ x + y

protected theorem lt_add_left_of_pos (x y : Nat) (h : y > 0 := by nat_is_pos) : x < y + x :=
  calc
  _ = 0 + x := by rw [Nat.zero_add]
  _ < y + x := by apply Nat.add_lt_add_right h

protected theorem lt_add_right_of_pos (x y : Nat) (h : y > 0 := by nat_is_pos) : x < x + y :=
  calc
  _ = x + 0 := by rw [Nat.add_zero]
  _ < x + y := by apply Nat.add_lt_add_left h

theorem pos_add_left (x y : Nat) (h : x > 0 := by nat_is_pos) : x + y > 0 :=
  calc
  0 ≤ y := by apply Nat.zero_le
  _ < x + y := by apply Nat.lt_add_left_of_pos _ _

theorem pos_add_right (x y : Nat) (h : y > 0 := by nat_is_pos) : x + y > 0 :=
  calc
  0 ≤ x := by apply Nat.zero_le
  _ < x + y := by apply Nat.lt_add_right_of_pos _ _

-- assert -- theorem eq_zero_of_add_eq_zero_right : {x y : Nat} → x + y = 0 → y = 0

-- assert theorem eq_zero_of_add_eq_zero_left {x y : Nat} : x + y = 0 → x = 0

-- assert theorem add_le_add {x₁ x₂ y₁ y₂ : Nat} : x₁ ≤ x₂ → y₁ ≤ y₂ → x₁ + y₁ ≤ x₂ + y₂

-- assert theorem add_le_add_left {x y : Nat} (h : x ≤ y) (z : Nat) : z + x ≤ z + y

-- assert theorem add_le_add_right {x y : Nat} (h : x ≤ y) (z : Nat) : x + z ≤ y + z

-- assert theorem add_lt_add {x₁ x₂ y₁ y₂ : Nat} : x₁ < x₂ → y₁ < y₂ → x₁ + y₁ < x₂ + y₂

-- assert theorem add_lt_add_left {x y : Nat} (h : x ≤ y) (z : Nat) : z + x ≤ z + y

-- assert theorem add_lt_add_right {x y : Nat} (h : x ≤ y) (z : Nat) : x + z ≤ y + z

protected theorem add_lt_add_of_le_of_lt {x₁ x₂ y₁ y₂ : Nat} : x₁ ≤ x₂ → y₁ < y₂ → x₁ + y₁ < x₂ + y₂ := by
  intro h₁ h₂
  transitivity (x₁ + y₂) using LT.lt, LE.le
  · apply Nat.add_lt_add_left h₂
  · apply Nat.add_le_add_right h₁

protected theorem add_lt_add_of_lt_of_le {x₁ x₂ y₁ y₂ : Nat} : x₁ < x₂ → y₁ ≤ y₂ → x₁ + y₁ < x₂ + y₂ := by
  intro h₁ h₂
  transitivity (x₁ + y₂) using LE.le, LT.lt
  · apply Nat.add_le_add_left h₂
  · apply Nat.add_lt_add_right h₁

protected theorem le_of_add_le_add_left' (x : Nat) {y z : Nat} : x + y ≤ x + z → y ≤ z := Nat.le_of_add_le_add_left

protected theorem le_iff_add_le_add_left (x y z : Nat) : x ≤ y ↔ z + x ≤ z + y :=
  ⟨λ h => Nat.add_le_add_left h z, Nat.le_of_add_le_add_left⟩

protected theorem le_of_add_le_add_right' (x : Nat) {y z : Nat} : y + x ≤ z + x → y ≤ z := Nat.le_of_add_le_add_right

protected theorem le_iff_add_le_add_right (x y z : Nat) : x ≤ y ↔ x + z ≤ y + z :=
  ⟨λ h => Nat.add_le_add_right h z, Nat.le_of_add_le_add_right⟩

-- assert theorem lt_of_add_lt_add_left {x y z : Nat} : x + y < x + z → y < z

protected theorem lt_of_add_lt_add_left' (x : Nat) {y z : Nat} : x + y < x + z → y < z := Nat.lt_of_add_lt_add_left

protected theorem lt_iff_add_lt_add_left (x y z : Nat) : x < y ↔ z + x < z + y :=
  ⟨λ h => Nat.add_lt_add_left h z, Nat.lt_of_add_lt_add_left⟩

-- assert theorem lt_of_add_lt_add_right {x y z : Nat} : y + x < z + x → y < z

protected theorem lt_of_add_lt_add_right' (x : Nat) {y z : Nat} : y + x < z + x → y < z := Nat.lt_of_add_lt_add_right

protected theorem lt_iff_add_lt_add_right (x y z : Nat) : x < y ↔ x + z < y + z :=
  ⟨λ h => Nat.add_lt_add_right h z, Nat.lt_of_add_lt_add_right⟩

end Nat


/-
Copyright (c) 2021 Alex Kontorovich and Heather Macbeth and Marc Masdeu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alex Kontorovich, Heather Macbeth, Marc Masdeu
-/

import linear_algebra.special_linear_group
import analysis.complex.basic
import group_theory.group_action.defs

/-!
# The upper half plane and its automorphisms

This file defines `upper_half_plane` to be the upper half plane in `ℂ`.

We furthermore equip it with the structure of an `SL(2,ℝ)` action by
fractional linear transformations.

We define the notation `ℍ` for the upper half plane available in the locale
`upper_half_plane` so as not to conflict with the quaternions.
-/

noncomputable theory

open matrix matrix.special_linear_group

open_locale classical big_operators matrix_groups

local attribute [instance] fintype.card_fin_even

/-- The open upper half plane -/
abbreviation upper_half_plane :=
{point : ℂ // 0 < point.im}

localized "notation `ℍ` := upper_half_plane" in upper_half_plane

namespace upper_half_plane

/-- Imaginary part -/
def im (z : ℍ) := (z : ℂ).im

/-- Real part -/
def re (z : ℍ) := (z : ℂ).re

@[simp] lemma coe_im (z : ℍ) : (z : ℂ).im = z.im := rfl

@[simp] lemma coe_re (z : ℍ) : (z : ℂ).re = z.re := rfl

lemma im_pos (z : ℍ) : 0 < z.im := z.2

lemma im_ne_zero (z : ℍ) : z.im ≠ 0 := z.im_pos.ne'

lemma ne_zero (z : ℍ) : (z : ℂ) ≠ 0 :=
mt (congr_arg complex.im) z.im_ne_zero

lemma norm_sq_pos (z : ℍ) : 0 < complex.norm_sq (z : ℂ) :=
by { rw complex.norm_sq_pos, exact z.ne_zero }

lemma norm_sq_ne_zero (z : ℍ) : complex.norm_sq (z : ℂ) ≠ 0 := (norm_sq_pos z).ne'

/-- Numerator of the formula for a fractional linear transformation -/
@[simp] def num (g : SL(2, ℝ)) (z : ℍ) : ℂ := (g 0 0) * z + (g 0 1)

/-- Denominator of the formula for a fractional linear transformation -/
@[simp] def denom (g : SL(2, ℝ)) (z : ℍ) : ℂ := (g 1 0) * z + (g 1 1)

lemma linear_ne_zero (cd : fin 2 → ℝ) (z : ℍ) (h : cd ≠ 0) : (cd 0 : ℂ) * z + cd 1 ≠ 0 :=
begin
  contrapose! h,
  have : cd 0 = 0, -- we will need this twice
  { apply_fun complex.im at h,
    simpa only [z.im_ne_zero, complex.add_im, add_zero, coe_im, zero_mul, or_false,
      complex.of_real_im, complex.zero_im, complex.mul_im, mul_eq_zero] using h, },
  simp only [this, zero_mul, complex.of_real_zero, zero_add, complex.of_real_eq_zero] at h,
  ext i,
  fin_cases i; assumption,
end

lemma denom_ne_zero (g : SL(2, ℝ)) (z : ℍ) : denom g z ≠ 0 :=
linear_ne_zero (g 1) z (g.row_ne_zero 1)

lemma norm_sq_denom_pos (g : SL(2, ℝ)) (z : ℍ) : 0 < complex.norm_sq (denom g z) :=
complex.norm_sq_pos.mpr (denom_ne_zero g z)

lemma norm_sq_denom_ne_zero (g : SL(2, ℝ)) (z : ℍ) : complex.norm_sq (denom g z) ≠ 0 :=
ne_of_gt (norm_sq_denom_pos g z)

/-- Fractional linear transformation -/
def smul_aux' (g : SL(2, ℝ)) (z : ℍ) : ℂ := num g z / denom g z

lemma smul_aux'_im (g : SL(2, ℝ)) (z : ℍ) :
  (smul_aux' g z).im = z.im / (denom g z).norm_sq :=
begin
  rw [smul_aux', complex.div_im],
  set NsqBot := (denom g z).norm_sq,
  have : NsqBot ≠ 0,
  { simp only [denom_ne_zero g z, monoid_with_zero_hom.map_eq_zero, ne.def, not_false_iff], },
  field_simp [smul_aux'],
  convert congr_arg (λ x, x * z.im * NsqBot ^ 2) g.det_coe using 1,
  { rw det_fin_two ↑g,
    ring },
  { ring }
end

/-- Fractional linear transformation -/
def smul_aux (g : SL(2,ℝ)) (z : ℍ) : ℍ :=
⟨smul_aux' g z,
by { rw smul_aux'_im, exact div_pos z.im_pos (complex.norm_sq_pos.mpr (denom_ne_zero g z)) }⟩

lemma denom_cocycle (x y : SL(2,ℝ)) (z : ℍ) :
  denom (x * y) z = denom x (smul_aux y z) * denom y z :=
begin
  change _ = (_ * (_ / _) + _) * _,
  field_simp [denom_ne_zero, -denom, -num],
  simp [matrix.mul, dot_product, fin.sum_univ_succ],
  ring
end

lemma mul_smul' (x y : SL(2, ℝ)) (z : ℍ) :
  smul_aux (x * y) z = smul_aux x (smul_aux y z) :=
begin
  ext1,
  change _ / _ = (_ * (_ / _) + _)  * _,
  rw denom_cocycle,
  field_simp [denom_ne_zero, -denom, -num],
  simp [matrix.mul, dot_product, fin.sum_univ_succ],
  ring
end

/-- The action of `SL(2, ℝ)` on the upper half-plane by fractional linear transformations. -/
instance : mul_action SL(2, ℝ) ℍ :=
{ smul := smul_aux,
  one_smul := λ z, by { ext1, change _ / _ = _, simp },
  mul_smul := mul_smul' }

@[simp] lemma coe_smul (g : SL(2, ℝ)) (z : ℍ) : ↑(g • z) = num g z / denom g z := rfl
@[simp] lemma re_smul (g : SL(2, ℝ)) (z : ℍ) : (g • z).re = (num g z / denom g z).re := rfl

lemma im_smul (g : SL(2, ℝ)) (z : ℍ) : (g • z).im = (num g z / denom g z).im := rfl

lemma im_smul_eq_div_norm_sq (g : SL(2, ℝ)) (z : ℍ) :
  (g • z).im = z.im / (complex.norm_sq (denom g z)) :=
smul_aux'_im g z

@[simp] lemma neg_smul (g : SL(2,ℝ)) (z : ℍ) : -g • z = g • z :=
begin
  ext1,
  change _ / _ = _ / _,
  field_simp [denom_ne_zero, -denom, -num],
  simp,
  ring,
end

end upper_half_plane