/-
Copyright (c) 2021 Ashvni Narayanan. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ashvni Narayanan
-/
import tendsto_zero_of_sum_even_char
import p_adic_L_function_def
import general_bernoulli_number.basic
import zmod.chinese_remainder_units
--import bernoulli_measure.ind_fn
import topology.algebra.continuous_monoid_hom
--import topology.algebra.nonarchimedean.bases
--import chinese_remainder_units

/-!
# A convergence property regarding (ℤ/dp^n ℤ)
This file proves Proposition 7.11 in Introduction to Cyclotomic Fields, Washington.
It gives a convergence property relating to generalized Bernoulli numbers.

# Main Theorems
 * `lim_even_character`

## Tags
p-adic, L-function, Bernoulli measure, Dirichlet character
-/

open_locale big_operators
local attribute [instance] zmod.topological_space

open filter ind_fn dirichlet_character
open_locale topological_space

open_locale big_operators

variables {p : ℕ} [fact (nat.prime p)] {d : ℕ} [fact (0 < d)] {R : Type*} [normed_comm_ring R] (m : ℕ)
(hd : d.gcd p = 1) (χ : dirichlet_character R (d*(p^m))) {c : ℕ} (hc : c.gcd p = 1)
(hc' : c.gcd d = 1) (na : ∀ (n : ℕ) (f : ℕ → R),
  ∥ ∑ (i : ℕ) in finset.range n, f i∥ ≤ ⨆ (i : zmod n), ∥f i.val∥)
(w : continuous_monoid_hom (units (zmod d) × units ℤ_[p]) R)

-- note that this works for any dirichlet character which is primitive and whose conductor divides d * p^m
lemma helper_13 [normed_algebra ℚ_[p] R] [algebra ℚ R] [is_scalar_tower ℚ ℚ_[p] R] [fact (0 < m)]
  {k : ℕ} (hk : 1 < k) : (λ (n : ℕ), (1 / ((d * p ^ n : ℕ) : ℚ_[p])) •
  ∑ (i : ℕ) in finset.range (d * p ^ n), (asso_dirichlet_character (χ.mul
  (teichmuller_character_mod_p' p R^k))) ↑i * ↑i ^ k - general_bernoulli_number
  (χ.mul (teichmuller_character_mod_p' p R ^ k)) k) =ᶠ[filter.at_top]
  λ (x : ℕ), -((1 / (d * p ^ x : ℕ) : ℚ_[p]) • ∑ (x_1 : ℕ) in finset.range (d * p ^ x).pred,
  (asso_dirichlet_character (χ.mul (teichmuller_character_mod_p' p R ^ k))) ↑(x_1.succ) *
  ((algebra_map ℚ R) (bernoulli 1 * ↑k) * ↑(d * p ^ x) * ↑(1 + x_1) ^ (k - 1)) +
  (1 / (d * p ^ x : ℕ) : ℚ_[p]) • ∑ (x_1 : ℕ) in finset.range (d * p ^ x).pred,
  (asso_dirichlet_character (χ.mul (teichmuller_character_mod_p' p R ^ k))) ↑(x_1.succ) *
  (↑(d * p ^ x) * ∑ (x_2 : ℕ) in finset.range (k - 1),
  (algebra_map ℚ R) (bernoulli ((k - 1).succ - x_2) * ↑((k - 1).succ.choose x_2) *
  (↑(1 + x_1) ^ x_2 / ↑(d * p ^ x) ^ x_2) * ↑(d * p ^ x) ^ (k - 1))) +
  (1 / (d * p ^ x : ℕ) : ℚ_[p]) •
  ((asso_dirichlet_character (χ.mul (teichmuller_character_mod_p' p R ^ k)).asso_primitive_character)
  ↑(d * p ^ x) * ((algebra_map ℚ R) (↑(d * p ^ x) ^ k) *
  (algebra_map ℚ R) (polynomial.eval (↑(d * p ^ x) / ↑(d * p ^ x)) (polynomial.bernoulli k))))) :=
begin
  rw [eventually_eq, eventually_at_top],
  refine ⟨m, λ x hx, _⟩,
  have h1 : lcm (d * p^m) p ∣ d * p^x,
  { rw helper_4, refine (nat.mul_dvd_mul_iff_left (fact.out _)).2 (pow_dvd_pow _ hx), },
  have poss : 0 < d * p^x := fact.out _,
  have ne_zero : ((d * p^x : ℕ) : ℚ) ≠ 0 := nat.cast_ne_zero.2 (nat.ne_zero_of_lt' 0),
  have coe_sub : (k : ℤ) - 1 = ((k - 1 : ℕ) : ℤ),
  { change int.of_nat k - 1 = int.of_nat (k - 1),
    rw [int.of_nat_sub (le_of_lt hk), int.of_nat_one], },
  have : ∀ x : ℕ, asso_dirichlet_character (χ.mul (teichmuller_character_mod_p' p R ^ k)).asso_primitive_character x =
    asso_dirichlet_character (χ.mul (teichmuller_character_mod_p' p R ^ k)) x :=
  asso_dirichlet_character.asso_primitive_character _ (is_primitive.mul _ _),
  have f1 : (χ.mul (teichmuller_character_mod_p' p R ^ k)).asso_primitive_character.conductor =
    (χ.mul (teichmuller_character_mod_p' p R ^ k)).conductor,
  { rw asso_primitive_conductor_eq, },
  rw general_bernoulli_number.eq_sum_bernoulli_of_conductor_dvd _ k (dvd_trans (conductor.dvd_lev _)
    (dvd_trans (conductor.dvd_lev _) h1)),
  conv_lhs { conv { congr, skip, rw [coe_sub, zpow_coe_nat, ← one_mul
    ((algebra_map ℚ R) (((d * p ^ x : ℕ) : ℚ) ^ (k - 1))), ← (algebra_map ℚ R).map_one,
    ←one_div_mul_cancel ne_zero, (algebra_map ℚ R).map_mul, mul_assoc _ _ ((algebra_map ℚ R)
    (((d * p ^ x : ℕ) : ℚ) ^ (k - 1))), ←(algebra_map ℚ R).map_mul, ←pow_succ,
    nat.sub_add_cancel (le_of_lt hk), mul_assoc, algebra.algebra_map_eq_smul_one, smul_mul_assoc,
    one_mul, finset.mul_sum],
    congr, skip, apply_congr, skip,
    rw [mul_comm ((algebra_map ℚ R) (((d * p ^ x : ℕ) : ℚ) ^ k)) _, mul_assoc,
      mul_comm _ ((algebra_map ℚ R) (((d * p ^ x : ℕ) : ℚ) ^ k))], },
    rw finset.range_eq_Ico,
    conv { rw [finset.sum_eq_sum_Ico_succ_bot poss, nat.cast_zero, nat.cast_zero,
      zero_pow (pos_of_gt hk), mul_zero, zero_add, ←nat.sub_add_cancel (nat.succ_le_iff.2 poss),
      ←finset.sum_Ico_add, finset.sum_Ico_succ_top (nat.zero_le _) _, ←finset.range_eq_Ico,
      ←nat.pred_eq_sub_one, nat.succ_pred_eq_of_pos poss], }, },
  conv { congr, conv { congr, skip, congr, skip, congr, conv { apply_congr, skip,
    rw [nat.pred_add_one_eq_self poss, helper_12 p d R hk x _, add_assoc, mul_add, this _,
      add_comm _ 1],
    conv { congr, congr, rw [nat.succ_eq_add_one, add_comm x_1 1], }, }, }, },
  rw [finset.sum_add_distrib, div_smul_eq_div_smul p R, ←smul_sub, ←sub_sub, ←sub_sub, sub_self,
    zero_sub, ←neg_add', smul_neg, nat.pred_add_one_eq_self poss, ←smul_add, ←smul_add],
  congr,
  simp_rw mul_add, rw finset.sum_add_distrib,
  congr,
end

variables (p d R) [complete_space R] [char_zero R]
open continuous_map
variables [normed_algebra ℚ_[p] R] [fact (0 < m)]
open clopen_from

-- `helper_289` replaced with `helper_18`
lemma helper_18 {n : ℕ} (hn : 1 < n) (a : (zmod d)ˣ × (zmod (p^n))ˣ) :
  loc_const_ind_fn (_root_.char_fn R (clopen_from.is_clopen_units a)) =
  _root_.char_fn R (@clopen_from.is_clopen p _ d n (↑(((units.chinese_remainder (nat.coprime.pow_right n hd)).symm) a))) :=
begin
  ext,
  rw loc_const_ind_fn, rw ← locally_constant.to_fun_eq_coe,
  simp only,
  by_cases h' : is_unit x.fst ∧ is_unit x.snd, --rw ind_fn.ind_fn_def, --simp only, split_ifs,
  { by_cases hx : x ∈ clopen_from ↑(((units.chinese_remainder
      (nat.coprime.pow_right n hd)).symm) a),
    { rw ind_fn.map_ind_fn_eq_fn,
      rw (char_fn_one R x _).1 hx, rw ← char_fn_one R _ _,
      rw set.mem_prod, rw set.mem_preimage, rw set.mem_singleton_iff, rw set.mem_singleton_iff,
      rw units.ext_iff, rw units.ext_iff, rw is_unit.unit_spec, rw units.coe_map,
      rw is_unit.unit_spec, rw clopen_from.mem_clopen_from at hx, rw hx.1, rw ring_hom.to_monoid_hom_eq_coe,
      rw ring_hom.coe_monoid_hom, rw ← hx.2, rw units.chinese_remainder_symm_apply_fst,
      rw units.chinese_remainder_symm_apply_snd, refine ⟨rfl, rfl⟩,
      { -- make a separate lemma
        rw mem_clopen_from at hx, rw units.chinese_remainder_symm_apply_snd at hx,
        rw units.chinese_remainder_symm_apply_fst at hx,
        rw hx.1, simp only [units.is_unit, true_and],
        apply padic_int.is_unit_to_zmod_pow_of_is_unit p hn x.snd, rw ←hx.2,
        simp only [units.is_unit], }, },
    { rw map_ind_fn_eq_fn _ h',
      rw (char_fn_zero R x _).1 hx,
      rw (char_fn_zero R _ _).1 _,
      -- simp,
      -- rw is_unit.unit_spec,
      intro h', apply hx,
      rw mem_clopen_from, rw units.chinese_remainder_symm_apply_fst,
      rw units.chinese_remainder_symm_apply_snd,
      rw set.mem_prod at h', rw set.mem_preimage at h', rw set.mem_singleton_iff at h', rw set.mem_singleton_iff at h',
      rw units.ext_iff at h', rw units.ext_iff at h', rw is_unit.unit_spec at h',
      rw units.coe_map at h', rw is_unit.unit_spec at h',
      refine ⟨h'.1, h'.2.symm⟩, }, },
  { -- same as above
    rw map_ind_fn_eq_zero _ h', rw (char_fn_zero R _ _).1 _,
    intro hx, apply h',
    rw mem_clopen_from at hx, rw units.chinese_remainder_symm_apply_fst at hx,
    rw units.chinese_remainder_symm_apply_snd at hx,
    rw hx.1, simp only [units.is_unit, true_and],
    apply padic_int.is_unit_to_zmod_pow_of_is_unit p hn x.snd, rw ←hx.2,
    simp only [units.is_unit], },
end

variable [fact (0 < d)]
open eventually_constant_seq clopen_from

open dirichlet_character
variable (hd)

lemma lim_even_character' [nontrivial R] [no_zero_divisors R] [normed_algebra ℚ_[p] R]
  [fact (0 < m)] {k : ℕ} [algebra ℚ R] [is_scalar_tower ℚ ℚ_[p] R] [norm_one_class R] (hk : 1 < k)
  (hχ : χ.is_even) (hp : 2 < p)
  (na : ∀ (n : ℕ) (f : ℕ → R), ∥ ∑ (i : ℕ) in finset.range n, f i∥ ≤ ⨆ (i : zmod n), ∥f i.val∥) :
  filter.tendsto (λ n, (1/((d * p^n : ℕ) : ℚ_[p])) • ∑ i in finset.range (d * p^n),
  ((asso_dirichlet_character (χ.mul (teichmuller_character_mod_p' p R ^ k))) i * i^k) )
  (@filter.at_top ℕ _) (nhds (general_bernoulli_number
  (χ.mul (teichmuller_character_mod_p' p R ^ k)) k)) :=
begin
  refine tendsto_sub_nhds_zero_iff.1 ((filter.tendsto_congr' (helper_13 m _ hk)).2 _),
  conv { congr, skip, skip, rw ←neg_zero, rw ←add_zero (0 : R),
    conv { congr, congr, congr, rw ←add_zero (0 : R), }, },
  refine tendsto.neg (tendsto.add (tendsto.add _ _) _),
  { conv { congr, funext, conv { congr, skip, apply_congr, skip,
      rw [mul_comm ((algebra_map ℚ R) (bernoulli 1 * ↑k) * ↑(d * p ^ x)) _, ←mul_assoc], },
      rw [←finset.sum_mul, mul_comm _ ((algebra_map ℚ R) (bernoulli 1 * ↑k) * ↑(d * p ^ x)),
       ←smul_mul_assoc, mul_comm ((algebra_map ℚ R) (bernoulli 1 * ↑k)) ↑(d * p ^ x),
       ←smul_mul_assoc, ←div_smul_eq_div_smul p R (d * p ^ x) _,
       one_div_smul_self R (@nat.ne_zero_of_lt' 0 (d * p^x) _), one_mul, ←smul_eq_mul,
       algebra_map_smul, helper_14 p R], skip, skip,
       rw ←@smul_zero ℚ_[p] R _ _ _ ((algebra_map ℚ ℚ_[p]) (bernoulli 1 * ↑k)), },
    refine tendsto.const_smul _ _,
    convert (tendsto_congr' _).2 (sum_even_character_tendsto_zero hk hχ hp na),
    rw [eventually_eq, eventually_at_top],
    refine ⟨m, λ x hx, _⟩,
    have poss : 0 < d * p^x := fact.out _,
    simp_rw [add_comm 1 _, nat.succ_eq_add_one],
    rw [finset.range_eq_Ico, finset.sum_Ico_add' (λ x : ℕ, (asso_dirichlet_character (χ.mul
      (teichmuller_character_mod_p' p R ^ k))) ↑x * ↑x ^ (k - 1)) 0 (d * p^x).pred 1,
      finset.sum_eq_sum_Ico_succ_bot poss, @nat.cast_zero R _ _, zero_pow (nat.sub_pos_of_lt hk),
      mul_zero, zero_add, zero_add, nat.pred_add_one_eq_self poss], },
  { rw metric.tendsto_at_top,
    intros ε hε,
    obtain ⟨N, h⟩ := metric.tendsto_at_top.1 (tendsto.const_mul ((⨆ (x_1 : zmod (k.sub 0).pred),
      ∥(algebra_map ℚ R) (bernoulli ((k.sub 0).pred.succ - x_1.val) *
      ↑((k.sub 0).pred.succ.choose x_1.val))∥) *
      (χ.mul (teichmuller_character_mod_p' p R ^ k)).bound) (tendsto_iff_norm_tendsto_zero.1
      (nat_cast_mul_prime_pow_tendsto_zero p d R))) (ε/2) (half_pos hε),
    simp_rw [sub_zero, mul_zero _, dist_zero_right _, real.norm_eq_abs] at h,
    refine ⟨N, λ  x hx, _⟩,
    rw dist_eq_norm, rw sub_zero,
    conv { congr, congr, conv { congr, skip,
      conv { apply_congr, skip, rw [←mul_assoc, mul_comm ((asso_dirichlet_character (χ.mul
        (teichmuller_character_mod_p' p R ^ k))) ↑(x_1.succ)) _, mul_assoc, add_comm 1 x_1], },
      rw ←finset.mul_sum, },
      rw [←smul_mul_assoc, ←div_smul_eq_div_smul p R (d * p ^ x) _, one_div_smul_self R
        (@nat.ne_zero_of_lt' 0 (d * p^x) _), one_mul], },
    refine lt_of_le_of_lt (na _ _) (lt_of_le_of_lt (cSup_le (set.range_nonempty _) (λ b hb, _))
      (half_lt_self hε)),
    cases hb with y hy,
    rw ←hy,
    simp only,
    refine le_trans (norm_mul_le _ _) (le_trans (mul_le_mul
      (le_of_lt (dirichlet_character.lt_bound _ _)) (helper_15 na hk _ _) (norm_nonneg _)
      (le_of_lt (bound_pos _))) (le_of_lt _)),
    rw [mul_comm, mul_assoc, mul_comm],
    apply lt_of_abs_lt (h x hx),  },
  { have nz : ∀ x : ℕ, ((d * p^x : ℕ) : ℚ) ≠ 0 := λ x, nat.cast_ne_zero.2 (nat.ne_zero_of_lt' 0),
    simp_rw [div_self (nz _)],
    conv { congr, funext, rw [mul_comm ((asso_dirichlet_character (χ.mul
      (teichmuller_character_mod_p' p R ^ k)).asso_primitive_character) ↑(d * p ^ x))
      ((algebra_map ℚ R) (↑(d * p ^ x) ^ k) * (algebra_map ℚ R)
      (polynomial.eval 1 (polynomial.bernoulli k))), mul_assoc, ← smul_mul_assoc,
      ← nat.succ_pred_eq_of_pos (pos_of_gt hk), pow_succ, (algebra_map ℚ R).map_mul,
      ← smul_mul_assoc, ← inv_eq_one_div, map_nat_cast,--], },
      inv_smul_self' p R (@nat.ne_zero_of_lt' 0 (d * p^x) _), one_mul, ← mul_assoc, mul_comm _
      ((algebra_map ℚ R) (polynomial.eval 1 (polynomial.bernoulli k.pred.succ))), mul_assoc], skip,
      skip, congr, rw ←mul_zero ((algebra_map ℚ R) (polynomial.eval 1 (polynomial.bernoulli k.pred.succ))), },
    apply tendsto.const_mul _ _,
    { apply_instance, },
    { rw metric.tendsto_at_top,
      intros ε hε,
      obtain ⟨N, hN⟩ := metric.tendsto_at_top.1 (norm_pow_lim_eq_zero p d R 1 (nat.pred_lt_pred
        nat.one_ne_zero hk)) (ε/((χ.mul
        (teichmuller_character_mod_p' p R ^ k.pred.succ)).asso_primitive_character.bound))
        (div_pos hε (bound_pos _)),
      refine ⟨N, λ x hx, _⟩,
      rw dist_eq_norm, rw sub_zero, rw mul_comm,
      apply lt_of_le_of_lt (norm_mul_le _ _) _,
      rw ← nat.cast_pow, rw map_nat_cast,
      apply lt_trans (mul_lt_mul (lt_bound _ _) le_rfl _ _) _,
      { rw norm_pos_iff,
        refine nat.cast_ne_zero.2 _,
        refine pow_ne_zero _ (nat.ne_zero_of_lt' 0), },
      { apply le_of_lt (bound_pos _), },
      { rw mul_comm, rw nat.cast_pow,
        simp_rw [dist_eq_norm, mul_one, sub_zero] at hN,
        apply (lt_div_iff (bound_pos _)).1 (hN x hx), }, }, },
end


import polyhedral_lattice.basic
import normed_group.pseudo_normed_group
import pseudo_normed_group.with_Tinv

import topology.connected

import facts
/-!

# If M is a profinitely filtered pseudo-normed group with T⁻¹ then so is Hom(Λ, M)

Here Λ is a polyhedral lattice, and the T⁻¹ is in the sense
of `pseudo_normed_group.with_Tinv`.

-/

noncomputable theory
open_locale nnreal big_operators

open pseudo_normed_group seminormed_add_comm_group

lemma int.one_mem_filtration : (1 : ℤ) ∈ filtration ℤ 1 :=
by simp only [nnnorm_one, mem_filtration_iff]

section

variables {Λ : Type*} [polyhedral_lattice Λ]
variables {M : Type*} [pseudo_normed_group M]

lemma generates_norm.add_monoid_hom_mem_filtration_iff {ι : Type} [fintype ι]
  {l : ι → Λ} (hl : generates_norm l) (x : Λ →+ M) (c : ℝ≥0) :
  x ∈ filtration (Λ →+ M) c ↔ ∀ i, x (l i) ∈ filtration M (c * ∥l i∥₊) :=
begin
  refine ⟨λ H i, H (le_refl ∥l i∥₊), _⟩,
  intros H c' l' hl',
  obtain ⟨cᵢ, h1, h2⟩ := hl.generates_nnnorm l',
  rw [h1, x.map_sum],
  refine filtration_mono _ (sum_mem_filtration _ (λ i, c * cᵢ i * ∥l i∥₊) _ _),
  { calc ∑ i, c * cᵢ i * ∥l i∥₊
        = c * ∑ i, cᵢ i * ∥l i∥₊ : by simp only [mul_assoc, ← finset.mul_sum]
    ... = c * ∥l'∥₊ : by rw h2
    ... ≤ c * c' : mul_le_mul' le_rfl hl' },
  rintro i -,
  rw [mul_assoc, mul_left_comm, x.map_nsmul],
  exact pseudo_normed_group.nat_smul_mem_filtration (cᵢ i) _ _ (H i),
end

end

namespace polyhedral_lattice

variables (Λ : Type*) (r' : ℝ≥0) (M : Type*) [polyhedral_lattice Λ]
variables [profinitely_filtered_pseudo_normed_group_with_Tinv r' M]

include r'

namespace add_monoid_hom

variables {Λ r' M} (c : ℝ≥0)

def incl (c : ℝ≥0) : filtration (Λ →+ M) c → Π l : Λ, filtration M (c * ∥l∥₊) :=
λ f l, ⟨f l, f.2 $ mem_filtration_nnnorm _⟩

@[simp] lemma coe_incl_apply (f : filtration (Λ →+ M) c) (l : Λ) :
  (incl c f l : M) = f l :=
rfl

variables (Λ r' M)

lemma incl_injective : function.injective (@incl Λ r' M _ _ c) :=
begin
  intros f g h,
  ext l,
  show (incl c f l : M) = incl c g l,
  rw h
end

instance : topological_space (filtration (Λ →+ M) c) :=
topological_space.induced (incl c) infer_instance

lemma incl_embedding : embedding (@incl Λ r' M _ _ c) :=
{ induced := rfl,
  inj := incl_injective Λ r' M c }

lemma incl_inducing : inducing (@incl Λ r' M _ _ c) := ⟨rfl⟩

lemma incl_continuous : continuous (@incl Λ r' M _ _ c) :=
(incl_inducing _ _ _ _).continuous

instance : t2_space (filtration (Λ →+ M) c) :=
(incl_embedding Λ r' M c).t2_space

instance : totally_disconnected_space (filtration (Λ →+ M) c) :=
{ is_totally_disconnected_univ := (incl_embedding Λ r' M c).is_totally_disconnected $
    is_totally_disconnected_of_totally_disconnected_space _ }

lemma incl_range_eq :
  (set.range (@incl Λ r' M _ _ c)) =
    ⋂ l₁ l₂, {f | (cast_le (f (l₁ + l₂)) : filtration M (c * (∥l₁∥₊ + ∥l₂∥₊))) =
    cast_le (add' (f l₁, f l₂))} :=
begin
  ext f,
  simp only [set.mem_range, set.mem_Inter, coe_fn_coe_base, coe_incl_apply,
    set.mem_set_of_eq, subtype.coe_mk, subtype.ext_iff],
  split,
  { rintro ⟨⟨f, hf⟩, rfl⟩ l₁ l₂,
    exact f.map_add _ _ },
  { intro h,
    refine ⟨⟨add_monoid_hom.mk' (λ l, f l) h, _⟩, _⟩,
    { intros c' l hl,
      rw mem_filtration_iff at hl,
      exact filtration_mono (mul_le_mul' le_rfl hl) (f l).2 },
    { ext, refl } }
end

open profinitely_filtered_pseudo_normed_group
  comphaus_filtered_pseudo_normed_group

lemma incl_range_is_closed : (is_closed (set.range (@incl Λ r' M _ _ c))) :=
begin
  rw incl_range_eq,
  apply is_closed_Inter,
  intro l₁,
  apply is_closed_Inter,
  intro l₂,
  apply is_closed_eq,
  { exact (continuous_cast_le _ _).comp (continuous_apply (l₁ + l₂)) },
  { exact (continuous_cast_le _ _).comp ((continuous_add' _ _).comp
          ((continuous_apply l₁).prod_mk (continuous_apply l₂))) },
end

instance : compact_space (filtration (Λ →+ M) c) :=
{ compact_univ :=
  begin
    rw ← (incl_inducing Λ r' M c).is_compact_iff,
    apply is_closed.is_compact,
    rw set.image_univ,
    exact incl_range_is_closed _ _ _ _
  end }

lemma continuous_iff {X : Type*} [topological_space X]
  (ϕ : X → (filtration (Λ →+ M) c)) :
  continuous ϕ ↔ ∀ l : Λ, continuous (λ x, incl c (ϕ x) l) :=
begin
  rw (incl_inducing Λ r' M c).continuous_iff,
  split,
  { intros h l, exact (continuous_apply l).comp h },
  { exact continuous_pi }
end

instance profinitely_filtered_pseudo_normed_group :
  profinitely_filtered_pseudo_normed_group (Λ →+ M) :=
{ continuous_add' :=
  begin
    intros c₁ c₂,
    rw continuous_iff,
    intro l,
    have step1 :=
      ((continuous_apply l).comp (incl_continuous Λ r' M c₁)).prod_map
      ((continuous_apply l).comp (incl_continuous Λ r' M c₂)),
    have step2 := (continuous_add' (c₁ * ∥l∥₊) (c₂ * ∥l∥₊)),
    have := step2.comp step1,
    refine (@continuous_cast_le _ _ _ _ (id _)).comp this,
    rw add_mul, exact ⟨le_rfl⟩
  end,
  continuous_neg' :=
  begin
    intro c,
    rw continuous_iff,
    intro l,
    exact (continuous_neg' _).comp ((continuous_apply l).comp (incl_continuous Λ r' M c)),
  end,
  continuous_cast_le :=
  begin
    introsI c₁ c₂ h,
    rw continuous_iff,
    intro l,
    exact (continuous_cast_le _ _).comp ((continuous_apply l).comp (incl_continuous Λ r' M c₁))
  end,
  .. add_monoid_hom.pseudo_normed_group }

end add_monoid_hom

variables {Λ r' M}

open profinitely_filtered_pseudo_normed_group_with_Tinv

def Tinv' : (Λ →+ M) →+ (Λ →+ M) :=
add_monoid_hom.comp_hom
  (@Tinv r' M _).to_add_monoid_hom

@[simp] lemma Tinv'_apply (f : Λ →+ M) (l : Λ) :
  Tinv' f l = Tinv (f l) := rfl

lemma Tinv'_mem_filtration (c : ℝ≥0) (f : Λ →+ M) (hf : f ∈ filtration (Λ →+ M) c) :
  Tinv' f ∈ filtration (Λ →+ M) (r'⁻¹ * c) :=
begin
  intros x l hl,
  rw [Tinv'_apply, mul_assoc],
  apply Tinv_mem_filtration,
  exact hf hl
end

variables (Λ r' M)

open profinitely_filtered_pseudo_normed_group
open comphaus_filtered_pseudo_normed_group
variables [fact (0 < r')]

def Tinv : comphaus_filtered_pseudo_normed_group_hom (Λ →+ M) (Λ →+ M) :=
comphaus_filtered_pseudo_normed_group_hom.mk' Tinv'
begin
  refine ⟨r'⁻¹, λ c, ⟨Tinv'_mem_filtration c, _⟩⟩,
  rw add_monoid_hom.continuous_iff,
  intro l,
  haveI : ∀ a, fact (a ≤ r' * (r'⁻¹ * a)) :=
    λ a, ⟨by simp [mul_inv_cancel_left₀ (ne_of_gt (fact.out _ : 0 < r'))]⟩,
  refine (@continuous_cast_le _ _ _ _ (id _)).comp
    ((@Tinv₀_continuous r' M _ (c * ∥l∥₊) (r'⁻¹ * (c * ∥l∥₊)) _).comp
    ((continuous_apply l).comp (add_monoid_hom.incl_continuous Λ r' M c))),
  rw mul_assoc, exact ⟨le_rfl⟩
end

instance : profinitely_filtered_pseudo_normed_group_with_Tinv r' (Λ →+ M) :=
{ Tinv := Tinv Λ r' M,
  Tinv_mem_filtration := Tinv'_mem_filtration,
  .. add_monoid_hom.profinitely_filtered_pseudo_normed_group Λ r' M }

@[simp] lemma Tinv_apply (x : Λ →+ M) (l : Λ) :
  (profinitely_filtered_pseudo_normed_group_with_Tinv.Tinv x) l =
  profinitely_filtered_pseudo_normed_group_with_Tinv.Tinv (x l) := rfl

end polyhedral_lattice


import algebra.free_monoid
import group_theory.congruence
import computability.language
import group_theory.free_group

universes u v
variable (α : Type u)
variables {L L₁ L₂ L₃ L₄ : list (α × bool)}

open relation

namespace dyck

variable {α}

inductive red.step : list (α × bool) → list (α × bool) → Prop
| mul_inv {L L₁ : list (α × bool)} {x} : red.step (L ++ (x,tt) :: (x,ff) :: L₁) (L ++ L₁)
attribute [simp] mul_inv

def red {α}  := relation.refl_trans_gen (@red.step α)

@[refl] lemma red.refl : red L L := relation.refl_trans_gen.refl
@[trans] lemma red.trans : red L₁ L₂ → red L₂ L₃ → red L₁ L₃ := relation.refl_trans_gen.trans

namespace red

theorem step.length : ∀ {L₁ L₂ : list (α × bool)}, step L₁ L₂ → L₂.length + 2 = L₁.length
| _ _ (@red.step.mul_inv _ L₁ L₂ x) := by rw [list.length_append, list.length_append]; refl

@[simp] lemma step.cons_mul_inv {x} : red.step ((x, tt) :: (x, ff) :: L) L :=
@step.mul_inv _ [] _ _

theorem step.append_left : ∀ {L₁ L₂ L₃ : list (α × bool)}, step L₂ L₃ → step (L₁ ++ L₂) (L₁ ++ L₃)
| _ _ _ red.step.mul_inv := by rw [← list.append_assoc, ← list.append_assoc]; constructor

theorem step.append_right : ∀ {L₁ L₂ L₃ : list (α × bool)}, step L₁ L₂ → step (L₁ ++ L₃) (L₂ ++ L₃)
| _ _ _ red.step.mul_inv := by simp only [list.append_assoc, list.cons_append]; constructor

theorem step.cons {x} (H : red.step L₁ L₂) : red.step (x :: L₁) (x :: L₂) :=
@step.append_left _ [x] _ _ H

lemma not_step_nil : ¬ step [] L :=
begin
  generalize h' : [] = L',
  assume h,
  cases h with L₁ L₂,
  simp [list.append_eq_has_append, list.nil_eq_append_iff] at h',
  contradiction,
end

private lemma not_step_inv {a : α} : ¬ step [(a, ff)] L :=
begin
  assume h,
  generalize h' : [(a,ff)] = L',
  rw h' at h,
  cases h with L₁ L₂,
  simp [list.append_eq_has_append, list.nil_eq_append_iff] at h',
  cases L₁,
  { simp only [list.append, list.nil_append, and_false] at h',
    exact h' },
  { dsimp at h',
    simp only [list.nil_eq_append_iff, and_false] at h',
    exact h' }
end

lemma step.cons_left_iff {a : α} :
  step ((a, tt) :: L₁) L₂ ↔ (∃ L, step L₁ L ∧ L₂ = (a, tt) :: L) ∨ (L₁ = (a, ff) :: L₂) :=
begin
  split,
  { generalize hL : ((a, tt) :: L₁ : list _) = L,
    assume h,
    rcases h with ⟨_ | ⟨p, s'⟩, e, a'⟩,
    { simp at hL, simp [*] },
    { simp at hL,
      rcases hL with ⟨rfl, rfl⟩,
      refine or.inl ⟨s' ++ e, step.mul_inv, _⟩,
      simp only [list.append, eq_self_iff_true, true_and],
      tauto } },
  { assume h,
    rcases h with ⟨L, h, rfl⟩ | rfl,
    { exact step.cons h },
    { simp only [step.cons_mul_inv] } }
end

lemma step.cons_left_of_inv_iff {a : α} :
  step ((a, ff) :: L₁) L₂ ↔ (∃ L, step L₁ L ∧ L₂ = (a, ff) :: L) :=
begin
  split,
  { generalize hL : ((a, ff) :: L₁ : list _) = L,
    assume h,
    rcases h with ⟨_ | ⟨p, s'⟩, e, a'⟩,
    { simp only [list.append, prod.mk.inj_iff, and_false, false_and, step.cons_mul_inv] at *,
      exact false.rec (∃ (L : list (α × bool)), step L₁ L ∧ e = (a, ff) :: L) hL },
    { simp only [list.append, eq_self_iff_true, true_and] at *,
      rcases hL with ⟨rfl, rfl⟩,
      simp only [eq_self_iff_true, true_and, exists_eq_right'] at *,
      fconstructor } },
    { intro h,
      rcases h with ⟨L, h, h'⟩,
      rw h'; exact step.cons h }
end

lemma not_step_singleton : ∀ {p : α × bool}, ¬ step [p] L
| (a, tt) := by simp [step.cons_left_iff, not_step_nil]
| (a, ff) := by exact not_step_inv

lemma step.to_red : step L₁ L₂ → red L₁ L₂ :=
relation.refl_trans_gen.single

lemma step.cons_of_inv_cons_iff : ∀ {a : α}, step ((a, ff) :: L₁) ((a, ff) :: L₂) ↔ step L₁ L₂ :=
begin
  intro a,
  split,
  { intro h,
    rw step.cons_left_of_inv_iff at h,
    rcases h with ⟨L, _, _⟩,
    simp only [eq_self_iff_true, true_and] at h_h_right,
    rw ← h_h_right at h_h_left,
    exact h_h_left },
    { exact step.cons }
end

lemma cons_cons {p} : red L₁ L₂ → red (p :: L₁) (p :: L₂) :=
relation.refl_trans_gen.lift (list.cons p) (assume a b, step.cons)

private theorem step.diamond_aux : ∀ {L₁ L₂ L₃ L₄ : list (α × bool)} {x1 x2 },
  L₁ ++ (x1, tt) :: (x1, ff) :: L₂ = L₃ ++ (x2, tt) :: (x2, ff) :: L₄ →
  L₁ ++ L₂ = L₃ ++ L₄ ∨ ∃ L₅, red.step (L₁ ++ L₂) L₅ ∧ red.step (L₃ ++ L₄) L₅
:=
begin
  intros L₁ L₂ L₃ L₄ x1 x2 h,
  rw list.append_eq_append_iff at *,
  induction h,
  rcases h with ⟨a', hl, hr⟩,
  rw list.cons_eq_append_iff at *,
  induction hr,
  cases hr with hrl hrr,

  simp at *,
  left,
  left,
  use ([]),
  split,
  rw ← hrl,
  exact hl,

  simp,
  exact hrr.2.symm,

  rcases hr with ⟨a'', hrl, hrr⟩,
  rw list.cons_eq_append_iff at *,
  induction hrr,
  cases hrr with hrrl hrrr,
  simp at *,
  exact false.rec
  (((∃ (a' : list (α × bool)), L₃ = L₁ ++ a' ∧ L₂ = a' ++ L₄) ∨
        ∃ (c' : list (α × bool)), L₁ = L₃ ++ c' ∧ L₄ = c' ++ L₂) ∨
     ∃ (L₅ : list (α × bool)), step (L₁ ++ L₂) L₅ ∧ step (L₃ ++ L₄) L₅)
  hrrr,

  rcases hrr with ⟨b', hrrl, hrrr⟩,
  rw hrrl at hrl,
  rw hrl at hl,
  right,
  subst_vars,
  use (L₁ ++ b' ++L₄),
  split,
  rw ← list.append_assoc,
  generalize eq₁ : (L₁ ++ b' = LL),
  exact step.mul_inv,
  generalize eq₁ : (b' ++ L₄= LL),
  simp,
  rw eq₁,
  exact step.mul_inv,

  rcases h with ⟨c, hl, hr⟩,
  rw list.cons_eq_append_iff at *,
  induction hr,
  cases hr with hrl hrr,
  simp at *,
  left,
  rw hrl at *,
  simp at *,
  use ([]),
  simp,
  tauto,

  rcases hr with ⟨a', hrl, hrr⟩,
  rw list.cons_eq_append_iff at *,
  induction hrr,

  cases hrr with hrrl hrrr,
  simp at *,
  exact false.rec
  (((∃ (a' : list (α × bool)), L₃ = L₁ ++ a' ∧ L₂ = a' ++ L₄) ∨
        ∃ (c' : list (α × bool)), L₁ = L₃ ++ c' ∧ L₄ = c' ++ L₂) ∨
     ∃ (L₅ : list (α × bool)), step (L₁ ++ L₂) L₅ ∧ step (L₃ ++ L₄) L₅)
  hrrr,

  rcases hrr with ⟨b', hrrl, hrrr⟩,
  rw hrrl at hrl,
  rw hrl at hl,
  right,
  subst_vars,
  use (L₃ ++ b' ++ L₂),
  split,
  simp,
  generalize eq₁ : (b' ++ L₂ = LL),
  exact step.mul_inv,

  rw ← list.append_assoc,
  generalize eq₁ : (L₃ ++ b' = LL),
  exact step.mul_inv,
end

theorem step.diamond : ∀ {L₁ L₂ L₃ L₄ : list (α × bool)},
  red.step L₁ L₃ → red.step L₂ L₄ → L₁ = L₂ →
  L₃ = L₄ ∨ ∃ L₅, red.step L₃ L₅ ∧ red.step L₄ L₅
| _ _ _ _ red.step.mul_inv red.step.mul_inv H := step.diamond_aux H

theorem church_rosser : red L₁ L₂ → red L₁ L₃ → relation.join red L₂ L₃ :=
relation.church_rosser (assume a b c hab hac,
match b, c, red.step.diamond hab hac rfl with
| b, _, or.inl rfl           := ⟨b, by refl, by refl⟩
| b, c, or.inr ⟨d, hbd, hcd⟩ := ⟨d, relation.refl_gen.single hbd, hcd.to_red⟩
end)

theorem nil_iff : red [] L ↔ L = [] :=
refl_trans_gen_iff_eq (assume l, red.not_step_nil)

theorem singleton_iff {x} : red [x] L₁ ↔ L₁ = [x] :=
refl_trans_gen_iff_eq (assume l, not_step_singleton)

private lemma cons_nil_iff_singleton_aux {x} :
red L [] → (∃ L', L = (x, tt) :: L') → red L.tail [(x, ff)] :=
begin
  intros h,
  apply h.head_induction_on,
  intro h',
  rcases h' with ⟨L', _⟩,
  simp at *,
  contradiction,
  rintros a c h₂ h₃ h₄ ⟨ L', h₅⟩,
  induction h₂ with L₁ L₂ x1,
  have := eq.symm h₅,
  clear h₅,
  rw list.cons_eq_append_iff at *,
  induction this,
  cases this with hl hr,
  simp at *,
  cases hr with hrl hrr,
  subst_vars,
  simp at *,
  rw ← red at *,
  exact cons_cons h₃,

  rcases this with ⟨a', hl, hr⟩,
  subst_vars,
  specialize h₄ _,
  use (a' ++ L₂),
  simp at *,
  have : ((x, tt) :: a' ++ L₂).tail = a' ++ L₂ := by simp,
  rw this at *,
  clear this,
  have : ((x, tt) :: a' ++ (x1, tt) :: (x1, ff) :: L₂).tail = a' ++ (x1, tt) :: (x1, ff) :: L₂ := by simp,
  rw this at *,
  clear this,
  have h₁ : red (a' ++ (x1, tt) :: (x1, ff) :: L₂) (a' ++ L₂), {
    refine step.to_red _,
    exact step.mul_inv,
  },
  exact trans h₁ h₄,
end

theorem cons_nil_iff_singleton {x} : red ((x, tt) :: L) [] ↔ red L [(x, ff)] :=
begin
  split,
  intro h,
  have := @cons_nil_iff_singleton_aux α ((x, tt) :: L) x h _,
  simp at *,
  exact this,
  use L,
  intro h,
  have h₁ : red ((x, tt) :: L) ((x, tt) :: [(x, ff)]) := cons_cons h,
  have h₂ : red [(x, tt), (x, ff)] [], {
    refine step.to_red _,
    exact step.cons_mul_inv,
  },
  exact trans h₁ h₂,
end

/-
private lemma append_nil_iff_singleton_aux {x} :
red L [] → (∃ L', L = L' ++ [(x, ff)]) → red (L.reverse.tail.reverse) [(x, tt)] :=
begin
  intro h,
  apply h.head_induction_on,
  sorry,
  intros a c h₁ h₂ h₃ h₄,
  induction h₁ with L₁ L₂ x1,
  rcases h₄ with ⟨L', h⟩,
  rw list.append_eq_append_iff at *,
  induction h,
  rcases h_1 with ⟨a', hl, hr⟩,
  rw list.cons_eq_append_iff at *,
  induction hr,
  cases hr with hrl hrr,
  simp at *,
  contradiction,
  rcases hr with ⟨b, hrl, hrr⟩,
  rw list.cons_eq_append_iff at *,
  induction hrr,
  cases hrr with hrrl hrrr,
  cases hrrr with hrrrl hrrrr,
  subst_vars,
  simp at *,
  repeat {sorry},
end
-/

theorem equivalence_join_red : equivalence (join (@red α)) :=
equivalence_join_refl_trans_gen $ assume a b c hab hac,
(match b, c, red.step.diamond hab hac rfl with
| b, _, or.inl rfl           := ⟨b, by refl, by refl⟩
| b, c, or.inr ⟨d, hbd, hcd⟩ := ⟨d, refl_gen.single hbd, refl_trans_gen.single hcd⟩
end)

theorem join_red_of_step (h : red.step L₁ L₂) : join red L₁ L₂ :=
join_of_single reflexive_refl_trans_gen h.to_red

theorem eqv_gen_step_iff_join_red : eqv_gen red.step L₁ L₂ ↔ join red L₁ L₂ :=
iff.intro
  (assume h,
    have eqv_gen (join red) L₁ L₂ := h.mono (assume a b, join_red_of_step),
    equivalence_join_red.eqv_gen_iff.1 this)
  (join_of_equivalence (eqv_gen.is_equivalence _) $ assume a b,
    refl_trans_gen_of_equivalence (eqv_gen.is_equivalence _) eqv_gen.rel)

lemma to_free_group_step : step L₁ L₂ → free_group.red.step L₁ L₂ :=
begin
  intro h,
  induction h,
  exact free_group.red.step.bnot,
end

lemma to_free_group_red : red L₁ L₂ → free_group.red L₁ L₂ :=
begin
  rw red,
  rw free_group.red,
  refine refl_trans_gen.lift (λ {L₁ : list (α × bool)}, L₁) _,
  intros a b,
  exact to_free_group_step,
end

theorem step.sublist (H : red.step L₁ L₂) : L₂ <+ L₁ :=
begin
  cases H,
  rw list.append_eq_has_append at *,
  rw list.append_eq_has_append at *,
  simp,
  constructor,
  constructor,
  refl,
end

theorem sublist : red L₁ L₂ → L₂ <+ L₁ :=
refl_trans_gen_of_transitive_reflexive
  (λl, list.sublist.refl l) (λa b c hab hbc, list.sublist.trans hbc hab) (λa b, red.step.sublist)

end red

end dyck

-- Definition of the dyck syntactic monoid
def dyck (α : Type u) : Type u :=
quot $ @dyck.red.step α

namespace dyck

variable {α}

def mk (L) : dyck α := quot.mk red.step L

@[simp] lemma quot_mk_eq_mk : quot.mk red.step L = mk L := rfl

@[simp] lemma quot_lift_mk (β : Type v) (f : list (α × bool) → β)
  (H : ∀ L₁ L₂, red.step L₁ L₂ → f L₁ = f L₂) :
quot.lift f H (mk L) = f L := rfl

@[simp] lemma quot_lift_on_mk (β : Type v) (f : list (α × bool) → β)
  (H : ∀ L₁ L₂, red.step L₁ L₂ → f L₁ = f L₂) :
quot.lift_on (mk L) f H = f L := rfl

@[simp] lemma quot_map_mk (β : Type v) (f : list (α × bool) → list (β × bool))
  (H : (red.step ⇒ red.step) f f) :
quot.map f H (mk L) = mk (f L) := rfl

instance : has_one (dyck α) := ⟨mk []⟩
lemma one_eq_mk : (1 : dyck α) = mk [] := rfl

instance : inhabited (dyck α) := ⟨1⟩

instance : has_mul (dyck α) :=
⟨λ x y, quot.lift_on x
    (λ L₁, quot.lift_on y (λ L₂, mk $ L₁ ++ L₂) (λ L₂ L₃ H, quot.sound $ red.step.append_left H))
    (λ L₁ L₂ H, quot.induction_on y $ λ L₃, quot.sound $ red.step.append_right H)⟩
@[simp] lemma mul_mk : mk L₁ * mk L₂ = mk (L₁ ++ L₂) := rfl

instance : monoid (dyck α) :=
{ mul := (*),
  one := 1,
  mul_assoc := by rintros ⟨L₁⟩ ⟨L₂⟩ ⟨L₃⟩; simp,
  one_mul := by rintros ⟨L⟩; refl,
  mul_one := by rintros ⟨L⟩; simp [one_eq_mk],
}

def of (x : α) : dyck α :=
mk [(x, tt)]

theorem red.exact : mk L₁ = mk L₂ ↔ join red L₁ L₂ :=
calc (mk L₁ = mk L₂) ↔ eqv_gen red.step L₁ L₂ : iff.intro (quot.exact _) quot.eqv_gen_sound
  ... ↔ join red L₁ L₂ : red.eqv_gen_step_iff_join_red

theorem of_injective : function.injective (@of α) :=
λ _ _ H, let ⟨L₁, hx, hy⟩ := red.exact.1 H in
  by simp [red.singleton_iff] at hx hy; cc

lemma mk_one_iff {L : list (α × bool)}: mk L = 1 ↔ red L [] :=
begin
split,
  { intro h,
    rw [one_eq_mk, red.exact] at h,
    rcases h with ⟨c, hl, hr⟩,
    rw red.nil_iff at hr,
    rw hr at hl,
    exact hl },
  { intro h,
    rw [one_eq_mk, red.exact],
    use ([]),
    exact ⟨h, red.refl⟩ }
end

lemma mk_mul_inv : ∀ {x : α}, mk ([(x, tt), (x, ff)]) = 1 :=
begin
  intro x,
  rw one_eq_mk,
  rw red.exact,
  use ([]),
  split,
  refine red.step.to_red _,
  exact red.step.cons_mul_inv,
  exact red.refl,
end

theorem append_mul_inv_cons_eq {L L₁ : list (α × bool)} {x} :
mk (L ++ (x, tt) :: (x, ff) :: L₁) = mk (L ++ L₁) :=
begin
  have : L ++ (x, tt) :: (x, ff) :: L₁ = L ++ [(x, tt), (x, ff)] ++ L₁ := by simp,
  rw [this, ← mul_mk, ← mul_mk, mk_mul_inv, mul_one, mul_mk],
end

lemma mk_free_group : mk L₁ = mk L₂ → free_group.mk L₁ = free_group.mk L₂ :=
begin
  intro h,
  rw red.exact at *,
  rw free_group.red.exact,
  induction h with c h,
  use c,
  exact ⟨red.to_free_group_red h.1, red.to_free_group_red h.2⟩,
end

end dyck


import field_theory.perfect_closure

import for_mathlib.nnreal

import valuation.basic

lemma iterate_frobenius_apply {α : Type*} [monoid α] (p n : ℕ) (a : α) :
  (frobenius α p)^[n] a = a^p^n :=
begin
  induction n with n ih, {simp},
  rw [nat.iterate_succ', ih, frobenius_def, ← pow_mul, nat.pow_succ]
end

noncomputable theory
open_locale classical

namespace valuation
variables {R : Type*} [comm_ring R]
variables (v : valuation R nnreal)

namespace perfection
open nnreal
variables (p : ℕ) [nat.prime p] [char_p R p]

private def f₀ : ℕ × R → nnreal :=
λ (x : ℕ × R), (v x.2)^(p^(-x.1 : ℤ) : ℝ)

private def hf₀ : ∀ (x₁ x₂ : ℕ × R) (h : perfect_closure.r R p x₁ x₂),
  f₀ v p x₁ = f₀ v p x₂
| x₁ x₂ (perfect_closure.r.intro _ n x) :=
show v x ^ (p ^ (-n : ℤ) : ℝ) = v (x ^ p) ^ (p ^ (-(↑n + 1) : ℤ) : ℝ),
from have hp : (p : ℝ) ≠ 0 := by exact_mod_cast nat.prime.ne_zero ‹_›,
by rw [valuation.map_pow, ← rpow_nat_cast, ← rpow_mul, neg_add_rev,
    fpow_add hp, ← mul_assoc, fpow_inv, mul_inv_cancel hp, one_mul]

def f : perfect_closure R p → nnreal :=
quot.lift (f₀ v p) (hf₀ v p)

lemma f_zero : f v p (0 : perfect_closure R p) = 0 :=
calc f v p (0 : perfect_closure R p) = quot.lift (f₀ v p) (hf₀ v p) (0 : perfect_closure R p) : rfl
  ... = (v (0:R))^(p^(-0:ℤ) : ℝ) : quot.lift_beta (f₀ v p) (hf₀ v p) (0, 0)
  ... = 0 : by rw [v.map_zero, neg_zero, fpow_zero, rpow_one]

lemma f_one : f v p (1 : perfect_closure R p) = 1 :=
calc f v p (1 : perfect_closure R p) = quot.lift (f₀ v p) (hf₀ v p) (1 : perfect_closure R p) : rfl
  ... = (v (1:R))^(p^(-0:ℤ) : ℝ) : quot.lift_beta (f₀ v p) (hf₀ v p) (0, 1)
  ... = 1 : by rw [v.map_one, neg_zero, fpow_zero, rpow_one]

lemma f_mul (r s : perfect_closure R p) : f v p (r * s) = f v p r * f v p s :=
quot.induction_on r $ λ ⟨m,x⟩, quot.induction_on s $ λ ⟨n,y⟩,
show f₀ v p (m + n, _) = f₀ v p (m,x) * f₀ v p (n,y), from
have hp : p ≠ 0 := nat.prime.ne_zero ‹_›,
have hpQ : (p : ℝ) ≠ 0 := by exact_mod_cast hp,
begin
  clear _fun_match _fun_match _x _x,
  dsimp only [f₀],
  simp only [iterate_frobenius_apply, v.map_mul, v.map_pow, mul_rpow],
  congr' 1,
  all_goals {
    rw [← rpow_nat_cast, ← rpow_mul, nat.cast_pow, ←fpow_of_nat, ← fpow_add hpQ],
    { congr, rw [int.coe_nat_add, neg_add], abel }, },
end

lemma f_add (r s : perfect_closure R p) :
  f v p (r + s) ≤ max (f v p r) (f v p s) :=
quot.induction_on r $ λ ⟨m,x⟩, quot.induction_on s $ λ ⟨n,y⟩,
show f₀ v p (m + n, _) ≤ max (f₀ v p (m,x)) (f₀ v p (n,y)), from
have hp : p ≠ 0 := nat.prime.ne_zero ‹_›,
have hpQ : (p : ℝ) ≠ 0 := by exact_mod_cast hp,
begin
  clear _fun_match _fun_match _x _x,
  dsimp only [f₀],
  rw [iterate_frobenius_apply, iterate_frobenius_apply],
  have h := v.map_add (x^p^n) (y^p^m),
  rw le_max_iff at h ⊢,
  cases h with h h; [ {left, rw add_comm m}, right],
  all_goals {
    conv_rhs at h { rw v.map_pow },
    refine le_trans (rpow_le_rpow _ h (fpow_nonneg_of_nonneg (nat.cast_nonneg p) _)) (le_of_eq _),
    rw [← rpow_nat_cast, ← rpow_mul, nat.cast_pow, ←fpow_of_nat, ← fpow_add hpQ],
    { congr, rw [int.coe_nat_add, neg_add], abel }, }
end

end perfection

section
variables (p : ℕ) [nat.prime p] [char_p R p]

def perfection : valuation (perfect_closure R p) nnreal :=
{ to_fun := perfection.f v p,
  map_zero' := perfection.f_zero v p,
  map_one' := perfection.f_one v p,
  map_mul' := perfection.f_mul v p,
  map_add' :=
  begin
    -- TODO(jmc): This is really ugly. But Lean doesn't cooperate.
    -- It finds two instances that aren't defeq.
    intros r s,
    convert perfection.f_add v p r s,
    delta classical.DLO nnreal.decidable_linear_order,
    congr,
  end }

end

end valuation


/-
Copyright (c) 2020 David Wärn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Wärn
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.natural_isomorphism
import Mathlib.PostPort

universes v u l u_1 u_2

namespace Mathlib

/-!
# Quotient category

Constructs the quotient of a category by an arbitrary family of relations on its hom-sets,
by introducing a type synonym for the objects, and identifying homs as necessary.

This is analogous to 'the quotient of a group by the normal closure of a subset', rather
than 'the quotient of a group by a normal subgroup'.
-/

namespace category_theory

/-- A type synonom for `C`, thought of as the objects of the quotient category. -/
structure quotient {C : Type u} [category C] (r : {a b : C} → (a ⟶ b) → (a ⟶ b) → Prop)
where
  as : C

protected instance quotient.inhabited {C : Type u} [category C] (r : {a b : C} → (a ⟶ b) → (a ⟶ b) → Prop) [Inhabited C] : Inhabited (quotient r) :=
  { default := quotient.mk Inhabited.default }

namespace quotient

/-- Generates the closure of a family of relations w.r.t. composition from left and right. -/
inductive comp_closure {C : Type u} [category C] (r : {a b : C} → (a ⟶ b) → (a ⟶ b) → Prop) {s : C} {t : C} : (s ⟶ t) → (s ⟶ t) → Prop
where
| intro : ∀ {a b : C} (f : s ⟶ a) (m₁ m₂ : a ⟶ b) (g : b ⟶ t), r m₁ m₂ → comp_closure r (f ≫ m₁ ≫ g) (f ≫ m₂ ≫ g)

theorem comp_left {C : Type u} [category C] (r : {a b : C} → (a ⟶ b) → (a ⟶ b) → Prop) {a : C} {b : C} {c : C} (f : a ⟶ b) (g₁ : b ⟶ c) (g₂ : b ⟶ c) (h : comp_closure r g₁ g₂) : comp_closure r (f ≫ g₁) (f ≫ g₂) := sorry

theorem comp_right {C : Type u} [category C] (r : {a b : C} → (a ⟶ b) → (a ⟶ b) → Prop) {a : C} {b : C} {c : C} (g : b ⟶ c) (f₁ : a ⟶ b) (f₂ : a ⟶ b) (h : comp_closure r f₁ f₂) : comp_closure r (f₁ ≫ g) (f₂ ≫ g) := sorry

/-- Hom-sets of the quotient category. -/
def hom {C : Type u} [category C] (r : {a b : C} → (a ⟶ b) → (a ⟶ b) → Prop) (s : quotient r) (t : quotient r) :=
  Quot (comp_closure r)

protected instance hom.inhabited {C : Type u} [category C] (r : {a b : C} → (a ⟶ b) → (a ⟶ b) → Prop) (a : quotient r) : Inhabited (hom r a a) :=
  { default := Quot.mk (comp_closure r) 𝟙 }

/-- Composition in the quotient category. -/
def comp {C : Type u} [category C] (r : {a b : C} → (a ⟶ b) → (a ⟶ b) → Prop) {a : quotient r} {b : quotient r} {c : quotient r} : hom r a b → hom r b c → hom r a c :=
  fun (hf : hom r a b) (hg : hom r b c) =>
    quot.lift_on hf
      (fun (f : as a ⟶ as b) => quot.lift_on hg (fun (g : as b ⟶ as c) => Quot.mk (comp_closure r) (f ≫ g)) sorry) sorry

@[simp] theorem comp_mk {C : Type u} [category C] (r : {a b : C} → (a ⟶ b) → (a ⟶ b) → Prop) {a : quotient r} {b : quotient r} {c : quotient r} (f : as a ⟶ as b) (g : as b ⟶ as c) : comp r (Quot.mk (comp_closure r) f) (Quot.mk (comp_closure r) g) = Quot.mk (comp_closure r) (f ≫ g) :=
  rfl

protected instance category {C : Type u} [category C] (r : {a b : C} → (a ⟶ b) → (a ⟶ b) → Prop) : category (quotient r) :=
  category.mk

/-- The functor from a category to its quotient. -/
@[simp] theorem functor_map {C : Type u} [category C] (r : {a b : C} → (a ⟶ b) → (a ⟶ b) → Prop) (_x : C) : ∀ (_x_1 : C) (f : _x ⟶ _x_1), functor.map (functor r) f = Quot.mk (comp_closure r) f :=
  fun (_x_1 : C) (f : _x ⟶ _x_1) => Eq.refl (functor.map (functor r) f)

protected theorem induction {C : Type u} [category C] (r : {a b : C} → (a ⟶ b) → (a ⟶ b) → Prop) {P : {a b : quotient r} → (a ⟶ b) → Prop} (h : ∀ {x y : C} (f : x ⟶ y), P (functor.map (functor r) f)) {a : quotient r} {b : quotient r} (f : a ⟶ b) : P f := sorry

protected theorem sound {C : Type u} [category C] (r : {a b : C} → (a ⟶ b) → (a ⟶ b) → Prop) {a : C} {b : C} {f₁ : a ⟶ b} {f₂ : a ⟶ b} (h : r f₁ f₂) : functor.map (functor r) f₁ = functor.map (functor r) f₂ := sorry

/-- The induced functor on the quotient category. -/
def lift {C : Type u} [category C] (r : {a b : C} → (a ⟶ b) → (a ⟶ b) → Prop) {D : Type u_1} [category D] (F : C ⥤ D) (H : ∀ (x y : C) (f₁ f₂ : x ⟶ y), r f₁ f₂ → functor.map F f₁ = functor.map F f₂) : quotient r ⥤ D :=
  functor.mk (fun (a : quotient r) => functor.obj F (as a))
    fun (a b : quotient r) (hf : a ⟶ b) => quot.lift_on hf (fun (f : as a ⟶ as b) => functor.map F f) sorry

/-- The original functor factors through the induced functor. -/
def lift.is_lift {C : Type u} [category C] (r : {a b : C} → (a ⟶ b) → (a ⟶ b) → Prop) {D : Type u_1} [category D] (F : C ⥤ D) (H : ∀ (x y : C) (f₁ f₂ : x ⟶ y), r f₁ f₂ → functor.map F f₁ = functor.map F f₂) : functor r ⋙ lift r F H ≅ F :=
  nat_iso.of_components (fun (X : C) => iso.refl (functor.obj (functor r ⋙ lift r F H) X)) sorry

@[simp] theorem lift.is_lift_hom {C : Type u} [category C] (r : {a b : C} → (a ⟶ b) → (a ⟶ b) → Prop) {D : Type u_1} [category D] (F : C ⥤ D) (H : ∀ (x y : C) (f₁ f₂ : x ⟶ y), r f₁ f₂ → functor.map F f₁ = functor.map F f₂) (X : C) : nat_trans.app (iso.hom (lift.is_lift r F H)) X = 𝟙 :=
  rfl

@[simp] theorem lift.is_lift_inv {C : Type u} [category C] (r : {a b : C} → (a ⟶ b) → (a ⟶ b) → Prop) {D : Type u_1} [category D] (F : C ⥤ D) (H : ∀ (x y : C) (f₁ f₂ : x ⟶ y), r f₁ f₂ → functor.map F f₁ = functor.map F f₂) (X : C) : nat_trans.app (iso.inv (lift.is_lift r F H)) X = 𝟙 :=
  rfl


import data.finsupp
import algebra.ring
import .to_finset
import .to_multiset

local infix ^ := monoid.pow

universe u
variable {α : Type u}
variable [semiring α]

def associated (x y : α) : Prop:=
∃u : units α, x = u * y

local notation a `~ᵤ` b : 50 := associated a b

def is_unit (a : α) : Prop := ∃b : units α, a = b

/- is used once in UFD, but I don't understand what it does
-/
lemma is_unit_unit  (u : units α) : @is_unit α _ u :=
⟨u, rfl⟩

@[simp] lemma is_unit_one : is_unit (1 : α ) := ⟨1, rfl⟩

--Should I do all these lemmas using the zero_ne_one class?
@[simp] lemma not_is_unit_zero (h : (0 : α) ≠ 1) : ¬ is_unit (0 : α) := --Do we need semiring?
begin
  intro h,
  rcases h with ⟨u, hu⟩,
  have h2: u.val*u.inv = 1,
    from u.val_inv,
  simp [units.val_coe] at *,
  rw [←hu, _root_.zero_mul] at h2,
  contradiction,
end

lemma ne_zero_of_is_unit {a : α} (h : (0 : α) ≠ 1) : is_unit a → a ≠ 0 :=
begin
  intros h1 h2,
  subst h2,
  exact not_is_unit_zero h h1,
end

lemma is_unit_mul_of_is_unit_of_is_unit {a b : α} (h1 : is_unit a) (h2 : is_unit b) : is_unit (a * b) :=
let ⟨aᵤ, ha⟩ := h1 in
let ⟨bᵤ, hb⟩ := h2 in ⟨aᵤ*bᵤ, by simp [units.mul_coe, *]⟩

lemma zero_associated_zero   : (0 : α) ~ᵤ 0 := ⟨1, by simp⟩

lemma unit_associated_one {u : units α}: (u : α) ~ᵤ 1 := ⟨u, by simp⟩


/-
Copyright (c) 2022 Newell Jensen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Newell Jensen
-/
import Lean

/-!
# `rfl` tactic extension for reflexive relations

This extends the `rfl` tactic so that it works on any reflexive relation,
provided the reflexivity lemma has been marked as `@[refl]`.
-/

namespace Mathlib.Tactic

open Lean Meta

/-- Environment extensions for `refl` lemmas -/
initialize reflExt :
    SimpleScopedEnvExtension (Name × Array (DiscrTree.Key true)) (DiscrTree Name true) ←
  registerSimpleScopedEnvExtension {
    addEntry := fun dt (n, ks) ↦ dt.insertCore ks n
    initial := {}
  }

initialize registerBuiltinAttribute {
  name := `refl
  descr := "reflexivity relation"
  add := fun decl _ kind ↦ MetaM.run' do
    let declTy := (← getConstInfo decl).type
    let (_, _, targetTy) ← withReducible <| forallMetaTelescopeReducing declTy
    let fail := throwError
      "@[refl] attribute only applies to lemmas proving x ∼ x, got {declTy}"
    let .app (.app rel lhs) rhs := targetTy | fail
    unless ← withNewMCtxDepth <| isDefEq lhs rhs do fail
    let key ← DiscrTree.mkPath rel
    reflExt.add (decl, key) kind
}

open Elab.Tactic in
/--
This tactic applies to a goal whose target has the form `x ~ x`, where `~` is a reflexive
relation, that is, a relation which has a reflexive lemma tagged with the attribute [refl].
-/
elab_rules : tactic
| `(tactic| rfl) => withMainContext do
  let tgt ← getMainTarget
  let .app (.app rel _) _ := tgt
    | throwError "reflexivity lemmas only apply to binary relations, not {indentExpr tgt}"
  let s ← saveState
  for lem in ← (reflExt.getState (← getEnv)).getMatch rel do
    try
      liftMetaTactic (·.apply (← mkConstWithFreshMVarLevels lem))
      return
    catch e =>
      s.restore
      throw e
  throwError "rfl failed, no lemma with @[refl] applies"


universe u
variables (α β : Type u)

example (f : α → β) (a : α) : (λ x, f x) a = f a := rfl
example (a : α) (b : α) : (a, b).1 = a := rfl
example : 2 + 3 = 5 := rfl


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura

! This file was ported from Lean 3 source module logic.basic
! leanprover-community/mathlib commit d2d8742b0c21426362a9dacebc6005db895ca963
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Init.Logic
import Mathlib.Init.Function
import Mathlib.Init.Algebra.Classes
import Mathlib.Tactic.Basic
import Mathlib.Tactic.LeftRight
import Std.Util.LibraryNote
import Std.Tactic.Lint.Basic

/-!
# Basic logic properties

This file is one of the earliest imports in mathlib.

## Implementation notes

Theorems that require decidability hypotheses are in the namespace `Decidable`.
Classical versions are in the namespace `Classical`.
-/

open Function
attribute [local instance 10] Classical.propDecidable

section Miscellany

-- Porting note: the following `inline` attributes have been omitted,
-- on the assumption that this issue has been dealt with properly in Lean 4.
-- /- We add the `inline` attribute to optimize VM computation using these declarations.
--    For example, `if p ∧ q then ... else ...` will not evaluate the decidability
--    of `q` if `p` is false. -/
-- attribute [inline]
--   And.decidable Or.decidable Decidable.false Xor.decidable Iff.decidable Decidable.true
--   Implies.decidable Not.decidable Ne.decidable Bool.decidableEq Decidable.toBool

attribute [simp] cast_eq cast_heq

/-- An identity function with its main argument implicit. This will be printed as `hidden` even
if it is applied to a large term, so it can be used for elision,
as done in the `elide` and `unelide` tactics. -/
@[reducible] def hidden {α : Sort _} {a : α} := a
#align hidden hidden

instance (priority := 10) decidableEq_of_subsingleton [Subsingleton α] : DecidableEq α :=
  fun a b ↦ isTrue (Subsingleton.elim a b)
#align decidable_eq_of_subsingleton decidableEq_of_subsingleton

instance (α : Sort _) [Subsingleton α] (p : α → Prop) : Subsingleton (Subtype p) :=
  ⟨fun ⟨x, _⟩ ⟨y, _⟩ ↦ by cases Subsingleton.elim x y; rfl⟩

#align pempty PEmpty

theorem congr_heq {α β γ : Sort _} {f : α → γ} {g : β → γ} {x : α} {y : β}
    (h₁ : HEq f g) (h₂ : HEq x y) : f x = g y := by
  cases h₂; cases h₁; rfl
#align congr_heq congr_heq

theorem congr_arg_heq {α} {β : α → Sort _} (f : ∀ a, β a) :
    ∀ {a₁ a₂ : α}, a₁ = a₂ → HEq (f a₁) (f a₂)
  | _, _, rfl => HEq.rfl
#align congr_arg_heq congr_arg_heq

theorem ULift.down_injective {α : Sort _} : Function.Injective (@ULift.down α)
  | ⟨a⟩, ⟨b⟩, _ => by congr
#align ulift.down_injective ULift.down_injective

@[simp] theorem ULift.down_inj {α : Sort _} {a b : ULift α} : a.down = b.down ↔ a = b :=
  ⟨fun h ↦ ULift.down_injective h, fun h ↦ by rw [h]⟩
#align ulift.down_inj ULift.down_inj

theorem PLift.down_injective {α : Sort _} : Function.Injective (@PLift.down α)
  | ⟨a⟩, ⟨b⟩, _ => by congr
#align plift.down_injective PLift.down_injective

@[simp] theorem PLift.down_inj {α : Sort _} {a b : PLift α} : a.down = b.down ↔ a = b :=
  ⟨fun h ↦ PLift.down_injective h, fun h ↦ by rw [h]⟩
#align plift.down_inj PLift.down_inj

@[simp] theorem eq_iff_eq_cancel_left {b c : α} : (∀ {a}, a = b ↔ a = c) ↔ b = c :=
  ⟨fun h ↦ by rw [← h], fun h a ↦ by rw [h]⟩
#align eq_iff_eq_cancel_left eq_iff_eq_cancel_left

@[simp] theorem eq_iff_eq_cancel_right {a b : α} : (∀ {c}, a = c ↔ b = c) ↔ a = b :=
  ⟨fun h ↦ by rw [h], fun h a ↦ by rw [h]⟩
#align eq_iff_eq_cancel_right eq_iff_eq_cancel_right

lemma ne_and_eq_iff_right {α : Sort _} {a b c : α} (h : b ≠ c) : a ≠ b ∧ a = c ↔ a = c :=
  and_iff_right_of_imp (fun h2 => h2.symm ▸ h.symm)
#align ne_and_eq_iff_right ne_and_eq_iff_right

/-- Wrapper for adding elementary propositions to the type class systems.
Warning: this can easily be abused. See the rest of this docstring for details.

Certain propositions should not be treated as a class globally,
but sometimes it is very convenient to be able to use the type class system
in specific circumstances.

For example, `ZMod p` is a field if and only if `p` is a prime number.
In order to be able to find this field instance automatically by type class search,
we have to turn `p.prime` into an instance implicit assumption.

On the other hand, making `Nat.prime` a class would require a major refactoring of the library,
and it is questionable whether making `Nat.prime` a class is desirable at all.
The compromise is to add the assumption `[Fact p.prime]` to `ZMod.field`.

In particular, this class is not intended for turning the type class system
into an automated theorem prover for first order logic. -/
class Fact (p : Prop) : Prop where
  /-- `Fact.out` contains the unwrapped witness for the fact represented by the instance of
  `Fact p`. -/
  out : p
#align fact Fact

library_note "fact non-instances"/--
In most cases, we should not have global instances of `Fact`; typeclass search only reads the head
symbol and then tries any instances, which means that adding any such instance will cause slowdowns
everywhere. We instead make them as lemmata and make them local instances as required.
-/

theorem Fact.elim {p : Prop} (h : Fact p) : p := h.1
theorem fact_iff {p : Prop} : Fact p ↔ p := ⟨fun h ↦ h.1, fun h ↦ ⟨h⟩⟩
#align fact_iff fact_iff
#align fact.elim Fact.elim

/-- Swaps two pairs of arguments to a function. -/
@[reducible] def Function.swap₂ {κ₁ : ι₁ → Sort _} {κ₂ : ι₂ → Sort _}
    {φ : ∀ i₁, κ₁ i₁ → ∀ i₂, κ₂ i₂ → Sort _} (f : ∀ i₁ j₁ i₂ j₂, φ i₁ j₁ i₂ j₂)
    (i₂ j₂ i₁ j₁) : φ i₁ j₁ i₂ j₂ := f i₁ j₁ i₂ j₂
#align function.swap₂ Function.swap₂

-- Porting note: these don't work as intended any more
-- /-- If `x : α . tac_name` then `x.out : α`. These are definitionally equal, but this can
-- nevertheless be useful for various reasons, e.g. to apply further projection notation or in an
-- argument to `simp`. -/
-- def autoParam'.out {α : Sort _} {n : Name} (x : autoParam' α n) : α := x

-- /-- If `x : α := d` then `x.out : α`. These are definitionally equal, but this can
-- nevertheless be useful for various reasons, e.g. to apply further projection notation or in an
-- argument to `simp`. -/
-- def optParam.out {α : Sort _} {d : α} (x : α := d) : α := x

end Miscellany

open Function

/-!
### Declarations about propositional connectives
-/

section Propositional

/-! ### Declarations about `implies` -/

instance : IsRefl Prop Iff := ⟨Iff.refl⟩

instance : IsTrans Prop Iff := ⟨fun _ _ _ ↦ Iff.trans⟩

alias imp_congr ← Iff.imp
#align iff.imp Iff.imp

@[simp] theorem eq_true_eq_id : Eq True = id := by
  funext _; simp only [true_iff, id.def, eq_iff_iff]
#align eq_true_eq_id eq_true_eq_id

#align imp_and_distrib imp_and
#align imp_iff_right imp_iff_rightₓ -- reorder implicits
#align imp_iff_not imp_iff_notₓ -- reorder implicits

@[simp] theorem imp_iff_right_iff : (a → b ↔ b) ↔ a ∨ b := Decidable.imp_iff_right_iff
#align imp_iff_right_iff imp_iff_right_iff

@[simp] theorem and_or_imp : a ∧ b ∨ (a → c) ↔ a → b ∨ c := Decidable.and_or_imp
#align and_or_imp and_or_imp

/-- Provide modus tollens (`mt`) as dot notation for implications. -/
protected theorem Function.mt : (a → b) → ¬b → ¬a := mt
#align function.mt Function.mt

/-! ### Declarations about `not` -/

alias Decidable.em ← dec_em
#align dec_em dec_em

theorem dec_em' (p : Prop) [Decidable p] : ¬p ∨ p := (dec_em p).symm
#align dec_em' dec_em'

alias Classical.em ← em
#align em em

theorem em' (p : Prop) : ¬p ∨ p := (em p).symm
#align em' em'

theorem or_not {p : Prop} : p ∨ ¬p := em _
#align or_not or_not

theorem Decidable.eq_or_ne (x y : α) [Decidable (x = y)] : x = y ∨ x ≠ y := dec_em <| x = y
#align decidable.eq_or_ne Decidable.eq_or_ne

theorem Decidable.ne_or_eq (x y : α) [Decidable (x = y)] : x ≠ y ∨ x = y := dec_em' <| x = y
#align decidable.ne_or_eq Decidable.ne_or_eq

theorem eq_or_ne (x y : α) : x = y ∨ x ≠ y := em <| x = y
#align eq_or_ne eq_or_ne

theorem ne_or_eq (x y : α) : x ≠ y ∨ x = y := em' <| x = y
#align ne_or_eq ne_or_eq

theorem by_contradiction : (¬p → False) → p := Decidable.by_contradiction
#align classical.by_contradiction by_contradiction
#align by_contradiction by_contradiction

theorem by_cases {q : Prop} (hpq : p → q) (hnpq : ¬p → q) : q :=
if hp : p then hpq hp else hnpq hp
#align classical.by_cases by_cases

alias by_contradiction ← by_contra
#align by_contra by_contra

library_note "decidable namespace"/--
In most of mathlib, we use the law of excluded middle (LEM) and the axiom of choice (AC) freely.
The `Decidable` namespace contains versions of lemmas from the root namespace that explicitly
attempt to avoid the axiom of choice, usually by adding decidability assumptions on the inputs.

You can check if a lemma uses the axiom of choice by using `#print axioms foo` and seeing if
`Classical.choice` appears in the list.
-/

library_note "decidable arguments"/--
As mathlib is primarily classical,
if the type signature of a `def` or `lemma` does not require any `Decidable` instances to state,
it is preferable not to introduce any `Decidable` instances that are needed in the proof
as arguments, but rather to use the `classical` tactic as needed.

In the other direction, when `Decidable` instances do appear in the type signature,
it is better to use explicitly introduced ones rather than allowing Lean to automatically infer
classical ones, as these may cause instance mismatch errors later.
-/

export Classical (not_not)
attribute [simp] not_not
#align not_not Classical.not_not

theorem of_not_not : ¬¬a → a := by_contra
#align of_not_not of_not_not

theorem not_ne_iff : ¬a ≠ b ↔ a = b := not_not
#align not_ne_iff not_ne_iff

theorem of_not_imp {a b : Prop} : ¬(a → b) → a := Decidable.of_not_imp
#align of_not_imp of_not_imp

alias Decidable.not_imp_symm ← Not.decidable_imp_symm
#align not.decidable_imp_symm Not.decidable_imp_symm

theorem Not.imp_symm : (¬a → b) → ¬b → a := Not.decidable_imp_symm
#align not.imp_symm Not.imp_symm

theorem not_imp_comm : ¬a → b ↔ ¬b → a := Decidable.not_imp_comm
#align not_imp_comm not_imp_comm

@[simp] theorem not_imp_self : ¬a → a ↔ a := Decidable.not_imp_self
#align not_imp_self not_imp_self

theorem Imp.swap : a → b → c ↔ b → a → c := ⟨Function.swap, Function.swap⟩
#align imp.swap Imp.swap

alias not_congr ← Iff.not
theorem Iff.not_left (h : a ↔ ¬b) : ¬a ↔ b := h.not.trans not_not
theorem Iff.not_right (h : ¬a ↔ b) : a ↔ ¬b := not_not.symm.trans h.not
#align iff.not_right Iff.not_right
#align iff.not_left Iff.not_left
#align iff.not Iff.not

/-! ### Declarations about `xor` -/

@[simp] theorem xor_true : Xor' True = Not := by simp [Xor']
#align xor_true xor_true

@[simp] theorem xor_false : Xor' False = id := by ext; simp [Xor']
#align xor_false xor_false

theorem xor_comm (a b) : Xor' a b = Xor' b a := by simp [Xor', and_comm, or_comm]
#align xor_comm xor_comm

instance : IsCommutative Prop Xor' := ⟨xor_comm⟩

@[simp] theorem xor_self (a : Prop) : Xor' a a = False := by simp [Xor']
@[simp] theorem xor_not_left : Xor' (¬a) b ↔ (a ↔ b) := by by_cases a <;> simp [*]
@[simp] theorem xor_not_right : Xor' a (¬b) ↔ (a ↔ b) := by by_cases a <;> simp [*]
theorem xor_not_not : Xor' (¬a) (¬b) ↔ Xor' a b := by simp [Xor', or_comm, and_comm]
protected theorem Xor'.or (h : Xor' a b) : a ∨ b := h.imp And.left And.left
#align xor.or Xor'.or
#align xor_not_not xor_not_not
#align xor_not_right xor_not_right
#align xor_not_left xor_not_left
#align xor_self xor_self

/-! ### Declarations about `and` -/

alias and_congr ← Iff.and
#align and_congr_left and_congr_leftₓ -- reorder implicits
#align and_congr_right' and_congr_right'ₓ -- reorder implicits
#align and.right_comm and_right_comm
#align and_and_distrib_left and_and_left
#align and_and_distrib_right and_and_right
alias and_rotate ↔ And.rotate _
#align and.congr_right_iff and_congr_right_iff
#align and.congr_left_iff and_congr_left_iffₓ -- reorder implicits
#align and.rotate And.rotate
#align iff.and Iff.and

theorem and_symm_right (a b : α) (p : Prop) : p ∧ a = b ↔ p ∧ b = a := by simp [eq_comm]
theorem and_symm_left (a b : α) (p : Prop) : a = b ∧ p ↔ b = a ∧ p := by simp [eq_comm]

/-! ### Declarations about `or` -/

alias or_congr ← Iff.or
#align or_congr_left' or_congr_left
#align or_congr_right' or_congr_rightₓ -- reorder implicits
#align or.right_comm or_right_comm
alias or_rotate ↔ Or.rotate _
#align or.rotate Or.rotate
#align iff.or Iff.or

@[deprecated Or.imp]
theorem or_of_or_of_imp_of_imp (h₁ : a ∨ b) (h₂ : a → c) (h₃ : b → d) : c ∨ d := Or.imp h₂ h₃ h₁
#align or_of_or_of_imp_of_imp or_of_or_of_imp_of_imp

@[deprecated Or.imp_left]
theorem or_of_or_of_imp_left (h₁ : a ∨ c) (h : a → b) : b ∨ c := Or.imp_left h h₁
#align or_of_or_of_imp_left or_of_or_of_imp_left

@[deprecated Or.imp_right]
theorem or_of_or_of_imp_right (h₁ : c ∨ a) (h : a → b) : c ∨ b := Or.imp_right h h₁
#align or_of_or_of_imp_right or_of_or_of_imp_right

theorem Or.elim3 {d : Prop} (h : a ∨ b ∨ c) (ha : a → d) (hb : b → d) (hc : c → d) : d :=
  Or.elim h ha fun h₂ ↦ Or.elim h₂ hb hc
#align or.elim3 Or.elim3

theorem Or.imp3 (had : a → d) (hbe : b → e) (hcf : c → f) : a ∨ b ∨ c → d ∨ e ∨ f :=
  Or.imp had <| Or.imp hbe hcf
#align or.imp3 Or.imp3

#align or_imp_distrib or_imp

theorem or_iff_not_imp_left : a ∨ b ↔ ¬a → b := Decidable.or_iff_not_imp_left
#align or_iff_not_imp_left or_iff_not_imp_left

theorem or_iff_not_imp_right : a ∨ b ↔ ¬b → a := Decidable.or_iff_not_imp_right
#align or_iff_not_imp_right or_iff_not_imp_right

theorem not_or_of_imp : (a → b) → ¬a ∨ b := Decidable.not_or_of_imp
#align not_or_of_imp not_or_of_imp

-- See Note [decidable namespace]
protected theorem Decidable.or_not_of_imp [Decidable a] (h : a → b) : b ∨ ¬a :=
  dite _ (Or.inl ∘ h) Or.inr
#align decidable.or_not_of_imp Decidable.or_not_of_imp

theorem or_not_of_imp : (a → b) → b ∨ ¬a := Decidable.or_not_of_imp
#align or_not_of_imp or_not_of_imp

theorem imp_iff_not_or : a → b ↔ ¬a ∨ b := Decidable.imp_iff_not_or
#align imp_iff_not_or imp_iff_not_or

theorem imp_iff_or_not : b → a ↔ a ∨ ¬b := Decidable.imp_iff_or_not
#align imp_iff_or_not imp_iff_or_not

theorem not_imp_not : ¬a → ¬b ↔ b → a := Decidable.not_imp_not
#align not_imp_not not_imp_not

/-- Provide the reverse of modus tollens (`mt`) as dot notation for implications. -/
protected theorem Function.mtr : (¬a → ¬b) → b → a := not_imp_not.mp
#align function.mtr Function.mtr

#align decidable.or_congr_left Decidable.or_congr_left'
#align decidable.or_congr_right Decidable.or_congr_right'
#align decidable.or_iff_not_imp_right Decidable.or_iff_not_imp_rightₓ -- reorder implicits
#align decidable.imp_iff_or_not Decidable.imp_iff_or_notₓ -- reorder implicits

theorem or_congr_left' (h : ¬c → (a ↔ b)) : a ∨ c ↔ b ∨ c := Decidable.or_congr_left' h
#align or_congr_left or_congr_left'

theorem or_congr_right' (h : ¬a → (b ↔ c)) : a ∨ b ↔ a ∨ c := Decidable.or_congr_right' h
#align or_congr_right or_congr_right'ₓ -- reorder implicits

#align or_iff_left or_iff_leftₓ -- reorder implicits

/-! ### Declarations about distributivity -/

#align and_or_distrib_left and_or_left
#align or_and_distrib_right or_and_right
#align or_and_distrib_left or_and_left
#align and_or_distrib_right and_or_right

/-! Declarations about `iff` -/

alias iff_congr ← Iff.iff
#align iff.iff Iff.iff

-- @[simp] -- FIXME simp ignores proof rewrites
theorem iff_mpr_iff_true_intro (h : P) : Iff.mpr (iff_true_intro h) True.intro = h := rfl
#align iff_mpr_iff_true_intro iff_mpr_iff_true_intro

#align decidable.imp_or_distrib Decidable.imp_or

theorem imp_or {a b c : Prop} : a → b ∨ c ↔ (a → b) ∨ (a → c) := Decidable.imp_or
#align imp_or_distrib imp_or

#align decidable.imp_or_distrib' Decidable.imp_or'

theorem imp_or' : a → b ∨ c ↔ (a → b) ∨ (a → c) := Decidable.imp_or'
#align imp_or_distrib' imp_or'ₓ -- universes

theorem not_imp : ¬(a → b) ↔ a ∧ ¬b := Decidable.not_imp
#align not_imp not_imp

theorem peirce (a b : Prop) : ((a → b) → a) → a := Decidable.peirce _ _
#align peirce peirce

theorem not_iff_not : (¬a ↔ ¬b) ↔ (a ↔ b) := Decidable.not_iff_not
#align not_iff_not not_iff_not

theorem not_iff_comm : (¬a ↔ b) ↔ (¬b ↔ a) := Decidable.not_iff_comm
#align not_iff_comm not_iff_comm

theorem not_iff : ¬(a ↔ b) ↔ (¬a ↔ b) := Decidable.not_iff
#align not_iff not_iff

theorem iff_not_comm : (a ↔ ¬b) ↔ (b ↔ ¬a) := Decidable.iff_not_comm
#align iff_not_comm iff_not_comm

theorem iff_iff_and_or_not_and_not : (a ↔ b) ↔ a ∧ b ∨ ¬a ∧ ¬b :=
  Decidable.iff_iff_and_or_not_and_not
#align iff_iff_and_or_not_and_not iff_iff_and_or_not_and_not

theorem iff_iff_not_or_and_or_not : (a ↔ b) ↔ (¬a ∨ b) ∧ (a ∨ ¬b) :=
  Decidable.iff_iff_not_or_and_or_not
#align iff_iff_not_or_and_or_not iff_iff_not_or_and_or_not

theorem not_and_not_right : ¬(a ∧ ¬b) ↔ a → b := Decidable.not_and_not_right
#align not_and_not_right not_and_not_right

#align decidable_of_iff decidable_of_iff
#align decidable_of_iff' decidable_of_iff'
#align decidable_of_bool decidable_of_bool

/-! ### De Morgan's laws -/

#align decidable.not_and_distrib Decidable.not_and
#align decidable.not_and_distrib' Decidable.not_and'

/-- One of de Morgan's laws: the negation of a conjunction is logically equivalent to the
disjunction of the negations. -/
theorem not_and_or : ¬(a ∧ b) ↔ ¬a ∨ ¬b := Decidable.not_and
#align not_and_distrib not_and_or

#align not_or_distrib not_or

theorem or_iff_not_and_not : a ∨ b ↔ ¬(¬a ∧ ¬b) := Decidable.or_iff_not_and_not
#align or_iff_not_and_not or_iff_not_and_not

theorem and_iff_not_or_not : a ∧ b ↔ ¬(¬a ∨ ¬b) := Decidable.and_iff_not_or_not
#align and_iff_not_or_not and_iff_not_or_not

@[simp] theorem not_xor (P Q : Prop) : ¬Xor' P Q ↔ (P ↔ Q) := by
  simp only [not_and, Xor', not_or, not_not, ← iff_iff_implies_and_implies]
#align not_xor not_xor

theorem xor_iff_not_iff (P Q : Prop) : Xor' P Q ↔ ¬ (P ↔ Q) := (not_xor P Q).not_right
theorem xor_iff_iff_not : Xor' a b ↔ (a ↔ ¬b) := by simp only [← @xor_not_right a, not_not]
theorem xor_iff_not_iff' : Xor' a b ↔ (¬a ↔ b) := by simp only [← @xor_not_left _ b, not_not]
#align xor_iff_not_iff' xor_iff_not_iff'
#align xor_iff_iff_not xor_iff_iff_not
#align xor_iff_not_iff xor_iff_not_iff

end Propositional

/-! ### Declarations about equality -/

alias ne_of_mem_of_not_mem ← Membership.mem.ne_of_not_mem
alias ne_of_mem_of_not_mem' ← Membership.mem.ne_of_not_mem'

#align has_mem.mem.ne_of_not_mem Membership.mem.ne_of_not_mem
#align has_mem.mem.ne_of_not_mem' Membership.mem.ne_of_not_mem'

section Equality

-- todo: change name
theorem ball_cond_comm {α} {s : α → Prop} {p : α → α → Prop} :
    (∀ a, s a → ∀ b, s b → p a b) ↔ ∀ a b, s a → s b → p a b :=
  ⟨fun h a b ha hb ↦ h a ha b hb, fun h a ha b hb ↦ h a b ha hb⟩
#align ball_cond_comm ball_cond_comm

theorem ball_mem_comm {α β} [Membership α β] {s : β} {p : α → α → Prop} :
    (∀ a (_ : a ∈ s) b (_ : b ∈ s), p a b) ↔ ∀ a b, a ∈ s → b ∈ s → p a b :=
  ball_cond_comm
#align ball_mem_comm ball_mem_comm

theorem ne_of_apply_ne {α β : Sort _} (f : α → β) {x y : α} (h : f x ≠ f y) : x ≠ y :=
  fun w : x = y ↦ h (congr_arg f w)
#align ne_of_apply_ne ne_of_apply_ne

theorem eq_equivalence : Equivalence (@Eq α) :=
  ⟨Eq.refl, @Eq.symm _, @Eq.trans _⟩
#align eq_equivalence eq_equivalence

@[simp] theorem eq_mp_eq_cast (h : α = β) : Eq.mp h = cast h := rfl
#align eq_mp_eq_cast eq_mp_eq_cast

@[simp] theorem eq_mpr_eq_cast (h : α = β) : Eq.mpr h = cast h.symm := rfl
#align eq_mpr_eq_cast eq_mpr_eq_cast

@[simp] theorem cast_cast : ∀ (ha : α = β) (hb : β = γ) (a : α),
    cast hb (cast ha a) = cast (ha.trans hb) a
  | rfl, rfl, _ => rfl
#align cast_cast cast_cast

-- @[simp] -- FIXME simp ignores proof rewrites
theorem congr_refl_left (f : α → β) {a b : α} (h : a = b) :
    congr (Eq.refl f) h = congr_arg f h := rfl
#align congr_refl_left congr_refl_left

-- @[simp] -- FIXME simp ignores proof rewrites
theorem congr_refl_right {f g : α → β} (h : f = g) (a : α) :
    congr h (Eq.refl a) = congr_fun h a := rfl
#align congr_refl_right congr_refl_right

-- @[simp] -- FIXME simp ignores proof rewrites
theorem congr_arg_refl (f : α → β) (a : α) : congr_arg f (Eq.refl a) = Eq.refl (f a) := rfl
#align congr_arg_refl congr_arg_refl

-- @[simp] -- FIXME simp ignores proof rewrites
theorem congr_fun_rfl (f : α → β) (a : α) : congr_fun (Eq.refl f) a = Eq.refl (f a) := rfl
#align congr_fun_rfl congr_fun_rfl

-- @[simp] -- FIXME simp ignores proof rewrites
theorem congr_fun_congr_arg (f : α → β → γ) {a a' : α} (p : a = a') (b : β) :
    congr_fun (congr_arg f p) b = congr_arg (fun a ↦ f a b) p := rfl
#align congr_fun_congr_arg congr_fun_congr_arg

theorem heq_of_cast_eq : ∀ (e : α = β) (_ : cast e a = a'), HEq a a'
  | rfl, h => Eq.recOn h (HEq.refl _)
#align heq_of_cast_eq heq_of_cast_eq

theorem cast_eq_iff_heq : cast e a = a' ↔ HEq a a' :=
  ⟨heq_of_cast_eq _, fun h ↦ by cases h; rfl⟩
#align cast_eq_iff_heq cast_eq_iff_heq

--Porting note: new theorem. More general version of `eqRec_heq`
theorem eqRec_heq' {α : Sort u_1} {a' : α} {motive : (a : α) → a' = a → Sort u}
    (p : motive a' (rfl : a' = a')) {a : α} (t : a' = a) :
    HEq (@Eq.rec α a' motive p a t) p :=
  by subst t; rfl

theorem rec_heq_of_heq {C : α → Sort _} {x : C a} {y : β} (e : a = b) (h : HEq x y) :
    HEq (e ▸ x) y := by subst e; exact h
#align rec_heq_of_heq rec_heq_of_heq

theorem rec_heq_iff_heq {C : α → Sort _} {x : C a} {y : β} {e : a = b} :
    HEq (e ▸ x) y ↔ HEq x y := by subst e; rfl
#align rec_heq_iff_heq rec_heq_iff_heq

theorem heq_rec_iff_heq {C : α → Sort _} {x : β} {y : C a} {e : a = b} :
    HEq x (e ▸ y) ↔ HEq x y := by subst e; rfl
#align heq_rec_iff_heq heq_rec_iff_heq

protected theorem Eq.congr (h₁ : x₁ = y₁) (h₂ : x₂ = y₂) : x₁ = x₂ ↔ y₁ = y₂ := by
  subst h₁; subst h₂; rfl
#align eq.congr Eq.congr

theorem Eq.congr_left {x y z : α} (h : x = y) : x = z ↔ y = z := by rw [h]
#align eq.congr_left Eq.congr_left

theorem Eq.congr_right {x y z : α} (h : x = y) : z = x ↔ z = y := by rw [h]
#align eq.congr_right Eq.congr_right

alias congrArg₂ ← congr_arg₂
#align congr_arg2 congr_arg₂

variable {β : α → Sort _} {γ : ∀ a, β a → Sort _} {δ : ∀ a b, γ a b → Sort _}

theorem congr_fun₂ {f g : ∀ a b, γ a b} (h : f = g) (a : α) (b : β a) : f a b = g a b :=
  congr_fun (congr_fun h _) _
#align congr_fun₂ congr_fun₂

theorem congr_fun₃ {f g : ∀ a b c, δ a b c} (h : f = g) (a : α) (b : β a) (c : γ a b) :
    f a b c = g a b c :=
  congr_fun₂ (congr_fun h _) _ _
#align congr_fun₃ congr_fun₃

theorem funext₂ {f g : ∀ a b, γ a b} (h : ∀ a b, f a b = g a b) : f = g :=
  funext fun _ ↦ funext <| h _
#align funext₂ funext₂

theorem funext₃ {f g : ∀ a b c, δ a b c} (h : ∀ a b c, f a b c = g a b c) : f = g :=
  funext fun _ ↦ funext₂ <| h _
#align funext₃ funext₃

end Equality

/-! ### Declarations about quantifiers -/

section Quantifiers
section Dependent

variable {β : α → Sort _} {γ : ∀ a, β a → Sort _} {δ : ∀ a b, γ a b → Sort _}
  {ε : ∀ a b c, δ a b c → Sort _}

theorem pi_congr {β' : α → Sort _} (h : ∀ a, β a = β' a) : (∀ a, β a) = ∀ a, β' a :=
  (funext h : β = β') ▸ rfl
#align pi_congr pi_congr

-- Porting note: some higher order lemmas such as `forall₂_congr` and `exists₂_congr`
-- were moved to `Std4`

theorem forall₂_imp {p q : ∀ a, β a → Prop} (h : ∀ a b, p a b → q a b) :
    (∀ a b, p a b) → ∀ a b, q a b :=
  forall_imp fun i ↦ forall_imp <| h i
#align forall₂_imp forall₂_imp

theorem forall₃_imp {p q : ∀ a b, γ a b → Prop} (h : ∀ a b c, p a b c → q a b c) :
    (∀ a b c, p a b c) → ∀ a b c, q a b c :=
  forall_imp fun a ↦ forall₂_imp <| h a
#align forall₃_imp forall₃_imp

theorem Exists₂.imp {p q : ∀ a, β a → Prop} (h : ∀ a b, p a b → q a b) :
    (∃ a b, p a b) → ∃ a b, q a b :=
  Exists.imp fun a ↦ Exists.imp <| h a
#align Exists₂.imp Exists₂.imp

theorem Exists₃.imp {p q : ∀ a b, γ a b → Prop} (h : ∀ a b c, p a b c → q a b c) :
    (∃ a b c, p a b c) → ∃ a b c, q a b c :=
  Exists.imp fun a ↦ Exists₂.imp <| h a
#align Exists₃.imp Exists₃.imp

end Dependent

variable {κ : ι → Sort _} {p q : α → Prop}

#align exists_imp_exists' Exists.imp'

theorem forall_swap {p : α → β → Prop} : (∀ x y, p x y) ↔ ∀ y x, p x y := ⟨swap, swap⟩
#align forall_swap forall_swap

theorem forall₂_swap {κ₁ : ι₁ → Sort _} {κ₂ : ι₂ → Sort _} {p : ∀ i₁, κ₁ i₁ → ∀ i₂, κ₂ i₂ → Prop} :
    (∀ i₁ j₁ i₂ j₂, p i₁ j₁ i₂ j₂) ↔ ∀ i₂ j₂ i₁ j₁, p i₁ j₁ i₂ j₂ := ⟨swap₂, swap₂⟩
#align forall₂_swap forall₂_swap

/-- We intentionally restrict the type of `α` in this lemma so that this is a safer to use in simp
than `forall_swap`. -/
theorem imp_forall_iff {α : Type _} {p : Prop} {q : α → Prop} : (p → ∀ x, q x) ↔ ∀ x, p → q x :=
  forall_swap
#align imp_forall_iff imp_forall_iff

theorem exists_swap {p : α → β → Prop} : (∃ x y, p x y) ↔ ∃ y x, p x y :=
  ⟨fun ⟨x, y, h⟩ ↦ ⟨y, x, h⟩, fun ⟨y, x, h⟩ ↦ ⟨x, y, h⟩⟩
#align exists_swap exists_swap

#align forall_exists_index forall_exists_index

#align exists_imp_distrib exists_imp
alias exists_imp ↔ _ not_exists_of_forall_not
#align not_exists_of_forall_not not_exists_of_forall_not

#align Exists.some Exists.choose
#align Exists.some_spec Exists.choose_spec

-- See Note [decidable namespace]
protected theorem Decidable.not_forall {p : α → Prop} [Decidable (∃ x, ¬p x)]
    [∀ x, Decidable (p x)] : (¬∀ x, p x) ↔ ∃ x, ¬p x :=
  ⟨Not.decidable_imp_symm fun nx x ↦ nx.decidable_imp_symm fun h ↦ ⟨x, h⟩,
   not_forall_of_exists_not⟩
#align decidable.not_forall Decidable.not_forall

@[simp]
theorem not_forall {p : α → Prop} : (¬∀ x, p x) ↔ ∃ x, ¬p x :=
  Decidable.not_forall
#align not_forall not_forall

-- See Note [decidable namespace]
protected theorem Decidable.not_forall_not [Decidable (∃ x, p x)] : (¬∀ x, ¬p x) ↔ ∃ x, p x :=
  (@Decidable.not_iff_comm _ _ _ (decidable_of_iff (¬∃ x, p x) not_exists)).1 not_exists
#align decidable.not_forall_not Decidable.not_forall_not

theorem not_forall_not : (¬∀ x, ¬p x) ↔ ∃ x, p x := Decidable.not_forall_not
#align not_forall_not not_forall_not

-- See Note [decidable namespace]
protected theorem Decidable.not_exists_not [∀ x, Decidable (p x)] : (¬∃ x, ¬p x) ↔ ∀ x, p x := by
  simp only [not_exists, Decidable.not_not]
#align decidable.not_exists_not Decidable.not_exists_not

theorem not_exists_not : (¬∃ x, ¬p x) ↔ ∀ x, p x := Decidable.not_exists_not
#align not_exists_not not_exists_not

theorem forall_imp_iff_exists_imp [ha : Nonempty α] : (∀ x, p x) → b ↔ ∃ x, p x → b := by
  let ⟨a⟩ := ha
  refine ⟨fun h ↦ not_forall_not.1 fun h' ↦ ?_, fun ⟨x, hx⟩ h ↦ hx (h x)⟩
  exact if hb : b then h' a fun _ ↦ hb else hb <| h fun x ↦ (not_imp.1 (h' x)).1
#align forall_imp_iff_exists_imp forall_imp_iff_exists_imp

theorem forall_true_iff : (α → True) ↔ True := imp_true_iff _
#align forall_true_iff forall_true_iff

-- Unfortunately this causes simp to loop sometimes, so we
-- add the 2 and 3 cases as simp lemmas instead
theorem forall_true_iff' (h : ∀ a, p a ↔ True) : (∀ a, p a) ↔ True :=
  iff_true_intro fun _ ↦ of_iff_true (h _)
#align forall_true_iff' forall_true_iff'

-- This is not marked `@[simp]` because `implies_true : (α → True) = True` works
theorem forall₂_true_iff {β : α → Sort _} : (∀ a, β a → True) ↔ True := by simp
#align forall_2_true_iff forall₂_true_iff

-- This is not marked `@[simp]` because `implies_true : (α → True) = True` works
theorem forall₃_true_iff {β : α → Sort _} {γ : ∀ a, β a → Sort _} :
    (∀ (a) (b : β a), γ a b → True) ↔ True := by simp
#align forall_3_true_iff forall₃_true_iff

@[simp] theorem exists_unique_iff_exists [Subsingleton α] {p : α → Prop} :
    (∃! x, p x) ↔ ∃ x, p x :=
  ⟨fun h ↦ h.exists, Exists.imp fun x hx ↦ ⟨hx, fun y _ ↦ Subsingleton.elim y x⟩⟩
#align exists_unique_iff_exists exists_unique_iff_exists

-- forall_forall_const is no longer needed

@[simp] theorem exists_const (α) [i : Nonempty α] : (∃ _ : α, b) ↔ b :=
  ⟨fun ⟨_, h⟩ ↦ h, i.elim Exists.intro⟩
#align exists_const exists_const

theorem exists_unique_const (α) [i : Nonempty α] [Subsingleton α] :
    (∃! _ : α, b) ↔ b := by simp
#align exists_unique_const exists_unique_const

#align forall_and_distrib forall_and
#align exists_or_distrib exists_or

#align exists_and_distrib_left exists_and_left
#align exists_and_distrib_right exists_and_right

theorem Decidable.and_forall_ne [DecidableEq α] (a : α) {p : α → Prop} :
    (p a ∧ ∀ b, b ≠ a → p b) ↔ ∀ b, p b := by
  simp only [← @forall_eq _ p a, ← forall_and, ← or_imp, Decidable.em, forall_const]
#align decidable.and_forall_ne Decidable.and_forall_ne

theorem and_forall_ne (a : α) : (p a ∧ ∀ b, b ≠ a → p b) ↔ ∀ b, p b :=
  Decidable.and_forall_ne a
#align and_forall_ne and_forall_ne

theorem Ne.ne_or_ne {x y : α} (z : α) (h : x ≠ y) : x ≠ z ∨ y ≠ z :=
  not_and_or.1 <| mt (and_imp.2 (· ▸ ·)) h.symm
#align ne.ne_or_ne Ne.ne_or_ne

@[simp] theorem exists_unique_eq {a' : α} : ∃! a, a = a' := by
  simp only [eq_comm, ExistsUnique, and_self, forall_eq', exists_eq']
#align exists_unique_eq exists_unique_eq

@[simp] theorem exists_unique_eq' {a' : α} : ∃! a, a' = a := by
  simp only [ExistsUnique, and_self, forall_eq', exists_eq']
#align exists_unique_eq' exists_unique_eq'

-- @[simp] -- FIXME simp does not apply this lemma for some reason
theorem exists_apply_eq_apply' (f : α → β) (a' : α) : ∃ a, f a' = f a := ⟨a', rfl⟩
#align exists_apply_eq_apply' exists_apply_eq_apply'

-- porting note: an alternative workaround theorem:
theorem exists_apply_eq (a : α) (b : β) : ∃ f : α → β, f a = b := ⟨fun _ ↦ b, rfl⟩

@[simp] theorem exists_exists_and_eq_and {f : α → β} {p : α → Prop} {q : β → Prop} :
    (∃ b, (∃ a, p a ∧ f a = b) ∧ q b) ↔ ∃ a, p a ∧ q (f a) :=
  ⟨fun ⟨_, ⟨a, ha, hab⟩, hb⟩ ↦ ⟨a, ha, hab.symm ▸ hb⟩, fun ⟨a, hp, hq⟩ ↦ ⟨f a, ⟨a, hp, rfl⟩, hq⟩⟩
#align exists_exists_and_eq_and exists_exists_and_eq_and

@[simp] theorem exists_exists_eq_and {f : α → β} {p : β → Prop} :
    (∃ b, (∃ a, f a = b) ∧ p b) ↔ ∃ a, p (f a) :=
  ⟨fun ⟨_, ⟨a, ha⟩, hb⟩ ↦ ⟨a, ha.symm ▸ hb⟩, fun ⟨a, ha⟩ ↦ ⟨f a, ⟨a, rfl⟩, ha⟩⟩
#align exists_exists_eq_and exists_exists_eq_and

@[simp] theorem exists_or_eq_left (y : α) (p : α → Prop) : ∃ x : α, x = y ∨ p x := ⟨y, .inl rfl⟩
#align exists_or_eq_left exists_or_eq_left

@[simp] theorem exists_or_eq_right (y : α) (p : α → Prop) : ∃ x : α, p x ∨ x = y := ⟨y, .inr rfl⟩
#align exists_or_eq_right exists_or_eq_right

@[simp] theorem exists_or_eq_left' (y : α) (p : α → Prop) : ∃ x : α, y = x ∨ p x := ⟨y, .inl rfl⟩
#align exists_or_eq_left' exists_or_eq_left'

@[simp] theorem exists_or_eq_right' (y : α) (p : α → Prop) : ∃ x : α, p x ∨ y = x := ⟨y, .inr rfl⟩
#align exists_or_eq_right' exists_or_eq_right'

theorem forall_apply_eq_imp_iff {f : α → β} {p : β → Prop} :
    (∀ a b, f a = b → p b) ↔ ∀ a, p (f a) := by simp
#align forall_apply_eq_imp_iff forall_apply_eq_imp_iff

@[simp] theorem forall_apply_eq_imp_iff' {f : α → β} {p : β → Prop} :
    (∀ b a, f a = b → p b) ↔ ∀ a, p (f a) := by simp [forall_swap]
#align forall_apply_eq_imp_iff' forall_apply_eq_imp_iff'

theorem forall_eq_apply_imp_iff {f : α → β} {p : β → Prop} :
    (∀ a b, b = f a → p b) ↔ ∀ a, p (f a) := by simp
#align forall_eq_apply_imp_iff forall_eq_apply_imp_iff

@[simp] theorem forall_eq_apply_imp_iff' {f : α → β} {p : β → Prop} :
    (∀ b a, b = f a → p b) ↔ ∀ a, p (f a) := by simp [forall_swap]
#align forall_eq_apply_imp_iff' forall_eq_apply_imp_iff'

@[simp] theorem forall_apply_eq_imp_iff₂ {f : α → β} {p : α → Prop} {q : β → Prop} :
    (∀ b a, p a → f a = b → q b) ↔ ∀ a, p a → q (f a) :=
  ⟨fun h a ha ↦ h (f a) a ha rfl, fun h _ a ha hb ↦ hb ▸ h a ha⟩
#align forall_apply_eq_imp_iff₂ forall_apply_eq_imp_iff₂

@[simp] theorem exists_eq_right' {a' : α} : (∃ a, p a ∧ a' = a) ↔ p a' := by simp [@eq_comm _ a']
#align exists_eq_right' exists_eq_right'

theorem exists_comm {p : α → β → Prop} : (∃ a b, p a b) ↔ ∃ b a, p a b :=
  ⟨fun ⟨a, b, h⟩ ↦ ⟨b, a, h⟩, fun ⟨b, a, h⟩ ↦ ⟨a, b, h⟩⟩
#align exists_comm exists_comm

theorem exists₂_comm {κ₁ : ι₁ → Sort _} {κ₂ : ι₂ → Sort _} {p : ∀ i₁, κ₁ i₁ → ∀ i₂, κ₂ i₂ → Prop} :
    (∃ i₁ j₁ i₂ j₂, p i₁ j₁ i₂ j₂) ↔ ∃ i₂ j₂ i₁ j₁, p i₁ j₁ i₂ j₂ := by
  simp only [@exists_comm (κ₁ _), @exists_comm ι₁]
#align exists₂_comm exists₂_comm

theorem And.exists {p q : Prop} {f : p ∧ q → Prop} : (∃ h, f h) ↔ ∃ hp hq, f ⟨hp, hq⟩ :=
  ⟨fun ⟨h, H⟩ ↦ ⟨h.1, h.2, H⟩, fun ⟨hp, hq, H⟩ ↦ ⟨⟨hp, hq⟩, H⟩⟩
#align and.exists And.exists

theorem forall_or_of_or_forall (h : b ∨ ∀ x, p x) (x) : b ∨ p x := h.imp_right fun h₂ ↦ h₂ x
#align forall_or_of_or_forall forall_or_of_or_forall

-- See Note [decidable namespace]
protected theorem Decidable.forall_or_left {q : Prop} {p : α → Prop} [Decidable q] :
    (∀ x, q ∨ p x) ↔ q ∨ ∀ x, p x :=
  ⟨fun h ↦ if hq : q then Or.inl hq else
    Or.inr fun x ↦ (h x).resolve_left hq, forall_or_of_or_forall⟩
#align decidable.forall_or_distrib_left Decidable.forall_or_left

theorem forall_or_left {q} {p : α → Prop} : (∀ x, q ∨ p x) ↔ q ∨ ∀ x, p x :=
  Decidable.forall_or_left
#align forall_or_distrib_left forall_or_left

-- See Note [decidable namespace]
protected theorem Decidable.forall_or_right {q} {p : α → Prop} [Decidable q] :
    (∀ x, p x ∨ q) ↔ (∀ x, p x) ∨ q := by simp [or_comm, Decidable.forall_or_left]
#align decidable.forall_or_distrib_right Decidable.forall_or_right

theorem forall_or_right {q} {p : α → Prop} : (∀ x, p x ∨ q) ↔ (∀ x, p x) ∨ q :=
  Decidable.forall_or_right
#align forall_or_distrib_right forall_or_right

theorem exists_unique_prop {p q : Prop} : (∃! _ : p, q) ↔ p ∧ q := by simp
#align exists_unique_prop exists_unique_prop

@[simp] theorem exists_unique_false : ¬∃! _ : α, False := fun ⟨_, h, _⟩ ↦ h
#align exists_unique_false exists_unique_false

theorem Exists.fst {b : Prop} {p : b → Prop} : Exists p → b
  | ⟨h, _⟩ => h
#align Exists.fst Exists.fst

theorem Exists.snd {b : Prop} {p : b → Prop} : ∀ h : Exists p, p h.fst
  | ⟨_, h⟩ => h
#align Exists.snd Exists.snd

theorem exists_prop_of_true {p : Prop} {q : p → Prop} (h : p) : (∃ h' : p, q h') ↔ q h :=
  @exists_const (q h) p ⟨h⟩
#align exists_prop_of_true exists_prop_of_true

theorem exists_iff_of_forall {p : Prop} {q : p → Prop} (h : ∀ h, q h) : (∃ h, q h) ↔ p :=
  ⟨Exists.fst, fun H ↦ ⟨H, h H⟩⟩
#align exists_iff_of_forall exists_iff_of_forall

theorem exists_unique_prop_of_true {p : Prop} {q : p → Prop} (h : p) : (∃! h' : p, q h') ↔ q h :=
  @exists_unique_const (q h) p ⟨h⟩ _
#align exists_unique_prop_of_true exists_unique_prop_of_true

theorem forall_prop_of_false {p : Prop} {q : p → Prop} (hn : ¬p) : (∀ h' : p, q h') ↔ True :=
  iff_true_intro fun h ↦ hn.elim h
#align forall_prop_of_false forall_prop_of_false

theorem exists_prop_of_false {p : Prop} {q : p → Prop} : ¬p → ¬∃ h' : p, q h' :=
  mt Exists.fst
#align exists_prop_of_false exists_prop_of_false

@[congr]
theorem exists_prop_congr {p p' : Prop} {q q' : p → Prop} (hq : ∀ h, q h ↔ q' h) (hp : p ↔ p') :
    Exists q ↔ ∃ h : p', q' (hp.2 h) :=
  ⟨fun ⟨_, _⟩ ↦ ⟨hp.1 ‹_›, (hq _).1 ‹_›⟩, fun ⟨_, _⟩ ↦ ⟨_, (hq _).2 ‹_›⟩⟩
#align exists_prop_congr exists_prop_congr

@[congr]
theorem exists_prop_congr' {p p' : Prop} {q q' : p → Prop} (hq : ∀ h, q h ↔ q' h) (hp : p ↔ p') :
    Exists q = ∃ h : p', q' (hp.2 h) :=
  propext (exists_prop_congr hq hp)
#align exists_prop_congr' exists_prop_congr'

/-- See `IsEmpty.exists_iff` for the `false` version. -/
@[simp] theorem exists_true_left (p : True → Prop) : (∃ x, p x) ↔ p True.intro :=
  exists_prop_of_true _
#align exists_true_left exists_true_left

-- Porting note: `@[congr]` commented out for now.
-- @[congr]
theorem forall_prop_congr {p p' : Prop} {q q' : p → Prop} (hq : ∀ h, q h ↔ q' h) (hp : p ↔ p') :
    (∀ h, q h) ↔ ∀ h : p', q' (hp.2 h) :=
  ⟨fun h1 h2 ↦ (hq _).1 (h1 (hp.2 h2)), fun h1 h2 ↦ (hq _).2 (h1 (hp.1 h2))⟩
#align forall_prop_congr forall_prop_congr

-- Porting note: `@[congr]` commented out for now.
-- @[congr]
theorem forall_prop_congr' {p p' : Prop} {q q' : p → Prop} (hq : ∀ h, q h ↔ q' h) (hp : p ↔ p') :
    (∀ h, q h) = ∀ h : p', q' (hp.2 h) :=
  propext (forall_prop_congr hq hp)
#align forall_prop_congr' forall_prop_congr'

/-- See `IsEmpty.forall_iff` for the `false` version. -/
@[simp] theorem forall_true_left (p : True → Prop) : (∀ x, p x) ↔ p True.intro :=
  forall_prop_of_true _
#align forall_true_left forall_true_left

theorem ExistsUnique.elim₂ {α : Sort _} {p : α → Sort _} [∀ x, Subsingleton (p x)]
    {q : ∀ (x) (_ : p x), Prop} {b : Prop} (h₂ : ∃! (x : _) (h : p x), q x h)
    (h₁ : ∀ (x) (h : p x), q x h → (∀ (y) (hy : p y), q y hy → y = x) → b) : b := by
  simp only [exists_unique_iff_exists] at h₂
  apply h₂.elim
  exact fun x ⟨hxp, hxq⟩ H ↦ h₁ x hxp hxq fun y hyp hyq ↦ H y ⟨hyp, hyq⟩
#align exists_unique.elim2 ExistsUnique.elim₂

theorem ExistsUnique.intro₂ {α : Sort _} {p : α → Sort _} [∀ x, Subsingleton (p x)]
    {q : ∀ (x : α) (_ : p x), Prop} (w : α) (hp : p w) (hq : q w hp)
    (H : ∀ (y) (hy : p y), q y hy → y = w) : ∃! (x : _) (hx : p x), q x hx := by
  simp only [exists_unique_iff_exists]
  exact ExistsUnique.intro w ⟨hp, hq⟩ fun y ⟨hyp, hyq⟩ ↦ H y hyp hyq
#align exists_unique.intro2 ExistsUnique.intro₂

theorem ExistsUnique.exists₂ {α : Sort _} {p : α → Sort _} {q : ∀ (x : α) (_ : p x), Prop}
    (h : ∃! (x : _) (hx : p x), q x hx) : ∃ (x : _) (hx : p x), q x hx :=
  h.exists.imp fun _ hx ↦ hx.exists
#align exists_unique.exists2 ExistsUnique.exists₂

theorem ExistsUnique.unique₂ {α : Sort _} {p : α → Sort _} [∀ x, Subsingleton (p x)]
    {q : ∀ (x : α) (_ : p x), Prop} (h : ∃! (x : _) (hx : p x), q x hx) {y₁ y₂ : α}
    (hpy₁ : p y₁) (hqy₁ : q y₁ hpy₁) (hpy₂ : p y₂) (hqy₂ : q y₂ hpy₂) : y₁ = y₂ := by
  simp only [exists_unique_iff_exists] at h
  exact h.unique ⟨hpy₁, hqy₁⟩ ⟨hpy₂, hqy₂⟩
#align exists_unique.unique2 ExistsUnique.unique₂

end Quantifiers

/-! ### Classical lemmas -/

namespace Classical
variable {p : α → Prop}

-- use shortened names to avoid conflict when classical namespace is open.
/-- Any prop `p` is decidable classically. A shorthand for `classical.prop_decidable`. -/
noncomputable def dec (p : Prop) : Decidable p := by infer_instance
#align classical.dec Classical.dec

/-- Any predicate `p` is decidable classically. -/
noncomputable def decPred (p : α → Prop) : DecidablePred p := by infer_instance
#align classical.dec_pred Classical.decPred

/-- Any relation `p` is decidable classically. -/
noncomputable def decRel (p : α → α → Prop) : DecidableRel p := by infer_instance
#align classical.dec_rel Classical.decRel

/-- Any type `α` has decidable equality classically. -/
noncomputable def decEq (α : Sort u) : DecidableEq α := by infer_instance
#align classical.dec_eq Classical.decEq

/-- Construct a function from a default value `H0`, and a function to use if there exists a value
satisfying the predicate. -/
-- @[elab_as_elim] -- FIXME
noncomputable def existsCases (H0 : C) (H : ∀ a, p a → C) : C :=
  if h : ∃ a, p a then H (Classical.choose h) (Classical.choose_spec h) else H0
#align classical.exists_cases Classical.existsCases

theorem some_spec₂ {α : Sort _} {p : α → Prop} {h : ∃ a, p a} (q : α → Prop)
    (hpq : ∀ a, p a → q a) : q (choose h) := hpq _ <| choose_spec _
#align classical.some_spec2 Classical.some_spec₂

/-- A version of `Classical.indefiniteDescription` which is definitionally equal to a pair -/
noncomputable def subtype_of_exists {α : Type _} {P : α → Prop} (h : ∃ x, P x) : { x // P x } :=
  ⟨Classical.choose h, Classical.choose_spec h⟩
#align classical.subtype_of_exists Classical.subtype_of_exists

/-- A version of `byContradiction` that uses types instead of propositions. -/
protected noncomputable def byContradiction' {α : Sort _} (H : ¬(α → False)) : α :=
  Classical.choice <| (peirce _ False) fun h ↦ (H fun a ↦ h ⟨a⟩).elim
#align classical.by_contradiction' Classical.byContradiction'

/-- `classical.byContradiction'` is equivalent to lean's axiom `classical.choice`. -/
def choice_of_byContradiction' {α : Sort _} (contra : ¬(α → False) → α) : Nonempty α → α :=
  fun H ↦ contra H.elim
#align classical.choice_of_by_contradiction' Classical.choice_of_byContradiction'

end Classical

/-- This function has the same type as `Exists.recOn`, and can be used to case on an equality,
but `Exists.recOn` can only eliminate into Prop, while this version eliminates into any universe
using the axiom of choice. -/
-- @[elab_as_elim] -- FIXME
noncomputable def Exists.classicalRecOn {p : α → Prop} (h : ∃ a, p a) {C} (H : ∀ a, p a → C) : C :=
  H (Classical.choose h) (Classical.choose_spec h)
#align exists.classical_rec_on Exists.classicalRecOn

/-! ### Declarations about bounded quantifiers -/

section BoundedQuantifiers
variable {r p q : α → Prop} {P Q : ∀ x, p x → Prop} {b : Prop}

theorem bex_def : (∃ (x : _) (_ : p x), q x) ↔ ∃ x, p x ∧ q x :=
  ⟨fun ⟨x, px, qx⟩ ↦ ⟨x, px, qx⟩, fun ⟨x, px, qx⟩ ↦ ⟨x, px, qx⟩⟩
#align bex_def bex_def

theorem BEx.elim {b : Prop} : (∃ x h, P x h) → (∀ a h, P a h → b) → b
  | ⟨a, h₁, h₂⟩, h' => h' a h₁ h₂
#align bex.elim BEx.elim

theorem BEx.intro (a : α) (h₁ : p a) (h₂ : P a h₁) : ∃ (x : _) (h : p x), P x h :=
  ⟨a, h₁, h₂⟩
#align bex.intro BEx.intro

theorem ball_congr (H : ∀ x h, P x h ↔ Q x h) : (∀ x h, P x h) ↔ ∀ x h, Q x h :=
  forall_congr' fun x ↦ forall_congr' (H x)
#align ball_congr ball_congr

theorem bex_congr (H : ∀ x h, P x h ↔ Q x h) : (∃ x h, P x h) ↔ ∃ x h, Q x h :=
  exists_congr fun x ↦ exists_congr (H x)
#align bex_congr bex_congr

theorem bex_eq_left {a : α} : (∃ (x : _) (_ : x = a), p x) ↔ p a := by
  simp only [exists_prop, exists_eq_left]
#align bex_eq_left bex_eq_left

theorem BAll.imp_right (H : ∀ x h, P x h → Q x h) (h₁ : ∀ x h, P x h) (x h) : Q x h :=
  H _ _ <| h₁ _ _
#align ball.imp_right BAll.imp_right

theorem BEx.imp_right (H : ∀ x h, P x h → Q x h) : (∃ x h, P x h) → ∃ x h, Q x h
  | ⟨_, _, h'⟩ => ⟨_, _, H _ _ h'⟩
#align bex.imp_right BEx.imp_right

theorem BAll.imp_left (H : ∀ x, p x → q x) (h₁ : ∀ x, q x → r x) (x) (h : p x) : r x :=
  h₁ _ <| H _ h
#align ball.imp_left BAll.imp_left

theorem BEx.imp_left (H : ∀ x, p x → q x) : (∃ (x : _) (_ : p x), r x) → ∃ (x : _) (_ : q x), r x
  | ⟨x, hp, hr⟩ => ⟨x, H _ hp, hr⟩
#align bex.imp_left BEx.imp_left

theorem ball_of_forall (h : ∀ x, p x) (x) : p x := h x
#align ball_of_forall ball_of_forall

theorem forall_of_ball (H : ∀ x, p x) (h : ∀ x, p x → q x) (x) : q x := h x <| H x
#align forall_of_ball forall_of_ball

theorem bex_of_exists (H : ∀ x, p x) : (∃ x, q x) → ∃ (x : _) (_ : p x), q x
  | ⟨x, hq⟩ => ⟨x, H x, hq⟩
#align bex_of_exists bex_of_exists

theorem exists_of_bex : (∃ (x : _) (_ : p x), q x) → ∃ x, q x
  | ⟨x, _, hq⟩ => ⟨x, hq⟩
#align exists_of_bex exists_of_bex

theorem bex_imp : (∃ x h, P x h) → b ↔ ∀ x h, P x h → b := by simp
#align bex_imp_distrib bex_imp

theorem not_bex : (¬∃ x h, P x h) ↔ ∀ x h, ¬P x h := bex_imp
#align not_bex not_bex

theorem not_ball_of_bex_not : (∃ x h, ¬P x h) → ¬∀ x h, P x h
  | ⟨x, h, hp⟩, al => hp <| al x h
#align not_ball_of_bex_not not_ball_of_bex_not

-- See Note [decidable namespace]
protected theorem Decidable.not_ball [Decidable (∃ x h, ¬P x h)] [∀ x h, Decidable (P x h)] :
    (¬∀ x h, P x h) ↔ ∃ x h, ¬P x h :=
  ⟨Not.decidable_imp_symm fun nx x h ↦ nx.decidable_imp_symm
    fun h' ↦ ⟨x, h, h'⟩, not_ball_of_bex_not⟩
#align decidable.not_ball Decidable.not_ball

theorem not_ball : (¬∀ x h, P x h) ↔ ∃ x h, ¬P x h := Decidable.not_ball
#align not_ball not_ball

theorem ball_true_iff (p : α → Prop) : (∀ x, p x → True) ↔ True :=
  iff_true_intro fun _ _ ↦ trivial
#align ball_true_iff ball_true_iff

theorem ball_and : (∀ x h, P x h ∧ Q x h) ↔ (∀ x h, P x h) ∧ ∀ x h, Q x h :=
  Iff.trans (forall_congr' fun _ ↦ forall_and) forall_and
#align ball_and_distrib ball_and

theorem bex_or : (∃ x h, P x h ∨ Q x h) ↔ (∃ x h, P x h) ∨ ∃ x h, Q x h :=
  Iff.trans (exists_congr fun _ ↦ exists_or) exists_or
#align bex_or_distrib bex_or

theorem ball_or_left : (∀ x, p x ∨ q x → r x) ↔ (∀ x, p x → r x) ∧ ∀ x, q x → r x :=
  Iff.trans (forall_congr' fun _ ↦ or_imp) forall_and
#align ball_or_left_distrib ball_or_left

theorem bex_or_left :
    (∃ (x : _) (_ : p x ∨ q x), r x) ↔ (∃ (x : _) (_ : p x), r x) ∨ ∃ (x : _) (_ : q x), r x := by
  simp only [exists_prop]
  exact Iff.trans (exists_congr fun x ↦ or_and_right) exists_or
#align bex_or_left_distrib bex_or_left

end BoundedQuantifiers

#align classical.not_ball not_ball

section ite

variable {σ : α → Sort _} (f : α → β) {P Q : Prop} [Decidable P] [Decidable Q]
  {a b c : α} {A : P → α} {B : ¬P → α}

theorem dite_eq_iff : dite P A B = c ↔ (∃ h, A h = c) ∨ ∃ h, B h = c := by
  by_cases P <;> simp [*, exists_prop_of_true, exists_prop_of_false]
#align dite_eq_iff dite_eq_iff

theorem ite_eq_iff : ite P a b = c ↔ P ∧ a = c ∨ ¬P ∧ b = c :=
  dite_eq_iff.trans <| by simp only; rw [exists_prop, exists_prop]
#align ite_eq_iff ite_eq_iff

theorem eq_ite_iff : a = ite P b c ↔ P ∧ a = b ∨ ¬P ∧ a = c :=
eq_comm.trans <| ite_eq_iff.trans <| (Iff.rfl.and eq_comm).or (Iff.rfl.and eq_comm)

theorem dite_eq_iff' : dite P A B = c ↔ (∀ h, A h = c) ∧ ∀ h, B h = c :=
  ⟨fun he ↦ ⟨fun h ↦ (dif_pos h).symm.trans he, fun h ↦ (dif_neg h).symm.trans he⟩, fun he ↦
    (em P).elim (fun h ↦ (dif_pos h).trans <| he.1 h) fun h ↦ (dif_neg h).trans <| he.2 h⟩
#align dite_eq_iff' dite_eq_iff'

theorem ite_eq_iff' : ite P a b = c ↔ (P → a = c) ∧ (¬P → b = c) := dite_eq_iff'
#align ite_eq_iff' ite_eq_iff'

@[simp] theorem dite_eq_left_iff : dite P (fun _ ↦ a) B = a ↔ ∀ h, B h = a := by
  by_cases P <;> simp [*, forall_prop_of_true, forall_prop_of_false]
#align dite_eq_left_iff dite_eq_left_iff

@[simp] theorem dite_eq_right_iff : (dite P A fun _ ↦ b) = b ↔ ∀ h, A h = b := by
  by_cases P <;> simp [*, forall_prop_of_true, forall_prop_of_false]
#align dite_eq_right_iff dite_eq_right_iff

@[simp] theorem ite_eq_left_iff : ite P a b = a ↔ ¬P → b = a := dite_eq_left_iff
@[simp] theorem ite_eq_right_iff : ite P a b = b ↔ P → a = b := dite_eq_right_iff
#align ite_eq_right_iff ite_eq_right_iff
#align ite_eq_left_iff ite_eq_left_iff

theorem dite_ne_left_iff : dite P (fun _ ↦ a) B ≠ a ↔ ∃ h, a ≠ B h := by
  rw [Ne.def, dite_eq_left_iff, not_forall]
  exact exists_congr fun h ↦ by rw [ne_comm]
#align dite_ne_left_iff dite_ne_left_iff

theorem dite_ne_right_iff : (dite P A fun _ ↦ b) ≠ b ↔ ∃ h, A h ≠ b := by
  simp only [Ne.def, dite_eq_right_iff, not_forall]
#align dite_ne_right_iff dite_ne_right_iff

theorem ite_ne_left_iff : ite P a b ≠ a ↔ ¬P ∧ a ≠ b :=
  dite_ne_left_iff.trans <| by simp only; rw [exists_prop]
#align ite_ne_left_iff ite_ne_left_iff

theorem ite_ne_right_iff : ite P a b ≠ b ↔ P ∧ a ≠ b :=
  dite_ne_right_iff.trans <| by simp only; rw [exists_prop]
#align ite_ne_right_iff ite_ne_right_iff

protected theorem Ne.dite_eq_left_iff (h : ∀ h, a ≠ B h) : dite P (fun _ ↦ a) B = a ↔ P :=
  dite_eq_left_iff.trans ⟨fun H ↦ of_not_not fun h' ↦ h h' (H h').symm, fun h H ↦ (H h).elim⟩
#align ne.dite_eq_left_iff Ne.dite_eq_left_iff

protected theorem Ne.dite_eq_right_iff (h : ∀ h, A h ≠ b) : (dite P A fun _ ↦ b) = b ↔ ¬P :=
  dite_eq_right_iff.trans ⟨fun H h' ↦ h h' (H h'), fun h' H ↦ (h' H).elim⟩
#align ne.dite_eq_right_iff Ne.dite_eq_right_iff

protected theorem Ne.ite_eq_left_iff (h : a ≠ b) : ite P a b = a ↔ P :=
  Ne.dite_eq_left_iff fun _ ↦ h
#align ne.ite_eq_left_iff Ne.ite_eq_left_iff

protected theorem Ne.ite_eq_right_iff (h : a ≠ b) : ite P a b = b ↔ ¬P :=
  Ne.dite_eq_right_iff fun _ ↦ h
#align ne.ite_eq_right_iff Ne.ite_eq_right_iff

protected theorem Ne.dite_ne_left_iff (h : ∀ h, a ≠ B h) : dite P (fun _ ↦ a) B ≠ a ↔ ¬P :=
  dite_ne_left_iff.trans <| exists_iff_of_forall h
#align ne.dite_ne_left_iff Ne.dite_ne_left_iff

protected theorem Ne.dite_ne_right_iff (h : ∀ h, A h ≠ b) : (dite P A fun _ ↦ b) ≠ b ↔ P :=
  dite_ne_right_iff.trans <| exists_iff_of_forall h
#align ne.dite_ne_right_iff Ne.dite_ne_right_iff

protected theorem Ne.ite_ne_left_iff (h : a ≠ b) : ite P a b ≠ a ↔ ¬P :=
  Ne.dite_ne_left_iff fun _ ↦ h
#align ne.ite_ne_left_iff Ne.ite_ne_left_iff

protected theorem Ne.ite_ne_right_iff (h : a ≠ b) : ite P a b ≠ b ↔ P :=
  Ne.dite_ne_right_iff fun _ ↦ h
#align ne.ite_ne_right_iff Ne.ite_ne_right_iff

variable (P Q a b)

/-- A `dite` whose results do not actually depend on the condition may be reduced to an `ite`. -/
@[simp] theorem dite_eq_ite : (dite P (fun _ ↦ a) fun _ ↦ b) = ite P a b := rfl
#align dite_eq_ite dite_eq_ite

theorem dite_eq_or_eq : (∃ h, dite P A B = A h) ∨ ∃ h, dite P A B = B h :=
  if h : _ then .inl ⟨h, dif_pos h⟩ else .inr ⟨h, dif_neg h⟩
#align dite_eq_or_eq dite_eq_or_eq

theorem ite_eq_or_eq : ite P a b = a ∨ ite P a b = b :=
  if h : _ then .inl (if_pos h) else .inr (if_neg h)
#align ite_eq_or_eq ite_eq_or_eq

/-- A two-argument function applied to two `dite`s is a `dite` of that two-argument function
applied to each of the branches. -/
theorem apply_dite₂ (f : α → β → γ) (P : Prop) [Decidable P] (a : P → α) (b : ¬P → α)
    (c : P → β) (d : ¬P → β) :
    f (dite P a b) (dite P c d) = dite P (fun h ↦ f (a h) (c h)) fun h ↦ f (b h) (d h) := by
  by_cases h : P <;> simp [h]
#align apply_dite2 apply_dite₂

/-- A two-argument function applied to two `ite`s is a `ite` of that two-argument function
applied to each of the branches. -/
theorem apply_ite₂ (f : α → β → γ) (P : Prop) [Decidable P] (a b : α) (c d : β) :
    f (ite P a b) (ite P c d) = ite P (f a c) (f b d) :=
  apply_dite₂ f P (fun _ ↦ a) (fun _ ↦ b) (fun _ ↦ c) fun _ ↦ d
#align apply_ite2 apply_ite₂

/-- A 'dite' producing a `Pi` type `Π a, σ a`, applied to a value `a : α` is a `dite` that applies
either branch to `a`. -/
theorem dite_apply (f : P → ∀ a, σ a) (g : ¬P → ∀ a, σ a) (a : α) :
    (dite P f g) a = dite P (fun h ↦ f h a) fun h ↦ g h a := by by_cases h:P <;> simp [h]
#align dite_apply dite_apply

/-- A 'ite' producing a `Pi` type `Π a, σ a`, applied to a value `a : α` is a `ite` that applies
either branch to `a`. -/
theorem ite_apply (f g : ∀ a, σ a) (a : α) : (ite P f g) a = ite P (f a) (g a) :=
  dite_apply P (fun _ ↦ f) (fun _ ↦ g) a
#align ite_apply ite_apply

theorem ite_and : ite (P ∧ Q) a b = ite P (ite Q a b) b := by
  by_cases hp : P <;> by_cases hq : Q <;> simp [hp, hq]
#align ite_and ite_and

theorem dite_dite_comm {B : Q → α} {C : ¬P → ¬Q → α} (h : P → ¬Q) :
    (if p : P then A p else if q : Q then B q else C p q) =
     if q : Q then B q else if p : P then A p else C p q :=
  dite_eq_iff'.2 ⟨
    fun p ↦ by rw [dif_neg (h p), dif_pos p],
    fun np ↦ by congr; funext _; rw [dif_neg np]⟩
#align dite_dite_comm dite_dite_comm

theorem ite_ite_comm (h : P → ¬Q) :
    (if P then a else if Q then b else c) =
     if Q then b else if P then a else c :=
  dite_dite_comm P Q h
#align ite_ite_comm ite_ite_comm

end ite