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

! This file was ported from Lean 3 source module data.complex.exponential_bounds
! leanprover-community/mathlib commit 402f8982dddc1864bd703da2d6e2ee304a866973
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Complex.Exponential
import Mathbin.Analysis.SpecialFunctions.Log.Deriv

/-!
# Bounds on specific values of the exponential
-/

namespace Real

open IsAbsoluteValue Finset CauSeq Complex

theorem exp_one_near_10 : |exp 1 - 2244083 / 825552| ≤ 1 / 10 ^ 10 :=
  by
  apply exp_approx_start
  iterate 13 refine' exp_1_approx_succ_eq (by norm_num1 <;> rfl) (by norm_cast <;> rfl) _
  norm_num1
  refine' exp_approx_end' _ (by norm_num1 <;> rfl) _ (by norm_cast <;> rfl) (by simp) _
  rw [_root_.abs_one, abs_of_pos] <;> norm_num1
#align real.exp_one_near_10 Real.exp_one_near_10

theorem exp_one_near_20 : |exp 1 - 363916618873 / 133877442384| ≤ 1 / 10 ^ 20 :=
  by
  apply exp_approx_start
  iterate 21 refine' exp_1_approx_succ_eq (by norm_num1 <;> rfl) (by norm_cast <;> rfl) _
  norm_num1
  refine' exp_approx_end' _ (by norm_num1 <;> rfl) _ (by norm_cast <;> rfl) (by simp) _
  rw [_root_.abs_one, abs_of_pos] <;> norm_num1
#align real.exp_one_near_20 Real.exp_one_near_20

theorem exp_one_gt_d9 : 2.7182818283 < exp 1 :=
  lt_of_lt_of_le (by norm_num) (sub_le_comm.1 (abs_sub_le_iff.1 exp_one_near_10).2)
#align real.exp_one_gt_d9 Real.exp_one_gt_d9

theorem exp_one_lt_d9 : exp 1 < 2.7182818286 :=
  lt_of_le_of_lt (sub_le_iff_le_add.1 (abs_sub_le_iff.1 exp_one_near_10).1) (by norm_num)
#align real.exp_one_lt_d9 Real.exp_one_lt_d9

theorem exp_neg_one_gt_d9 : 0.36787944116 < exp (-1) :=
  by
  rw [exp_neg, lt_inv _ (exp_pos _)]
  refine' lt_of_le_of_lt (sub_le_iff_le_add.1 (abs_sub_le_iff.1 exp_one_near_10).1) _
  all_goals norm_num
#align real.exp_neg_one_gt_d9 Real.exp_neg_one_gt_d9

theorem exp_neg_one_lt_d9 : exp (-1) < 0.3678794412 :=
  by
  rw [exp_neg, inv_lt (exp_pos _)]
  refine' lt_of_lt_of_le _ (sub_le_comm.1 (abs_sub_le_iff.1 exp_one_near_10).2)
  all_goals norm_num
#align real.exp_neg_one_lt_d9 Real.exp_neg_one_lt_d9

theorem log_two_near_10 : |log 2 - 287209 / 414355| ≤ 1 / 10 ^ 10 :=
  by
  suffices |log 2 - 287209 / 414355| ≤ 1 / 17179869184 + (1 / 10 ^ 10 - 1 / 2 ^ 34)
    by
    norm_num1 at *
    assumption
  have t : |(2⁻¹ : ℝ)| = 2⁻¹ := by
    rw [abs_of_pos]
    norm_num
  have z :=
    Real.abs_log_sub_add_sum_range_le
      (show |(2⁻¹ : ℝ)| < 1 by
        rw [t]
        norm_num)
      34
  rw [t] at z
  norm_num1 at z
  rw [one_div (2 : ℝ), log_inv, ← sub_eq_add_neg, _root_.abs_sub_comm] at z
  apply le_trans (_root_.abs_sub_le _ _ _) (add_le_add z _)
  simp_rw [sum_range_succ]
  norm_num
  rw [abs_of_pos] <;> norm_num
#align real.log_two_near_10 Real.log_two_near_10

theorem log_two_gt_d9 : 0.6931471803 < log 2 :=
  lt_of_lt_of_le (by norm_num1) (sub_le_comm.1 (abs_sub_le_iff.1 log_two_near_10).2)
#align real.log_two_gt_d9 Real.log_two_gt_d9

theorem log_two_lt_d9 : log 2 < 0.6931471808 :=
  lt_of_le_of_lt (sub_le_iff_le_add.1 (abs_sub_le_iff.1 log_two_near_10).1) (by norm_num)
#align real.log_two_lt_d9 Real.log_two_lt_d9

end Real


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

import data.nat.digits

/-!
# IMO 1960 Q1

Determine all three-digit numbers $N$ having the property that $N$ is divisible by 11, and
$\dfrac{N}{11}$ is equal to the sum of the squares of the digits of $N$.

Since Lean doesn't have a way to directly express problem statements of the form
"Determine all X satisfying Y", we express two predicates where proving that one implies the
other is equivalent to solving the problem. A human solver also has to discover the
second predicate.

The strategy here is roughly brute force, checking the possible multiples of 11.
-/

open nat

namespace imo1960_q1

def sum_of_squares (L : list ℕ) : ℕ := (L.map (λ x, x * x)).sum

def problem_predicate (n : ℕ) : Prop :=
(nat.digits 10 n).length = 3 ∧ 11 ∣ n ∧ n / 11 = sum_of_squares (nat.digits 10 n)

def solution_predicate (n : ℕ) : Prop := n = 550 ∨ n = 803

/-
Proving that three digit numbers are the ones in [100, 1000).
-/

lemma not_zero {n : ℕ} (h1 : problem_predicate n) : n ≠ 0 :=
have h2 : nat.digits 10 n ≠ list.nil, from list.ne_nil_of_length_eq_succ h1.left,
digits_ne_nil_iff_ne_zero.mp h2

lemma ge_100 {n : ℕ} (h1 : problem_predicate n) : 100 ≤ n :=
have h2 : 10^3 ≤ 10 * n, begin
  rw ← h1.left,
  refine nat.base_pow_length_digits_le 10 n _ (not_zero h1),
  simp,
end,
by linarith

lemma lt_1000 {n : ℕ} (h1 : problem_predicate n) : n < 1000 :=
have h2 : n < 10^3, begin
  rw ← h1.left,
  refine nat.lt_base_pow_length_digits _,
  simp,
end,
by linarith

/-
We do an exhaustive search to show that all results are covered by `solution_predicate`.
-/

def search_up_to (c n : ℕ) : Prop :=
n = c * 11 ∧ ∀ m : ℕ, m < n → problem_predicate m → solution_predicate m

lemma search_up_to_start : search_up_to 9 99 := ⟨rfl, λ n h p, by linarith [ge_100 p]⟩

lemma search_up_to_step {c n} (H : search_up_to c n)
  {c' n'} (ec : c + 1 = c') (en : n + 11 = n')
  {l} (el : nat.digits 10 n = l)
  (H' : c = sum_of_squares l → c = 50 ∨ c = 73) :
  search_up_to c' n' :=
begin
  subst ec, subst en, subst el,
  obtain ⟨rfl, H⟩ := H,
  refine ⟨by ring, λ m l p, _⟩,
  obtain ⟨h₁, ⟨m, rfl⟩, h₂⟩ := id p,
  by_cases h : 11 * m < c * 11, { exact H _ h p },
  obtain rfl : m = c := by linarith,
  rw [nat.mul_div_cancel_left _ (by norm_num : 11 > 0), mul_comm] at h₂,
  refine (H' h₂).imp _ _; {rintro rfl, norm_num}
end

lemma search_up_to_end {c} (H : search_up_to c 1001)
  {n : ℕ} (ppn : problem_predicate n) : solution_predicate n :=
H.2 _ (by linarith [lt_1000 ppn]) ppn

lemma right_direction {n : ℕ} : problem_predicate n → solution_predicate n :=
begin
  have := search_up_to_start,
  iterate 82
  { replace := search_up_to_step this (by norm_num1; refl) (by norm_num1; refl)
      (by norm_num1; refl) dec_trivial },
  exact search_up_to_end this
end

/-
Now we just need to prove the equivalence, for the precise problem statement.
-/

lemma left_direction (n : ℕ) (spn : solution_predicate n) : problem_predicate n :=
by rcases spn with (rfl | rfl); norm_num [problem_predicate, sum_of_squares]

end imo1960_q1

open imo1960_q1

theorem imo1960_q1 (n : ℕ) : problem_predicate n ↔ solution_predicate n :=
⟨right_direction, left_direction n⟩


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

Author: Leonardo de Moura

Define propositional calculus, valuation, provability, validity, prove soundness.

This file is based on Floris van Doorn Coq files.
-/
import data.nat data.list
open nat bool list decidable

definition PropVar [reducible] := nat

inductive PropF :=
| Var  : PropVar → PropF
| Bot  : PropF
| Conj : PropF → PropF → PropF
| Disj : PropF → PropF → PropF
| Impl : PropF → PropF → PropF

namespace PropF
  notation `#`:max P:max := Var P
  notation A ∨ B         := Disj A B
  notation A ∧ B         := Conj A B
  infixr `⇒`:27          := Impl
  notation `⊥`           := Bot

  definition Neg A       := A ⇒ ⊥
  notation ~ A           := Neg A
  definition Top         := ~⊥
  notation `⊤`           := Top
  definition BiImpl A B  := A ⇒ B ∧ B ⇒ A
  infixr `⇔`:27          := BiImpl

  definition valuation   := PropVar → bool

  definition TrueQ (v : valuation) : PropF → bool
  | TrueQ (# P)   := v P
  | TrueQ ⊥       := ff
  | TrueQ (A ∨ B) := TrueQ A || TrueQ B
  | TrueQ (A ∧ B) := TrueQ A && TrueQ B
  | TrueQ (A ⇒ B) := bnot (TrueQ A) || TrueQ B

  definition is_true [reducible] (b : bool) := b = tt

  -- the valuation v satisfies a list of PropF, if forall (A : PropF) in Γ,
  -- (TrueQ v A) is tt (the Boolean true)
  definition Satisfies v Γ := ∀ A, A ∈ Γ → is_true (TrueQ v A)
  definition Models Γ A    := ∀ v, Satisfies v Γ → is_true (TrueQ v A)

  infix `⊨`:80 := Models

  definition Valid p := [] ⊨ p
  reserve infix `⊢`:26

  /- Provability -/

  inductive Nc : list PropF → PropF → Prop :=
  infix ⊢ := Nc
  | Nax   : ∀ Γ A,   A ∈ Γ →             Γ ⊢ A
  | ImpI  : ∀ Γ A B, A::Γ ⊢ B →          Γ ⊢ A ⇒ B
  | ImpE  : ∀ Γ A B, Γ ⊢ A ⇒ B → Γ ⊢ A → Γ ⊢ B
  | BotC  : ∀ Γ A,   (~A)::Γ ⊢ ⊥ →       Γ ⊢ A
  | AndI  : ∀ Γ A B, Γ ⊢ A → Γ ⊢ B →     Γ ⊢ A ∧ B
  | AndE₁ : ∀ Γ A B, Γ ⊢ A ∧ B →         Γ ⊢ A
  | AndE₂ : ∀ Γ A B, Γ ⊢ A ∧ B →         Γ ⊢ B
  | OrI₁  : ∀ Γ A B, Γ ⊢ A →             Γ ⊢ A ∨ B
  | OrI₂  : ∀ Γ A B, Γ ⊢ B →             Γ ⊢ A ∨ B
  | OrE   : ∀ Γ A B C, Γ ⊢ A ∨ B → A::Γ ⊢ C → B::Γ ⊢ C → Γ ⊢ C

  infix ⊢ := Nc

  definition Provable A := [] ⊢ A

  definition Prop_Soundness := ∀ A, Provable A → Valid A

  definition Prop_Completeness := ∀ A, Valid A → Provable A

  open Nc

  lemma weakening2 : ∀ Γ A, Γ ⊢ A → ∀ Δ, Γ ⊆ Δ → Δ ⊢ A :=
  λ Γ A H, Nc.induction_on H
    (λ Γ A Hin Δ Hs,                   !Nax  (Hs A Hin))
    (λ Γ A B H w Δ Hs,                 !ImpI (w _ (cons_sub_cons A Hs)))
    (λ Γ A B H₁ H₂ w₁ w₂ Δ Hs,         !ImpE (w₁ _ Hs) (w₂ _ Hs))
    (λ Γ A H w Δ Hs,                   !BotC (w _ (cons_sub_cons (~A) Hs)))
    (λ Γ A B H₁ H₂ w₁ w₂ Δ Hs,         !AndI (w₁ _ Hs) (w₂ _ Hs))
    (λ Γ A B H w Δ Hs,                 !AndE₁ (w _ Hs))
    (λ Γ A B H w Δ Hs,                 !AndE₂ (w _ Hs))
    (λ Γ A B H w Δ Hs,                 !OrI₁ (w _ Hs))
    (λ Γ A B H w Δ Hs,                 !OrI₂ (w _ Hs))
    (λ Γ A B C H₁ H₂ H₃ w₁ w₂ w₃ Δ Hs, !OrE (w₁ _ Hs) (w₂ _ (cons_sub_cons A Hs)) (w₃ _ (cons_sub_cons B Hs)))

  lemma weakening : ∀ Γ Δ A, Γ ⊢ A → Γ++Δ ⊢ A :=
  λ Γ Δ A H, weakening2 Γ A H (Γ++Δ) (sub_append_left Γ Δ)

  lemma deduction : ∀ Γ A B, Γ ⊢ A ⇒ B → A::Γ ⊢ B :=
  λ Γ A B H, ImpE _ A _ (!weakening2 H _ (sub_cons A Γ)) (!Nax (mem_cons A Γ))

  lemma prov_impl : ∀ A B, Provable (A ⇒ B) → ∀ Γ, Γ ⊢ A → Γ ⊢ B :=
  λ A B Hp Γ Ha,
    have wHp : Γ ⊢ (A ⇒ B), from !weakening Hp,
    !ImpE wHp Ha

  lemma Satisfies_cons : ∀ {A Γ v}, Satisfies v Γ → is_true (TrueQ v A) → Satisfies v (A::Γ) :=
  λ A Γ v s t B BinAG,
    or.elim BinAG
      (λ e : B = A, by rewrite e; exact t)
      (λ i : B ∈ Γ, s _ i)

  theorem Soundness_general : ∀ A Γ, Γ ⊢ A → Γ ⊨ A :=
  λ A Γ H, Nc.induction_on H
    (λ Γ A Hin v s,   (s _ Hin))
    (λ Γ A B H r v s,
      by_cases
        (λ t : is_true (TrueQ v A),
           have aux₁ : Satisfies v (A::Γ), from Satisfies_cons s t,
           have aux₂ : is_true (TrueQ v B), from r v aux₁,
           bor_inr aux₂)
        (λ f : ¬ is_true (TrueQ v A),
           have aux : bnot (TrueQ v A) = tt, by rewrite (eq_ff_of_ne_tt f),
           bor_inl aux))
    (λ Γ A B H₁ H₂ r₁ r₂ v s,
       have aux₁ : bnot (TrueQ v A) || TrueQ v B = tt, from r₁ v s,
       have aux₂ : TrueQ v A = tt, from r₂ v s,
       by rewrite [aux₂ at aux₁, bnot_true at aux₁, ff_bor at aux₁]; exact aux₁)
    (λ Γ A H r v s, by_contradiction
       (λ n : TrueQ v A ≠ tt,
         have aux₁ : TrueQ v A    = ff, from eq_ff_of_ne_tt n,
         have aux₂ : TrueQ v (~A) = tt, begin change (bnot (TrueQ v A) || ff = tt), rewrite aux₁ end,
         have aux₃ : Satisfies v ((~A)::Γ), from Satisfies_cons s aux₂,
         have aux₄ : TrueQ v ⊥ = tt, from r v aux₃,
         absurd aux₄ ff_ne_tt))
    (λ Γ A B H₁ H₂ r₁ r₂ v s,
      have aux₁ : TrueQ v A = tt, from r₁ v s,
      have aux₂ : TrueQ v B = tt, from r₂ v s,
      band_intro aux₁ aux₂)
    (λ Γ A B H r v s,
      have aux : TrueQ v (A ∧ B) = tt, from r v s,
      band_elim_left aux)
    (λ Γ A B H r v s,
      have aux : TrueQ v (A ∧ B) = tt, from r v s,
      band_elim_right aux)
    (λ Γ A B H r v s,
      have aux : TrueQ v A = tt, from r v s,
      bor_inl aux)
    (λ Γ A B H r v s,
      have aux : TrueQ v B = tt, from r v s,
      bor_inr aux)
    (λ Γ A B C H₁ H₂ H₃ r₁ r₂ r₃ v s,
      have aux : TrueQ v A || TrueQ v B = tt, from r₁ v s,
      or.elim (or_of_bor_eq aux)
        (λ At : TrueQ v A = tt,
          have aux : Satisfies v (A::Γ), from Satisfies_cons s At,
          r₂ v aux)
        (λ Bt : TrueQ v B = tt,
          have aux : Satisfies v (B::Γ), from Satisfies_cons s Bt,
          r₃ v aux))

  theorem Soundness : Prop_Soundness :=
  λ A, Soundness_general A []

end PropF


import hilbertaxioms
open IncidencePlane

open_locale classical
noncomputable theory

variables {Ω : Type} [IncidencePlane Ω]
variables {A B C D P Q R S : Ω}
variables {ℓ r s t : Line Ω}

lemma distinct_lines_have_at_most_one_common_point
	(hrs: r ≠ s)
	(hAr: A ∈ r) (hAs: A ∈ s) (hBr: B ∈ r) (hBs: B ∈ s) :
	A = B :=
begin
    by_contradiction hc,
    apply hrs,
    apply equal_lines_of_contain_two_points hc; assumption,
end

lemma segments_are_symmetric' : pts (A⬝B) ⊆ pts (B⬝A) :=
begin
    intros x hx,
    simp at *,
    rw between_symmetric,
    tauto,
end

lemma segments_are_symmetric : pts (A⬝B) = pts (B⬝A) :=
begin
    apply set.subset.antisymm; exact segments_are_symmetric',
end

@[simp] lemma no_point_between_a_point (A x : Ω) : (A * x * A) ↔ false :=
begin
    split,
    {
        intro h,
        have H := different_of_between h,
        tauto,
    },
    tauto,
end

@[simp] lemma point_is_segment (A : Ω) : pts (A⬝A) = {A} :=
begin
    unfold pts,
    simp,
end

lemma exists_point_on_line (ℓ : Line Ω): ∃ A : Ω, A ∈ ℓ :=
begin
	have I2 := line_contains_two_points ℓ,
	rcases I2 with ⟨ A, B, hAB, hAℓ, hBℓ⟩,
    use A,
    exact line_through_left A B,
end

lemma exists_point_not_on_line (ℓ : Line Ω): ∃ A : Ω, A ∉ ℓ :=
begin
    rcases (existence Ω) with ⟨A, B, C, ⟨hAB, hAC, hBC, h⟩⟩,
    by_cases hA : A ∈ ℓ,
    {
        by_cases hB : B ∈ ℓ,
        {
            use C,
            rw (incidence hAB hA hB),
            assumption,
        },
        use B,
    },
    use A,
end

lemma point_in_line_difference (h : r ≠ s) :
	∃ A, A ∈ r ∧ A ∉ s :=
begin
	have AB : ∃ A B , A ≠ B ∧ r = line_through A B := line_contains_two_points r,
	rcases AB with ⟨ A, B, ⟨ hAB, hAr, hBr⟩⟩,
	have h1 : A ∉ s ∨ B ∉ s,
	{
		by_contradiction hcontra,
        push_neg at hcontra,
		apply hAB,
		apply distinct_lines_have_at_most_one_common_point h,
        {
            apply line_through_left,
        },
        {
            exact hcontra.1,
        },
        {
            apply line_through_right,
        },
        {
            exact hcontra.2,
        }
	},
	cases h1 with h_isA h_isB,
	work_on_goal 1 {use A},
	work_on_goal 2 {use B},
    all_goals {simp, tauto},
end

lemma between_points_share_line (hAr : A ∈ r) (hCr : C ∈ r) :
	(A * B * C) → B ∈ r :=
begin
    intro H,
	have h := collinear_of_between H,
    rcases h with ⟨s, ⟨h1,h2,h3⟩⟩,
    have hAC : A ≠ C,
    {
        intro hAC,
        rw hAC at H,
        exact (no_point_between_a_point C B).mp H,
    },
    have htmp : r = s := equal_lines_of_contain_two_points hAC hAr h1 hCr h3,
    rw htmp,
    exact h2,
end

lemma between_points_share_line_v2 (hAr : A ∈ r) (hBr : B ∈ r) :
	(A * B * C) → C ∈ r :=
begin
    intro H,
	have h := collinear_of_between H,
    rcases h with ⟨s, ⟨h1,h2,h3⟩⟩,
    have htmp : r = s := equal_lines_of_contain_two_points (different_of_between H).1 hAr h1 hBr h2,
    rw htmp,
    exact h3,
end


import group_theory.subgroup
import data.set.finite
import group_theory.coset
import data.fintype.card
import data.set.finite
import tactic

open_locale classical big_operators
noncomputable theory
-- set_option profiler true

lemma prod_finset_distinct_inv {α : Type*} [comm_group α] {s : finset α} :
  (∀ x ∈ s, x⁻¹ ∈ s) → (∀ x ∈ s, x⁻¹ ≠ x) → (∏ x in s, x) = 1 :=
begin
apply finset.case_strong_induction_on s,
tauto,
intros a s a_notin_s H h1 h2,
specialize H (finset.erase s a⁻¹) (finset.erase_subset (a⁻¹) s),
have r : (∏ x in (finset.erase s a⁻¹), x) = 1,
{
  apply H,
  {
    intros x h,
    suffices : ¬x = a ∧ x⁻¹ ∈ s, by simpa,
    split,
    {
      have x_in_s : x ∈ s := finset.mem_of_mem_erase h,
      by_contradiction hc,
      subst hc,
      exact a_notin_s x_in_s,
    },
    suffices : x⁻¹ ≠ a, from finset.mem_of_mem_insert_of_ne (h1 x (finset.mem_insert_of_mem (finset.mem_of_mem_erase h))) this,
    by_contradiction hh,
    push_neg at hh,
    induction hh,
    simpa using finset.ne_of_mem_erase h,
  },
  {
    intros x h,
    apply h2,
    exact finset.mem_insert_of_mem (finset.mem_of_mem_erase h)
  }
},
{
  rw finset.prod_insert a_notin_s,
  suffices hkey : (∏ x in s, x) = a⁻¹,
  exact mul_eq_one_iff_inv_eq.mpr (eq.symm hkey),
  have ainv_notin_s1 : a⁻¹ ∉ finset.erase s a⁻¹ := finset.not_mem_erase a⁻¹ s,
  have ainv_in_s : a⁻¹ ∈ s,
  {
    have ainv_in_s1 : a⁻¹ ∈ insert a s := h1 a (finset.mem_insert_self a s),
    suffices : a⁻¹ ≠ a, from finset.mem_of_mem_insert_of_ne ainv_in_s1 this,
    exact h2 a (finset.mem_insert_self a s)
  },
  {
    rw [←finset.insert_erase ainv_in_s,finset.prod_insert ainv_notin_s1,r],
    exact mul_one a⁻¹
  },
},
end

lemma prod_eq_one_of_non_twotorsion {G : Type*} [comm_group G] [fintype G] : (∏ g in {x : G | x ≠ x⁻¹ }.to_finset, g) = 1 :=
begin
  apply prod_finset_distinct_inv;
  finish,
end

def two_torsion_subgroup (G : Type*) [comm_group G] : subgroup G :=
{ carrier := {z : G | z * z = 1},
  one_mem' := by simp,
  mul_mem' := λ a b (ha : a * a = 1) (hb : b * b = 1),
  begin
    dsimp at *,
    rw [mul_mul_mul_comm a b a b, ha, hb],
    refine mul_one 1,
  end,
  inv_mem' := λ a (ha : a * a = 1), by {tidy, rw mul_inv_eq_one, refine inv_eq_of_mul_eq_one ha}
}

lemma mem_two_torsion_iff_square_eq_one (G : Type*) [comm_group G] :
∀ x : G, x ∈ two_torsion_subgroup G ↔ x * x = 1 :=
begin
  intro x,
  refl,
end

lemma twotorsion_disjoint_non_twotorsion {G : Type*} [comm_group G]:
disjoint {x : G | x ∈ two_torsion_subgroup G} {x : G | x ≠ x⁻¹} :=
begin
    intros x hx,
    cases hx with h1 h2,
    have hA : x * x = 1, by assumption,
    suffices hB : x * x ≠ 1, by exact h2 (false.rec (x = x⁻¹) (hB hA)),
    simpa [← mul_eq_one_iff_eq_inv] using h2,
end

lemma prod_all_eq_prod_two_torsion {G : Type*} [comm_group G] [fintype G]:
(∏ g : G, g) = (∏ g : two_torsion_subgroup G, g) :=
begin
    have H : (∏ (g : G), g) = (∏ x in {x : G | x ∈ two_torsion_subgroup G}.to_finset, x)
            * (∏ x in {x : G | x ≠ x⁻¹ }.to_finset, x),
    {
        rw ← finset.prod_union,
        {
            congr, ext, safe,
            suffices hh : a ∈ two_torsion_subgroup G, tauto,
            have a2: a * a = 1 := eq_inv_iff_mul_eq_one.mp h,
            tauto,
        },
        {
            apply finset.disjoint_iff_disjoint_coe.2,
            simpa using twotorsion_disjoint_non_twotorsion,
        },
    },
    {
        simp [H, prod_eq_one_of_non_twotorsion],
        apply finset.prod_subtype,
        finish,
    },
end

lemma two_products_id {α: Type*} {s : set α} [fintype s] [comm_monoid α] {t : finset α}
 (h: ∀ x, x ∈ s ↔ x ∈ t) : (∏ g : s, ↑g) = (∏ g in t, g) :=
begin
refine finset.prod_bij (λ x _, x.1) _ _ _ _,
{
  intros a ha,
  specialize h a,
  apply h.mp,
  exact subtype.mem a,
},
{
  intros a ha,
  refl,
},
{
  intros a1 a2 h1 h2,
  exact subtype.eq,
},
{
  intros b hb,
  specialize h b,
  use b,
  rw h,
  exact hb,
  split,
  apply finset.mem_univ,
  exact rfl,
}
end

lemma two_products {α β: Type*} {s : set α} [fintype s] [comm_monoid β] {t : finset α} {f : α → β}
 (h: ∀ x, x ∈ s ↔ x ∈ t) : (∏ g : s, f g) = (∏ g in t, f g) :=
begin
refine finset.prod_bij (λ x _, x.1) _ _ _ _,
{
  intros a ha,
  specialize h a,
  apply h.mp,
  exact subtype.mem a,
},
{
  intros a ha,
  refl,
},
{
  intros a1 a2 h1 h2,
  exact subtype.eq,
},
{
  intros b hb,
  specialize h b,
  use b,
  rw h,
  exact hb,
  split,
  apply finset.mem_univ,
  exact rfl,
}
end

lemma prod_all_eq_prod_two_torsion' {G : Type*} [comm_group G] [fintype G]:
(∏ g : G, g) =  (∏ g in ((two_torsion_subgroup G) : set G).to_finset, g) :=
begin
  rw prod_all_eq_prod_two_torsion,
  have h : ((two_torsion_subgroup G) : set G).to_finset = (two_torsion_subgroup G).carrier.to_finset,
  {
      refl,
  },
  apply two_products_id,
  finish,
end

variables {G : Type*} [comm_group G] [fintype G]

/-
If a is a subgroup of G[2] and x ∈ G[2], then a ∪ x *l a is a subgroup.
-/
def insert_twotors_to_twotors {x : G} {a : subgroup G}
  (hx : x * x = 1) (ha : ∀ g : G, g ∈ a → g * g = 1) : subgroup G :=
{
  carrier := ↑a ∪ left_coset x a,
  one_mem' := or.inl (subgroup.one_mem a),
  mul_mem' :=
  begin
    intros u v hu hv,
    --rcases? hu hv,-- with ⟨ hu1, hu2⟩ | ⟨  hv1, hv2⟩ ,
    cases hv with hv1 hv2,
    repeat {cases hu with hu1 hu2},
    {
      exact or.inl (subgroup.mul_mem a hu1 hv1),
    },
    {
      right,
      rw [mem_left_coset_iff, ←mul_assoc],
      rw mem_left_coset_iff at hu2,
      exact subgroup.mul_mem a hu2 hv1,
    },
    {
      right,
      rw [mul_comm, mem_left_coset_iff, ←mul_assoc],
      rw mem_left_coset_iff at hv2,
      exact subgroup.mul_mem a hv2 hu1,
    },
    {
      left,
      rw mem_left_coset_iff at hu2 hv2,
      have H : x⁻¹ * x⁻¹ * u * v ∈ a,
      {
          norm_num at hu2 hv2 ⊢,
          rw [mul_comm, mul_assoc, ←mul_assoc v _, mul_comm v _],
          exact subgroup.mul_mem a hv2 hu2,
      },
      have x_eq_xinv : x = x⁻¹ := eq_inv_of_mul_eq_one hx,
      rw [←x_eq_xinv, hx, one_mul] at H,
      exact H,
    }
  end,
  inv_mem' :=
  begin
      intros u hu,
      cases hu with hu1 hu2, by exact or.inl (subgroup.inv_mem a hu1),
      {
          right,
          rw mem_left_coset_iff at hu2 ⊢,
          norm_num at hu2 ⊢,
          rw [←subgroup.inv_mem_iff, mul_inv, inv_inv, inv_inv],
          have x_eq_xinv : x = x⁻¹ := eq_inv_of_mul_eq_one hx,
          rw ←x_eq_xinv at hu2,
          exact hu2,
      }
  end
}
/--
If g ∈ G[2] and a ≤ G[2], then a ∪ g l* a ⊆ G[2].
--/
lemma twotorsion_contains_a_and_ga {g : G} {a : subgroup G}
  (h₁ : g * g = 1) (h₂ : ∀ (x : G), x ∈ a → x * x = 1) :
    ↑a ∪ left_coset g ↑a ⊆ {x : G | x * x = 1} :=
begin
  -- prove that twotorsion(G) ⊇ a u ga
  intros x hx,
  by_cases (x ∈ a), tauto,
  have H : (x ∈ left_coset g a),
  {
      rw set.mem_union at hx,
      norm_cast at hx,
      tauto,
  },
  suffices x_is_twotors : x * x = 1, by tauto,
  clear hx h,
  have H2 : ∀ (x : G), x ∈ a → x * x = 1, by tauto,
  rw mem_left_coset_iff at H,
  specialize H2  (g⁻¹ * x) H,
  have H3 : g = g⁻¹ := eq_inv_of_mul_eq_one h₁,
  by calc
  x * x = g * g * x * x : by simp only [h₁, one_mul]
  ...   = g⁻¹ * g⁻¹ * x * x : by rw ← H3
  ...   = g⁻¹ * x * g⁻¹ * x : by rw mul_right_comm g⁻¹ g⁻¹ x
  ...   = g⁻¹ * x * (g⁻¹ * x) : by exact mul_assoc (g⁻¹ * x) g⁻¹ x
  ...   = 1 : by exact H2,
end

/--
Suppose a ≤ G[2], and g ∉ a.
Then if x ∈ G[2] and x ∉ g l* a,
then g ∉ ⟨ x, a ⟩.
--/
lemma g_notin_xua {x g: G} {a : subgroup G}
  (hg : g ∉ a)
  (hx : x * x = 1)
  (ha : ∀ y : G, y ∈ a → y * y = 1)
  (hgx : x ∉ left_coset g ↑a) :
    (g ∉ insert_twotors_to_twotors hx ha) :=
begin
  by_contradiction cont,
  cases cont,
  by contradiction,
  {
      rw mem_left_coset_iff at *,
      suffices : g⁻¹ * x ∈ ↑a, by solve_by_elim,
      norm_num at *,
      rw [←subgroup.inv_mem_iff, mul_inv, mul_comm, inv_inv],
      exact cont,
  }
end

/--
If x ∈ G[2] and a ≤ G[2], then ⟨ x, a ⟩ ≤ G[2].
--/
lemma xua_twotors {x : G} {a : subgroup G}
  (hx : x * x = 1)
  (ha : ∀ y : G, y ∈ a → y * y = 1) :
    (∀ (y : G), y ∈ (insert_twotors_to_twotors hx ha) → y * y = 1) :=
begin
  intros y hy,
  let xua := insert_twotors_to_twotors hx ha,
  have hxinxua : ∀ y : G, y ∈ xua ↔ (y ∈ ↑a ∨ y ∈ left_coset x a) := λ _, iff_of_eq rfl,
  rw hxinxua at hy,
  cases hy, by exact ha y hy,
  {
    rw mem_left_coset_iff at hy,
    have HH : ∃ w ∈ a, x⁻¹ * y = w, by tauto,
    rcases HH with ⟨ w ,⟨ hw1, hw2⟩⟩,
    have hhy : y = x * w := eq_mul_of_inv_mul_eq hw2,
    calc
    y * y = (x * w) * (x * w): congr (congr_arg has_mul.mul hhy) hhy
    ...   = (x * x) * (w * w): mul_mul_mul_comm x w x w
    ...   = w * w : mul_left_eq_self.mpr hx
    ...   = 1      : ha w hw1,
  }
end

/--
G[2] ≤ ⟨g, a⟩
--/
lemma twotorsion_containedin_a_union_ga {g : G} {a : subgroup G}
      (h₁ : g * g = 1) (h₂ : ∀ (x : G), x ∈ a → x * x = 1)
      (hga : g ∉ a)
      (hmax : ∀ (a' : subgroup G), g ∉ a' → (∀ (x : G), x ∈ a' → x * x = 1) → a ≤ a' → a = a') :
      {x : G | x * x = 1} ⊆ ↑a ∪ left_coset g ↑a :=
begin
  -- Prove that twotorsion(G) ⊆ a u ga
  intros x hx,
  dsimp at hx,
  by_contradiction h,
  rw set.mem_union at h,
  push_neg at h,
  let xua := insert_twotors_to_twotors hx h₂,
  have hxinxua : ∀ y : G, y ∈ xua ↔ (y ∈ ↑a ∨ y ∈ left_coset x a) := λ _, iff_of_eq rfl,
  have g_notin_xua : g ∉ xua, by exact g_notin_xua hga hx h₂ h.right,
  have h_twotors : (∀ (y : G), y ∈ xua → y * y = 1), by exact xua_twotors hx h₂,
  have a_eq_xua : a = xua := hmax xua g_notin_xua h_twotors (λ y hy, or.inl hy),
  have x_in_a : x ∈ a,
  {
      norm_num at *,
      rw [a_eq_xua, hxinxua, mem_left_coset_iff],
      right,
      simp only [mul_left_inv],
      exact subgroup.one_mem a
  },
  norm_num at h,
  have hl := h.left,
  trivial,
end

instance finite_sgp : fintype (subgroup G) :=
  fintype.of_injective (coe : subgroup G → set G) set_like.coe_injective

-- given G two torsion and 1 ≠ g ∈ G, there is H < G of index 2 with g ∉ H
lemma element_avoidance {g : G}  (h₁ : g ≠ 1) (h₂ : g * g = 1):
 ∃ (H : subgroup G),
  (g ∉ H ∧
  (∀ (x : G), x ∈ H → x * x = 1) ∧
  {x : G | x * x = 1} = H ∪ (left_coset g H))
  :=
begin
    let s := {X : subgroup G | g ∉ X ∧ (∀ x : G, x ∈ X → x*x = 1)},
    have sfin : s.finite := set.finite.of_fintype _,
    have snonempty : set.nonempty s,
    {
        use ⊥,
        split,
        exact h₁,
        intros x hx,
        rw subgroup.mem_bot at hx,
        rw hx,
        exact mul_one 1,
    },
    let existsH := set.finite.exists_maximal_wrt id s sfin snonempty,
    simp only [and_imp, exists_prop, id.def, set.mem_set_of_eq] at existsH,
    cases existsH with a ha,
    use a,
    repeat {split},
    exact ha.1.1,
    exact ha.1.2,
    -- We have defined a as the maximal subgroup of G satisfying
    -- 1) g ∉ a
    -- 2) ∀ x ∈ a, x*x = 1
    -- Now we must show that a ∪ ga = twotorsion(G)
    apply set.subset.antisymm,
    apply twotorsion_containedin_a_union_ga h₂ ha.1.2 ha.1.1 ha.2,
    exact twotorsion_contains_a_and_ga h₂ ha.1.2,
end

lemma disjoint_cosets {g : G} {a : subgroup G} (hga : g ∉ a) : disjoint ↑a (left_coset g ↑a) :=
begin
    rintros x ⟨ h1, ⟨ w ,⟨ hw1, hw2⟩⟩⟩,
    suffices H : g ∈ a, by solve_by_elim,
    rw eq_mul_inv_of_mul_eq hw2,
    exact subgroup.mul_mem a h1 (subgroup.inv_mem a hw1),
end

lemma prod_square_eq_one {H : subgroup G} (h: ∀ (x : G), x ∈ H → x * x = 1) :
    (∏ (x : H), ↑x) * (∏ (x : H), ↑x) = (1 : G) :=
begin
    rw ←finset.prod_mul_distrib,
    norm_cast at *,
    simp,
    have h' : (∏ x : H, (1 : G)) = (1:G) := fintype.prod_eq_one (λ (a : ↥H), 1) (congr_fun rfl),
    rw_mod_cast ←h',
    clear h',
    apply finset.prod_congr, refl,
    intros x hx,
    specialize h x,
    apply h,
    cases x,
    assumption
end

lemma prod_square_eq_one' {H : subgroup G} (h: ∀ (x : G), x ∈ H → x * x = 1) :
    (∏ (x : G) in (H : set G).to_finset, x) * (∏ (x : G) in (H : set G).to_finset, x) = (1 : G) :=
begin
    rw ←two_products_id,
    apply prod_square_eq_one h,
    finish,
end

lemma fintype_card_eq_finset_card : fintype.card G =
       finset.card (((⊤ : subgroup G) : set G).to_finset):=
begin
    unfold fintype.card,
    congr,
    simp [subgroup.coe_top],
    convert set.to_finset_univ.symm,
end

lemma prod_over_left_coset {g : G} {H : subgroup G} :
    ∏ x in (left_coset g ↑H).to_finset, x  =
    g^(finset.card (H : set G).to_finset) * (∏ x in (H : set G).to_finset, x) :=
begin
    have h : ∏ x in (left_coset g ↑H).to_finset, x  = ∏ x in (H : set G).to_finset, (g * x),
    {
        unfold left_coset,
        --λ x : G, g * x,
        simp [finset.prod_image],
        unfold_coes,
        have hinj : ∀ (x : G), x ∈ (H : set G).to_finset → ∀ (y : G), y ∈ (H : set G).to_finset → g * x = g * y → x = y,
        {
            intros x hx y hy hg,
            exact (mul_right_inj g).mp hg,
        },
        convert finset.prod_image hinj,
        ext1,
        norm_num,
        split,
        {
          intros,
          use g⁻¹ * a,
          finish,
        },
        {
          intro h,
          obtain ⟨b,⟨hb1,hb2⟩⟩ := h,
          subst hb2,
          simp at *,
          tauto,
        }
    },
    rw [h, finset.prod_mul_distrib],
    simp only [finset.prod_const],
end

lemma prod_identity {g : G} (h₁ : ∀ x : G, x * x = 1) (h₂ : g ≠ 1):
 ((∏ x : G, x) : G)= g^(fintype.card G / 2 : ℕ) :=
begin
    rw_mod_cast prod_all_eq_prod_two_torsion',
    have existsH := element_avoidance h₂ (h₁ g),
    rcases existsH with ⟨H, ⟨ hgH, hHtors, h_index2⟩⟩,
    have hdisj : disjoint (H : set G) (left_coset g ↑H) := disjoint_cosets hgH,
    have hdisj' : disjoint (H : set G).to_finset (left_coset g ↑H).to_finset,
    {
        intros x hx,
        simp only [finset.inf_eq_inter, set.mem_to_finset, finset.mem_inter] at hx,
        apply hdisj hx,
    },
    have all_twotors : (two_torsion_subgroup G) = ⊤,
    {
        unfold two_torsion_subgroup,
        ext1,
        tauto,
    },
    have dec : ∀ x : G, x ∈ ((H : set G) ∪ left_coset g ↑H),
    {
        intro x,
        specialize h₁ x,
        rw ←h_index2,
        assumption,
    },
    have dec' : (H : set G).to_finset ∪ ((left_coset g ↑H).to_finset) = ((⊤ : subgroup G) : set G).to_finset,
    {
        ext1,
        split;
        finish,
    },
    have p2 : ((∏ (x : G) in (two_torsion_subgroup G : set G).to_finset, x) : G) = ((∏ x in (↑H : set G).to_finset, x) : G) * (∏ x in (left_coset g ↑H).to_finset, x ),
    {
        convert finset.prod_union hdisj',
        rw dec',
        congr,
        exact all_twotors,
    },
    have p3 : fintype.card G = 2 * finset.card (H : set G).to_finset,
    {
        have h' : finset.card (H : set G).to_finset = finset.card (left_coset g H).to_finset,
        {
            clear hdisj hdisj' p2 h₁ h₂ hHtors all_twotors,
            have hinj : function.injective (λ (x : G), g*x),
            {
                unfold function.injective,
                intros x y hxy,
                exact (mul_right_inj g).mp hxy,
            },
            rw ←finset.card_image_of_injective ((H : set G).to_finset) hinj,
            congr,
            ext,
            simp,
            split;
            { exact id },
        },
        suffices h1 : fintype.card G = finset.card (H : set G).to_finset + finset.card (left_coset g H).to_finset, by linarith,
        have h2 : finset.card ((H : set G).to_finset ∪ (left_coset g H).to_finset)
            = finset.card (H : set G).to_finset + finset.card (left_coset g H).to_finset, by apply finset.card_disjoint_union hdisj',
        rw ←h2,
        convert fintype_card_eq_finset_card,
    },
    have p3' : fintype.card G / 2 = finset.card (H : set G).to_finset, by finish,
    rw [p3', p2, prod_over_left_coset, mul_comm, mul_assoc, mul_right_eq_self],
    suffices p4 : (∏ (x : G) in (H : set G).to_finset, x) * (∏ (x : G) in (H : set G).to_finset, x) = (1 : G), by assumption,
    solve_by_elim,
end

theorem two_torsion_subgroup_idem (G : Type*) [comm_group G] :
  two_torsion_subgroup (two_torsion_subgroup G) = ⊤ :=
begin
    apply eq_top_iff.2,
    intros x hx,
    apply subtype.eq,
    apply x.2,
end

instance subgroup.coe_is_monoid_hom {G : Type*} [group G] (H : subgroup G) :
    is_monoid_hom (coe : H → G) := by refine {..}; intros; refl

lemma prod_identity_general' {g : two_torsion_subgroup G} (h : g ≠ 1):
 (∏ x : G, x) = g^(fintype.card (two_torsion_subgroup G) / 2) :=
 begin
    have h1: (g : G) ≠ 1,
    {
        cases g,
        finish,
    },
    rw prod_all_eq_prod_two_torsion,
    let G2 := two_torsion_subgroup G,
    have htors : ∀ (x : G2),  x * x = 1,
    {
        intro x,
        rw ←mem_two_torsion_iff_square_eq_one,
        rw two_torsion_subgroup_idem,
        solve_by_elim,
    },
    norm_cast,
    rw ←prod_identity htors h,
    apply finset.prod_hom,
end

theorem prod_identity_general {g : G} (h1 : g ≠ 1) (h2 : g * g = 1) :
 (∏ x : G, x) = g^(fintype.card (two_torsion_subgroup G) / 2) :=
 begin
    suffices hg : (⟨ g, h2⟩  : two_torsion_subgroup G) ≠ 1, by exact prod_identity_general' hg,
    intro h, injections_and_clear, tauto,
 end


import data.set
import data.finset
import tactic

attribute [instance] classical.prop_decidable

open set finset

namespace finset

lemma inj_range {α} (S : finset α)
: ∃ (f : α → ℕ), (∀ x ∈ S, f x < card S) ∧ (∀ x ∈ S, ∀ y ∈ S, f x = f y → x = y) :=
begin
  induction S using finset.induction with x S' hasnt ih,
  use (λ y, 0), tauto,
  rcases ih with ⟨f, ih1, ih2⟩,
  set f' := λ y, if y = x then card S' else f y with f'eq,
  use f',
  split, {
    intros y yin,
    rw finset.mem_insert at yin,
    cases yin, {
      rw [yin, card_insert_of_not_mem hasnt],
      dsimp only [f'],
      simp,
    }, {
      specialize ih1 y yin,
      have neq : x ≠ y, by_contradiction, push_neg at a, rw a at hasnt, tauto,
      dsimp only [f'],
      have eqfalse : y = x ↔ false, tauto,
      rw eqfalse, simp,
      linarith [card_insert_of_not_mem hasnt],
    },
  }, {
    intros y₁ yin₁ y₂ yin₂, contrapose, intro neq,
    by_cases h₁ : y₁ = x, {
      rw h₁ at yin₁,
      by_cases h₂ : y₂ = x, {
        rw [h₁, h₂] at neq, tauto,
      }, {
        rw finset.mem_insert at yin₁,
        dsimp only [f'],
        have eqfalse : y₂ = x ↔ false, tauto,
        rw [h₁, eqfalse],
        simp,
        rw finset.mem_insert at yin₂,
        cases yin₂, tauto,
        linarith [ih1 y₂ yin₂],
      }
    }, {
      rw finset.mem_insert at yin₁,
      cases yin₁, tauto,
      have eqfalse : y₁ = x ↔ false, tauto,
      by_cases h₂ : y₂ = x, {
        dsimp only [f'],
        rw [eqfalse, h₂], simp,
        linarith [ih1 y₁ yin₁],
      }, {
        rw finset.mem_insert at yin₂, cases yin₂, tauto,
        have eqfalse₂ : y₂ = x ↔ false, tauto,
        dsimp only [f'], rw [eqfalse, eqfalse₂], simp,
        have ih2' := ih2 y₁ yin₁ y₂ yin₂,
        tauto,
      }
    }
  },
end

lemma range_sup (f : ℕ → ℕ) (n m : ℕ) (him : ∀ (x : ℕ), x < n → f x < m)
: (finset.image f (range n)).card ≤ m :=
begin
  have g : m = (range m).card, simp,
  rw g,
  have g' : image f (range n) ⊆ range m,
    rw subset_iff, intros x xin,
    simp, simp at xin,
    rcases xin with ⟨y, hlt, hfeq⟩,
    specialize him y hlt, rw hfeq at him, assumption,
  exact card_le_of_subset g',
end

end finset


-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que en los retículos se verifica que
--    (x ⊔ y) ⊔ z = x ⊔ (y ⊔ z)
-- ---------------------------------------------------------------------

import order.lattice

variables {α : Type*} [lattice α]
variables x y z : α

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

example : (x ⊔ y) ⊔ z = x ⊔ (y ⊔ z) :=
begin
  have h1 : (x ⊔ y) ⊔ z ≤ x ⊔ (y ⊔ z),
    { have h1a : x ⊔ y ≤ x ⊔ (y ⊔ z), by finish,
      have h1b : z ≤ x ⊔ (y ⊔ z), by finish,
      show (x ⊔ y) ⊔ z ≤ x ⊔ (y ⊔ z),
        by exact sup_le h1a h1b, },
  have h2 : x ⊔ (y ⊔ z) ≤ (x ⊔ y) ⊔ z,
    { have h2a : x ≤ (x ⊔ y) ⊔ z, by finish,
      have h2b : y ⊔ z ≤ (x ⊔ y) ⊔ z, by finish,
      show x ⊔ (y ⊔ z) ≤ (x ⊔ y) ⊔ z,
        by exact sup_le h2a h2b, },
  show (x ⊔ y) ⊔ z = x ⊔ (y ⊔ z),
    by exact le_antisymm h1 h2,
end

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

example : (x ⊔ y) ⊔ z = x ⊔ (y ⊔ z) :=
begin
  have h1 : (x ⊔ y) ⊔ z ≤ x ⊔ (y ⊔ z),
    { have h1a : x ⊔ y ≤ x ⊔ (y ⊔ z),
        { have h1a1 : x ≤ x ⊔ (y ⊔ z) :=
            le_sup_left,
          have h1a2 : y ≤ x ⊔ (y ⊔ z), calc
            y ≤ y ⊔ z         : le_sup_left
            ... ≤ x ⊔ (y ⊔ z) : le_sup_right,
          show x ⊔ y ≤ x ⊔ (y ⊔ z),
            by exact sup_le h1a1 h1a2, },
      have h1b : z ≤ x ⊔ (y ⊔ z), calc
        z   ≤ y ⊔ z       : le_sup_right
        ... ≤ x ⊔ (y ⊔ z) : le_sup_right,
      show (x ⊔ y) ⊔ z ≤ x ⊔ (y ⊔ z),
        by exact sup_le h1a h1b, },
  have h2 : x ⊔ (y ⊔ z) ≤ (x ⊔ y) ⊔ z,
    { have h2a : x ≤ (x ⊔ y) ⊔ z, calc
        x   ≤ x ⊔ y       : le_sup_left
        ... ≤ (x ⊔ y) ⊔ z : le_sup_left,
      have h2b : y ⊔ z ≤ (x ⊔ y) ⊔ z,
        { have h2b1 : y ≤ (x ⊔ y) ⊔ z, calc
            y   ≤ x ⊔ y       : le_sup_right
            ... ≤ (x ⊔ y) ⊔ z : le_sup_left,
          have h2b2 : z ≤ (x ⊔ y) ⊔ z :=
            le_sup_right,
          show y ⊔ z ≤ (x ⊔ y) ⊔ z,
            by exact sup_le h2b1 h2b2, },
      show x ⊔ (y ⊔ z) ≤ (x ⊔ y) ⊔ z,
        by exact sup_le h2a h2b, },
  show (x ⊔ y) ⊔ z = x ⊔ (y ⊔ z),
    by exact le_antisymm h1 h2,
end

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

example : (x ⊔ y) ⊔ z = x ⊔ (y ⊔ z) :=
begin
  apply le_antisymm,
  { apply sup_le,
    { apply sup_le le_sup_left (le_sup_of_le_right le_sup_left)},
    { apply le_sup_of_le_right le_sup_right}},
  { apply sup_le,
    { apply le_sup_of_le_left le_sup_left},
    { apply sup_le (le_sup_of_le_left le_sup_right) le_sup_right}},
end

-- Su desarrollo es
--
-- ⊢ x ⊔ y ⊔ z = x ⊔ (y ⊔ z)
--    apply le_antisymm,
-- | ⊢ x ⊔ y ⊔ z ≤ x ⊔ (y ⊔ z)
-- |    { apply sup_le,
-- | | ⊢ x ⊔ y ≤ x ⊔ (y ⊔ z)
-- | |     { apply sup_le le_sup_left (le_sup_right_of_le le_sup_left)},
-- | | ⊢ z ≤ x ⊔ (y ⊔ z)
-- | |     { apply le_sup_right_of_le le_sup_right}},
-- | ⊢ x ⊔ (y ⊔ z) ≤ x ⊔ y ⊔ z
-- |    { apply sup_le,
-- | | ⊢ x ≤ x ⊔ y ⊔ z
-- | |      { apply le_sup_left_of_le le_sup_left},
-- | | ⊢ y ⊔ z ≤ x ⊔ y ⊔ z
-- | |      { apply sup_le (le_sup_left_of_le le_sup_right) le_sup_right}},
-- no goals

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

example : (x ⊔ y) ⊔ z = x ⊔ (y ⊔ z) :=
le_antisymm
  (sup_le
    (sup_le le_sup_left (le_sup_of_le_right le_sup_left))
    (le_sup_of_le_right le_sup_right))
  (sup_le
    (le_sup_of_le_left le_sup_left)
    (sup_le (le_sup_of_le_left le_sup_right) le_sup_right))

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

example : x ⊔ y ⊔ z = x ⊔ (y ⊔ z) :=
-- by library_search
sup_assoc

-- 6ª demostración
-- ===============

example : x ⊔ y ⊔ z = x ⊔ (y ⊔ z) :=
-- by hint
by finish


/-
Various lemmas intended for mathlib.
Some parts of this file are originally from
https://github.com/johoelzl/mathlib/blob/c9507242274ac18defbceb917f30d6afb8b839a5/src/measure_theory/measurable_space.lean

Authors: Johannes Holzl, John Tristan, Koundinya Vajjha
-/
import tactic.tidy
import measure_theory.giry_monad measure_theory.integration measure_theory.borel_space .dvector
import .probability_theory
import analysis.complex.exponential

local attribute [instance] classical.prop_decidable

noncomputable theory

-- set_option pp.implicit true
-- set_option pp.coercions true
-- set_option trace.class_instances true
-- set_option class.instance_max_depth 39

-- local attribute [instance] classical.prop_decidable

universes u v

open nnreal measure_theory nat list measure_theory.measure set lattice ennreal measurable_space probability_measure

infixl ` >>=ₐ `:55 :=  measure.bind
infixl ` <$>ₐ `:55 := measure.map

local notation `doₐ` binders ` ←ₐ ` m ` ; ` t:(scoped p, m >>=ₐ p) := t

local notation `ret` := measure.dirac

namespace to_integration
variables {α : Type u} {β : Type u}

-- Auxilary results about simple functions and characteristic functions. The results in this section should go into integration.lean in mathlib.

@[simp] lemma integral_sum [measurable_space α] (m : measure α) (f g : α → ennreal) [hf : measurable f] [hg : measurable g] : m.integral (f + g) = m.integral f + m.integral g := begin
  rw [integral, integral, integral,←lintegral_add], refl,
  repeat{assumption},
end

@[simp] lemma integral_const_mul [measurable_space α] (m : measure α) {f : α → ennreal} (hf : measurable f) (k:ennreal): m.integral (λ x, k*f(x)) = k * m.integral f :=
by rw [integral,lintegral_const_mul,integral] ; assumption

/-- The characteristic function (indicator function) of a set A. -/
noncomputable def char_fun [measurable_space α] (A : set α) := simple_func.restrict (simple_func.const α (1 : ennreal)) A

notation `χ` `⟦` A `⟧` := char_fun A
notation `∫` f `ð`m := integral m f

-- variables (A : set α) (a : α) [measurable_space α]

@[simp] lemma char_fun_apply [measurable_space α] {A : set α} (hA : is_measurable A)(a : α):
(χ ⟦A⟧ : simple_func α ennreal) a = ite (a ∈ A) 1 0 := by
unfold_coes ; apply (simple_func.restrict_apply _ hA)

@[simp] lemma integral_char_fun [measurable_space α] [ne : nonempty α] (m : measure α) {A : set α} (hA : is_measurable A) :
(∫ χ⟦A⟧ ðm) = m A :=
begin
   rw [char_fun, integral, simple_func.lintegral_eq_integral, simple_func.restrict_integral],
   unfold set.preimage, dsimp, erw [simple_func.range_const α], simp, rw [←set.univ_def, set.univ_inter], refl, assumption,
end

lemma dirac_char_fun [measurable_space α] {A : set α} (hA : is_measurable A) : (λ (x : α), (ret x : measure α) A) = χ⟦A⟧ :=
begin
  funext,rw [measure.dirac_apply _ hA, char_fun_apply hA],
  by_cases x ∈ A, split_ifs, simp [h],
  split_ifs, simp [h],
end

lemma prob.dirac_char_fun [measurable_space α] {B: set α} (hB : is_measurable B) : (λ x:α,((retₚ x).to_measure : measure α) B) = χ⟦B⟧ :=
begin
  conv {congr, funext, rw ret_to_measure},
  exact dirac_char_fun hB,
end

lemma measurable_dirac_fun [measurable_space α] {A : set α} (hA : is_measurable A) : measurable (λ (x : α), (ret x : measure α) A) := by rw dirac_char_fun hA ; apply simple_func.measurable

instance simple_func.add_comm_monoid [measurable_space α] [add_comm_monoid β] : add_comm_monoid (simple_func α β) :=
{
  add_comm := assume a b, simple_func.ext (assume a, add_comm _ _),
  .. simple_func.add_monoid
}

lemma integral_finset_sum [measurable_space α] (m : measure α) (s : finset (set α))
(hX : ∀ (A : set α) , is_measurable (A)) :
m.integral (s.sum (λ A, χ ⟦ A ⟧)) = s.sum (λ A, m A) :=
begin
  rw integral,
  refine finset.induction_on s _ _,
  { simp, erw lintegral_zero },
  { assume a s has ih, simp [has], erw [lintegral_add],
  rw simple_func.lintegral_eq_integral,unfold char_fun,
  erw simple_func.restrict_const_integral, dsimp, rw ih, ext1,cases a_1, dsimp at *, simp at *, refl, exact(hX a),
  { intros i h, dsimp at *, solve_by_elim [hX] },
  { intros a b, dsimp at *, solve_by_elim },
  },
end

lemma integral_le_integral [measurable_space α] (m : measure α) (f g : α → ennreal) (h : f ≤ g) :
(∫ f ðm) ≤ (∫ g ðm) :=
begin
rw integral, rw integral, apply lintegral_le_lintegral, assumption,
end

noncomputable def char_prod [measurable_space α]{f : α → ennreal}{ε : ennreal}(hf : measurable f)(eh : ε > 0): simple_func α ennreal :=
⟨
  λ x, if (f(x) ≥ ε) then ε else 0,
  assume x, by letI : measurable_space ennreal := borel ennreal; exact
   measurable.if (measurable_le measurable_const hf) measurable_const measurable_const _ (is_measurable_of_is_closed is_closed_singleton),
  begin apply finite_subset (finite_union (finite_singleton ε) ((finite_singleton 0))),
  rintro _ ⟨a, rfl⟩,
  by_cases (f a ≥ ε); simp [h],
  end
⟩

@[simp] lemma char_prod_apply [measurable_space α]{f : α → ennreal}{ε : ennreal}(hf : measurable f)(eh : ε > 0) (a : α): (char_prod hf eh) a = if (f a ≥ ε) then ε else 0 := rfl

/-- Markov's inequality. -/
theorem measure_fun_ge_le_integral [measurable_space α] [nonempty α] (m : measure α) {f : α → ennreal} (hf : measurable f) : ∀ (ε > 0),
 ε*m({x | f(x) ≥ ε}) ≤ ∫ f ðm :=
begin
  intros ε eh,
  let s := char_prod hf eh,
  have hsf : ∀ x, s x ≤ f x, {
  intro x,
  by_cases g : (f(x) ≥ ε),
  dsimp [s], split_ifs, exact g,
  dsimp [s], split_ifs, exact zero_le (f x),
  },
  convert (integral_le_integral _ _ _ hsf),
  have seq : s = (simple_func.const α ε) * (χ ⟦{x : α | f x ≥ ε} ⟧),{
  apply simple_func.ext,
  intro a, simp * at *,
  dunfold char_fun,
  rw [simple_func.restrict_apply, simple_func.const_apply],
  split_ifs, rw mul_one, rw mul_zero,
  apply (@measurable_le ennreal α _ _), exact measurable_const, assumption,
  },
  rw seq, simp, rw [integral_const_mul m, integral_char_fun],
  apply (@measurable_le ennreal α _ _), exact measurable_const, assumption,
  apply simple_func.measurable,
end

/-- Chebyshev's inequality for a nondecreasing function `g`. -/
theorem measure_fun_ge_le_integral_comp [measurable_space α][nonempty α] (m : measure α) {f : α → ennreal} {g : ennreal → ennreal}(hf : measurable f) (hg : measurable g) (nondec : ∀ x y,x ≤ y → g x ≤ g y): ∀ (t > 0),
 g(t)*m({x | f(x) ≥ t}) ≤ ∫ g ∘ f ðm :=
begin
  intros t ht,
  have hsf : ∀ x, g(t) * (χ ⟦{x : α | f x ≥ t} ⟧ x) ≤ (g (f x)), {
  intro x,
  dunfold char_fun,
  rw [simple_func.restrict_apply, simple_func.const_apply],
  split_ifs,
  rw [mul_one], apply (@nondec _ _ h),
  finish,
  apply (@measurable_le ennreal α _ _), exact measurable_const, assumption,
  },
  rw [←integral_char_fun, ←integral_const_mul m],
  apply (integral_le_integral m),
  exact hsf,
  apply simple_func.measurable,
  apply (@measurable_le ennreal α _ _), exact measurable_const, assumption,
end

end to_integration

namespace giry_pi
-- Auxilary results about infinite products of measure spaces.
-- This section has to go back to `constructions` in `measure_theory/measurable_space`. Originally from Johannes' fork.

instance pi.measurable_space (ι : Type*) (α : ι → Type*) [m : ∀i, measurable_space (α i)] :
  measurable_space (Πi, α i) :=
⨆i, (m i).comap (λf, f i)

instance pi.measurable_space_Prop (ι : Prop) (α : ι → Type*) [m : ∀i, measurable_space (α i)] :
  measurable_space (Πi, α i) :=
⨆i, (m i).comap (λf, f i)

lemma measurable_pi {ι : Type*} {α : ι → Type*} {β : Type*}
  [m : ∀i, measurable_space (α i)] [measurable_space β] {f : β → Πi, α i} :
  measurable f ↔ (∀i, measurable (λb, f b i)):=
begin
  rw [measurable, pi.measurable_space, supr_le_iff],
  refine forall_congr (assume i, _),
  rw [measurable_space.comap_le_iff_le_map, measurable_space.map_comp],
  refl
end

lemma measurable_apply {ι : Type*} {α : ι → Type*} {β : Type*}
  [m : ∀i, measurable_space (α i)] [measurable_space β] (f : β → Πi, α i) (i : ι)
  (hf : measurable f) :
  measurable (λb, f b i) :=
measurable_pi.1 hf _

lemma measurable_pi_Prop {ι : Prop} {α : ι → Type*} {β : Type*}
  [m : ∀i, measurable_space (α i)] [measurable_space β] {f : β → Πi, α i} :
  measurable f ↔ (∀i, measurable (λb, f b i)):=
begin
  rw [measurable, pi.measurable_space_Prop, supr_le_iff],
  refine forall_congr (assume i, _),
  rw [measurable_space.comap_le_iff_le_map, measurable_space.map_comp],
  refl
end

lemma measurable_apply_Prop {p : Prop} {α : p → Type*} {β : Type*}
  [m : ∀i, measurable_space (α i)] [measurable_space β] (f : β → Πi, α i) (h : p)
  (hf : measurable f) :
  measurable (λb, f b h) :=
measurable_pi_Prop.1 hf _

end giry_pi

section giry_prod

open to_integration

variables {α : Type u} {β : Type u} {γ : Type v}

/- Auxilary results about the Giry monad and binary products. The following results should go back to giry_monad.lean -/

/-- Right identity monad law for the Giry monad. -/
lemma giry.bind_return_comp [measurable_space α][measurable_space β] (D : measure α) {p : α → β} (hp : measurable p) :
(doₐ (x : α) ←ₐ D ;
 ret (p x)) = p <$>ₐ D :=
measure.ext $ assume s hs, begin
  rw [measure.bind_apply hs _],
  rw [measure.map_apply hp hs],
  conv_lhs{congr, skip, funext, rw [measure.dirac_apply _ hs]},
  transitivity,
  apply lintegral_supr_const, exact hp _ hs,
   rw one_mul, refl,
  exact measurable.comp measurable_dirac hp,
end

/-- Left identity monad law for compositions in the Giry monad -/
lemma giry.return_bind_comp [measurable_space α][measurable_space β] {p : α → measure β} {f : α → α} (hf : measurable f)(hp : measurable p) (a : α) :
 (doₐ x ←ₐ dirac a ; p (f x))  = p (f a) :=
measure.ext $ assume s hs, begin
rw measure.bind_apply hs, rw measure.integral_dirac a,
swap, exact measurable.comp hp hf,
exact measurable.comp (measurable_coe hs) (measurable.comp hp hf),
end

def prod_measure [measurable_space α][measurable_space β] (μ : measure α) (ν : measure β) : measure (α × β) :=
doₐ x ←ₐ μ ;
doₐ y ←ₐ ν ;
  ret (x, y)

infixl ` ⊗ₐ `:55 :=  prod_measure

instance prod.measure_space [measurable_space α] [measurable_space β] (μ : measure α) (ν : measure β) : measure_space (α × β) := ⟨ μ ⊗ₐ ν ⟩

lemma inl_measurable [measurable_space α][measurable_space β] : ∀ y : β, measurable (λ x : α, (x,y)) := assume y, begin
apply measurable.prod, dsimp, exact measurable_id, dsimp, exact measurable_const,
end

lemma inr_measurable [measurable_space α][measurable_space β] : ∀ x : α, measurable (λ y : β, (x,y)) := assume y, begin
apply measurable.prod, dsimp, exact measurable_const, dsimp, exact measurable_id,
end

lemma inl_measurable_dirac [measurable_space α][measurable_space β]  : ∀ y : β,  measurable (λ (x : α), ret (x, y)) := assume y, begin
  apply measurable_of_measurable_coe,
  intros s hs,
  simp [hs, lattice.supr_eq_if, mem_prod_eq],
  apply measurable_const.if _ measurable_const,
  apply measurable.preimage _ hs,
  apply measurable.prod, dsimp, exact measurable_id,
  dsimp, exact measurable_const,
end

lemma inr_measurable_dirac [measurable_space β][measurable_space α] : ∀ x : α,  measurable (λ (y : β), ret (x, y)) := assume x, begin
  apply measurable_of_measurable_coe,
  intros s hs,
  simp [hs, lattice.supr_eq_if, mem_prod_eq],
  apply measurable_const.if _ measurable_const, apply measurable.preimage _ hs,
  apply measurable.prod, dsimp, exact measurable_const,
  dsimp, exact measurable_id,
end

lemma inr_section_is_measurable [measurable_space α] [measurable_space β]  {E : set (α × β)} (hE : is_measurable E) (x : α) :
is_measurable ({ y:β | (x,y) ∈ E}) :=
begin
  change (is_measurable ((λ z:β, (x,z))⁻¹' E)),
  apply inr_measurable, assumption,
end

lemma inl_section_is_measurable [measurable_space α] [measurable_space β]  {E : set (α × β)} (hE : is_measurable E) (y : β) :
is_measurable ({ x:α | (x,y) ∈ E}) :=
begin
  change (is_measurable ((λ z:α, (z,y))⁻¹' E)),
  apply inl_measurable, assumption,
end

lemma snd_comp_measurable [measurable_space α] [measurable_space β] [measurable_space γ] {f : α × β → γ} (hf : measurable f) (x : α) : measurable (λ y:β, f (x, y)) := (measurable.comp hf (inr_measurable _))

lemma fst_comp_measurable [measurable_space α] [measurable_space β] [measurable_space γ] {f : α × β → γ} (hf : measurable f) (y : β) : measurable ((λ x:α, f (x, y))) := (measurable.comp hf (inl_measurable _))

lemma measurable_pair_iff [measurable_space α] [measurable_space β] [measurable_space γ] (f : γ → α × β) :
measurable f ↔ (measurable (prod.fst ∘ f) ∧ measurable (prod.snd ∘ f)) :=
iff.intro
(assume h, and.intro (measurable_fst h) (measurable_snd h))
(assume ⟨h₁, h₂⟩, measurable.prod h₁ h₂)

@[simp] lemma dirac.prod_apply [measurable_space α][measurable_space β]{A : set α} {B : set β} (hA : is_measurable A) (hB : is_measurable B) (a : α) (b : β) :
 (ret (a,b) : measure (α × β)) (A.prod B) = ((ret a : measure α) A) * ((ret b : measure β) B) :=
begin
  rw [dirac_apply, dirac_apply, dirac_apply, mem_prod_eq],
  dsimp,
  by_cases Ha: (a ∈ A); by_cases Hb: (b ∈ B),
  repeat {simp [Ha, Hb]},
  repeat {assumption},
  exact is_measurable_set_prod hA hB,
end

lemma prod.bind_ret_comp [measurable_space α] [measurable_space β]
(μ : measure α) : ∀ y : β,
(doₐ (x : α) ←ₐ μ;
 ret (x,y)) = (λ x, (x,y)) <$>ₐ μ := assume y, begin apply  giry.bind_return_comp, apply measurable.prod, dsimp, exact measurable_id,
dsimp, exact measurable_const, end

-- TODO(Kody) : move this back to mathlib/measurable_space.lean
lemma measure_rect_generate_from [measurable_space α] [measurable_space β] : prod.measurable_space = generate_from {E | ∃ (A : set α) (B : set β), E = A.prod B ∧ is_measurable A ∧ is_measurable B} :=
begin
rw eq_iff_le_not_lt,
split,
  {
  apply generate_from_le_generate_from, intros s hs,
  rcases hs with ⟨A₀, hA, rfl⟩ | ⟨B₀, hB, rfl⟩,
  existsi [A₀, univ],
  fsplit, ext1, cases x, simp, exact and.intro hA is_measurable.univ,
  existsi [univ, B₀],
  fsplit, ext1, cases x, simp, exact and.intro is_measurable.univ hB,
  },
  {
  apply not_lt_of_le,
  apply measurable_space.generate_from_le,
  intros t ht, dsimp at ht, rcases ht with ⟨A, B, rfl, hA, hB⟩, exact is_measurable_set_prod hA hB,
  }
end

def measurable_prod_bind_ret [measurable_space α] [measurable_space β] (ν : probability_measure β): set(α × β) → Prop := λ s, measurable (λ (x : α), (doₚ (y : β) ←ₚ ν ; retₚ (x, y)) s)

lemma measure_rect_inter [measurable_space α] [measurable_space β] : ∀t₁ t₂, t₁ ∈ {E | ∃ (A : set α) (B : set β), E = A.prod B ∧ is_measurable A ∧ is_measurable B} → t₂ ∈ {E | ∃ (A : set α) (B : set β), E = A.prod B ∧ is_measurable A ∧ is_measurable B} → t₁ ∩ t₂ ≠ ∅ → t₁ ∩ t₂ ∈ {E | ∃ (A : set α) (B : set β), E = A.prod B ∧ is_measurable A ∧ is_measurable B} :=
begin
  rintros t₁ t₂ ⟨A, B, rfl, hA, hB⟩ ⟨A', B', rfl, hA', hB'⟩ hI,
  rw prod_inter_prod,
  existsi [(A ∩ A'),(B ∩ B')],
  fsplit, refl,
  exact and.intro (is_measurable.inter hA hA') (is_measurable.inter hB hB'),
end

lemma measurable_prod_bind_ret_empty [measurable_space α] [measurable_space β] (ν : probability_measure β): measurable (λ (x : α), (doₚ (y : β) ←ₚ ν ; retₚ (x, y)) ∅):=
by simp ; exact measurable_const

lemma measurable_prod_bind_ret_compl [measurable_space α] [measurable_space β] (ν : probability_measure β) :  ∀ t : set (α × β), is_measurable t → measurable (λ (x : α), (doₚ (y : β) ←ₚ ν ; retₚ (x, y)) t) → measurable (λ (x : α), (doₚ (y : β) ←ₚ ν ; retₚ (x, y)) (- t)) :=
begin
  intros t ht hA,
  rw compl_eq_univ_diff,
  conv{congr, funext, rw [probability_measure.prob_diff _ (subset_univ _) is_measurable.univ ht]}, simp,
  refine measurable.comp _ hA,
  refine measurable.comp _ (measurable_sub measurable_const _),
  exact measurable_of_real,
  exact measurable_of_continuous nnreal.continuous_coe,
end

lemma measurable_prod_bind_ret_basic [measurable_space α] [measurable_space β] (ν : probability_measure β) : ∀ (t : set (α × β)),t ∈ {E : set (α × β) | ∃ (A : set α) (B : set β), E = set.prod A B ∧ is_measurable A ∧ is_measurable B} → measurable (λ (x : α), (doₚ (y : β) ←ₚ ν ; retₚ (x, y)) t) :=
begin
  rintros t ⟨A, B, rfl, hA, hB⟩,
  conv{congr,funext,rw [_root_.bind_apply (is_measurable_set_prod hA hB)  (prob_inr_measurable_dirac x)],},
  refine measurable.comp _ _, exact measurable_to_nnreal,
  dsimp,
  conv{congr,funext,simp [coe_eq_to_measure]},
  simp [prob.dirac_apply' hA hB],
  have h : measurable (λ (x : β), ((retₚ x).to_measure : measure β) B),{
  conv{congr,funext,rw ret_to_measure,}, exact measurable_dirac_fun hB,
  },
  conv {congr, funext, rw [integral_const_mul ν.to_measure h],},
  refine measurable_mul _ _, conv{congr,funext, rw [ret_to_measure],},exact measurable_dirac_fun hA,
  exact measurable_const,
end

lemma measurable_prod_bind_ret_union [measurable_space α] [measurable_space β] (ν : probability_measure β): ∀h:ℕ → set (α × β), (∀i j, i ≠ j → h i ∩ h j ⊆ ∅) → (∀i, is_measurable (h i)) → (∀i, measurable(λ (x : α), (doₚ (y : β) ←ₚ ν ; retₚ (x, y)) (h i))) → measurable (λ (x : α), (doₚ (y : β) ←ₚ ν ; retₚ (x, y)) (⋃i, h i)) :=
begin
  rintros h hI hA hB,
  unfold_coes,
  refine measurable.comp (measurable_of_measurable_nnreal measurable_id) _,
  conv{congr,funext,rw [m_Union _ hA hI,ennreal.tsum_eq_supr_nat]},
  apply measurable.supr, intro i,
  apply measurable_finset_sum,
  intros i,
  have h := hB i, clear hB,
  refine measurable_of_ne_top _ _ _, assume x,
  refine probability_measure.to_measure_ne_top _ _, assumption,
end

-- Push this back to ennreal.lean
lemma to_nnreal_mul (a b : ennreal) : ennreal.to_nnreal(a*b) = ennreal.to_nnreal(a) * ennreal.to_nnreal(b) :=
begin
  cases a; cases b,
  { simp [none_eq_top] },
  { by_cases h : b = 0; simp [none_eq_top, some_eq_coe, h, top_mul] },
  { by_cases h : a = 0; simp [none_eq_top, some_eq_coe, h, mul_top] },
  { simp [some_eq_coe, coe_mul.symm, -coe_mul] }
end

@[simp] theorem prod.prob_measure_apply [measurable_space α] [measurable_space β][nonempty α] [nonempty β] (μ : probability_measure α) (ν : probability_measure β) {A : set α} {B : set β}
(hA : is_measurable A) (hB : is_measurable B) :
(μ ⊗ₚ ν) (A.prod B) = μ (A) * ν (B) :=
begin
  dunfold prod.prob_measure,
  rw _root_.bind_apply (is_measurable_set_prod hA hB),
  conv_lhs{congr, congr, skip, funext, erw [_root_.bind_apply ( is_measurable_set_prod hA hB) (prob_inr_measurable_dirac a)]},
  simp[coe_eq_to_measure, prob.dirac_apply' hA hB],
  -- move this to probability_theory
  have h : measurable (λ (x : β), ((retₚ x).to_measure : measure β) B),
  {
    conv{congr,funext,rw ret_to_measure,},
    exact measurable_dirac_fun hB,
  },
  conv {congr, funext, congr, congr, skip, funext, rw [integral_const_mul ν.to_measure h,ret_to_measure,mul_comm],},
  rw [prob.dirac_char_fun hB, integral_char_fun ν.to_measure hB],
  -- move this to measurable_space
  have g : ∀ a:α, ((ret a : measure α) A) < ⊤,
  {
    assume a, rw dirac_apply _ hA, by_cases(a ∈ A),
    simp[h],exact lt_top_iff_ne_top.2 one_ne_top,
    simp[h], exact lt_top_iff_ne_top.2 zero_ne_top,
  },
  conv_lhs{congr, congr, skip, funext, rw [coe_to_nnreal (lt_top_iff_ne_top.1 (mul_lt_top (to_measure_lt_top _ _) (g a)))]},
  conv_lhs{congr, rw [integral_const_mul μ.to_measure (measurable_dirac_fun hA)]},
  rw [dirac_char_fun hA, integral_char_fun _ hA, mul_comm, to_nnreal_mul], refl,
  apply prob.measurable_of_measurable_coe,
  exact (
    @induction_on_inter _
    (measurable_prod_bind_ret ν)
    ({E | ∃ (A : set α) (B : set β), (E = A.prod B) ∧ is_measurable A ∧ is_measurable B})
    _ measure_rect_generate_from measure_rect_inter (measurable_prod_bind_ret_empty ν) (measurable_prod_bind_ret_basic ν) (measurable_prod_bind_ret_compl ν) (measurable_prod_bind_ret_union ν)
    ),
end

end giry_prod

section fubini

variables {α : Type u} {β : Type u} [measure_space α] [measure_space β]

open to_integration

local notation  `∫` f `𝒹`m := integral m.to_measure f

lemma integral_char_rect [measurable_space α] [measurable_space β] [n₁ : nonempty α] [n₂ : nonempty β](μ : probability_measure α) (ν : probability_measure β)  {A : set α} {B : set β} (hA : is_measurable A) (hB : is_measurable B) :
(∫ χ ⟦ A.prod B ⟧ 𝒹(μ ⊗ₚ ν)) = (μ A) * (ν B) :=
begin
  haveI := (nonempty_prod.2 (and.intro n₁ n₂)),
  rw [integral_char_fun _ (is_measurable_set_prod hA hB),←coe_eq_to_measure,
  (prod.prob_measure_apply _ _ hA hB)], simp,
end

end fubini

section prod_measure_measurable

/-
This section aims to prove `measurable (λ x : α , f x ⊗ₚ g x)` using Dynkin's π-λ theorem.
Push this back to giry_monad.lean
-/

variables {α : Type u} {β : Type u} {γ : Type u}

def measurable_prod_measure_pred [measurable_space α] [measurable_space β] [measurable_space γ] {f : α → probability_measure β} {g : α → probability_measure γ} (hf : measurable f) (hg : measurable g) : set (β × γ) → Prop := λ s : set (β × γ), measurable (λ b:α,(f b ⊗ₚ g b) s)

lemma measurable_rect_empty {γ : Type u} [measurable_space α] [measurable_space β] [measurable_space γ] {f : α → probability_measure β} {g : α → probability_measure γ} (hf : measurable f) (hg : measurable g): measurable (λ b:α,(f b ⊗ₚ g b) ∅) :=
by simp ; exact measurable_const

lemma measure_rect_union {γ : Type u} [measurable_space α] [measurable_space β] [measurable_space γ] (f : α → probability_measure β) (g : α → probability_measure γ) : ∀h:ℕ → set (β × γ), (∀i j, i ≠ j → h i ∩ h j ⊆ ∅) → (∀i, is_measurable (h i)) → (∀i, measurable (λ b:α,(f b ⊗ₚ g b) (h i))) → measurable (λ b:α,(f b ⊗ₚ g b) (⋃i, h i)) :=
begin
  rintros h hI hA hB,
  unfold_coes,
  conv{congr,funext,rw [m_Union _ hA hI]},
  dsimp,
  conv{congr,funext,rw ennreal.tsum_eq_supr_nat,},
  refine measurable.comp measurable_to_nnreal _,
  apply measurable.supr, intro i,
  apply measurable_finset_sum, assume i,
  refine measurable_of_ne_top _ _ _, assume a,
  refine probability_measure.to_measure_ne_top _ _, solve_by_elim,
end

lemma measurable_rect_compl {γ : Type u} [measurable_space α] [measurable_space β] [measurable_space γ](f : α → probability_measure β) (g : α → probability_measure γ) :  ∀ t : set (β × γ), is_measurable t → measurable (λ b:α,(f b ⊗ₚ g b) t) → measurable (λ b:α,(f b ⊗ₚ g b) (- t)) :=
begin
  intros t ht hA,
  rw compl_eq_univ_diff,
  conv{congr, funext, rw [probability_measure.prob_diff _ (subset_univ _) is_measurable.univ ht]}, simp,
  refine measurable.comp _ hA,
  refine measurable.comp _ (measurable_sub measurable_const _),
  exact measurable_of_real,
  exact measurable_of_continuous nnreal.continuous_coe,
end

-- Move back to Giry monad
lemma measurable_measure_kernel [measurable_space α] [measurable_space β] {f : α → measure β} {A : set β} (hf : measurable f) (hA : is_measurable A) : measurable (λ a, f a A) :=
 measurable.comp (measurable_coe hA) hf

lemma measurable_rect_basic {γ : Type u} [measurable_space α] [measurable_space β] [measurable_space γ] [nonempty β] [nonempty γ] {f : α → probability_measure β} {g : α → probability_measure γ} (hf : measurable f) (hg : measurable g) : ∀ (t : set (β × γ)),t ∈ {E : set (β × γ) | ∃ (A : set β) (B : set γ), E = set.prod A B ∧ is_measurable A ∧ is_measurable B} → measurable (λ b:α,(f b ⊗ₚ g b) t) :=
begin
  rintros t ⟨A, B, rfl, hA, hB⟩,
  simp [prod.prob_measure_apply _ _ hA hB],
  exact measure_theory.measurable_mul (prob.measurable_measure_kernel hf hA) (prob.measurable_measure_kernel hg hB),
end

theorem measurable_pair_measure {γ : Type u} [measurable_space α] [measurable_space β] [measurable_space γ] [nonempty β] [nonempty γ]{f : α → probability_measure β} {g : α → probability_measure γ} (hf : measurable f) (hg : measurable g) : measurable (λ x : α , f x ⊗ₚ g x) :=
begin
  apply prob.measurable_of_measurable_coe,
  exact
  @induction_on_inter _
  (measurable_prod_measure_pred hf hg)
  ({E | ∃ (A : set β) (B : set γ), (E = A.prod B) ∧ is_measurable A ∧ is_measurable B}) _
  (measure_rect_generate_from)  (measure_rect_inter) (measurable_rect_empty hf hg) (measurable_rect_basic hf hg) (measurable_rect_compl f g)   (measure_rect_union f g),
end

end prod_measure_measurable

section giry_vec
/-
Auxilary lemmas about vectors as iterated binary prodcuts.
-/
variable {α : Type u}

def vec : Type u → ℕ → Type u
| A 0 := A
| A (succ k) := A × vec A k

@[simp] def kth_projn : Π {n}, vec α n → dfin (succ n) → α
| 0 x  _             := x
| (succ n) x dfin.fz := x.fst
| (succ n) (x,xs) (dfin.fs k) := kth_projn xs k

def vec.set_prod {n : ℕ}(A : set α) (B : set (vec α n)) : set (vec α (succ n)) :=
do l ← A, xs ← B, pure $ (l,xs)

instance nonempty.vec [nonempty α] : ∀ n, nonempty (vec α n) :=
λ n,
begin
induction n with k ih,
rwa vec,
rw vec, apply nonempty_prod.2, exact (and.intro _inst_1 ih)
end

instance vec.measurable_space (n : ℕ) [m : measurable_space α]: measurable_space (vec α n) :=
begin
  induction n with k ih, exact m,
  rw vec,
  exact (m.comap prod.fst ⊔ ih.comap prod.snd)
end

noncomputable def vec.prod_measure [measurable_space α] (μ : probability_measure α)
: Π n : ℕ, probability_measure (vec α n)
| 0 := μ
| (succ k) := doₚ x ←ₚ μ ;
        doₚ xs ←ₚ (vec.prod_measure k);
        retₚ (x,xs)

instance vec.measure_space  [measurable_space α] (μ : probability_measure α) : Π n:ℕ, measure_space (vec α n)
| 0 := ⟨ μ.to_measure ⟩
| (succ k) := ⟨ (vec.prod_measure μ _).to_measure ⟩

-- Why doesn't refl work here?!
@[simp] lemma vec.prod_measure_eq (n : ℕ) [measurable_space α](μ : probability_measure α) :
(vec.prod_measure μ (n+1)) = μ ⊗ₚ (vec.prod_measure μ n)
:=
by dunfold vec.prod_measure;refl

lemma vec.inl_measurable [measurable_space α] (n : ℕ): ∀ xs : vec α n, measurable (λ x : α, (x, xs)) := inl_measurable

lemma vec.inr_measurable [measurable_space α] (n : ℕ): ∀ x : α, measurable (λ xs : vec α n,(x,xs)) := inr_measurable

lemma vec.dirac_prod_apply [measurable_space α]{A : set α} {n : ℕ} {B : set (vec α n)} (hA : is_measurable A) (hB : is_measurable B) (a : α) (as : vec α n) :
(ret (a,as) : measure (vec α (succ n))) (A.prod B) = ((ret a : measure α) A) * ((ret as : measure (vec α n)) B) := dirac.prod_apply hA hB _ _

@[simp] lemma vec.prod_measure_apply {n : ℕ} [measurable_space α][nonempty α] (μ : probability_measure α) (ν : probability_measure (vec α n)) {A : set α} {B : set (vec α n)}
(hA : is_measurable A) (hB : is_measurable B) :
(μ ⊗ₚ ν) (A.prod B) = μ (A) * ν (B) := prod.prob_measure_apply _ _ hA hB

def vec_map {α: Type} {β: Type} (f: α → β): Π n: ℕ, vec α n → vec β n
| 0 := λ x, f x
| (nat.succ n) := λ v, (f v.fst,vec_map n v.snd)

lemma kth_projn_map_comm {α: Type} {β: Type}:
  ∀ f: α → β,
  ∀ n: ℕ, ∀ v: vec α n,
  ∀ i: dfin (succ n),
  f (kth_projn v i) = kth_projn (vec_map f n v) i :=
begin
  intros f n,
  induction n; intros,
  {
    dunfold vec_map,
    cases i, simp,
    refl,
  },
  {
    cases v,
    cases i,
    {
      simp, dunfold vec_map, simp,
    },
    {
      simp,rw n_ih, refl,
    }
  }
end

lemma measurable_map {α: Type} {β: Type} [measurable_space α] [measurable_space β]:
  ∀ n: ℕ,
  ∀ f: α → β,
  measurable f →
  measurable (vec_map f n) :=
begin
  intros,
  induction n,
  {
    intros,
    dunfold vec_map,
    assumption,
  },
  {
    intros,
    dunfold vec_map,
    apply measurable.prod; simp,
    {
      apply measurable.comp,
      assumption,
      apply measurable_fst,
      apply measurable_id,
    },
    {
      apply measurable.comp,
      assumption,
      apply measurable_snd,
      apply measurable_id,
    }
  },
end

end giry_vec

section hoeffding_aux
open complex real

lemma abs_le_one_iff_ge_neg_one_le_one {x : ℝ} : (complex.abs x ≤ 1) ↔ (-1 ≤ x ∧ x ≤ 1) := by rw abs_of_real ; apply abs_le

lemma abs_neg_exp_sub_one_le_double {x : ℝ} (h₁ : complex.abs x ≤ 1)(h₂ : x ≥ 0): complex.abs(exp(-x) - 1) ≤ 2*x :=
calc
complex.abs(exp(-x) - 1)
  ≤ 2*complex.abs(-x) : @abs_exp_sub_one_le (-x) ((complex.abs_neg x).symm ▸ h₁)
... = 2*complex.abs(x)  : by rw (complex.abs_neg x)
... = 2*x               : by rw [abs_of_real,((abs_eq h₂).2)]; left; refl

lemma neg_exp_ge {x : ℝ} (h₀ : 0 ≤ x) (h₁ : x ≤ 1) : 1 - 2 * x ≤ exp (-x)
:=
begin
have h : -(2*x) ≤ exp(-x) -1, {
  apply (abs_le.1 _).left,
  rw ←abs_of_real, simp [-add_comm, -sub_eq_add_neg],
  apply abs_neg_exp_sub_one_le_double _ h₀, rw abs_le_one_iff_ge_neg_one_le_one, split, linarith, assumption,
  },
  linarith,
end

end hoeffding_aux

instance : conditionally_complete_linear_order nnreal :=
{
 Sup := Sup,
  Inf     := Inf,
  le_cSup := assume s a x has, le_cSup x has,
  cSup_le := assume s a hs h,show Sup ((coe : nnreal → ℝ) '' s) ≤ a, from
  cSup_le (by simp [hs]) $ assume r ⟨b, hb, eq⟩, eq ▸ h _ hb,
  cInf_le := assume s a x has, cInf_le x has,
  le_cInf := assume s a hs h, show (↑a : ℝ) ≤ Inf ((coe : nnreal → ℝ) '' s), from
  le_cInf (by simp [hs]) $ assume r ⟨b, hb, eq⟩, eq ▸ h _ hb,
 decidable_le := begin assume x y, apply classical.dec end,
 .. nnreal.linear_ordered_semiring,
 .. lattice.lattice_of_decidable_linear_order,
 .. nnreal.lattice.order_bot
}


/-
Copyright (c) 2019 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.filter.basic
import Mathlib.PostPort

universes u v w x u_1 u_2

namespace Mathlib

/-!
# Minimum and maximum w.r.t. a filter and on a aet

## Main Definitions

This file defines six predicates of the form `is_A_B`, where `A` is `min`, `max`, or `extr`,
and `B` is `filter` or `on`.

* `is_min_filter f l a` means that `f a ≤ f x` in some `l`-neighborhood of `a`;
* `is_max_filter f l a` means that `f x ≤ f a` in some `l`-neighborhood of `a`;
* `is_extr_filter f l a` means `is_min_filter f l a` or `is_max_filter f l a`.

Similar predicates with `_on` suffix are particular cases for `l = 𝓟 s`.

## Main statements

### Change of the filter (set) argument

* `is_*_filter.filter_mono` : replace the filter with a smaller one;
* `is_*_filter.filter_inf` : replace a filter `l` with `l ⊓ l'`;
* `is_*_on.on_subset` : restrict to a smaller set;
* `is_*_on.inter` : replace a set `s` wtih `s ∩ t`.

### Composition

* `is_*_*.comp_mono` : if `x` is an extremum for `f` and `g` is a monotone function,
  then `x` is an extremum for `g ∘ f`;
* `is_*_*.comp_antimono` : similarly for the case of monotonically decreasing `g`;
* `is_*_*.bicomp_mono` : if `x` is an extremum of the same type for `f` and `g`
  and a binary operation `op` is monotone in both arguments, then `x` is an extremum
  of the same type for `λ x, op (f x) (g x)`.
* `is_*_filter.comp_tendsto` : if `g x` is an extremum for `f` w.r.t. `l'` and `tendsto g l l'`,
  then `x` is an extremum for `f ∘ g` w.r.t. `l`.
* `is_*_on.on_preimage` : if `g x` is an extremum for `f` on `s`, then `x` is an extremum
  for `f ∘ g` on `g ⁻¹' s`.

### Algebraic operations

* `is_*_*.add` : if `x` is an extremum of the same type for two functions,
  then it is an extremum of the same type for their sum;
* `is_*_*.neg` : if `x` is an extremum for `f`, then it is an extremum
  of the opposite type for `-f`;
* `is_*_*.sub` : if `x` is an a minimum for `f` and a maximum for `g`,
  then it is a minimum for `f - g` and a maximum for `g - f`;
* `is_*_*.max`, `is_*_*.min`, `is_*_*.sup`, `is_*_*.inf` : similarly for `is_*_*.add`
  for pointwise `max`, `min`, `sup`, `inf`, respectively.

### Miscellaneous definitions

* `is_*_*_const` : any point is both a minimum and maximum for a constant function;
* `is_min/max_*.is_ext` : any minimum/maximum point is an extremum;
* `is_*_*.dual`, `is_*_*.undual`: conversion between codomains `α` and `dual α`;

## Missing features (TODO)

* Multiplication and division;
* `is_*_*.bicompl` : if `x` is a minimum for `f`, `y` is a minimum for `g`, and `op` is a monotone
  binary operation, then `(x, y)` is a minimum for `uncurry (bicompl op f g)`. From this point of view,
  `is_*_*.bicomp` is a composition
* It would be nice to have a tactic that specializes `comp_(anti)mono` or `bicomp_mono`
  based on a proof of monotonicity of a given (binary) function. The tactic should maintain a `meta`
  list of known (anti)monotone (binary) functions with their names, as well as a list of special
  types of filters, and define the missing lemmas once one of these two lists grows.
-/

/-! ### Definitions -/

/-- `is_min_filter f l a` means that `f a ≤ f x` in some `l`-neighborhood of `a` -/
def is_min_filter {α : Type u} {β : Type v} [preorder β] (f : α → β) (l : filter α) (a : α) :=
  filter.eventually (fun (x : α) => f a ≤ f x) l

/-- `is_max_filter f l a` means that `f x ≤ f a` in some `l`-neighborhood of `a` -/
def is_max_filter {α : Type u} {β : Type v} [preorder β] (f : α → β) (l : filter α) (a : α) :=
  filter.eventually (fun (x : α) => f x ≤ f a) l

/-- `is_extr_filter f l a` means `is_min_filter f l a` or `is_max_filter f l a` -/
def is_extr_filter {α : Type u} {β : Type v} [preorder β] (f : α → β) (l : filter α) (a : α) :=
  is_min_filter f l a ∨ is_max_filter f l a

/-- `is_min_on f s a` means that `f a ≤ f x` for all `x ∈ a`. Note that we do not assume `a ∈ s`. -/
def is_min_on {α : Type u} {β : Type v} [preorder β] (f : α → β) (s : set α) (a : α) :=
  is_min_filter f (filter.principal s) a

/-- `is_max_on f s a` means that `f x ≤ f a` for all `x ∈ a`. Note that we do not assume `a ∈ s`. -/
def is_max_on {α : Type u} {β : Type v} [preorder β] (f : α → β) (s : set α) (a : α) :=
  is_max_filter f (filter.principal s) a

/-- `is_extr_on f s a` means `is_min_on f s a` or `is_max_on f s a` -/
def is_extr_on {α : Type u} {β : Type v} [preorder β] (f : α → β) (s : set α) (a : α) :=
  is_extr_filter f (filter.principal s) a

theorem is_extr_on.elim {α : Type u} {β : Type v} [preorder β] {f : α → β} {s : set α} {a : α} {p : Prop} : is_extr_on f s a → (is_min_on f s a → p) → (is_max_on f s a → p) → p :=
  or.elim

theorem is_min_on_iff {α : Type u} {β : Type v} [preorder β] {f : α → β} {s : set α} {a : α} : is_min_on f s a ↔ ∀ (x : α), x ∈ s → f a ≤ f x :=
  iff.rfl

theorem is_max_on_iff {α : Type u} {β : Type v} [preorder β] {f : α → β} {s : set α} {a : α} : is_max_on f s a ↔ ∀ (x : α), x ∈ s → f x ≤ f a :=
  iff.rfl

theorem is_min_on_univ_iff {α : Type u} {β : Type v} [preorder β] {f : α → β} {a : α} : is_min_on f set.univ a ↔ ∀ (x : α), f a ≤ f x :=
  iff.trans set.univ_subset_iff set.eq_univ_iff_forall

theorem is_max_on_univ_iff {α : Type u} {β : Type v} [preorder β] {f : α → β} {a : α} : is_max_on f set.univ a ↔ ∀ (x : α), f x ≤ f a :=
  iff.trans set.univ_subset_iff set.eq_univ_iff_forall

/-! ### Conversion to `is_extr_*` -/

theorem is_min_filter.is_extr {α : Type u} {β : Type v} [preorder β] {f : α → β} {l : filter α} {a : α} : is_min_filter f l a → is_extr_filter f l a :=
  Or.inl

theorem is_max_filter.is_extr {α : Type u} {β : Type v} [preorder β] {f : α → β} {l : filter α} {a : α} : is_max_filter f l a → is_extr_filter f l a :=
  Or.inr

theorem is_min_on.is_extr {α : Type u} {β : Type v} [preorder β] {f : α → β} {s : set α} {a : α} (h : is_min_on f s a) : is_extr_on f s a :=
  is_min_filter.is_extr h

theorem is_max_on.is_extr {α : Type u} {β : Type v} [preorder β] {f : α → β} {s : set α} {a : α} (h : is_max_on f s a) : is_extr_on f s a :=
  is_max_filter.is_extr h

/-! ### Constant function -/

theorem is_min_filter_const {α : Type u} {β : Type v} [preorder β] {l : filter α} {a : α} {b : β} : is_min_filter (fun (_x : α) => b) l a :=
  filter.univ_mem_sets' fun (_x : α) => le_refl ((fun (_x : α) => b) a)

theorem is_max_filter_const {α : Type u} {β : Type v} [preorder β] {l : filter α} {a : α} {b : β} : is_max_filter (fun (_x : α) => b) l a :=
  filter.univ_mem_sets' fun (_x : α) => le_refl ((fun (_x : α) => b) _x)

theorem is_extr_filter_const {α : Type u} {β : Type v} [preorder β] {l : filter α} {a : α} {b : β} : is_extr_filter (fun (_x : α) => b) l a :=
  is_min_filter.is_extr is_min_filter_const

theorem is_min_on_const {α : Type u} {β : Type v} [preorder β] {s : set α} {a : α} {b : β} : is_min_on (fun (_x : α) => b) s a :=
  is_min_filter_const

theorem is_max_on_const {α : Type u} {β : Type v} [preorder β] {s : set α} {a : α} {b : β} : is_max_on (fun (_x : α) => b) s a :=
  is_max_filter_const

theorem is_extr_on_const {α : Type u} {β : Type v} [preorder β] {s : set α} {a : α} {b : β} : is_extr_on (fun (_x : α) => b) s a :=
  is_extr_filter_const

/-! ### Order dual -/

theorem is_min_filter_dual_iff {α : Type u} {β : Type v} [preorder β] {f : α → β} {l : filter α} {a : α} : is_min_filter f l a ↔ is_max_filter f l a :=
  iff.rfl

theorem is_max_filter_dual_iff {α : Type u} {β : Type v} [preorder β] {f : α → β} {l : filter α} {a : α} : is_max_filter f l a ↔ is_min_filter f l a :=
  iff.rfl

theorem is_extr_filter_dual_iff {α : Type u} {β : Type v} [preorder β] {f : α → β} {l : filter α} {a : α} : is_extr_filter f l a ↔ is_extr_filter f l a :=
  or_comm (is_min_filter f l a) (is_max_filter f l a)

theorem is_max_filter.dual {α : Type u} {β : Type v} [preorder β] {f : α → β} {l : filter α} {a : α} : is_max_filter f l a → is_min_filter f l a :=
  iff.mpr is_min_filter_dual_iff

theorem is_max_filter.undual {α : Type u} {β : Type v} [preorder β] {f : α → β} {l : filter α} {a : α} : is_max_filter f l a → is_min_filter f l a :=
  iff.mp is_max_filter_dual_iff

theorem is_extr_filter.dual {α : Type u} {β : Type v} [preorder β] {f : α → β} {l : filter α} {a : α} : is_extr_filter f l a → is_extr_filter f l a :=
  iff.mpr is_extr_filter_dual_iff

theorem is_min_on_dual_iff {α : Type u} {β : Type v} [preorder β] {f : α → β} {s : set α} {a : α} : is_min_on f s a ↔ is_max_on f s a :=
  iff.rfl

theorem is_max_on_dual_iff {α : Type u} {β : Type v} [preorder β] {f : α → β} {s : set α} {a : α} : is_max_on f s a ↔ is_min_on f s a :=
  iff.rfl

theorem is_extr_on_dual_iff {α : Type u} {β : Type v} [preorder β] {f : α → β} {s : set α} {a : α} : is_extr_on f s a ↔ is_extr_on f s a :=
  or_comm (is_min_filter f (filter.principal s) a) (is_max_filter f (filter.principal s) a)

theorem is_max_on.dual {α : Type u} {β : Type v} [preorder β] {f : α → β} {s : set α} {a : α} : is_max_on f s a → is_min_on f s a :=
  iff.mpr is_min_on_dual_iff

theorem is_min_on.dual {α : Type u} {β : Type v} [preorder β] {f : α → β} {s : set α} {a : α} : is_min_on f s a → is_max_on f s a :=
  iff.mpr is_max_on_dual_iff

theorem is_extr_on.dual {α : Type u} {β : Type v} [preorder β] {f : α → β} {s : set α} {a : α} : is_extr_on f s a → is_extr_on f s a :=
  iff.mpr is_extr_on_dual_iff

/-! ### Operations on the filter/set -/

theorem is_min_filter.filter_mono {α : Type u} {β : Type v} [preorder β] {f : α → β} {l : filter α} {a : α} {l' : filter α} (h : is_min_filter f l a) (hl : l' ≤ l) : is_min_filter f l' a :=
  hl h

theorem is_max_filter.filter_mono {α : Type u} {β : Type v} [preorder β] {f : α → β} {l : filter α} {a : α} {l' : filter α} (h : is_max_filter f l a) (hl : l' ≤ l) : is_max_filter f l' a :=
  hl h

theorem is_extr_filter.filter_mono {α : Type u} {β : Type v} [preorder β] {f : α → β} {l : filter α} {a : α} {l' : filter α} (h : is_extr_filter f l a) (hl : l' ≤ l) : is_extr_filter f l' a :=
  or.elim h (fun (h : is_min_filter f l a) => is_min_filter.is_extr (is_min_filter.filter_mono h hl))
    fun (h : is_max_filter f l a) => is_max_filter.is_extr (is_max_filter.filter_mono h hl)

theorem is_min_filter.filter_inf {α : Type u} {β : Type v} [preorder β] {f : α → β} {l : filter α} {a : α} (h : is_min_filter f l a) (l' : filter α) : is_min_filter f (l ⊓ l') a :=
  is_min_filter.filter_mono h inf_le_left

theorem is_max_filter.filter_inf {α : Type u} {β : Type v} [preorder β] {f : α → β} {l : filter α} {a : α} (h : is_max_filter f l a) (l' : filter α) : is_max_filter f (l ⊓ l') a :=
  is_max_filter.filter_mono h inf_le_left

theorem is_extr_filter.filter_inf {α : Type u} {β : Type v} [preorder β] {f : α → β} {l : filter α} {a : α} (h : is_extr_filter f l a) (l' : filter α) : is_extr_filter f (l ⊓ l') a :=
  is_extr_filter.filter_mono h inf_le_left

theorem is_min_on.on_subset {α : Type u} {β : Type v} [preorder β] {f : α → β} {s : set α} {a : α} {t : set α} (hf : is_min_on f t a) (h : s ⊆ t) : is_min_on f s a :=
  is_min_filter.filter_mono hf (iff.mpr filter.principal_mono h)

theorem is_max_on.on_subset {α : Type u} {β : Type v} [preorder β] {f : α → β} {s : set α} {a : α} {t : set α} (hf : is_max_on f t a) (h : s ⊆ t) : is_max_on f s a :=
  is_max_filter.filter_mono hf (iff.mpr filter.principal_mono h)

theorem is_extr_on.on_subset {α : Type u} {β : Type v} [preorder β] {f : α → β} {s : set α} {a : α} {t : set α} (hf : is_extr_on f t a) (h : s ⊆ t) : is_extr_on f s a :=
  is_extr_filter.filter_mono hf (iff.mpr filter.principal_mono h)

theorem is_min_on.inter {α : Type u} {β : Type v} [preorder β] {f : α → β} {s : set α} {a : α} (hf : is_min_on f s a) (t : set α) : is_min_on f (s ∩ t) a :=
  is_min_on.on_subset hf (set.inter_subset_left s t)

theorem is_max_on.inter {α : Type u} {β : Type v} [preorder β] {f : α → β} {s : set α} {a : α} (hf : is_max_on f s a) (t : set α) : is_max_on f (s ∩ t) a :=
  is_max_on.on_subset hf (set.inter_subset_left s t)

theorem is_extr_on.inter {α : Type u} {β : Type v} [preorder β] {f : α → β} {s : set α} {a : α} (hf : is_extr_on f s a) (t : set α) : is_extr_on f (s ∩ t) a :=
  is_extr_on.on_subset hf (set.inter_subset_left s t)

/-! ### Composition with (anti)monotone functions -/

theorem is_min_filter.comp_mono {α : Type u} {β : Type v} {γ : Type w} [preorder β] [preorder γ] {f : α → β} {l : filter α} {a : α} (hf : is_min_filter f l a) {g : β → γ} (hg : monotone g) : is_min_filter (g ∘ f) l a :=
  filter.mem_sets_of_superset hf fun (x : α) (hx : x ∈ set_of fun (x : α) => (fun (x : α) => f a ≤ f x) x) => hg hx

theorem is_max_filter.comp_mono {α : Type u} {β : Type v} {γ : Type w} [preorder β] [preorder γ] {f : α → β} {l : filter α} {a : α} (hf : is_max_filter f l a) {g : β → γ} (hg : monotone g) : is_max_filter (g ∘ f) l a :=
  filter.mem_sets_of_superset hf fun (x : α) (hx : x ∈ set_of fun (x : α) => (fun (x : α) => f x ≤ f a) x) => hg hx

theorem is_extr_filter.comp_mono {α : Type u} {β : Type v} {γ : Type w} [preorder β] [preorder γ] {f : α → β} {l : filter α} {a : α} (hf : is_extr_filter f l a) {g : β → γ} (hg : monotone g) : is_extr_filter (g ∘ f) l a :=
  or.elim hf (fun (hf : is_min_filter f l a) => is_min_filter.is_extr (is_min_filter.comp_mono hf hg))
    fun (hf : is_max_filter f l a) => is_max_filter.is_extr (is_max_filter.comp_mono hf hg)

theorem is_min_filter.comp_antimono {α : Type u} {β : Type v} {γ : Type w} [preorder β] [preorder γ] {f : α → β} {l : filter α} {a : α} (hf : is_min_filter f l a) {g : β → γ} (hg : ∀ {x y : β}, x ≤ y → g y ≤ g x) : is_max_filter (g ∘ f) l a :=
  is_max_filter.comp_mono (is_min_filter.dual hf) fun (x y : order_dual β) (h : x ≤ y) => hg h

theorem is_max_filter.comp_antimono {α : Type u} {β : Type v} {γ : Type w} [preorder β] [preorder γ] {f : α → β} {l : filter α} {a : α} (hf : is_max_filter f l a) {g : β → γ} (hg : ∀ {x y : β}, x ≤ y → g y ≤ g x) : is_min_filter (g ∘ f) l a :=
  is_min_filter.comp_mono (is_max_filter.dual hf) fun (x y : order_dual β) (h : x ≤ y) => hg h

theorem is_extr_filter.comp_antimono {α : Type u} {β : Type v} {γ : Type w} [preorder β] [preorder γ] {f : α → β} {l : filter α} {a : α} (hf : is_extr_filter f l a) {g : β → γ} (hg : ∀ {x y : β}, x ≤ y → g y ≤ g x) : is_extr_filter (g ∘ f) l a :=
  is_extr_filter.comp_mono (is_extr_filter.dual hf) fun (x y : order_dual β) (h : x ≤ y) => hg h

theorem is_min_on.comp_mono {α : Type u} {β : Type v} {γ : Type w} [preorder β] [preorder γ] {f : α → β} {s : set α} {a : α} (hf : is_min_on f s a) {g : β → γ} (hg : monotone g) : is_min_on (g ∘ f) s a :=
  is_min_filter.comp_mono hf hg

theorem is_max_on.comp_mono {α : Type u} {β : Type v} {γ : Type w} [preorder β] [preorder γ] {f : α → β} {s : set α} {a : α} (hf : is_max_on f s a) {g : β → γ} (hg : monotone g) : is_max_on (g ∘ f) s a :=
  is_max_filter.comp_mono hf hg

theorem is_extr_on.comp_mono {α : Type u} {β : Type v} {γ : Type w} [preorder β] [preorder γ] {f : α → β} {s : set α} {a : α} (hf : is_extr_on f s a) {g : β → γ} (hg : monotone g) : is_extr_on (g ∘ f) s a :=
  is_extr_filter.comp_mono hf hg

theorem is_min_on.comp_antimono {α : Type u} {β : Type v} {γ : Type w} [preorder β] [preorder γ] {f : α → β} {s : set α} {a : α} (hf : is_min_on f s a) {g : β → γ} (hg : ∀ {x y : β}, x ≤ y → g y ≤ g x) : is_max_on (g ∘ f) s a :=
  is_min_filter.comp_antimono hf hg

theorem is_max_on.comp_antimono {α : Type u} {β : Type v} {γ : Type w} [preorder β] [preorder γ] {f : α → β} {s : set α} {a : α} (hf : is_max_on f s a) {g : β → γ} (hg : ∀ {x y : β}, x ≤ y → g y ≤ g x) : is_min_on (g ∘ f) s a :=
  is_max_filter.comp_antimono hf hg

theorem is_extr_on.comp_antimono {α : Type u} {β : Type v} {γ : Type w} [preorder β] [preorder γ] {f : α → β} {s : set α} {a : α} (hf : is_extr_on f s a) {g : β → γ} (hg : ∀ {x y : β}, x ≤ y → g y ≤ g x) : is_extr_on (g ∘ f) s a :=
  is_extr_filter.comp_antimono hf hg

theorem is_min_filter.bicomp_mono {α : Type u} {β : Type v} {γ : Type w} {δ : Type x} [preorder β] [preorder γ] {f : α → β} {l : filter α} {a : α} [preorder δ] {op : β → γ → δ} (hop : relator.lift_fun LessEq (LessEq ⇒ LessEq) op op) (hf : is_min_filter f l a) {g : α → γ} (hg : is_min_filter g l a) : is_min_filter (fun (x : α) => op (f x) (g x)) l a := sorry

theorem is_max_filter.bicomp_mono {α : Type u} {β : Type v} {γ : Type w} {δ : Type x} [preorder β] [preorder γ] {f : α → β} {l : filter α} {a : α} [preorder δ] {op : β → γ → δ} (hop : relator.lift_fun LessEq (LessEq ⇒ LessEq) op op) (hf : is_max_filter f l a) {g : α → γ} (hg : is_max_filter g l a) : is_max_filter (fun (x : α) => op (f x) (g x)) l a := sorry

-- No `extr` version because we need `hf` and `hg` to be of the same kind

theorem is_min_on.bicomp_mono {α : Type u} {β : Type v} {γ : Type w} {δ : Type x} [preorder β] [preorder γ] {f : α → β} {s : set α} {a : α} [preorder δ] {op : β → γ → δ} (hop : relator.lift_fun LessEq (LessEq ⇒ LessEq) op op) (hf : is_min_on f s a) {g : α → γ} (hg : is_min_on g s a) : is_min_on (fun (x : α) => op (f x) (g x)) s a :=
  is_min_filter.bicomp_mono hop hf hg

theorem is_max_on.bicomp_mono {α : Type u} {β : Type v} {γ : Type w} {δ : Type x} [preorder β] [preorder γ] {f : α → β} {s : set α} {a : α} [preorder δ] {op : β → γ → δ} (hop : relator.lift_fun LessEq (LessEq ⇒ LessEq) op op) (hf : is_max_on f s a) {g : α → γ} (hg : is_max_on g s a) : is_max_on (fun (x : α) => op (f x) (g x)) s a :=
  is_max_filter.bicomp_mono hop hf hg

/-! ### Composition with `tendsto` -/

theorem is_min_filter.comp_tendsto {α : Type u} {β : Type v} {δ : Type x} [preorder β] {f : α → β} {l : filter α} {g : δ → α} {l' : filter δ} {b : δ} (hf : is_min_filter f l (g b)) (hg : filter.tendsto g l' l) : is_min_filter (f ∘ g) l' b :=
  hg hf

theorem is_max_filter.comp_tendsto {α : Type u} {β : Type v} {δ : Type x} [preorder β] {f : α → β} {l : filter α} {g : δ → α} {l' : filter δ} {b : δ} (hf : is_max_filter f l (g b)) (hg : filter.tendsto g l' l) : is_max_filter (f ∘ g) l' b :=
  hg hf

theorem is_extr_filter.comp_tendsto {α : Type u} {β : Type v} {δ : Type x} [preorder β] {f : α → β} {l : filter α} {g : δ → α} {l' : filter δ} {b : δ} (hf : is_extr_filter f l (g b)) (hg : filter.tendsto g l' l) : is_extr_filter (f ∘ g) l' b :=
  or.elim hf (fun (hf : is_min_filter f l (g b)) => is_min_filter.is_extr (is_min_filter.comp_tendsto hf hg))
    fun (hf : is_max_filter f l (g b)) => is_max_filter.is_extr (is_max_filter.comp_tendsto hf hg)

theorem is_min_on.on_preimage {α : Type u} {β : Type v} {δ : Type x} [preorder β] {f : α → β} {s : set α} (g : δ → α) {b : δ} (hf : is_min_on f s (g b)) : is_min_on (f ∘ g) (g ⁻¹' s) b :=
  is_min_filter.comp_tendsto hf (iff.mpr filter.tendsto_principal_principal (set.subset.refl (g ⁻¹' s)))

theorem is_max_on.on_preimage {α : Type u} {β : Type v} {δ : Type x} [preorder β] {f : α → β} {s : set α} (g : δ → α) {b : δ} (hf : is_max_on f s (g b)) : is_max_on (f ∘ g) (g ⁻¹' s) b :=
  is_max_filter.comp_tendsto hf (iff.mpr filter.tendsto_principal_principal (set.subset.refl (g ⁻¹' s)))

theorem is_extr_on.on_preimage {α : Type u} {β : Type v} {δ : Type x} [preorder β] {f : α → β} {s : set α} (g : δ → α) {b : δ} (hf : is_extr_on f s (g b)) : is_extr_on (f ∘ g) (g ⁻¹' s) b :=
  is_extr_on.elim hf (fun (hf : is_min_on f s (g b)) => is_min_on.is_extr (is_min_on.on_preimage g hf))
    fun (hf : is_max_on f s (g b)) => is_max_on.is_extr (is_max_on.on_preimage g hf)

/-! ### Pointwise addition -/

theorem is_min_filter.add {α : Type u} {β : Type v} [ordered_add_comm_monoid β] {f : α → β} {g : α → β} {a : α} {l : filter α} (hf : is_min_filter f l a) (hg : is_min_filter g l a) : is_min_filter (fun (x : α) => f x + g x) l a :=
  (fun (this : is_min_filter (fun (x : α) => f x + g x) l a) => this)
    (is_min_filter.bicomp_mono (fun (x x' : β) (hx : x ≤ x') (y y' : β) (hy : y ≤ y') => add_le_add hx hy) hf hg)

theorem is_max_filter.add {α : Type u} {β : Type v} [ordered_add_comm_monoid β] {f : α → β} {g : α → β} {a : α} {l : filter α} (hf : is_max_filter f l a) (hg : is_max_filter g l a) : is_max_filter (fun (x : α) => f x + g x) l a :=
  (fun (this : is_max_filter (fun (x : α) => f x + g x) l a) => this)
    (is_max_filter.bicomp_mono (fun (x x' : β) (hx : x ≤ x') (y y' : β) (hy : y ≤ y') => add_le_add hx hy) hf hg)

theorem is_min_on.add {α : Type u} {β : Type v} [ordered_add_comm_monoid β] {f : α → β} {g : α → β} {a : α} {s : set α} (hf : is_min_on f s a) (hg : is_min_on g s a) : is_min_on (fun (x : α) => f x + g x) s a :=
  is_min_filter.add hf hg

theorem is_max_on.add {α : Type u} {β : Type v} [ordered_add_comm_monoid β] {f : α → β} {g : α → β} {a : α} {s : set α} (hf : is_max_on f s a) (hg : is_max_on g s a) : is_max_on (fun (x : α) => f x + g x) s a :=
  is_max_filter.add hf hg

/-! ### Pointwise negation and subtraction -/

theorem is_min_filter.neg {α : Type u} {β : Type v} [ordered_add_comm_group β] {f : α → β} {a : α} {l : filter α} (hf : is_min_filter f l a) : is_max_filter (fun (x : α) => -f x) l a :=
  is_min_filter.comp_antimono hf fun (x y : β) (hx : x ≤ y) => neg_le_neg hx

theorem is_max_filter.neg {α : Type u} {β : Type v} [ordered_add_comm_group β] {f : α → β} {a : α} {l : filter α} (hf : is_max_filter f l a) : is_min_filter (fun (x : α) => -f x) l a :=
  is_max_filter.comp_antimono hf fun (x y : β) (hx : x ≤ y) => neg_le_neg hx

theorem is_extr_filter.neg {α : Type u} {β : Type v} [ordered_add_comm_group β] {f : α → β} {a : α} {l : filter α} (hf : is_extr_filter f l a) : is_extr_filter (fun (x : α) => -f x) l a :=
  or.elim hf (fun (hf : is_min_filter f l a) => is_max_filter.is_extr (is_min_filter.neg hf))
    fun (hf : is_max_filter f l a) => is_min_filter.is_extr (is_max_filter.neg hf)

theorem is_min_on.neg {α : Type u} {β : Type v} [ordered_add_comm_group β] {f : α → β} {a : α} {s : set α} (hf : is_min_on f s a) : is_max_on (fun (x : α) => -f x) s a :=
  is_min_on.comp_antimono hf fun (x y : β) (hx : x ≤ y) => neg_le_neg hx

theorem is_max_on.neg {α : Type u} {β : Type v} [ordered_add_comm_group β] {f : α → β} {a : α} {s : set α} (hf : is_max_on f s a) : is_min_on (fun (x : α) => -f x) s a :=
  is_max_on.comp_antimono hf fun (x y : β) (hx : x ≤ y) => neg_le_neg hx

theorem is_extr_on.neg {α : Type u} {β : Type v} [ordered_add_comm_group β] {f : α → β} {a : α} {s : set α} (hf : is_extr_on f s a) : is_extr_on (fun (x : α) => -f x) s a :=
  is_extr_on.elim hf (fun (hf : is_min_on f s a) => is_max_on.is_extr (is_min_on.neg hf))
    fun (hf : is_max_on f s a) => is_min_on.is_extr (is_max_on.neg hf)

theorem is_min_filter.sub {α : Type u} {β : Type v} [ordered_add_comm_group β] {f : α → β} {g : α → β} {a : α} {l : filter α} (hf : is_min_filter f l a) (hg : is_max_filter g l a) : is_min_filter (fun (x : α) => f x - g x) l a := sorry

theorem is_max_filter.sub {α : Type u} {β : Type v} [ordered_add_comm_group β] {f : α → β} {g : α → β} {a : α} {l : filter α} (hf : is_max_filter f l a) (hg : is_min_filter g l a) : is_max_filter (fun (x : α) => f x - g x) l a := sorry

theorem is_min_on.sub {α : Type u} {β : Type v} [ordered_add_comm_group β] {f : α → β} {g : α → β} {a : α} {s : set α} (hf : is_min_on f s a) (hg : is_max_on g s a) : is_min_on (fun (x : α) => f x - g x) s a := sorry

theorem is_max_on.sub {α : Type u} {β : Type v} [ordered_add_comm_group β] {f : α → β} {g : α → β} {a : α} {s : set α} (hf : is_max_on f s a) (hg : is_min_on g s a) : is_max_on (fun (x : α) => f x - g x) s a := sorry

/-! ### Pointwise `sup`/`inf` -/

theorem is_min_filter.sup {α : Type u} {β : Type v} [semilattice_sup β] {f : α → β} {g : α → β} {a : α} {l : filter α} (hf : is_min_filter f l a) (hg : is_min_filter g l a) : is_min_filter (fun (x : α) => f x ⊔ g x) l a :=
  (fun (this : is_min_filter (fun (x : α) => f x ⊔ g x) l a) => this)
    (is_min_filter.bicomp_mono (fun (x x' : β) (hx : x ≤ x') (y y' : β) (hy : y ≤ y') => sup_le_sup hx hy) hf hg)

theorem is_max_filter.sup {α : Type u} {β : Type v} [semilattice_sup β] {f : α → β} {g : α → β} {a : α} {l : filter α} (hf : is_max_filter f l a) (hg : is_max_filter g l a) : is_max_filter (fun (x : α) => f x ⊔ g x) l a :=
  (fun (this : is_max_filter (fun (x : α) => f x ⊔ g x) l a) => this)
    (is_max_filter.bicomp_mono (fun (x x' : β) (hx : x ≤ x') (y y' : β) (hy : y ≤ y') => sup_le_sup hx hy) hf hg)

theorem is_min_on.sup {α : Type u} {β : Type v} [semilattice_sup β] {f : α → β} {g : α → β} {a : α} {s : set α} (hf : is_min_on f s a) (hg : is_min_on g s a) : is_min_on (fun (x : α) => f x ⊔ g x) s a :=
  is_min_filter.sup hf hg

theorem is_max_on.sup {α : Type u} {β : Type v} [semilattice_sup β] {f : α → β} {g : α → β} {a : α} {s : set α} (hf : is_max_on f s a) (hg : is_max_on g s a) : is_max_on (fun (x : α) => f x ⊔ g x) s a :=
  is_max_filter.sup hf hg

theorem is_min_filter.inf {α : Type u} {β : Type v} [semilattice_inf β] {f : α → β} {g : α → β} {a : α} {l : filter α} (hf : is_min_filter f l a) (hg : is_min_filter g l a) : is_min_filter (fun (x : α) => f x ⊓ g x) l a :=
  (fun (this : is_min_filter (fun (x : α) => f x ⊓ g x) l a) => this)
    (is_min_filter.bicomp_mono (fun (x x' : β) (hx : x ≤ x') (y y' : β) (hy : y ≤ y') => inf_le_inf hx hy) hf hg)

theorem is_max_filter.inf {α : Type u} {β : Type v} [semilattice_inf β] {f : α → β} {g : α → β} {a : α} {l : filter α} (hf : is_max_filter f l a) (hg : is_max_filter g l a) : is_max_filter (fun (x : α) => f x ⊓ g x) l a :=
  (fun (this : is_max_filter (fun (x : α) => f x ⊓ g x) l a) => this)
    (is_max_filter.bicomp_mono (fun (x x' : β) (hx : x ≤ x') (y y' : β) (hy : y ≤ y') => inf_le_inf hx hy) hf hg)

theorem is_min_on.inf {α : Type u} {β : Type v} [semilattice_inf β] {f : α → β} {g : α → β} {a : α} {s : set α} (hf : is_min_on f s a) (hg : is_min_on g s a) : is_min_on (fun (x : α) => f x ⊓ g x) s a :=
  is_min_filter.inf hf hg

theorem is_max_on.inf {α : Type u} {β : Type v} [semilattice_inf β] {f : α → β} {g : α → β} {a : α} {s : set α} (hf : is_max_on f s a) (hg : is_max_on g s a) : is_max_on (fun (x : α) => f x ⊓ g x) s a :=
  is_max_filter.inf hf hg

/-! ### Pointwise `min`/`max` -/

theorem is_min_filter.min {α : Type u} {β : Type v} [linear_order β] {f : α → β} {g : α → β} {a : α} {l : filter α} (hf : is_min_filter f l a) (hg : is_min_filter g l a) : is_min_filter (fun (x : α) => min (f x) (g x)) l a :=
  (fun (this : is_min_filter (fun (x : α) => min (f x) (g x)) l a) => this)
    (is_min_filter.bicomp_mono (fun (x x' : β) (hx : x ≤ x') (y y' : β) (hy : y ≤ y') => min_le_min hx hy) hf hg)

theorem is_max_filter.min {α : Type u} {β : Type v} [linear_order β] {f : α → β} {g : α → β} {a : α} {l : filter α} (hf : is_max_filter f l a) (hg : is_max_filter g l a) : is_max_filter (fun (x : α) => min (f x) (g x)) l a :=
  (fun (this : is_max_filter (fun (x : α) => min (f x) (g x)) l a) => this)
    (is_max_filter.bicomp_mono (fun (x x' : β) (hx : x ≤ x') (y y' : β) (hy : y ≤ y') => min_le_min hx hy) hf hg)

theorem is_min_on.min {α : Type u} {β : Type v} [linear_order β] {f : α → β} {g : α → β} {a : α} {s : set α} (hf : is_min_on f s a) (hg : is_min_on g s a) : is_min_on (fun (x : α) => min (f x) (g x)) s a :=
  is_min_filter.min hf hg

theorem is_max_on.min {α : Type u} {β : Type v} [linear_order β] {f : α → β} {g : α → β} {a : α} {s : set α} (hf : is_max_on f s a) (hg : is_max_on g s a) : is_max_on (fun (x : α) => min (f x) (g x)) s a :=
  is_max_filter.min hf hg

theorem is_min_filter.max {α : Type u} {β : Type v} [linear_order β] {f : α → β} {g : α → β} {a : α} {l : filter α} (hf : is_min_filter f l a) (hg : is_min_filter g l a) : is_min_filter (fun (x : α) => max (f x) (g x)) l a :=
  (fun (this : is_min_filter (fun (x : α) => max (f x) (g x)) l a) => this)
    (is_min_filter.bicomp_mono (fun (x x' : β) (hx : x ≤ x') (y y' : β) (hy : y ≤ y') => max_le_max hx hy) hf hg)

theorem is_max_filter.max {α : Type u} {β : Type v} [linear_order β] {f : α → β} {g : α → β} {a : α} {l : filter α} (hf : is_max_filter f l a) (hg : is_max_filter g l a) : is_max_filter (fun (x : α) => max (f x) (g x)) l a :=
  (fun (this : is_max_filter (fun (x : α) => max (f x) (g x)) l a) => this)
    (is_max_filter.bicomp_mono (fun (x x' : β) (hx : x ≤ x') (y y' : β) (hy : y ≤ y') => max_le_max hx hy) hf hg)

theorem is_min_on.max {α : Type u} {β : Type v} [linear_order β] {f : α → β} {g : α → β} {a : α} {s : set α} (hf : is_min_on f s a) (hg : is_min_on g s a) : is_min_on (fun (x : α) => max (f x) (g x)) s a :=
  is_min_filter.max hf hg

theorem is_max_on.max {α : Type u} {β : Type v} [linear_order β] {f : α → β} {g : α → β} {a : α} {s : set α} (hf : is_max_on f s a) (hg : is_max_on g s a) : is_max_on (fun (x : α) => max (f x) (g x)) s a :=
  is_max_filter.max hf hg

/-! ### Relation with `eventually` comparisons of two functions -/

theorem filter.eventually_le.is_max_filter {α : Type u_1} {β : Type u_2} [preorder β] {f : α → β} {g : α → β} {a : α} {l : filter α} (hle : filter.eventually_le l g f) (hfga : f a = g a) (h : is_max_filter f l a) : is_max_filter g l a := sorry

theorem is_max_filter.congr {α : Type u_1} {β : Type u_2} [preorder β] {f : α → β} {g : α → β} {a : α} {l : filter α} (h : is_max_filter f l a) (heq : filter.eventually_eq l f g) (hfga : f a = g a) : is_max_filter g l a :=
  filter.eventually_le.is_max_filter (filter.eventually_eq.le (filter.eventually_eq.symm heq)) hfga h

theorem filter.eventually_eq.is_max_filter_iff {α : Type u_1} {β : Type u_2} [preorder β] {f : α → β} {g : α → β} {a : α} {l : filter α} (heq : filter.eventually_eq l f g) (hfga : f a = g a) : is_max_filter f l a ↔ is_max_filter g l a :=
  { mp := fun (h : is_max_filter f l a) => is_max_filter.congr h heq hfga,
    mpr := fun (h : is_max_filter g l a) => is_max_filter.congr h (filter.eventually_eq.symm heq) (Eq.symm hfga) }

theorem filter.eventually_le.is_min_filter {α : Type u_1} {β : Type u_2} [preorder β] {f : α → β} {g : α → β} {a : α} {l : filter α} (hle : filter.eventually_le l f g) (hfga : f a = g a) (h : is_min_filter f l a) : is_min_filter g l a :=
  filter.eventually_le.is_max_filter hle hfga h

theorem is_min_filter.congr {α : Type u_1} {β : Type u_2} [preorder β] {f : α → β} {g : α → β} {a : α} {l : filter α} (h : is_min_filter f l a) (heq : filter.eventually_eq l f g) (hfga : f a = g a) : is_min_filter g l a :=
  filter.eventually_le.is_min_filter (filter.eventually_eq.le heq) hfga h

theorem filter.eventually_eq.is_min_filter_iff {α : Type u_1} {β : Type u_2} [preorder β] {f : α → β} {g : α → β} {a : α} {l : filter α} (heq : filter.eventually_eq l f g) (hfga : f a = g a) : is_min_filter f l a ↔ is_min_filter g l a :=
  { mp := fun (h : is_min_filter f l a) => is_min_filter.congr h heq hfga,
    mpr := fun (h : is_min_filter g l a) => is_min_filter.congr h (filter.eventually_eq.symm heq) (Eq.symm hfga) }

theorem is_extr_filter.congr {α : Type u_1} {β : Type u_2} [preorder β] {f : α → β} {g : α → β} {a : α} {l : filter α} (h : is_extr_filter f l a) (heq : filter.eventually_eq l f g) (hfga : f a = g a) : is_extr_filter g l a := sorry

theorem filter.eventually_eq.is_extr_filter_iff {α : Type u_1} {β : Type u_2} [preorder β] {f : α → β} {g : α → β} {a : α} {l : filter α} (heq : filter.eventually_eq l f g) (hfga : f a = g a) : is_extr_filter f l a ↔ is_extr_filter g l a :=
  { mp := fun (h : is_extr_filter f l a) => is_extr_filter.congr h heq hfga,
    mpr := fun (h : is_extr_filter g l a) => is_extr_filter.congr h (filter.eventually_eq.symm heq) (Eq.symm hfga) }