variables P Q R S T U : Prop

/--------------------------------------------------------------------------
``exact``

  If ``P`` is the current target and
  ``hp`` is a proof of ``P``, then
  ``exact hp,`` closes the goal.

English translation:
This is exactly what we wanted to prove.
--------------------------------------------------------------------------/

theorem tautology (hp : P) : P :=
begin
  exact hp,
end

/--------------------------------------------------------------------------
``intro``

  If the current target is an implication ``P → Q``, then
  ``intro hp,`` will produce a hypothesis
  ``hp : P`` and changes the target to  ``Q``.

English translation:
To prove ``P → Q``, let us assume ``P`` and try to prove ``Q``.
--------------------------------------------------------------------------/

theorem tautology' : P → P :=
begin
  intro hp,
  exact hp,
end

/--------------------------------------------------------------------------
``apply``

  If the current target is ``Q`` and
  ``h`` is a proof of ``P → Q``, then
  ``apply h,`` changes target to ``P``.

English translation:
(Backward reasoning.)
To prove ``Q``, since we know ``P → Q``, it suffices to prove ``P``.
--------------------------------------------------------------------------/

theorem syllogism (hp : P) (h : P → Q) : Q :=
begin
  apply h,
  exact hp,
end

/--------------------------------------------------------------------------

Delete the ``sorry,`` below and replace them with valid proofs.
Don't forget the ``,`` at the end of each line.

--------------------------------------------------------------------------/

theorem ex1 (P Q R : Prop) (f : P → Q) (g : Q → R) : P → R :=
begin
  sorry,
end

-- In Lean, implications are "right associative",
-- which means that ``P → Q → R`` is the same as ``P → (Q → R).``
theorem ex2 (P Q : Prop): P → (Q → P) :=
begin
  sorry,
end

theorem ex3 (P Q : Prop) : ((Q → P) → (Q → P)) :=
begin
  sorry,
end

theorem ex7
  (hpq : P → Q)
  (hqr : Q → R)
  (hqt : Q → T)
  (hst : S → T)
  (htu : T → U)
  : P → U :=
begin
  sorry,
end

-- Implication is not associative
-- what happens if you try to prove the following?
theorem ex2' (P Q : Prop): (P → Q) → P :=
begin
  sorry,
end


-- Ejercicios_sobre_aritmetica_real.lean
-- Ejercicios sobre aritmética real.
-- José A. Alonso Jiménez
-- Sevilla, 12 de agosto de 2020
-- ---------------------------------------------------------------------

-- En esta relación se comentan distintas pruebas con Lean de ejercicios
-- sobre la aritmética de los números reales. La primera es por
-- reescritura, la segunda es con encadenamiento de ecuaciones y las
-- restantes son automáticas.

-- ---------------------------------------------------------------------
-- Ejercicio 1. Ejecutar las siguientes acciones:
-- 1. Importar la teoría de los números reales.
-- 2. Declarar a, b, c y d como variables sobre los reales.
-- ----------------------------------------------------------------------

import data.real.basic     -- 1
variables (a b c d : ℝ)    -- 2

-- ---------------------------------------------------------------------
-- Ejercicio 2. Demostrar que
--    (c * b) * a = b * (a * c)
--
-- Indicación: Para alguna pueba pueden ser útiles los lemas
-- + mul_assoc : (a * b) * c = a * (b * c)
-- + mul_comm  : a * b = b * a
-- ----------------------------------------------------------------------

-- 1ª demostración
-- ===============

example : (c * b) * a = b * (a * c) :=
begin
  rw mul_comm c b,
  rw mul_assoc,
  rw mul_comm c a,
end

-- Prueba:
/-
  a b c : ℝ
  ⊢ (c * b) * a = b * (a * c)
rw mul_comm c b,
  ⊢ (b * c) * a = b * (a * c)
rw mul_assoc,
  ⊢ b * (c * a) = b * (a * c)
rw mul_comm c a,
  no goals
-/

-- 2ª demostración
-- ===============

example : (c * b) * a = b * (a * c) :=
begin
  calc (c * b) * a = (b * c) * a : by rw mul_comm c b
               ... = b * (c * a) : by rw mul_assoc
               ... = b * (a * c) : by rw mul_comm c a,
end

-- 3ª demostración
-- ===============

example : (c * b) * a = b * (a * c) :=
by linarith

-- 4ª demostración
-- ===============

example : (c * b) * a = b * (a * c) :=
by finish

-- 5ª demostración
-- ===============

example : (c * b) * a = b * (a * c) :=
by ring

-- ---------------------------------------------------------------------
-- Ejercicio 3. Demostrar que si
--    c = b * a - d
--    d = a * b
-- entonces c = 0.
--
-- Indicación: Para alguna pueba pueden ser útiles los lemas
-- + mul_comm : a * b = b * a
-- + sub_self : a - a = 0
-- ----------------------------------------------------------------------

example
  (h1 : c = b * a - d)
  (h2 : d = a * b)
  : c = 0 :=
begin
  rw h2 at h1,
  rw mul_comm b a at h1,
  rw sub_self (a * b) at h1,
  exact h1,
end

-- Prueba:
/-
  a b c d : ℝ,
  h1 : c = b * a - d,
  h2 : d = a * b
  ⊢ c = 0
rw h2 at h1,
  h1 : c = b * a - a * b
  ⊢ c = 0
rw mul_comm b a at h1,
  h1 : c = a * b - a * b
  ⊢ c = 0
rw sub_self (a * b) at h1,
  h1 : c = 0
  ⊢ c = 0
exact h1,
  no goals
-/

-- 2ª demostración
-- ===============

example
  (h1 : c = b * a - d)
  (h2 : d = a * b)
  : c = 0 :=
begin
  calc c = b * a - d     : by rw h1
     ... = b * a - a * b : by rw h2
     ... = a * b - a * b : by rw mul_comm a b
     ... = 0             : by rw sub_self (a*b),
end

-- 3ª demostración
-- ===============

example
  (h1 : c = b * a - d)
  (h2 : d = a * b)
  : c = 0 :=
begin
  calc c = b * a - d     : by rw h1
     ... = b * a - a * b : by rw h2
     ... = 0             : by ring,
end

-- ---------------------------------------------------------------------
-- Ejercicio 4. Demostrar que
--    (a + b) + a = 2 * a + b
--
-- Indicación: Para alguna pueba pueden ser útiles los lemas
-- + add_assoc : (a + b) + c = a + (b + c)
-- + add_comm  : a + b = b + a
-- + two_mul   : 2 * a = a + a
-- ----------------------------------------------------------------------

-- 1ª demostración
-- ===============

example : (a + b) + a = 2 * a + b :=
begin
  calc (a + b) + a = a + (b + a) : by rw add_assoc
               ... = a + (a + b) : by rw add_comm b a
               ... = (a + a) + b : by rw ← add_assoc
               ... = 2 * a + b   : by rw two_mul,
end

-- 2ª demostración
-- ===============

example : (a + b) + a = 2 * a + b :=
by ring

-- ---------------------------------------------------------------------
-- Ejercicio 5. Demostrar que
--    (a + b) * (a - b) = a^2 - b^2
--
-- Indicación: Para alguna pueba pueden ser útiles los lemas
-- + add_mul  : (a + b) * c = a * c + b * c
-- + add_sub  : a + (b - c) = (a + b) - c
-- + add_zero : a + 0 = a
-- + mul_comm : a * b = b * a
-- + mul_sub  : a * (b - c) = a * b - a * c
-- + pow_two  : a^2 = a * a
-- + sub_self : a - a = 0
-- + sub_sub  : (a - b) - c = a - (b + c)
-- ----------------------------------------------------------------------

-- 1ª demostración
-- ===============

example : (a + b) * (a - b) = a^2 - b^2 :=
begin
  rw pow_two a,
  rw pow_two b,
  rw mul_sub (a + b) a b,
  rw add_mul a b a,
  rw add_mul a b b,
  rw mul_comm b a,
  rw ← sub_sub,
  rw ← add_sub,
  rw sub_self,
  rw add_zero,
end

-- Prueba:
/-
  a b : ℝ
  ⊢ (a + b) * (a - b) = a ^ 2 - b ^ 2
rw pow_two a,
  ⊢ (a + b) * (a - b) = a * a - b ^ 2
rw pow_two b,
  ⊢ (a + b) * (a - b) = a * a - b * b
rw mul_sub (a + b) a b,
  ⊢ (a + b) * a - (a + b) * b = a * a - b * b
rw add_mul a b a,
  ⊢ a * a + b * a - (a + b) * b = a * a - b * b
rw add_mul a b b,
  ⊢ a * a + b * a - (a * b + b * b) = a * a - b * b
rw mul_comm b a,
  ⊢ a * a + a * b - (a * b + b * b) = a * a - b * b
rw ← sub_sub,
  ⊢ a * a + a * b - a * b - b * b = a * a - b * b
rw ← add_sub,
  ⊢ a * a + (a * b - a * b) - b * b = a * a - b * b
rw sub_self,
  ⊢ a * a + 0 - b * b = a * a - b * b
rw add_zero,
  no goals
-/

-- 2ª demostración
-- ===============

example : (a + b) * (a - b) = a^2 - b^2 :=
begin
  calc (a + b) * (a - b)
           = (a + b) * a - (a + b) * b       : by rw mul_sub (a + b) a b
       ... = a * a + b * a - (a + b) * b     : by rw add_mul a b a
       ... = a * a + b * a - (a * b + b * b) : by rw add_mul a b b
       ... = a * a + a * b - (a * b + b * b) : by rw mul_comm b a
       ... = a * a + a * b - a * b - b * b   : by rw sub_sub
       ... = a * a + (a * b - a * b) - b * b : by rw add_sub
       ... = a * a + 0 - b * b               : by rw sub_self
       ... = a * a - b * b                   : by rw add_zero
       ... = a^2 - b * b                     : by rw pow_two a
       ... = a^2 - b^2                       : by rw pow_two b,
end

-- 3ª demostración
-- ===============

example : (a + b) * (a - b) = a^2 - b^2 :=
by ring


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura

Small example showing that (nat → nat) is not encodable.
-/
import data.encodable
open nat encodable option

section
hypothesis nat_nat_encodable : encodable (nat → nat)

private definition decode_fun (n : nat) : option (nat → nat) :=
@decode (nat → nat) nat_nat_encodable n

private definition encode_fun (f : nat → nat) : nat :=
@encode (nat → nat) nat_nat_encodable f

private lemma encodek_fun : ∀ f : nat → nat, decode_fun (encode_fun f) = some f :=
λ f, !encodek

private definition f (n : nat) : nat :=
match decode_fun n with
| some g := succ (g n)
| none   := 0
end

private definition v : nat := encode_fun f

private lemma f_eq : succ (f v) = f v :=
begin
  change succ (f v) =
         match decode_fun (encode_fun f) with
         | some g := succ (g v)
         | none   := 0
         end,
  rewrite encodek_fun
end
end

theorem not_encodable_nat_arrow_nat : (encodable (nat → nat)) → false :=
assume h, absurd (f_eq h) succ_ne_self


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

! This file was ported from Lean 3 source module field_theory.finite.polynomial
! leanprover-community/mathlib commit 5fd3186f1ec30a75d5f65732e3ce5e623382556f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.FiniteDimensional
import Mathbin.LinearAlgebra.Basic
import Mathbin.RingTheory.MvPolynomial.Basic
import Mathbin.Data.MvPolynomial.Expand
import Mathbin.FieldTheory.Finite.Basic

/-!
## Polynomials over finite fields
-/

namespace MvPolynomial

variable {σ : Type _}

/-- A polynomial over the integers is divisible by `n : ℕ`
if and only if it is zero over `zmod n`. -/
theorem c_dvd_iff_zMod (n : ℕ) (φ : MvPolynomial σ ℤ) :
    C (n : ℤ) ∣ φ ↔ map (Int.castRingHom (ZMod n)) φ = 0 :=
  C_dvd_iff_map_hom_eq_zero _ _ (CharP.int_cast_eq_zero_iff (ZMod n) n) _
#align mv_polynomial.C_dvd_iff_zmod MvPolynomial.c_dvd_iff_zMod

section frobenius

variable {p : ℕ} [Fact p.Prime]

theorem frobenius_zMod (f : MvPolynomial σ (ZMod p)) : frobenius _ p f = expand p f :=
  by
  apply induction_on f
  · intro a
    rw [expand_C, frobenius_def, ← C_pow, ZMod.pow_card]
  · simp only [AlgHom.map_add, RingHom.map_add]
    intro _ _ hf hg
    rw [hf, hg]
  · simp only [expand_X, RingHom.map_mul, AlgHom.map_mul]
    intro _ _ hf
    rw [hf, frobenius_def]
#align mv_polynomial.frobenius_zmod MvPolynomial.frobenius_zMod

theorem expand_zMod (f : MvPolynomial σ (ZMod p)) : expand p f = f ^ p :=
  (frobenius_zMod _).symm
#align mv_polynomial.expand_zmod MvPolynomial.expand_zMod

end frobenius

end MvPolynomial

namespace MvPolynomial

noncomputable section

open BigOperators Classical

open Set LinearMap Submodule

variable {K : Type _} {σ : Type _}

section Indicator

variable [Fintype K] [Fintype σ]

/-- Over a field, this is the indicator function as an `mv_polynomial`. -/
def indicator [CommRing K] (a : σ → K) : MvPolynomial σ K :=
  ∏ n, 1 - (X n - C (a n)) ^ (Fintype.card K - 1)
#align mv_polynomial.indicator MvPolynomial.indicator

section CommRing

variable [CommRing K]

theorem eval_indicator_apply_eq_one (a : σ → K) : eval a (indicator a) = 1 :=
  by
  nontriviality
  have : 0 < Fintype.card K - 1 := tsub_pos_of_lt Fintype.one_lt_card
  simp only [indicator, map_prod, map_sub, map_one, map_pow, eval_X, eval_C, sub_self,
    zero_pow this, sub_zero, Finset.prod_const_one]
#align mv_polynomial.eval_indicator_apply_eq_one MvPolynomial.eval_indicator_apply_eq_one

theorem degrees_indicator (c : σ → K) :
    degrees (indicator c) ≤ ∑ s : σ, (Fintype.card K - 1) • {s} :=
  by
  rw [indicator]
  refine' le_trans (degrees_prod _ _) (Finset.sum_le_sum fun s hs => _)
  refine' le_trans (degrees_sub _ _) _
  rw [degrees_one, ← bot_eq_zero, bot_sup_eq]
  refine' le_trans (degrees_pow _ _) (nsmul_le_nsmul_of_le_right _ _)
  refine' le_trans (degrees_sub _ _) _
  rw [degrees_C, ← bot_eq_zero, sup_bot_eq]
  exact degrees_X' _
#align mv_polynomial.degrees_indicator MvPolynomial.degrees_indicator

theorem indicator_mem_restrictDegree (c : σ → K) :
    indicator c ∈ restrictDegree σ K (Fintype.card K - 1) :=
  by
  rw [mem_restrict_degree_iff_sup, indicator]
  intro n
  refine' le_trans (Multiset.count_le_of_le _ <| degrees_indicator _) (le_of_eq _)
  simp_rw [← Multiset.coe_countAddMonoidHom, (Multiset.countAddMonoidHom n).map_sum,
    AddMonoidHom.map_nsmul, Multiset.coe_countAddMonoidHom, nsmul_eq_mul, Nat.cast_id]
  trans
  refine' Finset.sum_eq_single n _ _
  · intro b hb ne
    rw [Multiset.count_singleton, if_neg Ne.symm, MulZeroClass.mul_zero]
  · intro h
    exact (h <| Finset.mem_univ _).elim
  · rw [Multiset.count_singleton_self, mul_one]
#align mv_polynomial.indicator_mem_restrict_degree MvPolynomial.indicator_mem_restrictDegree

end CommRing

variable [Field K]

theorem eval_indicator_apply_eq_zero (a b : σ → K) (h : a ≠ b) : eval a (indicator b) = 0 :=
  by
  obtain ⟨i, hi⟩ : ∃ i, a i ≠ b i := by rwa [(· ≠ ·), Function.funext_iff, not_forall] at h
  simp only [indicator, map_prod, map_sub, map_one, map_pow, eval_X, eval_C, sub_self,
    Finset.prod_eq_zero_iff]
  refine' ⟨i, Finset.mem_univ _, _⟩
  rw [FiniteField.pow_card_sub_one_eq_one, sub_self]
  rwa [(· ≠ ·), sub_eq_zero]
#align mv_polynomial.eval_indicator_apply_eq_zero MvPolynomial.eval_indicator_apply_eq_zero

end Indicator

section

variable (K σ)

/-- `mv_polynomial.eval` as a `K`-linear map. -/
@[simps]
def evalₗ [CommSemiring K] : MvPolynomial σ K →ₗ[K] (σ → K) → K
    where
  toFun p e := eval e p
  map_add' p q := by
    ext x
    rw [RingHom.map_add]
    rfl
  map_smul' a p := by
    ext e
    rw [smul_eq_C_mul, RingHom.map_mul, eval_C]
    rfl
#align mv_polynomial.evalₗ MvPolynomial.evalₗ

end

variable [Field K] [Fintype K] [Finite σ]

theorem map_restrict_dom_evalₗ : (restrictDegree σ K (Fintype.card K - 1)).map (evalₗ K σ) = ⊤ :=
  by
  cases nonempty_fintype σ
  refine' top_unique (SetLike.le_def.2 fun e _ => mem_map.2 _)
  refine' ⟨∑ n : σ → K, e n • indicator n, _, _⟩
  · exact sum_mem fun c _ => smul_mem _ _ (indicator_mem_restrict_degree _)
  · ext n
    simp only [LinearMap.map_sum, @Finset.sum_apply (σ → K) (fun _ => K) _ _ _ _ _, Pi.smul_apply,
      LinearMap.map_smul]
    simp only [evalₗ_apply]
    trans
    refine' Finset.sum_eq_single n (fun b _ h => _) _
    · rw [eval_indicator_apply_eq_zero _ _ h.symm, smul_zero]
    · exact fun h => (h <| Finset.mem_univ n).elim
    · rw [eval_indicator_apply_eq_one, smul_eq_mul, mul_one]
#align mv_polynomial.map_restrict_dom_evalₗ MvPolynomial.map_restrict_dom_evalₗ

end MvPolynomial

namespace MvPolynomial

open Classical Cardinal

open LinearMap Submodule

universe u

variable (σ : Type u) (K : Type u) [Fintype K]

/- ./././Mathport/Syntax/Translate/Command.lean:42:9: unsupported derive handler module[module] K -/
/-- The submodule of multivariate polynomials whose degree of each variable is strictly less
than the cardinality of K. -/
def R [CommRing K] : Type u :=
  restrictDegree σ K (Fintype.card K - 1)deriving AddCommGroup,
  «./././Mathport/Syntax/Translate/Command.lean:42:9: unsupported derive handler module[module] K»,
  Inhabited
#align mv_polynomial.R MvPolynomial.R

/-- Evaluation in the `mv_polynomial.R` subtype. -/
def evalᵢ [CommRing K] : R σ K →ₗ[K] (σ → K) → K :=
  (evalₗ K σ).comp (restrictDegree σ K (Fintype.card K - 1)).Subtype
#align mv_polynomial.evalᵢ MvPolynomial.evalᵢ

section CommRing

variable [CommRing K]

noncomputable instance decidableRestrictDegree (m : ℕ) :
    DecidablePred (· ∈ { n : σ →₀ ℕ | ∀ i, n i ≤ m }) := by
  simp only [Set.mem_setOf_eq] <;> infer_instance
#align mv_polynomial.decidable_restrict_degree MvPolynomial.decidableRestrictDegree

end CommRing

variable [Field K]

theorem dim_r [Fintype σ] : Module.rank K (R σ K) = Fintype.card (σ → K) :=
  calc
    Module.rank K (R σ K) =
        Module.rank K (↥{ s : σ →₀ ℕ | ∀ n : σ, s n ≤ Fintype.card K - 1 } →₀ K) :=
      LinearEquiv.dim_eq
        (Finsupp.supportedEquivFinsupp { s : σ →₀ ℕ | ∀ n : σ, s n ≤ Fintype.card K - 1 })
    _ = (#{ s : σ →₀ ℕ | ∀ n : σ, s n ≤ Fintype.card K - 1 }) := by
      rw [Finsupp.dim_eq, dim_self, mul_one]
    _ = (#{ s : σ → ℕ | ∀ n : σ, s n < Fintype.card K }) :=
      by
      refine' Quotient.sound ⟨Equiv.subtypeEquiv Finsupp.equivFunOnFinite fun f => _⟩
      refine' forall_congr' fun n => le_tsub_iff_right _
      exact Fintype.card_pos_iff.2 ⟨0⟩
    _ = (#σ → { n // n < Fintype.card K }) :=
      (@Equiv.subtypePiEquivPi σ (fun _ => ℕ) fun s n => n < Fintype.card K).cardinal_eq
    _ = (#σ → Fin (Fintype.card K)) :=
      (Equiv.arrowCongr (Equiv.refl σ) Fin.equivSubtype.symm).cardinal_eq
    _ = (#σ → K) := (Equiv.arrowCongr (Equiv.refl σ) (Fintype.equivFin K).symm).cardinal_eq
    _ = Fintype.card (σ → K) := Cardinal.mk_fintype _

#align mv_polynomial.dim_R MvPolynomial.dim_r

instance [Finite σ] : FiniteDimensional K (R σ K) :=
  by
  cases nonempty_fintype σ
  exact
    IsNoetherian.iff_fg.1
      (is_noetherian.iff_dim_lt_aleph_0.mpr <| by
        simpa only [dim_R] using Cardinal.nat_lt_aleph0 (Fintype.card (σ → K)))

theorem finrank_r [Fintype σ] : FiniteDimensional.finrank K (R σ K) = Fintype.card (σ → K) :=
  FiniteDimensional.finrank_eq_of_dim_eq (dim_r σ K)
#align mv_polynomial.finrank_R MvPolynomial.finrank_r

theorem range_evalᵢ [Finite σ] : (evalᵢ σ K).range = ⊤ :=
  by
  rw [evalᵢ, LinearMap.range_comp, range_subtype]
  exact map_restrict_dom_evalₗ
#align mv_polynomial.range_evalᵢ MvPolynomial.range_evalᵢ

theorem ker_evalₗ [Finite σ] : (evalᵢ σ K).ker = ⊥ :=
  by
  cases nonempty_fintype σ
  refine' (ker_eq_bot_iff_range_eq_top_of_finrank_eq_finrank _).mpr (range_evalᵢ _ _)
  rw [FiniteDimensional.finrank_fintype_fun_eq_card, finrank_R]
#align mv_polynomial.ker_evalₗ MvPolynomial.ker_evalₗ

theorem eq_zero_of_eval_eq_zero [Finite σ] (p : MvPolynomial σ K) (h : ∀ v : σ → K, eval v p = 0)
    (hp : p ∈ restrictDegree σ K (Fintype.card K - 1)) : p = 0 :=
  let p' : R σ K := ⟨p, hp⟩
  have : p' ∈ (evalᵢ σ K).ker := funext h
  show p'.1 = (0 : R σ K).1 from congr_arg _ <| by rwa [ker_evalₗ, mem_bot] at this
#align mv_polynomial.eq_zero_of_eval_eq_zero MvPolynomial.eq_zero_of_eval_eq_zero

end MvPolynomial


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

import ring_theory.adjoin.basic
import ring_theory.power_basis

/-!
# Power basis for `algebra.adjoin R {x}`

This file defines the canonical power basis on `algebra.adjoin R {x}`,
where `x` is an integral element over `R`.
-/

variables {K S : Type*} [field K] [comm_ring S] [algebra K S]

namespace algebra

open polynomial
open power_basis

lemma power_basis_is_basis {x : S} (hx : _root_.is_integral K x) :
  is_basis K (λ (i : fin (minpoly K x).nat_degree),
    (⟨x, subset_adjoin (set.mem_singleton x)⟩ ^ (i : ℕ) : adjoin K ({x} : set S))) :=
begin
  have hST : function.injective (algebra_map (adjoin K ({x} : set S)) S) := subtype.coe_injective,
  have hx' : _root_.is_integral K
    (show adjoin K ({x} : set S), from ⟨x, subset_adjoin (set.mem_singleton x)⟩),
  { apply (is_integral_algebra_map_iff hST).mp,
    convert hx,
    apply_instance },
  have minpoly_eq := minpoly.eq_of_algebra_map_eq hST hx' rfl,
  refine ⟨_, _root_.eq_top_iff.mpr _⟩,
  { have := hx'.linear_independent_pow,
    rwa minpoly_eq at this },
  { rintros ⟨y, hy⟩ _,
    have := hx'.mem_span_pow,
    rw minpoly_eq at this,
    apply this,
    { rw [adjoin_singleton_eq_range] at hy,
      obtain ⟨f, rfl⟩ := (aeval x).mem_range.mp hy,
      use f,
      ext,
      exact (is_scalar_tower.algebra_map_aeval K (adjoin K {x}) S ⟨x, _⟩ _).symm } }
end

/-- The power basis `1, x, ..., x ^ (d - 1)` for `K[x]`,
where `d` is the degree of the minimal polynomial of `x`. -/
noncomputable def adjoin.power_basis {x : S} (hx : _root_.is_integral K x) :
  power_basis K (adjoin K ({x} : set S)) :=
{ gen := ⟨x, subset_adjoin (set.mem_singleton x)⟩,
  dim := (minpoly K x).nat_degree,
  is_basis := power_basis_is_basis hx }

end algebra


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_110
  (q e : ℂ)
  (h₀ : q = 2 - 2 * complex.I)
  (h₁ : e = 5 + 5 * complex.I) :
  q * e = 20 :=
begin
  rw [h₀, h₁],
  ring_nf,
  rw [pow_two, complex.I_mul_I],
  ring,
end


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.combinatorics.composition
import Mathlib.data.nat.parity
import Mathlib.tactic.apply_fun
import Mathlib.PostPort

universes l

namespace Mathlib

/-!
# Partitions

A partition of a natural number `n` is a way of writing `n` as a sum of positive integers, where the
order does not matter: two sums that differ only in the order of their summands are considered the
same partition. This notion is closely related to that of a composition of `n`, but in a composition
of `n` the order does matter.
A summand of the partition is called a part.

## Main functions

* `p : partition n` is a structure, made of a multiset of integers which are all positive and
  add up to `n`.

## Implementation details

The main motivation for this structure and its API is to show Euler's partition theorem, and
related results.

The representation of a partition as a multiset is very handy as multisets are very flexible and
already have a well-developed API.

## Tags

Partition

## References

<https://en.wikipedia.org/wiki/Partition_(number_theory)>
-/

/-- A partition of `n` is a multiset of positive integers summing to `n`. -/
structure partition (n : ℕ)
where
  parts : multiset ℕ
  parts_pos : ∀ {i : ℕ}, i ∈ parts → 0 < i
  parts_sum : multiset.sum parts = n

namespace partition

/-- A composition induces a partition (just convert the list to a multiset). -/
def of_composition (n : ℕ) (c : composition n) : partition n :=
  mk ↑(composition.blocks c) sorry sorry

theorem of_composition_surj {n : ℕ} : function.surjective (of_composition n) := sorry

/--
Given a multiset which sums to `n`, construct a partition of `n` with the same multiset, but
without the zeros.
-/
-- The argument `n` is kept explicit here since it is useful in tactic mode proofs to generate the

-- proof obligation `l.sum = n`.

def of_sums (n : ℕ) (l : multiset ℕ) (hl : multiset.sum l = n) : partition n :=
  mk (multiset.filter (fun (_x : ℕ) => _x ≠ 0) l) sorry sorry

/-- A `multiset ℕ` induces a partition on its sum. -/
def of_multiset (l : multiset ℕ) : partition (multiset.sum l) :=
  of_sums (multiset.sum l) l sorry

/-- The partition of exactly one part. -/
def indiscrete_partition (n : ℕ) : partition n :=
  of_sums n (singleton n) sorry

protected instance inhabited {n : ℕ} : Inhabited (partition n) :=
  { default := indiscrete_partition n }

/--
The number of times a positive integer `i` appears in the partition `of_sums n l hl` is the same
as the number of times it appears in the multiset `l`.
(For `i = 0`, `partition.non_zero` combined with `multiset.count_eq_zero_of_not_mem` gives that
this is `0` instead.)
-/
theorem count_of_sums_of_ne_zero {n : ℕ} {l : multiset ℕ} (hl : multiset.sum l = n) {i : ℕ} (hi : i ≠ 0) : multiset.count i (parts (of_sums n l hl)) = multiset.count i l :=
  multiset.count_filter_of_pos hi

theorem count_of_sums_zero {n : ℕ} {l : multiset ℕ} (hl : multiset.sum l = n) : multiset.count 0 (parts (of_sums n l hl)) = 0 :=
  multiset.count_filter_of_neg fun (h : 0 ≠ 0) => h rfl

/--
Show there are finitely many partitions by considering the surjection from compositions to
partitions.
-/
protected instance fintype (n : ℕ) : fintype (partition n) :=
  fintype.of_surjective (of_composition n) of_composition_surj

/-- The finset of those partitions in which every part is odd. -/
def odds (n : ℕ) : finset (partition n) :=
  finset.filter (fun (c : partition n) => ∀ (i : ℕ), i ∈ parts c → ¬even i) finset.univ

/-- The finset of those partitions in which each part is used at most once. -/
def distincts (n : ℕ) : finset (partition n) :=
  finset.filter (fun (c : partition n) => multiset.nodup (parts c)) finset.univ

/-- The finset of those partitions in which every part is odd and used at most once. -/
def odd_distincts (n : ℕ) : finset (partition n) :=
  odds n ∩ distincts n


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Jens Wagemaker, Anne Baanen
-/

import algebra.associated
import data.list.big_operators
import data.list.perm

/-!
# Products of lists of prime elements.

This file contains some theorems relating `prime` and products of `list`s.

-/

open list

section comm_monoid_with_zero

variables {M : Type*} [comm_monoid_with_zero M]

/-- Prime `p` divides the product of a list `L` iff it divides some `a ∈ L` -/
lemma prime.dvd_prod_iff {p : M} {L : list M} (pp : prime p) : p ∣ L.prod ↔ ∃ a ∈ L, p ∣ a :=
begin
  split,
  { intros h,
    induction L with L_hd L_tl L_ih,
    { rw prod_nil at h, exact absurd h pp.not_dvd_one },
    { rw prod_cons at h,
      cases pp.dvd_or_dvd h with hd hd,
      { exact ⟨L_hd, mem_cons_self L_hd L_tl, hd⟩ },
      { obtain ⟨x, hx1, hx2⟩ := L_ih hd,
        exact ⟨x, mem_cons_of_mem L_hd hx1, hx2⟩ } } },
  { exact λ ⟨a, ha1, ha2⟩, dvd_trans ha2 (dvd_prod ha1) },
end

lemma prime.not_dvd_prod {p : M} {L : list M} (pp : prime p) (hL : ∀ a ∈ L, ¬ p ∣ a) :
  ¬ p ∣ L.prod :=
mt (prime.dvd_prod_iff pp).mp $ not_bex.mpr hL

end comm_monoid_with_zero

section cancel_comm_monoid_with_zero

variables {M : Type*} [cancel_comm_monoid_with_zero M] [unique (units M)]

lemma prime_dvd_prime_iff_eq {p q : M} (pp : prime p) (qp : prime q) : p ∣ q ↔ p = q :=
by rw [pp.dvd_prime_iff_associated qp, ←associated_eq_eq]

lemma mem_list_primes_of_dvd_prod {p : M} (hp : prime p) {L : list M} (hL : ∀ q ∈ L, prime q)
  (hpL : p ∣ L.prod) : p ∈ L :=
begin
  obtain ⟨x, hx1, hx2⟩ := hp.dvd_prod_iff.mp hpL,
  rwa (prime_dvd_prime_iff_eq hp (hL x hx1)).mp hx2
end

lemma perm_of_prod_eq_prod : ∀ {l₁ l₂ : list M}, l₁.prod = l₂.prod →
  (∀ p ∈ l₁, prime p) → (∀ p ∈ l₂, prime p) → perm l₁ l₂
| []        []        _  _  _  := perm.nil
| []        (a :: l)  h₁ h₂ h₃ :=
  have ha : a ∣ 1 := @prod_nil M _ ▸ h₁.symm ▸ (@prod_cons _ _ l a).symm ▸ dvd_mul_right _ _,
  absurd ha (prime.not_dvd_one (h₃ a (mem_cons_self _ _)))
| (a :: l)  []        h₁ h₂ h₃ :=
  have ha : a ∣ 1 := @prod_nil M _ ▸ h₁ ▸ (@prod_cons _ _ l a).symm ▸ dvd_mul_right _ _,
  absurd ha (prime.not_dvd_one (h₂ a (mem_cons_self _ _)))
| (a :: l₁) (b :: l₂) h hl₁ hl₂ :=
  begin
    classical,
    have hl₁' : ∀ p ∈ l₁, prime p := λ p hp, hl₁ p (mem_cons_of_mem _ hp),
    have hl₂' : ∀ p ∈ (b :: l₂).erase a, prime p := λ p hp, hl₂ p (mem_of_mem_erase hp),
    have ha : a ∈ (b :: l₂) := mem_list_primes_of_dvd_prod (hl₁ a (mem_cons_self _ _)) hl₂
      (h ▸ by rw prod_cons; exact dvd_mul_right _ _),
    have hb : b :: l₂ ~ a :: (b :: l₂).erase a := perm_cons_erase ha,
    have hl : prod l₁ = prod ((b :: l₂).erase a) :=
      ((mul_right_inj' (hl₁ a (mem_cons_self _ _)).ne_zero).1 $
        by rwa [← prod_cons, ← prod_cons, ← hb.prod_eq]),
    exact perm.trans ((perm_of_prod_eq_prod hl hl₁' hl₂').cons _) hb.symm
  end

end cancel_comm_monoid_with_zero


@[reducible]
def isLeapYear (y : Nat) : Prop :=  (y % 400 = 0) ∨ (y % 4 = 0 ∧ y % 100 ≠ 0)

def daysInMonth (year : Nat) (month : Nat) : Nat :=
  match month with
  | 2  => if isLeapYear year then 29 else 28
  | 4  => 30
  | 6  => 30
  | 9  => 30
  | 11 => 30
  | _  => 31

/-
Stuck at:
year : Nat
⊢ (match 4 with
  | 2 => if isLeapYear year then 29 else 28
  | 4 => 30
  | 6 => 30
  | 9 => 30
  | 11 => 30
  | x => 31) =
  30
-/
example (year : Nat) : daysInMonth year 4 = 30 := by
  simp [daysInMonth]

example (year : Nat) : daysInMonth year 12 = 31 := by
  delta daysInMonth
  simp

example (year : Nat) : daysInMonth year 2 = (if isLeapYear year then 29 else 28) := by
  simp [daysInMonth]

def f : Char → Nat → Nat
 | 'a', _ => 1
 | 'b', _ => 2
 | _, _   => 3

example : f 'a' n = 1 := by
  simp[f]

example : f 'b' n = 2 := by
  simp[f]

example : f 'c' n = 3 := by
  simp[f]

def g : String → Nat → Nat
 | "hello", _ => 1
 | "world", _ => 2
 | _, _       => 3

example : g "hello" n = 1 := by
  simp[g]

example : g "world" n = 2 := by
  simp[g]

example : g "abc" n = 3 := by
  simp[g]

def fn : Fin 8 → Nat → Nat
 | 2, _ => 1
 | 3, _ => 2
 | _, _ => 3

example : fn 2 n = 1 := by
  simp [fn]

example : fn 4 n = 3 := by
  simp [fn]

def f8 : UInt8 → Nat → Nat
 | 10, _ => 1
 | 20, _ => 2
 | _, _  => 3

example : f8 10 n = 1 := by
  simp [f8]

example : f8 30 n = 3 := by
  simp [f8]

def f16 : UInt16 → Nat → Nat
 | 10, _ => 1
 | 20, _ => 2
 | _, _  => 3

example : f16 10 n = 1 := by
  simp [f16]

example : f16 30 n = 3 := by
  simp [f16]

def f32 : UInt32 → Nat → Nat
 | 10, _ => 1
 | 20, _ => 2
 | _, _  => 3

example : f32 10 n = 1 := by
  simp [f32]

example : f32 30 n = 3 := by
  simp [f32]

def f64 : UInt64 → Nat → Nat
 | 10, _ => 1
 | 20, _ => 2
 | _, _  => 3

example : f64 10 n = 1 := by
  simp [f64]

example : f64 30 n = 3 := by
  simp [f64]


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

! This file was ported from Lean 3 source module measure_theory.group.fundamental_domain
! leanprover-community/mathlib commit eb810cf549db839dadf13353dbe69bac55acdbbc
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Group.Action
import Mathbin.MeasureTheory.Integral.SetIntegral

/-!
# Fundamental domain of a group action

A set `s` is said to be a *fundamental domain* of an action of a group `G` on a measurable space `α`
with respect to a measure `μ` if

* `s` is a measurable set;

* the sets `g • s` over all `g : G` cover almost all points of the whole space;

* the sets `g • s`, are pairwise a.e. disjoint, i.e., `μ (g₁ • s ∩ g₂ • s) = 0` whenever `g₁ ≠ g₂`;
  we require this for `g₂ = 1` in the definition, then deduce it for any two `g₁ ≠ g₂`.

In this file we prove that in case of a countable group `G` and a measure preserving action, any two
fundamental domains have the same measure, and for a `G`-invariant function, its integrals over any
two fundamental domains are equal to each other.

We also generate additive versions of all theorems in this file using the `to_additive` attribute.

## Main declarations

* `measure_theory.is_fundamental_domain`: Predicate for a set to be a fundamental domain of the
  action of a group
* `measure_theory.fundamental_frontier`: Fundamental frontier of a set under the action of a group.
  Elements of `s` that belong to some other translate of `s`.
* `measure_theory.fundamental_interior`: Fundamental interior of a set under the action of a group.
  Elements of `s` that do not belong to any other translate of `s`.
-/

open ENNReal Pointwise Topology NNReal ENNReal MeasureTheory

open MeasureTheory MeasureTheory.Measure Set Function TopologicalSpace Filter

namespace MeasureTheory

/-- A measurable set `s` is a *fundamental domain* for an additive action of an additive group `G`
on a measurable space `α` with respect to a measure `α` if the sets `g +ᵥ s`, `g : G`, are pairwise
a.e. disjoint and cover the whole space. -/
@[protect_proj]
structure IsAddFundamentalDomain (G : Type _) {α : Type _} [Zero G] [VAdd G α] [MeasurableSpace α]
  (s : Set α) (μ : Measure α := by exact MeasureTheory.MeasureSpace.volume) : Prop where
  NullMeasurableSet : NullMeasurableSet s μ
  ae_covers : ∀ᵐ x ∂μ, ∃ g : G, g +ᵥ x ∈ s
  AeDisjoint : Pairwise <| (AeDisjoint μ on fun g : G => g +ᵥ s)
#align measure_theory.is_add_fundamental_domain MeasureTheory.IsAddFundamentalDomain

/-- A measurable set `s` is a *fundamental domain* for an action of a group `G` on a measurable
space `α` with respect to a measure `α` if the sets `g • s`, `g : G`, are pairwise a.e. disjoint and
cover the whole space. -/
@[protect_proj, to_additive is_add_fundamental_domain]
structure IsFundamentalDomain (G : Type _) {α : Type _} [One G] [SMul G α] [MeasurableSpace α]
  (s : Set α) (μ : Measure α := by exact MeasureTheory.MeasureSpace.volume) : Prop where
  NullMeasurableSet : NullMeasurableSet s μ
  ae_covers : ∀ᵐ x ∂μ, ∃ g : G, g • x ∈ s
  AeDisjoint : Pairwise <| (AeDisjoint μ on fun g : G => g • s)
#align measure_theory.is_fundamental_domain MeasureTheory.IsFundamentalDomain
#align measure_theory.is_add_fundamental_domain MeasureTheory.IsAddFundamentalDomain

variable {G H α β E : Type _}

namespace IsFundamentalDomain

variable [Group G] [Group H] [MulAction G α] [MeasurableSpace α] [MulAction H β] [MeasurableSpace β]
  [NormedAddCommGroup E] {s t : Set α} {μ : Measure α}

/-- If for each `x : α`, exactly one of `g • x`, `g : G`, belongs to a measurable set `s`, then `s`
is a fundamental domain for the action of `G` on `α`. -/
@[to_additive
      "If for each `x : α`, exactly one of `g +ᵥ x`, `g : G`, belongs to a measurable set\n`s`, then `s` is a fundamental domain for the additive action of `G` on `α`."]
theorem mk' (h_meas : NullMeasurableSet s μ) (h_exists : ∀ x : α, ∃! g : G, g • x ∈ s) :
    IsFundamentalDomain G s μ :=
  { NullMeasurableSet := h_meas
    ae_covers := eventually_of_forall fun x => (h_exists x).exists
    AeDisjoint := fun a b hab =>
      Disjoint.aeDisjoint <|
        disjoint_left.2 fun x hxa hxb =>
          by
          rw [mem_smul_set_iff_inv_smul_mem] at hxa hxb
          exact hab (inv_injective <| (h_exists x).unique hxa hxb) }
#align measure_theory.is_fundamental_domain.mk' MeasureTheory.IsFundamentalDomain.mk'
#align measure_theory.is_add_fundamental_domain.mk' MeasureTheory.IsAddFundamentalDomain.mk'

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (g «expr ≠ » (1 : G)) -/
/-- For `s` to be a fundamental domain, it's enough to check `ae_disjoint (g • s) s` for `g ≠ 1`. -/
@[to_additive
      "For `s` to be a fundamental domain, it's enough to check `ae_disjoint (g +ᵥ s) s` for\n`g ≠ 0`."]
theorem mk'' (h_meas : NullMeasurableSet s μ) (h_ae_covers : ∀ᵐ x ∂μ, ∃ g : G, g • x ∈ s)
    (h_ae_disjoint : ∀ (g) (_ : g ≠ (1 : G)), AeDisjoint μ (g • s) s)
    (h_qmp : ∀ g : G, QuasiMeasurePreserving ((· • ·) g : α → α) μ μ) : IsFundamentalDomain G s μ :=
  { NullMeasurableSet := h_meas
    ae_covers := h_ae_covers
    AeDisjoint := pairwise_aeDisjoint_of_aeDisjoint_forall_ne_one h_ae_disjoint h_qmp }
#align measure_theory.is_fundamental_domain.mk'' MeasureTheory.IsFundamentalDomain.mk''
#align measure_theory.is_add_fundamental_domain.mk'' MeasureTheory.IsAddFundamentalDomain.mk''

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (g «expr ≠ » (1 : G)) -/
/-- If a measurable space has a finite measure `μ` and a countable group `G` acts
quasi-measure-preservingly, then to show that a set `s` is a fundamental domain, it is sufficient
to check that its translates `g • s` are (almost) disjoint and that the sum `∑' g, μ (g • s)` is
sufficiently large. -/
@[to_additive MeasureTheory.IsAddFundamentalDomain.mk_of_measure_univ_le
      "\nIf a measurable space has a finite measure `μ` and a countable additive group `G` acts\nquasi-measure-preservingly, then to show that a set `s` is a fundamental domain, it is sufficient\nto check that its translates `g +ᵥ s` are (almost) disjoint and that the sum `∑' g, μ (g +ᵥ s)` is\nsufficiently large."]
theorem mkOfMeasureUnivLe [IsFiniteMeasure μ] [Countable G] (h_meas : NullMeasurableSet s μ)
    (h_ae_disjoint : ∀ (g) (_ : g ≠ (1 : G)), AeDisjoint μ (g • s) s)
    (h_qmp : ∀ g : G, QuasiMeasurePreserving ((· • ·) g : α → α) μ μ)
    (h_measure_univ_le : μ (univ : Set α) ≤ ∑' g : G, μ (g • s)) : IsFundamentalDomain G s μ :=
  have ae_disjoint : Pairwise (AeDisjoint μ on fun g : G => g • s) :=
    pairwise_aeDisjoint_of_aeDisjoint_forall_ne_one h_ae_disjoint h_qmp
  { NullMeasurableSet := h_meas
    AeDisjoint
    ae_covers :=
      by
      replace h_meas : ∀ g : G, null_measurable_set (g • s) μ := fun g =>
        by
        rw [← inv_inv g, ← preimage_smul]
        exact h_meas.preimage (h_qmp g⁻¹)
      have h_meas' : null_measurable_set { a | ∃ g : G, g • a ∈ s } μ :=
        by
        rw [← Union_smul_eq_set_of_exists]
        exact null_measurable_set.Union h_meas
      rw [ae_iff_measure_eq h_meas', ← Union_smul_eq_set_of_exists]
      refine' le_antisymm (measure_mono <| subset_univ _) _
      rw [measure_Union₀ ae_disjoint h_meas]
      exact h_measure_univ_le }
#align measure_theory.is_fundamental_domain.mk_of_measure_univ_le MeasureTheory.IsFundamentalDomain.mkOfMeasureUnivLe
#align measure_theory.is_add_fundamental_domain.mk_of_measure_univ_le MeasureTheory.IsAddFundamentalDomain.mk_of_measure_univ_le

@[to_additive]
theorem unionᵢ_smul_ae_eq (h : IsFundamentalDomain G s μ) : (⋃ g : G, g • s) =ᵐ[μ] univ :=
  eventuallyEq_univ.2 <|
    h.ae_covers.mono fun x ⟨g, hg⟩ => mem_unionᵢ.2 ⟨g⁻¹, _, hg, inv_smul_smul _ _⟩
#align measure_theory.is_fundamental_domain.Union_smul_ae_eq MeasureTheory.IsFundamentalDomain.unionᵢ_smul_ae_eq
#align measure_theory.is_add_fundamental_domain.Union_vadd_ae_eq MeasureTheory.IsAddFundamentalDomain.Union_vadd_ae_eq

@[to_additive]
theorem mono (h : IsFundamentalDomain G s μ) {ν : Measure α} (hle : ν ≪ μ) :
    IsFundamentalDomain G s ν :=
  ⟨h.1.monoAc hle, hle h.2, h.AeDisjoint.mono fun a b hab => hle hab⟩
#align measure_theory.is_fundamental_domain.mono MeasureTheory.IsFundamentalDomain.mono
#align measure_theory.is_add_fundamental_domain.mono MeasureTheory.IsAddFundamentalDomain.mono

@[to_additive]
theorem preimageOfEquiv {ν : Measure β} (h : IsFundamentalDomain G s μ) {f : β → α}
    (hf : QuasiMeasurePreserving f ν μ) {e : G → H} (he : Bijective e)
    (hef : ∀ g, Semiconj f ((· • ·) (e g)) ((· • ·) g)) : IsFundamentalDomain H (f ⁻¹' s) ν :=
  { NullMeasurableSet := h.NullMeasurableSet.Preimage hf
    ae_covers := (hf.ae h.ae_covers).mono fun x ⟨g, hg⟩ => ⟨e g, by rwa [mem_preimage, hef g x]⟩
    AeDisjoint := fun a b hab => by
      lift e to G ≃ H using he
      have : (e.symm a⁻¹)⁻¹ ≠ (e.symm b⁻¹)⁻¹ := by simp [hab]
      convert(h.ae_disjoint this).Preimage hf using 1
      simp only [← preimage_smul_inv, preimage_preimage, ← hef _ _, e.apply_symm_apply, inv_inv] }
#align measure_theory.is_fundamental_domain.preimage_of_equiv MeasureTheory.IsFundamentalDomain.preimageOfEquiv
#align measure_theory.is_add_fundamental_domain.preimage_of_equiv MeasureTheory.IsAddFundamentalDomain.preimage_of_equiv

@[to_additive]
theorem imageOfEquiv {ν : Measure β} (h : IsFundamentalDomain G s μ) (f : α ≃ β)
    (hf : QuasiMeasurePreserving f.symm ν μ) (e : H ≃ G)
    (hef : ∀ g, Semiconj f ((· • ·) (e g)) ((· • ·) g)) : IsFundamentalDomain H (f '' s) ν :=
  by
  rw [f.image_eq_preimage]
  refine' h.preimage_of_equiv hf e.symm.bijective fun g x => _
  rcases f.surjective x with ⟨x, rfl⟩
  rw [← hef _ _, f.symm_apply_apply, f.symm_apply_apply, e.apply_symm_apply]
#align measure_theory.is_fundamental_domain.image_of_equiv MeasureTheory.IsFundamentalDomain.imageOfEquiv
#align measure_theory.is_add_fundamental_domain.image_of_equiv MeasureTheory.IsAddFundamentalDomain.image_of_equiv

@[to_additive]
theorem pairwise_aeDisjoint_of_ac {ν} (h : IsFundamentalDomain G s μ) (hν : ν ≪ μ) :
    Pairwise fun g₁ g₂ : G => AeDisjoint ν (g₁ • s) (g₂ • s) :=
  h.AeDisjoint.mono fun g₁ g₂ H => hν H
#align measure_theory.is_fundamental_domain.pairwise_ae_disjoint_of_ac MeasureTheory.IsFundamentalDomain.pairwise_aeDisjoint_of_ac
#align measure_theory.is_add_fundamental_domain.pairwise_ae_disjoint_of_ac MeasureTheory.IsAddFundamentalDomain.pairwise_ae_disjoint_of_ac

@[to_additive]
theorem smulOfComm {G' : Type _} [Group G'] [MulAction G' α] [MeasurableSpace G']
    [HasMeasurableSmul G' α] [SmulInvariantMeasure G' α μ] [SMulCommClass G' G α]
    (h : IsFundamentalDomain G s μ) (g : G') : IsFundamentalDomain G (g • s) μ :=
  h.imageOfEquiv (MulAction.toPerm g) (measurePreservingSmul _ _).QuasiMeasurePreserving
      (Equiv.refl _) <|
    smul_comm g
#align measure_theory.is_fundamental_domain.smul_of_comm MeasureTheory.IsFundamentalDomain.smulOfComm
#align measure_theory.is_add_fundamental_domain.vadd_of_comm MeasureTheory.IsAddFundamentalDomain.vadd_of_comm

variable [MeasurableSpace G] [HasMeasurableSmul G α] [SmulInvariantMeasure G α μ]

@[to_additive]
theorem nullMeasurableSetSmul (h : IsFundamentalDomain G s μ) (g : G) :
    NullMeasurableSet (g • s) μ :=
  h.NullMeasurableSet.smul g
#align measure_theory.is_fundamental_domain.null_measurable_set_smul MeasureTheory.IsFundamentalDomain.nullMeasurableSetSmul
#align measure_theory.is_add_fundamental_domain.null_measurable_set_vadd MeasureTheory.IsAddFundamentalDomain.null_measurable_set_vadd

@[to_additive]
theorem restrict_restrict (h : IsFundamentalDomain G s μ) (g : G) (t : Set α) :
    (μ.restrict t).restrict (g • s) = μ.restrict (g • s ∩ t) :=
  restrict_restrict₀ ((h.nullMeasurableSetSmul g).mono restrict_le_self)
#align measure_theory.is_fundamental_domain.restrict_restrict MeasureTheory.IsFundamentalDomain.restrict_restrict
#align measure_theory.is_add_fundamental_domain.restrict_restrict MeasureTheory.IsAddFundamentalDomain.restrict_restrict

@[to_additive]
theorem smul (h : IsFundamentalDomain G s μ) (g : G) : IsFundamentalDomain G (g • s) μ :=
  h.imageOfEquiv (MulAction.toPerm g) (measurePreservingSmul _ _).QuasiMeasurePreserving
    ⟨fun g' => g⁻¹ * g' * g, fun g' => g * g' * g⁻¹, fun g' => by simp [mul_assoc], fun g' => by
      simp [mul_assoc]⟩
    fun g' x => by simp [smul_smul, mul_assoc]
#align measure_theory.is_fundamental_domain.smul MeasureTheory.IsFundamentalDomain.smul
#align measure_theory.is_add_fundamental_domain.vadd MeasureTheory.IsAddFundamentalDomain.vadd

variable [Countable G] {ν : Measure α}

@[to_additive]
theorem sum_restrict_of_ac (h : IsFundamentalDomain G s μ) (hν : ν ≪ μ) :
    (Sum fun g : G => ν.restrict (g • s)) = ν := by
  rw [←
    restrict_Union_ae (h.ae_disjoint.mono fun i j h => hν h) fun g =>
      (h.null_measurable_set_smul g).monoAc hν,
    restrict_congr_set (hν h.Union_smul_ae_eq), restrict_univ]
#align measure_theory.is_fundamental_domain.sum_restrict_of_ac MeasureTheory.IsFundamentalDomain.sum_restrict_of_ac
#align measure_theory.is_add_fundamental_domain.sum_restrict_of_ac MeasureTheory.IsAddFundamentalDomain.sum_restrict_of_ac

@[to_additive]
theorem lintegral_eq_tsum_of_ac (h : IsFundamentalDomain G s μ) (hν : ν ≪ μ) (f : α → ℝ≥0∞) :
    (∫⁻ x, f x ∂ν) = ∑' g : G, ∫⁻ x in g • s, f x ∂ν := by
  rw [← lintegral_sum_measure, h.sum_restrict_of_ac hν]
#align measure_theory.is_fundamental_domain.lintegral_eq_tsum_of_ac MeasureTheory.IsFundamentalDomain.lintegral_eq_tsum_of_ac
#align measure_theory.is_add_fundamental_domain.lintegral_eq_tsum_of_ac MeasureTheory.IsAddFundamentalDomain.lintegral_eq_tsum_of_ac

@[to_additive]
theorem sum_restrict (h : IsFundamentalDomain G s μ) : (Sum fun g : G => μ.restrict (g • s)) = μ :=
  h.sum_restrict_of_ac (refl _)
#align measure_theory.is_fundamental_domain.sum_restrict MeasureTheory.IsFundamentalDomain.sum_restrict
#align measure_theory.is_add_fundamental_domain.sum_restrict MeasureTheory.IsAddFundamentalDomain.sum_restrict

@[to_additive]
theorem lintegral_eq_tsum (h : IsFundamentalDomain G s μ) (f : α → ℝ≥0∞) :
    (∫⁻ x, f x ∂μ) = ∑' g : G, ∫⁻ x in g • s, f x ∂μ :=
  h.lintegral_eq_tsum_of_ac (refl _) f
#align measure_theory.is_fundamental_domain.lintegral_eq_tsum MeasureTheory.IsFundamentalDomain.lintegral_eq_tsum
#align measure_theory.is_add_fundamental_domain.lintegral_eq_tsum MeasureTheory.IsAddFundamentalDomain.lintegral_eq_tsum

@[to_additive]
theorem lintegral_eq_tsum' (h : IsFundamentalDomain G s μ) (f : α → ℝ≥0∞) :
    (∫⁻ x, f x ∂μ) = ∑' g : G, ∫⁻ x in s, f (g⁻¹ • x) ∂μ :=
  calc
    (∫⁻ x, f x ∂μ) = ∑' g : G, ∫⁻ x in g • s, f x ∂μ := h.lintegral_eq_tsum f
    _ = ∑' g : G, ∫⁻ x in g⁻¹ • s, f x ∂μ := ((Equiv.inv G).tsum_eq _).symm
    _ = ∑' g : G, ∫⁻ x in s, f (g⁻¹ • x) ∂μ :=
      tsum_congr fun g =>
        ((measurePreservingSmul g⁻¹ μ).set_lintegral_comp_emb (measurableEmbedding_const_smul _) _
            _).symm

#align measure_theory.is_fundamental_domain.lintegral_eq_tsum' MeasureTheory.IsFundamentalDomain.lintegral_eq_tsum'
#align measure_theory.is_add_fundamental_domain.lintegral_eq_tsum' MeasureTheory.IsAddFundamentalDomain.lintegral_eq_tsum'

@[to_additive]
theorem set_lintegral_eq_tsum (h : IsFundamentalDomain G s μ) (f : α → ℝ≥0∞) (t : Set α) :
    (∫⁻ x in t, f x ∂μ) = ∑' g : G, ∫⁻ x in t ∩ g • s, f x ∂μ :=
  calc
    (∫⁻ x in t, f x ∂μ) = ∑' g : G, ∫⁻ x in g • s, f x ∂μ.restrict t :=
      h.lintegral_eq_tsum_of_ac restrict_le_self.AbsolutelyContinuous _
    _ = ∑' g : G, ∫⁻ x in t ∩ g • s, f x ∂μ := by simp only [h.restrict_restrict, inter_comm]

#align measure_theory.is_fundamental_domain.set_lintegral_eq_tsum MeasureTheory.IsFundamentalDomain.set_lintegral_eq_tsum
#align measure_theory.is_add_fundamental_domain.set_lintegral_eq_tsum MeasureTheory.IsAddFundamentalDomain.set_lintegral_eq_tsum

@[to_additive]
theorem set_lintegral_eq_tsum' (h : IsFundamentalDomain G s μ) (f : α → ℝ≥0∞) (t : Set α) :
    (∫⁻ x in t, f x ∂μ) = ∑' g : G, ∫⁻ x in g • t ∩ s, f (g⁻¹ • x) ∂μ :=
  calc
    (∫⁻ x in t, f x ∂μ) = ∑' g : G, ∫⁻ x in t ∩ g • s, f x ∂μ := h.set_lintegral_eq_tsum f t
    _ = ∑' g : G, ∫⁻ x in t ∩ g⁻¹ • s, f x ∂μ := ((Equiv.inv G).tsum_eq _).symm
    _ = ∑' g : G, ∫⁻ x in g⁻¹ • (g • t ∩ s), f x ∂μ := by simp only [smul_set_inter, inv_smul_smul]
    _ = ∑' g : G, ∫⁻ x in g • t ∩ s, f (g⁻¹ • x) ∂μ :=
      tsum_congr fun g =>
        ((measurePreservingSmul g⁻¹ μ).set_lintegral_comp_emb (measurableEmbedding_const_smul _) _
            _).symm

#align measure_theory.is_fundamental_domain.set_lintegral_eq_tsum' MeasureTheory.IsFundamentalDomain.set_lintegral_eq_tsum'
#align measure_theory.is_add_fundamental_domain.set_lintegral_eq_tsum' MeasureTheory.IsAddFundamentalDomain.set_lintegral_eq_tsum'

@[to_additive]
theorem measure_eq_tsum_of_ac (h : IsFundamentalDomain G s μ) (hν : ν ≪ μ) (t : Set α) :
    ν t = ∑' g : G, ν (t ∩ g • s) :=
  by
  have H : ν.restrict t ≪ μ := Measure.restrict_le_self.AbsolutelyContinuous.trans hν
  simpa only [set_lintegral_one, Pi.one_def,
    measure.restrict_apply₀ ((h.null_measurable_set_smul _).monoAc H), inter_comm] using
    h.lintegral_eq_tsum_of_ac H 1
#align measure_theory.is_fundamental_domain.measure_eq_tsum_of_ac MeasureTheory.IsFundamentalDomain.measure_eq_tsum_of_ac
#align measure_theory.is_add_fundamental_domain.measure_eq_tsum_of_ac MeasureTheory.IsAddFundamentalDomain.measure_eq_tsum_of_ac

@[to_additive]
theorem measure_eq_tsum' (h : IsFundamentalDomain G s μ) (t : Set α) :
    μ t = ∑' g : G, μ (t ∩ g • s) :=
  h.measure_eq_tsum_of_ac AbsolutelyContinuous.rfl t
#align measure_theory.is_fundamental_domain.measure_eq_tsum' MeasureTheory.IsFundamentalDomain.measure_eq_tsum'
#align measure_theory.is_add_fundamental_domain.measure_eq_tsum' MeasureTheory.IsAddFundamentalDomain.measure_eq_tsum'

@[to_additive]
theorem measure_eq_tsum (h : IsFundamentalDomain G s μ) (t : Set α) :
    μ t = ∑' g : G, μ (g • t ∩ s) := by
  simpa only [set_lintegral_one] using h.set_lintegral_eq_tsum' (fun _ => 1) t
#align measure_theory.is_fundamental_domain.measure_eq_tsum MeasureTheory.IsFundamentalDomain.measure_eq_tsum
#align measure_theory.is_add_fundamental_domain.measure_eq_tsum MeasureTheory.IsAddFundamentalDomain.measure_eq_tsum

@[to_additive]
theorem measure_zero_of_invariant (h : IsFundamentalDomain G s μ) (t : Set α)
    (ht : ∀ g : G, g • t = t) (hts : μ (t ∩ s) = 0) : μ t = 0 := by
  simp [measure_eq_tsum h, ht, hts]
#align measure_theory.is_fundamental_domain.measure_zero_of_invariant MeasureTheory.IsFundamentalDomain.measure_zero_of_invariant
#align measure_theory.is_add_fundamental_domain.measure_zero_of_invariant MeasureTheory.IsAddFundamentalDomain.measure_zero_of_invariant

/-- Given a measure space with an action of a finite group `G`, the measure of any `G`-invariant set
is determined by the measure of its intersection with a fundamental domain for the action of `G`. -/
@[to_additive measure_eq_card_smul_of_vadd_ae_eq_self
      "Given a measure space with an action of a\nfinite additive group `G`, the measure of any `G`-invariant set is determined by the measure of its\nintersection with a fundamental domain for the action of `G`."]
theorem measure_eq_card_smul_of_smul_ae_eq_self [Finite G] (h : IsFundamentalDomain G s μ)
    (t : Set α) (ht : ∀ g : G, (g • t : Set α) =ᵐ[μ] t) : μ t = Nat.card G • μ (t ∩ s) :=
  by
  haveI : Fintype G := Fintype.ofFinite G
  rw [h.measure_eq_tsum]
  replace ht : ∀ g : G, (g • t ∩ s : Set α) =ᵐ[μ] (t ∩ s : Set α) := fun g =>
    ae_eq_set_inter (ht g) (ae_eq_refl s)
  simp_rw [measure_congr (ht _), tsum_fintype, Finset.sum_const, Nat.card_eq_fintype_card,
    Finset.card_univ]
#align measure_theory.is_fundamental_domain.measure_eq_card_smul_of_smul_ae_eq_self MeasureTheory.IsFundamentalDomain.measure_eq_card_smul_of_smul_ae_eq_self
#align measure_theory.is_add_fundamental_domain.measure_eq_card_smul_of_vadd_ae_eq_self MeasureTheory.IsAddFundamentalDomain.measure_eq_card_smul_of_vadd_ae_eq_self

@[to_additive]
protected theorem set_lintegral_eq (hs : IsFundamentalDomain G s μ) (ht : IsFundamentalDomain G t μ)
    (f : α → ℝ≥0∞) (hf : ∀ (g : G) (x), f (g • x) = f x) :
    (∫⁻ x in s, f x ∂μ) = ∫⁻ x in t, f x ∂μ :=
  calc
    (∫⁻ x in s, f x ∂μ) = ∑' g : G, ∫⁻ x in s ∩ g • t, f x ∂μ := ht.set_lintegral_eq_tsum _ _
    _ = ∑' g : G, ∫⁻ x in g • t ∩ s, f (g⁻¹ • x) ∂μ := by simp only [hf, inter_comm]
    _ = ∫⁻ x in t, f x ∂μ := (hs.set_lintegral_eq_tsum' _ _).symm

#align measure_theory.is_fundamental_domain.set_lintegral_eq MeasureTheory.IsFundamentalDomain.set_lintegral_eq
#align measure_theory.is_add_fundamental_domain.set_lintegral_eq MeasureTheory.IsAddFundamentalDomain.set_lintegral_eq

@[to_additive]
theorem measure_set_eq (hs : IsFundamentalDomain G s μ) (ht : IsFundamentalDomain G t μ) {A : Set α}
    (hA₀ : MeasurableSet A) (hA : ∀ g : G, (fun x => g • x) ⁻¹' A = A) : μ (A ∩ s) = μ (A ∩ t) :=
  by
  have : (∫⁻ x in s, A.indicator 1 x ∂μ) = ∫⁻ x in t, A.indicator 1 x ∂μ :=
    by
    refine' hs.set_lintegral_eq ht (Set.indicator A fun _ => 1) _
    intro g x
    convert(Set.indicator_comp_right fun x : α => g • x).symm
    rw [hA g]
  simpa [measure.restrict_apply hA₀, lintegral_indicator _ hA₀] using this
#align measure_theory.is_fundamental_domain.measure_set_eq MeasureTheory.IsFundamentalDomain.measure_set_eq
#align measure_theory.is_add_fundamental_domain.measure_set_eq MeasureTheory.IsAddFundamentalDomain.measure_set_eq

/-- If `s` and `t` are two fundamental domains of the same action, then their measures are equal. -/
@[to_additive
      "If `s` and `t` are two fundamental domains of the same action, then their measures\nare equal."]
protected theorem measure_eq (hs : IsFundamentalDomain G s μ) (ht : IsFundamentalDomain G t μ) :
    μ s = μ t := by
  simpa only [set_lintegral_one] using hs.set_lintegral_eq ht (fun _ => 1) fun _ _ => rfl
#align measure_theory.is_fundamental_domain.measure_eq MeasureTheory.IsFundamentalDomain.measure_eq
#align measure_theory.is_add_fundamental_domain.measure_eq MeasureTheory.IsAddFundamentalDomain.measure_eq

@[to_additive]
protected theorem aeStronglyMeasurable_on_iff {β : Type _} [TopologicalSpace β]
    [PseudoMetrizableSpace β] (hs : IsFundamentalDomain G s μ) (ht : IsFundamentalDomain G t μ)
    {f : α → β} (hf : ∀ (g : G) (x), f (g • x) = f x) :
    AeStronglyMeasurable f (μ.restrict s) ↔ AeStronglyMeasurable f (μ.restrict t) :=
  calc
    AeStronglyMeasurable f (μ.restrict s) ↔
        AeStronglyMeasurable f (Measure.sum fun g : G => μ.restrict (g • t ∩ s)) :=
      by
      simp only [← ht.restrict_restrict,
        ht.sum_restrict_of_ac restrict_le_self.absolutely_continuous]
    _ ↔ ∀ g : G, AeStronglyMeasurable f (μ.restrict (g • (g⁻¹ • s ∩ t))) := by
      simp only [smul_set_inter, inter_comm, smul_inv_smul, aeStronglyMeasurable_sum_measure_iff]
    _ ↔ ∀ g : G, AeStronglyMeasurable f (μ.restrict (g⁻¹ • (g⁻¹⁻¹ • s ∩ t))) :=
      inv_surjective.forall
    _ ↔ ∀ g : G, AeStronglyMeasurable f (μ.restrict (g⁻¹ • (g • s ∩ t))) := by simp only [inv_inv]
    _ ↔ ∀ g : G, AeStronglyMeasurable f (μ.restrict (g • s ∩ t)) :=
      by
      refine' forall_congr' fun g => _
      have he : MeasurableEmbedding ((· • ·) g⁻¹ : α → α) := measurableEmbedding_const_smul _
      rw [← image_smul, ←
        ((measure_preserving_smul g⁻¹ μ).restrictImageEmb he _).aeStronglyMeasurable_comp_iff he]
      simp only [(· ∘ ·), hf]
    _ ↔ AeStronglyMeasurable f (μ.restrict t) := by
      simp only [← aeStronglyMeasurable_sum_measure_iff, ← hs.restrict_restrict,
        hs.sum_restrict_of_ac restrict_le_self.absolutely_continuous]

#align measure_theory.is_fundamental_domain.ae_strongly_measurable_on_iff MeasureTheory.IsFundamentalDomain.aeStronglyMeasurable_on_iff
#align measure_theory.is_add_fundamental_domain.ae_strongly_measurable_on_iff MeasureTheory.IsAddFundamentalDomain.ae_strongly_measurable_on_iff

@[to_additive]
protected theorem hasFiniteIntegral_on_iff (hs : IsFundamentalDomain G s μ)
    (ht : IsFundamentalDomain G t μ) {f : α → E} (hf : ∀ (g : G) (x), f (g • x) = f x) :
    HasFiniteIntegral f (μ.restrict s) ↔ HasFiniteIntegral f (μ.restrict t) :=
  by
  dsimp only [has_finite_integral]
  rw [hs.set_lintegral_eq ht]
  intro g x; rw [hf]
#align measure_theory.is_fundamental_domain.has_finite_integral_on_iff MeasureTheory.IsFundamentalDomain.hasFiniteIntegral_on_iff
#align measure_theory.is_add_fundamental_domain.has_finite_integral_on_iff MeasureTheory.IsAddFundamentalDomain.has_finite_integral_on_iff

@[to_additive]
protected theorem integrableOn_iff (hs : IsFundamentalDomain G s μ) (ht : IsFundamentalDomain G t μ)
    {f : α → E} (hf : ∀ (g : G) (x), f (g • x) = f x) : IntegrableOn f s μ ↔ IntegrableOn f t μ :=
  and_congr (hs.aeStronglyMeasurable_on_iff ht hf) (hs.hasFiniteIntegral_on_iff ht hf)
#align measure_theory.is_fundamental_domain.integrable_on_iff MeasureTheory.IsFundamentalDomain.integrableOn_iff
#align measure_theory.is_add_fundamental_domain.integrable_on_iff MeasureTheory.IsAddFundamentalDomain.integrable_on_iff

variable [NormedSpace ℝ E] [CompleteSpace E]

@[to_additive]
theorem integral_eq_tsum_of_ac (h : IsFundamentalDomain G s μ) (hν : ν ≪ μ) (f : α → E)
    (hf : Integrable f ν) : (∫ x, f x ∂ν) = ∑' g : G, ∫ x in g • s, f x ∂ν :=
  by
  rw [← MeasureTheory.integral_sum_measure, h.sum_restrict_of_ac hν]
  rw [h.sum_restrict_of_ac hν]
  -- Weirdly, these rewrites seem not to be combinable
  exact hf
#align measure_theory.is_fundamental_domain.integral_eq_tsum_of_ac MeasureTheory.IsFundamentalDomain.integral_eq_tsum_of_ac
#align measure_theory.is_add_fundamental_domain.integral_eq_tsum_of_ac MeasureTheory.IsAddFundamentalDomain.integral_eq_tsum_of_ac

@[to_additive]
theorem integral_eq_tsum (h : IsFundamentalDomain G s μ) (f : α → E) (hf : Integrable f μ) :
    (∫ x, f x ∂μ) = ∑' g : G, ∫ x in g • s, f x ∂μ :=
  integral_eq_tsum_of_ac h (by rfl) f hf
#align measure_theory.is_fundamental_domain.integral_eq_tsum MeasureTheory.IsFundamentalDomain.integral_eq_tsum
#align measure_theory.is_add_fundamental_domain.integral_eq_tsum MeasureTheory.IsAddFundamentalDomain.integral_eq_tsum

@[to_additive]
theorem integral_eq_tsum' (h : IsFundamentalDomain G s μ) (f : α → E) (hf : Integrable f μ) :
    (∫ x, f x ∂μ) = ∑' g : G, ∫ x in s, f (g⁻¹ • x) ∂μ :=
  calc
    (∫ x, f x ∂μ) = ∑' g : G, ∫ x in g • s, f x ∂μ := h.integral_eq_tsum f hf
    _ = ∑' g : G, ∫ x in g⁻¹ • s, f x ∂μ := ((Equiv.inv G).tsum_eq _).symm
    _ = ∑' g : G, ∫ x in s, f (g⁻¹ • x) ∂μ :=
      tsum_congr fun g =>
        (measurePreservingSmul g⁻¹ μ).set_integral_image_emb (measurableEmbedding_const_smul _) _ _

#align measure_theory.is_fundamental_domain.integral_eq_tsum' MeasureTheory.IsFundamentalDomain.integral_eq_tsum'
#align measure_theory.is_add_fundamental_domain.integral_eq_tsum' MeasureTheory.IsAddFundamentalDomain.integral_eq_tsum'

@[to_additive]
theorem set_integral_eq_tsum (h : IsFundamentalDomain G s μ) {f : α → E} {t : Set α}
    (hf : IntegrableOn f t μ) : (∫ x in t, f x ∂μ) = ∑' g : G, ∫ x in t ∩ g • s, f x ∂μ :=
  calc
    (∫ x in t, f x ∂μ) = ∑' g : G, ∫ x in g • s, f x ∂μ.restrict t :=
      h.integral_eq_tsum_of_ac restrict_le_self.AbsolutelyContinuous f hf
    _ = ∑' g : G, ∫ x in t ∩ g • s, f x ∂μ := by
      simp only [h.restrict_restrict, measure_smul, inter_comm]

#align measure_theory.is_fundamental_domain.set_integral_eq_tsum MeasureTheory.IsFundamentalDomain.set_integral_eq_tsum
#align measure_theory.is_add_fundamental_domain.set_integral_eq_tsum MeasureTheory.IsAddFundamentalDomain.set_integral_eq_tsum

@[to_additive]
theorem set_integral_eq_tsum' (h : IsFundamentalDomain G s μ) {f : α → E} {t : Set α}
    (hf : IntegrableOn f t μ) : (∫ x in t, f x ∂μ) = ∑' g : G, ∫ x in g • t ∩ s, f (g⁻¹ • x) ∂μ :=
  calc
    (∫ x in t, f x ∂μ) = ∑' g : G, ∫ x in t ∩ g • s, f x ∂μ := h.set_integral_eq_tsum hf
    _ = ∑' g : G, ∫ x in t ∩ g⁻¹ • s, f x ∂μ := ((Equiv.inv G).tsum_eq _).symm
    _ = ∑' g : G, ∫ x in g⁻¹ • (g • t ∩ s), f x ∂μ := by simp only [smul_set_inter, inv_smul_smul]
    _ = ∑' g : G, ∫ x in g • t ∩ s, f (g⁻¹ • x) ∂μ :=
      tsum_congr fun g =>
        (measurePreservingSmul g⁻¹ μ).set_integral_image_emb (measurableEmbedding_const_smul _) _ _

#align measure_theory.is_fundamental_domain.set_integral_eq_tsum' MeasureTheory.IsFundamentalDomain.set_integral_eq_tsum'
#align measure_theory.is_add_fundamental_domain.set_integral_eq_tsum' MeasureTheory.IsAddFundamentalDomain.set_integral_eq_tsum'

@[to_additive]
protected theorem set_integral_eq (hs : IsFundamentalDomain G s μ) (ht : IsFundamentalDomain G t μ)
    {f : α → E} (hf : ∀ (g : G) (x), f (g • x) = f x) : (∫ x in s, f x ∂μ) = ∫ x in t, f x ∂μ :=
  by
  by_cases hfs : integrable_on f s μ
  · have hft : integrable_on f t μ := by rwa [ht.integrable_on_iff hs hf]
    calc
      (∫ x in s, f x ∂μ) = ∑' g : G, ∫ x in s ∩ g • t, f x ∂μ := ht.set_integral_eq_tsum hfs
      _ = ∑' g : G, ∫ x in g • t ∩ s, f (g⁻¹ • x) ∂μ := by simp only [hf, inter_comm]
      _ = ∫ x in t, f x ∂μ := (hs.set_integral_eq_tsum' hft).symm

  · rw [integral_undef hfs, integral_undef]
    rwa [hs.integrable_on_iff ht hf] at hfs
#align measure_theory.is_fundamental_domain.set_integral_eq MeasureTheory.IsFundamentalDomain.set_integral_eq
#align measure_theory.is_add_fundamental_domain.set_integral_eq MeasureTheory.IsAddFundamentalDomain.set_integral_eq

/-- If the action of a countable group `G` admits an invariant measure `μ` with a fundamental domain
`s`, then every null-measurable set `t` such that the sets `g • t ∩ s` are pairwise a.e.-disjoint
has measure at most `μ s`. -/
@[to_additive
      "If the additive action of a countable group `G` admits an invariant measure `μ` with\na fundamental domain `s`, then every null-measurable set `t` such that the sets `g +ᵥ t ∩ s` are\npairwise a.e.-disjoint has measure at most `μ s`."]
theorem measure_le_of_pairwise_disjoint (hs : IsFundamentalDomain G s μ)
    (ht : NullMeasurableSet t μ) (hd : Pairwise (AeDisjoint μ on fun g : G => g • t ∩ s)) :
    μ t ≤ μ s :=
  calc
    μ t = ∑' g : G, μ (g • t ∩ s) := hs.measure_eq_tsum t
    _ = μ (⋃ g : G, g • t ∩ s) :=
      (Eq.symm <| measure_Union₀ hd fun g => (ht.smul _).inter hs.NullMeasurableSet)
    _ ≤ μ s := measure_mono (unionᵢ_subset fun g => inter_subset_right _ _)

#align measure_theory.is_fundamental_domain.measure_le_of_pairwise_disjoint MeasureTheory.IsFundamentalDomain.measure_le_of_pairwise_disjoint
#align measure_theory.is_add_fundamental_domain.measure_le_of_pairwise_disjoint MeasureTheory.IsAddFundamentalDomain.measure_le_of_pairwise_disjoint

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (x y «expr ∈ » t) -/
/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (g «expr ≠ » (1 : G)) -/
/-- If the action of a countable group `G` admits an invariant measure `μ` with a fundamental domain
`s`, then every null-measurable set `t` of measure strictly greater than `μ s` contains two
points `x y` such that `g • x = y` for some `g ≠ 1`. -/
@[to_additive
      "If the additive action of a countable group `G` admits an invariant measure `μ` with\na fundamental domain `s`, then every null-measurable set `t` of measure strictly greater than `μ s`\ncontains two points `x y` such that `g +ᵥ x = y` for some `g ≠ 0`."]
theorem exists_ne_one_smul_eq (hs : IsFundamentalDomain G s μ) (htm : NullMeasurableSet t μ)
    (ht : μ s < μ t) : ∃ (x : _)(_ : x ∈ t)(y : _)(_ : y ∈ t)(g : _)(_ : g ≠ (1 : G)), g • x = y :=
  by
  contrapose! ht
  refine' hs.measure_le_of_pairwise_disjoint htm (Pairwise.aeDisjoint fun g₁ g₂ hne => _)
  dsimp [Function.onFun]
  refine' (Disjoint.inf_left _ _).inf_right _
  rw [Set.disjoint_left]
  rintro _ ⟨x, hx, rfl⟩ ⟨y, hy, hxy⟩
  refine' ht x hx y hy (g₂⁻¹ * g₁) (mt inv_mul_eq_one.1 hne.symm) _
  rw [mul_smul, ← hxy, inv_smul_smul]
#align measure_theory.is_fundamental_domain.exists_ne_one_smul_eq MeasureTheory.IsFundamentalDomain.exists_ne_one_smul_eq
#align measure_theory.is_add_fundamental_domain.exists_ne_zero_vadd_eq MeasureTheory.IsAddFundamentalDomain.exists_ne_zero_vadd_eq

/-- If `f` is invariant under the action of a countable group `G`, and `μ` is a `G`-invariant
  measure with a fundamental domain `s`, then the `ess_sup` of `f` restricted to `s` is the same as
  that of `f` on all of its domain. -/
@[to_additive
      "If `f` is invariant under the action of a countable additive group `G`, and `μ` is a\n`G`-invariant measure with a fundamental domain `s`, then the `ess_sup` of `f` restricted to `s` is\nthe same as that of `f` on all of its domain."]
theorem essSup_measure_restrict (hs : IsFundamentalDomain G s μ) {f : α → ℝ≥0∞}
    (hf : ∀ γ : G, ∀ x : α, f (γ • x) = f x) : essSup f (μ.restrict s) = essSup f μ :=
  by
  refine' le_antisymm (essSup_mono_measure' measure.restrict_le_self) _
  rw [essSup_eq_infₛ (μ.restrict s) f, essSup_eq_infₛ μ f]
  refine' infₛ_le_infₛ _
  rintro a (ha : (μ.restrict s) { x : α | a < f x } = 0)
  rw [measure.restrict_apply₀' hs.null_measurable_set] at ha
  refine' measure_zero_of_invariant hs _ _ ha
  intro γ
  ext x
  rw [mem_smul_set_iff_inv_smul_mem]
  simp only [mem_set_of_eq, hf γ⁻¹ x]
#align measure_theory.is_fundamental_domain.ess_sup_measure_restrict MeasureTheory.IsFundamentalDomain.essSup_measure_restrict
#align measure_theory.is_add_fundamental_domain.ess_sup_measure_restrict MeasureTheory.IsAddFundamentalDomain.ess_sup_measure_restrict

end IsFundamentalDomain

/-! ### Interior/frontier of a fundamental domain -/

section MeasurableSpace

variable (G) [Group G] [MulAction G α] (s : Set α) {x : α}

/-- The boundary of a fundamental domain, those points of the domain that also lie in a nontrivial
translate. -/
@[to_additive MeasureTheory.addFundamentalFrontier
      "The boundary of a fundamental domain, those\npoints of the domain that also lie in a nontrivial translate."]
def fundamentalFrontier : Set α :=
  s ∩ ⋃ (g : G) (hg : g ≠ 1), g • s
#align measure_theory.fundamental_frontier MeasureTheory.fundamentalFrontier
#align measure_theory.add_fundamental_frontier MeasureTheory.addFundamentalFrontier

/-- The interior of a fundamental domain, those points of the domain not lying in any translate. -/
@[to_additive MeasureTheory.addFundamentalInterior
      "The interior of a fundamental domain, those\npoints of the domain not lying in any translate."]
def fundamentalInterior : Set α :=
  s \ ⋃ (g : G) (hg : g ≠ 1), g • s
#align measure_theory.fundamental_interior MeasureTheory.fundamentalInterior
#align measure_theory.add_fundamental_interior MeasureTheory.addFundamentalInterior

variable {G s}

@[simp, to_additive MeasureTheory.mem_add_fundamentalFrontier]
theorem mem_fundamentalFrontier :
    x ∈ fundamentalFrontier G s ↔ x ∈ s ∧ ∃ (g : G)(hg : g ≠ 1), x ∈ g • s := by
  simp [fundamental_frontier]
#align measure_theory.mem_fundamental_frontier MeasureTheory.mem_fundamentalFrontier
#align measure_theory.mem_add_fundamental_frontier MeasureTheory.mem_add_fundamentalFrontier

@[simp, to_additive MeasureTheory.mem_add_fundamentalInterior]
theorem mem_fundamentalInterior :
    x ∈ fundamentalInterior G s ↔ x ∈ s ∧ ∀ (g : G) (hg : g ≠ 1), x ∉ g • s := by
  simp [fundamental_interior]
#align measure_theory.mem_fundamental_interior MeasureTheory.mem_fundamentalInterior
#align measure_theory.mem_add_fundamental_interior MeasureTheory.mem_add_fundamentalInterior

@[to_additive MeasureTheory.add_fundamentalFrontier_subset]
theorem fundamentalFrontier_subset : fundamentalFrontier G s ⊆ s :=
  inter_subset_left _ _
#align measure_theory.fundamental_frontier_subset MeasureTheory.fundamentalFrontier_subset
#align measure_theory.add_fundamental_frontier_subset MeasureTheory.add_fundamentalFrontier_subset

@[to_additive MeasureTheory.add_fundamentalInterior_subset]
theorem fundamentalInterior_subset : fundamentalInterior G s ⊆ s :=
  diff_subset _ _
#align measure_theory.fundamental_interior_subset MeasureTheory.fundamentalInterior_subset
#align measure_theory.add_fundamental_interior_subset MeasureTheory.add_fundamentalInterior_subset

variable (G s)

@[to_additive MeasureTheory.disjoint_add_fundamental_interior_add_fundamental_frontier]
theorem disjoint_fundamentalInterior_fundamentalFrontier :
    Disjoint (fundamentalInterior G s) (fundamentalFrontier G s) :=
  disjoint_sdiff_self_left.mono_right inf_le_right
#align measure_theory.disjoint_fundamental_interior_fundamental_frontier MeasureTheory.disjoint_fundamentalInterior_fundamentalFrontier
#align measure_theory.disjoint_add_fundamental_interior_add_fundamental_frontier MeasureTheory.disjoint_add_fundamental_interior_add_fundamental_frontier

@[simp, to_additive MeasureTheory.add_fundamentalInterior_union_add_fundamentalFrontier]
theorem fundamentalInterior_union_fundamentalFrontier :
    fundamentalInterior G s ∪ fundamentalFrontier G s = s :=
  diff_union_inter _ _
#align measure_theory.fundamental_interior_union_fundamental_frontier MeasureTheory.fundamentalInterior_union_fundamentalFrontier
#align measure_theory.add_fundamental_interior_union_add_fundamental_frontier MeasureTheory.add_fundamentalInterior_union_add_fundamentalFrontier

@[simp, to_additive MeasureTheory.add_fundamentalInterior_union_add_fundamentalFrontier]
theorem fundamentalFrontier_union_fundamentalInterior :
    fundamentalFrontier G s ∪ fundamentalInterior G s = s :=
  inter_union_diff _ _
#align measure_theory.fundamental_frontier_union_fundamental_interior MeasureTheory.fundamentalFrontier_union_fundamentalInterior
#align measure_theory.add_fundamental_interior_union_add_fundamental_frontier MeasureTheory.add_fundamentalInterior_union_add_fundamentalFrontier

@[simp, to_additive MeasureTheory.sdiff_add_fundamentalInterior]
theorem sdiff_fundamentalInterior : s \ fundamentalInterior G s = fundamentalFrontier G s :=
  sdiff_sdiff_right_self
#align measure_theory.sdiff_fundamental_interior MeasureTheory.sdiff_fundamentalInterior
#align measure_theory.sdiff_add_fundamental_interior MeasureTheory.sdiff_add_fundamentalInterior

@[simp, to_additive MeasureTheory.sdiff_add_fundamentalFrontier]
theorem sdiff_fundamentalFrontier : s \ fundamentalFrontier G s = fundamentalInterior G s :=
  diff_self_inter
#align measure_theory.sdiff_fundamental_frontier MeasureTheory.sdiff_fundamentalFrontier
#align measure_theory.sdiff_add_fundamental_frontier MeasureTheory.sdiff_add_fundamentalFrontier

@[simp, to_additive MeasureTheory.add_fundamentalFrontier_vadd]
theorem fundamentalFrontier_smul [Group H] [MulAction H α] [SMulCommClass H G α] (g : H) :
    fundamentalFrontier G (g • s) = g • fundamentalFrontier G s := by
  simp_rw [fundamental_frontier, smul_set_inter, smul_set_Union, smul_comm g]
#align measure_theory.fundamental_frontier_smul MeasureTheory.fundamentalFrontier_smul
#align measure_theory.add_fundamental_frontier_vadd MeasureTheory.add_fundamentalFrontier_vadd

@[simp, to_additive MeasureTheory.add_fundamentalInterior_vadd]
theorem fundamentalInterior_smul [Group H] [MulAction H α] [SMulCommClass H G α] (g : H) :
    fundamentalInterior G (g • s) = g • fundamentalInterior G s := by
  simp_rw [fundamental_interior, smul_set_sdiff, smul_set_Union, smul_comm g]
#align measure_theory.fundamental_interior_smul MeasureTheory.fundamentalInterior_smul
#align measure_theory.add_fundamental_interior_vadd MeasureTheory.add_fundamentalInterior_vadd

@[to_additive MeasureTheory.pairwise_disjoint_add_fundamental_interior]
theorem pairwise_disjoint_fundamentalInterior :
    Pairwise (Disjoint on fun g : G => g • fundamentalInterior G s) :=
  by
  refine' fun a b hab => disjoint_left.2 _
  rintro _ ⟨x, hx, rfl⟩ ⟨y, hy, hxy⟩
  rw [mem_fundamental_interior] at hx hy
  refine' hx.2 (a⁻¹ * b) _ _
  rwa [Ne.def, inv_mul_eq_iff_eq_mul, mul_one, eq_comm]
  simpa [mul_smul, ← hxy, mem_inv_smul_set_iff] using hy.1
#align measure_theory.pairwise_disjoint_fundamental_interior MeasureTheory.pairwise_disjoint_fundamentalInterior
#align measure_theory.pairwise_disjoint_add_fundamental_interior MeasureTheory.pairwise_disjoint_add_fundamental_interior

variable [Countable G] [MeasurableSpace G] [MeasurableSpace α] [HasMeasurableSmul G α]
  {μ : Measure α} [SmulInvariantMeasure G α μ]

@[to_additive MeasureTheory.NullMeasurableSet.add_fundamental_frontier]
protected theorem NullMeasurableSet.fundamentalFrontier (hs : NullMeasurableSet s μ) :
    NullMeasurableSet (fundamentalFrontier G s) μ :=
  hs.inter <| NullMeasurableSet.union fun g => NullMeasurableSet.union fun hg => hs.smul _
#align measure_theory.null_measurable_set.fundamental_frontier MeasureTheory.NullMeasurableSet.fundamentalFrontier
#align measure_theory.null_measurable_set.add_fundamental_frontier MeasureTheory.NullMeasurableSet.add_fundamental_frontier

@[to_additive MeasureTheory.NullMeasurableSet.add_fundamental_interior]
protected theorem NullMeasurableSet.fundamentalInterior (hs : NullMeasurableSet s μ) :
    NullMeasurableSet (fundamentalInterior G s) μ :=
  hs.diffₓ <| NullMeasurableSet.union fun g => NullMeasurableSet.union fun hg => hs.smul _
#align measure_theory.null_measurable_set.fundamental_interior MeasureTheory.NullMeasurableSet.fundamentalInterior
#align measure_theory.null_measurable_set.add_fundamental_interior MeasureTheory.NullMeasurableSet.add_fundamental_interior

end MeasurableSpace

namespace IsFundamentalDomain

section Group

variable [Countable G] [Group G] [MulAction G α] [MeasurableSpace α] {μ : Measure α} {s : Set α}
  (hs : IsFundamentalDomain G s μ)

include hs

@[to_additive MeasureTheory.IsAddFundamentalDomain.measure_add_fundamental_frontier]
theorem measure_fundamentalFrontier : μ (fundamentalFrontier G s) = 0 := by
  simpa only [fundamental_frontier, Union₂_inter, measure_Union_null_iff', one_smul,
    measure_Union_null_iff, inter_comm s, Function.onFun] using fun g (hg : g ≠ 1) =>
    hs.ae_disjoint hg
#align measure_theory.is_fundamental_domain.measure_fundamental_frontier MeasureTheory.IsFundamentalDomain.measure_fundamentalFrontier
#align measure_theory.is_add_fundamental_domain.measure_add_fundamental_frontier MeasureTheory.IsAddFundamentalDomain.measure_add_fundamental_frontier

@[to_additive MeasureTheory.IsAddFundamentalDomain.measure_add_fundamental_interior]
theorem measure_fundamentalInterior : μ (fundamentalInterior G s) = μ s :=
  measure_diff_null' hs.measure_fundamentalFrontier
#align measure_theory.is_fundamental_domain.measure_fundamental_interior MeasureTheory.IsFundamentalDomain.measure_fundamentalInterior
#align measure_theory.is_add_fundamental_domain.measure_add_fundamental_interior MeasureTheory.IsAddFundamentalDomain.measure_add_fundamental_interior

end Group

variable [Countable G] [Group G] [MulAction G α] [MeasurableSpace α] {μ : Measure α} {s : Set α}
  (hs : IsFundamentalDomain G s μ) [MeasurableSpace G] [HasMeasurableSmul G α]
  [SmulInvariantMeasure G α μ]

include hs

protected theorem fundamentalInterior : IsFundamentalDomain G (fundamentalInterior G s) μ :=
  { NullMeasurableSet := hs.NullMeasurableSet.fundamentalInterior _ _
    ae_covers :=
      by
      simp_rw [ae_iff, not_exists, ← mem_inv_smul_set_iff, set_of_forall, ← compl_set_of,
        set_of_mem_eq, ← compl_Union]
      have :
        ((⋃ g : G, g⁻¹ • s) \ ⋃ g : G, g⁻¹ • fundamental_frontier G s) ⊆
          ⋃ g : G, g⁻¹ • fundamental_interior G s :=
        by
        simp_rw [diff_subset_iff, ← Union_union_distrib, ← smul_set_union,
          fundamental_frontier_union_fundamental_interior]
      refine' eq_bot_mono (μ.mono <| compl_subset_compl.2 this) _
      simp only [Union_inv_smul, outer_measure.measure_of_eq_coe, coe_to_outer_measure, compl_sdiff,
        ENNReal.bot_eq_zero, himp_eq, sup_eq_union, @Union_smul_eq_set_of_exists _ _ _ _ s]
      exact
        measure_union_null
          (measure_Union_null fun _ => measure_smul_null hs.measure_fundamental_frontier _)
          hs.ae_covers
    AeDisjoint := (pairwise_disjoint_fundamentalInterior _ _).mono fun _ _ => Disjoint.aeDisjoint }
#align measure_theory.is_fundamental_domain.fundamental_interior MeasureTheory.IsFundamentalDomain.fundamentalInterior

end IsFundamentalDomain

end MeasureTheory


/-!
# Binary Search Trees

If the type of keys can be totally ordered -- that is, it supports a well-behaved `≤` comparison --
then maps can be implemented with binary search trees (BSTs). Insert and lookup operations on BSTs take time
proportional to the height of the tree. If the tree is balanced, the operations therefore take logarithmic time.

This example is based on a similar example found in the ["Sofware Foundations"](https://softwarefoundations.cis.upenn.edu/vfa-current/SearchTree.html)
book (volume 3).
-/

/-!
We use `Nat` as the key type in our implementation of BSTs,
since it has a convenient total order with lots of theorems and automation available.
We leave as an exercise to the reader the generalization to arbitrary types.
-/

inductive Tree (β : Type v) where
  | leaf
  | node (left : Tree β) (key : Nat) (value : β) (right : Tree β)
  deriving Repr

/-!
The function `contains` returns `true` iff the given tree contains the key `k`.
-/
def Tree.contains (t : Tree β) (k : Nat) : Bool :=
  match t with
  | leaf => false
  | node left key value right =>
    if k < key then
      left.contains k
    else if key < k then
      right.contains k
    else
      true

/-!
`t.find? k` returns `some v` if `v` is the value bound to key `k` in the tree `t`. It returns `none` otherwise.
-/
def Tree.find? (t : Tree β) (k : Nat) : Option β :=
  match t with
  | leaf => none
  | node left key value right =>
    if k < key then
      left.find? k
    else if key < k then
      right.find? k
    else
      some value

/-!
`t.insert k v` is the map containing all the bindings of `t` along with a binding of `k` to `v`.
-/
def Tree.insert (t : Tree β) (k : Nat) (v : β) : Tree β :=
  match t with
  | leaf => node leaf k v leaf
  | node left key value right =>
    if k < key then
      node (left.insert k v) key value right
    else if key < k then
      node left key value (right.insert k v)
    else
      node left k v right
/-!
Let's add a new operation to our tree: converting it to an association list that contains the key--value bindings from the tree stored as pairs.
If that list is sorted by the keys, then any two trees that represent the same map would be converted to the same list.
Here's a function that does so with an in-order traversal of the tree.
-/
def Tree.toList (t : Tree β) : List (Nat × β) :=
  match t with
  | leaf => []
  | node l k v r => l.toList ++ [(k, v)] ++ r.toList

#eval Tree.leaf.insert 2 "two"
      |>.insert 3 "three"
      |>.insert 1 "one"

#eval Tree.leaf.insert 2 "two"
      |>.insert 3 "three"
      |>.insert 1 "one"
      |>.toList

/-!
The implemention of `Tree.toList` is inefficient because of how it uses the `++` operator.
On a balanced tree its running time is linearithmic, because it does a linear number of
concatentations at each level of the tree. On an unbalanced tree it's quadratic time.
Here's a tail-recursive implementation than runs in linear time, regardless of whether the tree is balanced:
-/
def Tree.toListTR (t : Tree β) : List (Nat × β) :=
  go t []
where
  go (t : Tree β) (acc : List (Nat × β)) : List (Nat × β) :=
    match t with
    | leaf => acc
    | node l k v r => go l ((k, v) :: go r acc)

/-!
We now prove that `t.toList` and `t.toListTR` return the same list.
The proof is on induction, and as we used the auxiliary function `go`
to define `Tree.toListTR`, we use the auxiliary theorem `go` to prove the theorem.

The proof of the auxiliary theorem is by induction on `t`.
The `generalizing acc` modifier instructs Lean to revert `acc`, apply the
induction theorem for `Tree`s, and then reintroduce `acc` in each case.
By using `generalizing`, we obtain the more general induction hypotheses

- `left_ih : ∀ acc, toListTR.go left acc = toList left ++ acc`

- `right_ih : ∀ acc, toListTR.go right acc = toList right ++ acc`

Recall that the combinator `tac <;> tac'` runs `tac` on the main goal and `tac'` on each produced goal,
concatenating all goals produced by `tac'`. In this theorem, we use it to apply
`simp` and close each subgoal produced by the `induction` tactic.

The `simp` parameters `toListTR.go` and `toList` instruct the simplifier to try to reduce
and/or apply auto generated equation theorems for these two functions.
The parameter `*` intructs the simplifier to use any equation in a goal as rewriting rules.
In this particular case, `simp` uses the induction hypotheses as rewriting rules.
Finally, the parameter `List.append_assoc` intructs the simplifier to use the
`List.append_assoc` theorem as a rewriting rule.
-/
theorem Tree.toList_eq_toListTR (t : Tree β)
        : t.toList = t.toListTR := by
  simp [toListTR, go t []]
where
  go (t : Tree β) (acc : List (Nat × β))
     : toListTR.go t acc = t.toList ++ acc := by
    induction t generalizing acc <;>
      simp [toListTR.go, toList, *, List.append_assoc]

/-!
The `[csimp]` annotation instructs the Lean code generator to replace
any `Tree.toList` with `Tree.toListTR` when generating code.
-/
@[csimp] theorem Tree.toList_eq_toListTR_csimp
                 : @Tree.toList = @Tree.toListTR := by
  funext β t
  apply toList_eq_toListTR

/-!
The implementations of `Tree.find?` and `Tree.insert` assume that values of type tree obey the BST invariant:
for any non-empty node with key `k`, all the values of the `left` subtree are less than `k` and all the values
of the right subtree are greater than `k`. But that invariant is not part of the definition of tree.

So, let's formalize the BST invariant. Here's one way to do so. First, we define a helper `ForallTree`
to express that idea that a predicate holds at every node of a tree:
-/
inductive ForallTree (p : Nat → β → Prop) : Tree β → Prop
  | leaf : ForallTree p .leaf
  | node :
     ForallTree p left →
     p key value →
     ForallTree p right →
     ForallTree p (.node left key value right)

/-!
Second, we define the BST invariant:
An empty tree is a BST.
A non-empty tree is a BST if all its left nodes have a lesser key, its right nodes have a greater key, and the left and right subtrees are themselves BSTs.
-/
inductive BST : Tree β → Prop
  | leaf : BST .leaf
  | node :
     ForallTree (fun k v => k < key) left →
     ForallTree (fun k v => key < k) right →
     BST left → BST right →
     BST (.node left key value right)

/-!
We can use the `macro` command to create helper tactics for organizing our proofs.
The macro `have_eq x y` tries to prove `x = y` using linear arithmetic, and then
immediately uses the new equality to substitute `x` with `y` everywhere in the goal.

The modifier `local` specifies the scope of the macro.
-/
/-- The `have_eq lhs rhs` tactic (tries to) prove that `lhs = rhs`,
    and then replaces `lhs` with `rhs`. -/
local macro "have_eq " lhs:term:max rhs:term:max : tactic =>
  `(tactic|
    (have h : $lhs = $rhs :=
       -- TODO: replace with linarith
       by simp_arith at *; apply Nat.le_antisymm <;> assumption
     try subst $lhs))

/-!
The `by_cases' e` is just the regular `by_cases` followed by `simp` using all
hypotheses in the current goal as rewriting rules.
Recall that the `by_cases` tactic creates two goals. One where we have `h : e` and
another one containing `h : ¬ e`. The simplier uses the `h` to rewrite `e` to `True`
in the first subgoal, and `e` to `False` in the second. This is particularly
useful if `e` is the condition of an `if`-statement.
-/
/-- `by_cases' e` is a shorthand form `by_cases e <;> simp[*]` -/
local macro "by_cases' " e:term :  tactic =>
  `(tactic| by_cases $e <;> simp [*])

/-!
We can use the attribute `[simp]` to instruct the simplifier to reduce given definitions or
apply rewrite theorems. The `local` modifier limits the scope of this modification to this file.
-/
attribute [local simp] Tree.insert

/-!
We now prove that `Tree.insert` preserves the BST invariant using induction and case analysis.
Recall that the tactic `. tac` focuses on the main goal and tries to solve it using `tac`, or else fails.
It is used to structure proofs in Lean.
The notation `‹e›` is just syntax sugar for `(by assumption : e)`. That is, it tries to find a hypothesis `h : e`.
It is useful to access hypothesis that have auto generated names (aka "inaccessible") names.
-/

theorem Tree.forall_insert_of_forall
        (h₁ : ForallTree p t) (h₂ : p key value)
        : ForallTree p (t.insert key value) := by
  induction h₁ with
  | leaf => exact .node .leaf h₂ .leaf
  | node hl hp hr ihl ihr =>
    rename Nat => k
    by_cases' key < k
    . exact .node ihl hp hr
    . by_cases' k < key
      . exact .node hl hp ihr
      . have_eq key k
        exact .node hl h₂ hr

theorem Tree.bst_insert_of_bst
        {t : Tree β} (h : BST t) (key : Nat) (value : β)
        : BST (t.insert key value) := by
  induction h with
  | leaf => exact .node .leaf .leaf .leaf .leaf
  | node h₁ h₂ b₁ b₂ ih₁ ih₂ =>
    rename Nat => k
    simp
    by_cases' key < k
    . exact .node (forall_insert_of_forall h₁ ‹key < k›) h₂ ih₁ b₂
    . by_cases' k < key
      . exact .node h₁ (forall_insert_of_forall h₂ ‹k < key›) b₁ ih₂
      . have_eq key k
        exact .node h₁ h₂ b₁ b₂

/-!
Now, we define the type `BinTree` using a `Subtype` that states that only trees satisfying the BST invariant are `BinTree`s.
-/
def BinTree (β : Type u) := { t : Tree β // BST t }

def BinTree.mk : BinTree β :=
  ⟨.leaf, .leaf⟩

def BinTree.contains (b : BinTree β) (k : Nat) : Bool :=
  b.val.contains k

def BinTree.find? (b : BinTree β) (k : Nat) : Option β :=
  b.val.find? k

def BinTree.insert (b : BinTree β) (k : Nat) (v : β) : BinTree β :=
  ⟨b.val.insert k v, b.val.bst_insert_of_bst b.property k v⟩

/-!
Finally, we prove that `BinTree.find?` and `BinTree.insert` satisfy the map properties.
-/

attribute [local simp]
  BinTree.mk BinTree.contains BinTree.find?
  BinTree.insert Tree.find? Tree.contains Tree.insert

theorem BinTree.find_mk (k : Nat)
        : BinTree.mk.find? k = (none : Option β) := by
  simp

theorem BinTree.find_insert (b : BinTree β) (k : Nat) (v : β)
        : (b.insert k v).find? k = some v := by
  let ⟨t, h⟩ := b; simp
  induction t with simp
  | node left key value right ihl ihr =>
    by_cases' k < key
    . cases h; apply ihl; assumption
    . by_cases' key < k
      cases h; apply ihr; assumption

theorem BinTree.find_insert_of_ne (b : BinTree β) (h : k ≠ k') (v : β)
        : (b.insert k v).find? k' = b.find? k' := by
  let ⟨t, h⟩ := b; simp
  induction t with simp
  | leaf =>
    split <;> simp <;> split <;> simp
    have_eq k k'
    contradiction
  | node left key value right ihl ihr =>
    let .node hl hr bl br := h
    specialize ihl bl
    specialize ihr br
    by_cases' k < key; by_cases' key < k
    have_eq key k
    by_cases' k' < k; by_cases' k  < k'
    have_eq k k'
    contradiction


import ..lovelib

/-! # LoVe Exercise 3: Forward Proofs -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1: Connectives and Quantifiers

1.1. Supply structured proofs of the following lemmas. -/

lemma I (a : Prop) :
  a → a :=
assume ha : a,
show a, from
  ha

lemma K (a b : Prop) :
  a → b → b :=
assume ha : a,
assume hb : b,
show b, from
  hb

lemma C (a b c : Prop) :
  (a → b → c) → b → a → c :=
assume hg : a → b → c,
assume hb : b,
assume ha : a,
show c, from
  hg ha hb

lemma proj_1st (a : Prop) :
  a → a → a :=
assume ha ha' : a,
show a, from
  ha

/-! Please give a different answer than for `proj_1st`. -/

lemma proj_2nd (a : Prop) :
  a → a → a :=
assume ha ha' : a,
show a, from
  ha'

lemma some_nonsense (a b c : Prop) :
  (a → b → c) → a → (a → c) → b → c :=
assume hg : a → b → c,
assume ha : a,
assume hf : a → c,
assume hb : b,
have hc : c :=
  hf ha,
show c, from
  hc

/-! 1.2. Supply a structured proof of the contraposition rule. -/

lemma contrapositive (a b : Prop) :
  (a → b) → ¬ b → ¬ a :=
assume hab : a → b,
assume hnb : ¬ b,
assume ha : a,
have hb : b :=
  hab ha,
show false, from
  hnb hb

/-! 1.3. Supply a structured proof of the distributivity of `∀` over `∧`. -/

lemma forall_and {α : Type} (p q : α → Prop) :
  (∀x, p x ∧ q x) ↔ (∀x, p x) ∧ (∀x, q x) :=
iff.intro
  (assume hpq : ∀x, p x ∧ q x,
   have hp : ∀x, p x :=
     fix x,
     and.elim_left (hpq x),
   have hq : ∀x, q x :=
     fix x,
     and.elim_right (hpq x),
   show (∀x, p x) ∧ (∀x, q x), from
     and.intro hp hq)
  (assume hpq : (∀x, p x) ∧ (∀x, q x),
   have hp : ∀x, p x :=
     and.elim_left hpq,
   have hq : ∀x, q x :=
     and.elim_right hpq,
   assume x : α,
   show p x ∧ q x, from
     and.intro (hp x) (hq x))

/-! 1.4 (**optional**). Reuse, if possible, the lemma `forall_and` from question
1.3 to prove the following instance of the lemma. -/

lemma forall_and_inst {α : Type} (r s : α → α → Prop) :
  (∀x, r x x ∧ s x x) ↔ (∀x, r x x) ∧ (∀x, s x x) :=
forall_and (λx, r x x) (λx, s x x)

/-! 1.5. Supply a structured proof of the following property, which can be used
to pull a `∀`-quantifier past an `∃`-quantifier. -/

lemma forall_exists_of_exists_forall {α : Type} (p : α → α → Prop) :
  (∃x, ∀y, p x y) → (∀y, ∃x, p x y) :=
assume hpxy : ∃x, ∀y, p x y,
fix b,
show ∃x, p x b, from
  exists.elim hpxy
    (fix a,
     assume hpay : ∀y, p a y,
     show ∃x, p x b, from
       exists.intro a (hpay b))

/-! ## Question 2: Chain of Equalities

2.1. Write the following proof using `calc`.

      (a + b) * (a + b)
    = a * (a + b) + b * (a + b)
    = a * a + a * b + b * a + b * b
    = a * a + a * b + a * b + b * b
    = a * a + 2 * a * b + b * b

Hint: You might need the tactics `simp` and `cc` and the lemmas `mul_add`,
`add_mul`, and `two_mul`. -/

lemma binomial_square (a b : ℕ) :
  (a + b) * (a + b) = a * a + 2 * a * b + b * b :=
calc  (a + b) * (a + b)
    = a * (a + b) + b * (a + b) :
  begin
    simp [add_mul, mul_add],
    cc
  end
... = a * a + a * b + b * a + b * b :
  begin
    simp [add_mul, mul_add],
    cc
  end
... = a * a + a * b + a * b + b * b :
  by cc
... = a * a + 2 * a * b + b * b :
  begin
    simp [two_mul, mul_add, add_mul],
    cc
  end

/-! 2.2 (**optional**). Prove the same argument again, this time as a structured
proof, with `have` steps corresponding to the `calc` equations. Try to reuse as
much of the above proof idea as possible, proceeding mechanically. -/

lemma binomial_square₂ (a b : ℕ) :
  (a + b) * (a + b) = a * a + 2 * a * b + b * b :=
have h1 : (a + b) * (a + b) = a * (a + b) + b * (a + b) :=
  begin
    simp [add_mul, mul_add],
    cc
  end,
have h2 : a * (a + b) + b * (a + b) = a * a + a * b + b * a + b * b :=
  begin
    simp [add_mul, mul_add],
    cc
  end,
have h3 : a * a + a * b + b * a + b * b = a * a + a * b + a * b + b * b :=
  begin
    simp,
    cc
  end,
have h4 : a * a + a * b + a * b + b * b = a * a + 2 * a * b + b * b :=
  begin
    simp [two_mul, add_mul, mul_add],
    cc
  end,
show _, from
  begin
    rw h1,
    rw h2,
    rw h3,
    rw h4
  end

/-! 2.3. Prove the same lemma again, this time using tactics. -/

lemma binomial_square₃ (a b : ℕ) :
  (a + b) * (a + b) = a * a + 2 * a * b + b * b :=
begin
  simp [two_mul, add_mul, mul_add],
  cc
end

/-! ## Question 3 (**optional**): One-Point Rules

3.1 (**optional**). Prove that the following wrong formulation of the one-point
rule for `∀` is inconsistent, using a structured proof. -/

axiom forall.one_point_wrong {α : Type} {t : α} {p : α → Prop} :
  (∀x : α, x = t ∧ p x) ↔ p t

lemma proof_of_false :
  false :=
begin
  have wrong : (∀x, x = 0 ∧ true) ↔ true :=
    @forall.one_point_wrong ℕ 0 (λ_, true),
  simp at wrong,
  have one_eq_zero : 1 = 0 :=
    wrong 1,
  cc
end

/-! 3.2 (**optional**). Prove that the following wrong formulation of the
one-point rule for `∃` is inconsistent, using a tactical or structured proof. -/

axiom exists.one_point_wrong {α : Type} {t : α} {p : α → Prop} :
  (∃x : α, x = t → p x) ↔ p t

lemma proof_of_false₂ :
  false :=
begin
  have wrong : (∃x, x ≠ 0) ↔ false :=
    @exists.one_point_wrong ℕ 0 (λ_, false),
  simp at wrong,
  have one_eq_zero : 1 = 0 :=
    wrong 1,
  cc
end

end LoVe