/-
Copyright (c) 2022 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: María Inés de Frutos-Fernández
-/
import ring_theory.class_group
import adeles_K
import ideles_R

/-!
# The group of idèles of a global field
We define the group of finite idèles and the group of idèles of a global field, both of which are
topological commutative groups.

For a number field `K`, we also prove that `K*` can be regarded as a subgroup of `I_K_f` and `I_K`
and define the idèle class group of `K` as the quotient `I_K/K*`. We then show that the ideal class
group of `K` is isomorphic to an explicit quotient of `C_K` as topological groups, by constructing
a continuous surjective group homomorphism from `C_K` to the ideal class group `Cl(K)` of `K` and
computing its kernel.

## Main definitions
- `number_field.I_K_f` : The finite idèle group of the number field `K`.
- `number_field.I_K`   : The idèle group of the number field `K`.
- `C_K.map_to_class_group` : The natural group homomorphism from `C_K` to the `Cl(K)`.
- `function_field.I_F_f` : The finite idèle group of the function field `F`.
- `function_field.I_F`   : The idèle group of the function field `F`.

## Main results
- `C_K.map_to_class_group.surjective` : The natural map `C_K → Cl(K)` is surjective.
- `C_K.map_to_class_group.continuous` : The natural map `C_K → Cl(K)` is continuous.
- `C_K.map_to_class_group.mem_kernel_iff` : We compute the kernel of `C_K → Cl(K)`.

## References
* [J.W.S. Cassels, A. Frölich, *Algebraic Number Theory*][cassels1967algebraic]

## Tags
idèle group, number field, function field
-/

noncomputable theory

open set function is_dedekind_domain
open_locale tensor_product number_field non_zero_divisors

/-- Every nonzero element in a field is a unit. -/
def field.units.mk' {F : Type*} [field F] {k : F} (hk : k ≠ 0) : units F :=
{ val     := k,
  inv     := k⁻¹,
  val_inv := mul_inv_cancel hk,
  inv_val := inv_mul_cancel hk }

namespace fractional_ideal

theorem is_unit_of_span_singleton_eq_one {R P : Type*} [comm_ring R] {S : submonoid R}
  [comm_ring P] [algebra R P] [loc : is_localization S P] [no_zero_smul_divisors R P] {x : P}
  (hx : span_singleton S x = 1) : is_unit x :=
begin
  rw [← span_singleton_one, span_singleton_eq_span_singleton] at hx,
  obtain ⟨r, hr⟩ := hx,
  rw is_unit_iff_exists_inv',
  use algebra_map R P r,
  rw [← algebra.smul_def, ← hr],
  refl
end

theorem unit_is_principal_iff  (K R : Type*) [field K] [comm_ring R] [algebra R K]
  [is_fraction_ring R K] (I : (fractional_ideal R⁰ K)ˣ) :
  ((I : (fractional_ideal R⁰ K)) : submodule R K).is_principal ↔
  ∃ (x : Kˣ), (I : fractional_ideal R⁰ K) = fractional_ideal.span_singleton R⁰ (x : K) :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { obtain ⟨x, hx⟩ := (fractional_ideal.is_principal_iff _).mp h,
    have hx0 : x ≠ 0,
    { intro h0,
      rw [h0, span_singleton_zero] at hx,
      exact units.ne_zero _ hx },
    exact ⟨field.units.mk' hx0, hx⟩, },
  { obtain ⟨x, hx⟩ := h,
    exact (fractional_ideal.is_principal_iff _).mpr ⟨x, hx⟩ }
end

end fractional_ideal

section class_group

lemma class_group.mk_surjective {R K : Type*} [comm_ring R] [is_domain R] [is_dedekind_domain R]
  [field K] [algebra R K] [is_fraction_ring R K] :
  surjective (@class_group.mk R K _ _ _ _ _ ) :=
begin
  intros I,
  obtain ⟨J, hJ⟩ := class_group.mk0_surjective I,
  use fractional_ideal.mk0 K J,
  rw class_group.mk_mk0,
  exact hJ,
end

lemma class_group.mk_eq_one_iff' {R K : Type*} [comm_ring R] [is_domain R] [is_dedekind_domain R]
  [field K] [algebra R K] [is_fraction_ring R K] {I : (fractional_ideal R⁰ K)ˣ} :
  class_group.mk I = 1 ↔
  ∃ (x : Kˣ), (I : fractional_ideal R⁰ K) = fractional_ideal.span_singleton R⁰ (x : K)  :=
by rw [class_group.mk_eq_one_iff, coe_coe, fractional_ideal.unit_is_principal_iff]

end class_group

namespace number_field
/-! ### The idèle group of a number field
We define the (finite) idèle group of a number field `K`, with its topological group structure.
We define the idèle class group `C_K` of `K` and show that the ideal class group of `K` is
isomorphic to an explicit quotient of `C_K` as topological groups. -/

variables (K : Type) [field K] [number_field K]

/-- The finite idèle group of the number field `K`.-/
def I_K_f := units (A_K_f K)
/-- The idèle group of the number field `K`.-/
def I_K := units (A_K K)

instance : comm_group (I_K_f K) := units.comm_group
instance : comm_group (I_K K) := units.comm_group
instance : topological_space (I_K_f K) :=
finite_idele_group'.topological_space (𝓞 K) K
instance : topological_group (I_K_f K) :=
finite_idele_group'.topological_group (𝓞 K) K
instance : topological_space (I_K K) := units.topological_space
instance : topological_group (I_K K) := units.topological_group

/-- `I_K` is isomorphic to the product `I_K_f × (ℝ ⊗[ℚ] K)*`, as groups. -/
def I_K.as_prod : I_K K ≃* (I_K_f K) × units (ℝ ⊗[ℚ] K) :=
by apply @mul_equiv.prod_units (A_K_f K) (ℝ ⊗[ℚ] K) _ _

/-- `I_K` is homeomorphic to the product `I_K_f × (ℝ ⊗[ℚ] K)*`. -/
def I_K.as_prod.homeo : homeomorph (I_K K) ((I_K_f K) × units (ℝ ⊗[ℚ] K)) :=
units.homeomorph.prod_units

variable {K}
lemma I_K.as_prod.continuous : continuous ((I_K.as_prod K).to_fun) :=
(I_K.as_prod.homeo K).continuous_to_fun
lemma I_K.as_prod.continuous_inv : continuous ((I_K.as_prod K).inv_fun) :=
(I_K.as_prod.homeo K).continuous_inv_fun

/-- We construct an idèle of `K` given a finite idèle and a unit of `ℝ ⊗[ℚ] K`. -/
def I_K.mk (x : I_K_f K) (u : units (ℝ ⊗[ℚ] K)) : I_K K := (I_K.as_prod K).inv_fun (prod.mk x u)

variable (K)

/-- The projection from `I_K` to `I_K_f`, as a group homomorphism. -/
def I_K.fst : monoid_hom (I_K K) (I_K_f K) :=
{ to_fun := λ x, ((I_K.as_prod K).to_fun x).1,
  map_one' := by {rw [mul_equiv.to_fun_eq_coe, mul_equiv.map_one, prod.fst_one]},
  map_mul' := λ x y, by {simp only [prod.fst_mul, mul_equiv.to_fun_eq_coe, mul_equiv.map_mul]}}

variable {K}
/-- The projection map `I_K.fst` is surjective. -/
lemma I_K.fst.surjective : function.surjective (I_K.fst K) :=
begin
  intro x,
  use I_K.mk x (1 : units (ℝ ⊗[ℚ] K)),
  rw [I_K.fst, monoid_hom.coe_mk, mul_equiv.to_fun_eq_coe, I_K.mk,
    mul_equiv.inv_fun_eq_symm, mul_equiv.apply_symm_apply],
end

/-- The projection map `I_K.fst` is continuous. -/
lemma I_K.fst.continuous : continuous (I_K.fst K) :=
continuous.comp continuous_fst I_K.as_prod.continuous

lemma right_inv (x : units K) : (inj_K.ring_hom K) x.val * (inj_K.ring_hom K) x.inv = 1 :=
begin
  rw [← (inj_K.ring_hom K).map_mul, units.val_eq_coe, units.inv_eq_coe_inv, units.mul_inv],
  exact (inj_K.ring_hom K).map_one
end

lemma left_inv (x : units K) : (inj_K.ring_hom K) x.inv * (inj_K.ring_hom K) x.val  = 1 :=
by rw [mul_comm, right_inv]

variable (K)
/-- The map from `K^*` to `I_K` sending `k` to `((k)_v, 1 ⊗ k)`. -/
def inj_units_K : units K → I_K K := units.map (inj_K.ring_hom K).to_monoid_hom

variable {K}
@[simp] lemma inj_units_K.map_one : inj_units_K K 1 = 1 := by rw [inj_units_K, map_one]

@[simp] lemma inj_units_K.map_mul (x y : units K) :
  inj_units_K K (x*y) = (inj_units_K K x) * (inj_units_K K y) :=  by rw [inj_units_K, map_mul]

variable (K)
/-- `inj_units_K` is a group homomorphism. -/
def inj_units_K.group_hom : monoid_hom (units K) (I_K K) :=
{ to_fun    := inj_units_K K,
  map_one'  := inj_units_K.map_one,
  map_mul'  := inj_units_K.map_mul, }

/-- `inj_units_K` is injective. -/
lemma inj_units_K.injective : injective (inj_units_K K) :=
begin
  intros x y hxy,
  simp only [inj_units_K, units.map, monoid_hom.mk', ring_hom.coe_monoid_hom, monoid_hom.coe_mk,
    ← units.eq_iff, units.coe_mk] at hxy,
  ext,
  exact inj_K.injective K hxy,
end

/-- The idèle class group of `K` is the quotient of `I_K` by the group `K*` of principal idèles. -/
def C_K := (I_K K) ⧸ (inj_units_K.group_hom K).range

instance : comm_group (C_K K) :=
quotient_group.quotient.comm_group ((inj_units_K.group_hom K).range)
instance : topological_space (C_K K) := quotient.topological_space
instance : topological_group (C_K K) := topological_group_quotient ((inj_units_K.group_hom K).range)

/-- The `v`-adic absolute value of the `v`th component of the idèle `x`. -/
def v_comp_val (x : I_K K) (v : height_one_spectrum (𝓞 K)) :
  with_zero (multiplicative ℤ) := valued.v (x.val.1.val v)

/-- The `v`-adic absolute value of the inverse of the `v`th component of the idèle `x`. -/
def v_comp_inv (x : I_K K) (v : height_one_spectrum (𝓞 K)) :
  with_zero (multiplicative ℤ) := valued.v (x.inv.1.val v)

/-- For any finite idèle `x`, there are finitely many maximal ideals `v` of `R` for which
`x_v ∉ R_v` or `x⁻¹_v ∉ R_v`. -/
lemma I_K_f.restricted_product (x : I_K_f K) : set.finite ({ v : height_one_spectrum (𝓞 K) |
  ¬ (x.val.val v) ∈ v.adic_completion_integers K } ∪ { v : height_one_spectrum (𝓞 K) |
   ¬ (x.inv.val v) ∈ v.adic_completion_integers K }) :=
restricted_product (𝓞 K) K x

lemma prod_val_inv_eq_one (x : I_K K) (v : height_one_spectrum (𝓞 K)):
  (x.val.fst.val v) * (x.inv.fst.val v) = 1  :=
begin
  rw [← pi.mul_apply, mul_apply_val, ← prod.fst_mul, units.val_inv,
    prod.fst_one, subtype.val_eq_coe, ← one_def, subtype.coe_mk],
  refl,
end

lemma valuation.prod_val_inv_eq_one (x : I_K K) (v : height_one_spectrum (𝓞 K)):
  (v_comp_val K x v) * (v_comp_inv K x v) = 1 :=
begin
  simp only [v_comp_val, v_comp_inv],
  rw [← valued.v.map_mul, prod_val_inv_eq_one K x v],
  exact valuation.map_one _,
end

lemma v_comp.ne_zero (x : I_K K) (v : height_one_spectrum (𝓞 K)) :
  (x.val.1.val v) ≠ 0 := left_ne_zero_of_mul_eq_one (prod_val_inv_eq_one K x v)

/-- For any idèle `x`, there are finitely many maximal ideals `v` of `R` for which `x_v ∉ R_v` or
`x⁻¹_v ∉ R_v`. -/
lemma I_K.restricted_product (x : I_K K) : set.finite
  ({ v : height_one_spectrum (𝓞 K) | (¬ (x.val.1.val v) ∈ v.adic_completion_integers K) } ∪
    { v : height_one_spectrum (𝓞 K) | ¬ (x.inv.1.val v) ∈ v.adic_completion_integers K }) :=
finite.union x.val.1.property x.inv.1.property

/-- For any idèle `x`, there are finitely many maximal ideals `v` of `R` for which `|x_v|_v ≠ 1`. -/
lemma I_K.finite_exponents (x : I_K K) :
 { v : height_one_spectrum (𝓞 K) | v_comp_val K x v ≠ 1 }.finite :=
begin
  have h_subset : { v : height_one_spectrum (𝓞 K) | v_comp_val K x v ≠ 1 } ⊆
  { v : height_one_spectrum (𝓞 K) | ¬ (x.val.1.val v) ∈ v.adic_completion_integers K } ∪
  { v : height_one_spectrum (𝓞 K) | ¬ (x.inv.1.val v) ∈ v.adic_completion_integers K },
  { intros v hv,
    rw [mem_union, mem_set_of_eq, mem_set_of_eq, adic_completion.is_integer, adic_completion.is_integer],
    rw mem_set_of_eq at hv,
    cases (lt_or_gt_of_ne hv) with hlt hgt,
    { right,
      have h_one : (v_comp_val K x v) * (v_comp_inv K x v) = 1 :=
      valuation.prod_val_inv_eq_one K x v,
      have h_inv : 1 < v_comp_inv K x v,
      { have hx : v_comp_val K x v ≠ 0,
        { rw [v_comp_val, valuation.ne_zero_iff],
          exact v_comp.ne_zero K x v,},
        rw mul_eq_one_iff_inv_eq₀ hx at h_one,
        rw [← h_one, ← inv_one, inv_lt_inv₀ (ne.symm zero_ne_one) hx],
        exact hlt, },
      exact not_le.mpr h_inv,},
    { left, exact not_le.mpr hgt, }},
  exact finite.subset (I_K.restricted_product K x) h_subset,
end

/-- The natural map from `I_K_f` to the group of invertible fractional ideals of `K`, sending a
finite idèle `x` to the product `∏_v v^(val_v(x_v))`, where `val_v` denotes the additive
`v`-adic valuation. -/
def I_K_f.map_to_fractional_ideals : monoid_hom
  (I_K_f K) (units (fractional_ideal (non_zero_divisors (𝓞 K)) K)) :=
map_to_fractional_ideals (𝓞 K) K

variable {K}
/-- `I_K_f.map_to_fractional_ideals` is surjective. -/
lemma I_K_f.map_to_fractional_ideals.surjective :
  function.surjective (I_K_f.map_to_fractional_ideals K) :=
@map_to_fractional_ideals.surjective (𝓞 K) K _ _ _ _ _ _

/-- A finite idèle `x` is in the kernel of `I_K_f.map_to_fractional_ideals` if and only if
`|x_v|_v = 1` for all `v`. -/
lemma I_K_f.map_to_fractional_ideals.mem_kernel_iff (x : I_K_f K) :
  I_K_f.map_to_fractional_ideals K x = 1 ↔
  ∀ v : height_one_spectrum (𝓞 K),
    finite_idele.to_add_valuations (𝓞 K) K x v = 0 :=
@map_to_fractional_ideals.mem_kernel_iff (𝓞 K) K _ _ _ _ _ _ x

/-- `I_K_f.map_to_fractional_ideals` is continuous. -/
lemma I_K_f.map_to_fractional_ideals.continuous :
  continuous (I_K_f.map_to_fractional_ideals K) :=
@map_to_fractional_ideals.continuous (𝓞 K) K _ _ _ _ _ _

variable (K)
/-- The natural map from `I_K` to the group of invertible fractional ideals of `K`. -/
def I_K.map_to_fractional_ideals :
  monoid_hom (I_K K) (units (fractional_ideal (non_zero_divisors (𝓞 K)) K)) :=
monoid_hom.comp (I_K_f.map_to_fractional_ideals K) (I_K.fst K)

variable {K}
/-- `I_K.map_to_fractional_ideals` is surjective. -/
lemma I_K.map_to_fractional_ideals.surjective :
  function.surjective (I_K.map_to_fractional_ideals K) :=
function.surjective.comp I_K_f.map_to_fractional_ideals.surjective I_K.fst.surjective

/-- An idèle `x` is in the kernel of `I_K_f.map_to_fractional_ideals` if and only if `|x_v|_v = 1`
for all `v`. -/
lemma I_K.map_to_fractional_ideals.mem_kernel_iff (x : I_K K) :
  I_K.map_to_fractional_ideals K x = 1 ↔
  ∀ v : height_one_spectrum (𝓞 K),
    finite_idele.to_add_valuations (𝓞 K) K (I_K.fst K x) v = 0 :=
I_K_f.map_to_fractional_ideals.mem_kernel_iff (I_K.fst K x)

/-- `I_K.map_to_fractional_ideals` is continuous. -/
lemma I_K.map_to_fractional_ideals.continuous :
  continuous (I_K.map_to_fractional_ideals K) :=
continuous.comp I_K_f.map_to_fractional_ideals.continuous I_K.fst.continuous

variable (K)
/-- The map from `I_K_f` to the ideal  class group of `K` induced by
`I_K_f.map_to_fractional_ideals`. -/
def I_K_f.map_to_class_group :
  (I_K_f K) → (class_group (𝓞 K)) :=
λ x, class_group.mk (I_K_f.map_to_fractional_ideals K x)

instance : topological_space (class_group ↥(𝓞 K)) := ⊥
instance : topological_group (class_group ↥(𝓞 K)) :=
{ continuous_mul := continuous_of_discrete_topology,
  continuous_inv := continuous_of_discrete_topology, }

variable {K}
lemma I_K_f.map_to_class_group.surjective : surjective (I_K_f.map_to_class_group K) :=
(class_group.mk_surjective).comp I_K_f.map_to_fractional_ideals.surjective

lemma I_K_f.map_to_class_group.continuous : continuous (I_K_f.map_to_class_group K) :=
continuous_bot.comp I_K_f.map_to_fractional_ideals.continuous

variable (K)
/-- The map from `I_K` to the ideal  class group of `K` induced by
`I_K.map_to_fractional_ideals`. -/
def I_K.map_to_class_group :
  (I_K K) → (class_group (𝓞 K)) :=
λ x, class_group.mk (I_K.map_to_fractional_ideals K x)

variable {K}
lemma I_K.map_to_class_group.surjective : surjective (I_K.map_to_class_group K) :=
(class_group.mk_surjective).comp I_K.map_to_fractional_ideals.surjective

lemma I_K.map_to_class_group.continuous : continuous (I_K.map_to_class_group K) :=
continuous.comp continuous_bot I_K.map_to_fractional_ideals.continuous

variable {K}
lemma I_K.map_to_class_group.map_one : I_K.map_to_class_group K 1 = 1 :=
by {simp only [I_K.map_to_class_group, monoid_hom.map_one] }

lemma I_K.map_to_class_group.map_mul (x y : I_K K) : I_K.map_to_class_group K (x * y) =
  I_K.map_to_class_group K x * I_K.map_to_class_group K y :=
by {simp only [I_K.map_to_class_group, monoid_hom.map_mul] }

/-- The map from `I_K` to the ideal  class group of `K` induced by
`I_K.map_to_fractional_ideals` is a group homomorphism. -/
def I_K.monoid_hom_to_class_group : (I_K K) →* (class_group (𝓞 K)) :=
{ to_fun   := I_K.map_to_class_group K,
  map_one' := I_K.map_to_class_group.map_one,
  map_mul' := λ x y, I_K.map_to_class_group.map_mul x y }

lemma I_K_f.unit_image.mul_inv (k : units K):
  ((inj_K_f.ring_hom K) k.val) * ((inj_K_f.ring_hom K) k.inv) = 1 :=
by rw [← ring_hom.map_mul, units.val_eq_coe, units.inv_eq_coe_inv, units.mul_inv, ring_hom.map_one]

lemma I_K_f.unit_image.inv_mul (k : units K):
  ((inj_K_f.ring_hom K) k.inv) * ((inj_K_f.ring_hom K) k.val) = 1 :=
by rw [mul_comm, I_K_f.unit_image.mul_inv]

open_locale classical

/-- `I_K_f.map_to_fractional_ideals` sends the principal finite idèle `(k)_v` corresponding to
`k ∈ K*` to the principal fractional ideal generated by `k`. -/
lemma I_K_f.map_to_fractional_ideal.map_units (k : units K) :
  fractional_ideal.span_singleton (non_zero_divisors ↥(𝓞 K)) (k : K) =
  ((I_K_f.map_to_fractional_ideals K) (units.mk ((inj_K_f.ring_hom K) k.val)
  ((inj_K_f.ring_hom K) k.inv) (I_K_f.unit_image.mul_inv k) (I_K_f.unit_image.inv_mul k))) :=
begin
  set I := (fractional_ideal.span_singleton (non_zero_divisors ↥(𝓞 K)) (k : K))
    with hI_def,
  have hI : I ≠ 0,
  { rw [hI_def, fractional_ideal.span_singleton_ne_zero_iff],
    exact units.ne_zero k },
  rw ← fractional_ideal.factorization_principal I hI k hI_def,
  apply finprod_congr,
  intro v,
  apply congr_arg,
  simp only [finite_idele.to_add_valuations],

  rw [with_zero.to_integer, ← injective.eq_iff multiplicative.of_add.injective, of_add_neg,
    of_add_to_add, ← neg_sub_neg, of_add_sub, ← inv_div],
  apply congr_arg,
  have hv : valued.v (((inj_K_f.ring_hom K) k.val).val v) ≠ (0 : with_zero (multiplicative ℤ)),
  { rw [valuation.ne_zero_iff, inj_K_f.ring_hom.v_comp, units.val_eq_coe,
      ← uniform_space.completion.coe_zero, injective.ne_iff
      (@uniform_space.completion.coe_inj K v.adic_valued.to_uniform_space _)],
    exact units.ne_zero k },
  let z :=  classical.some (with_zero.to_integer._proof_1 hv),
  let hz :=  classical.some_spec (with_zero.to_integer._proof_1 hv),
  rw [← with_zero.coe_inj, hz, height_one_spectrum.valued_adic_completion_def,
    inj_K_f.ring_hom, inj_K.ring_hom_apply, inj_K_apply, valued.extension_extends,
    units.val_eq_coe, v.adic_valued_apply/- , height_one_spectrum.valuation_def -/],
  simp only,
  rw [with_zero.coe_div],
  set n := classical.some (is_localization.mk'_surjective (non_zero_divisors ↥(𝓞 K))
    (k : K)),
  set d' := classical.some (classical.some_spec (is_localization.mk'_surjective
    (non_zero_divisors ↥(𝓞 K)) (k : K))),
  set d : ↥(𝓞 K) := ↑d',
  have hk := classical.some_spec (classical.some_spec (is_localization.mk'_surjective
    (non_zero_divisors ↥(𝓞 K)) (k : K))),
  conv_rhs{rw ← hk},
  rw v.valuation_of_mk',
  have hn : v.int_valuation n = v.int_valuation_def n := rfl,
  have hd : v.int_valuation d = v.int_valuation_def d := rfl, --TODO : change
  rw [hn, hd],
  rw [height_one_spectrum.int_valuation_def_if_neg v
    (non_zero_divisors.coe_ne_zero _), height_one_spectrum.int_valuation_def_if_neg],
  { rw [ne.def, ← @is_fraction_ring.mk'_eq_zero_iff_eq_zero _ _ K _ _ _ _ d', hk],
    exact units.ne_zero k, }
end

/-- `I_K.map_to_fractional_ideals` sends the principal idèle `(k)_v` corresponding to `k ∈ K*` to
the principal fractional ideal generated by `k`. -/
lemma I_K.map_to_fractional_ideals.map_units_K (k : units K) :
  fractional_ideal.span_singleton (non_zero_divisors ↥(𝓞 K)) (k : K) =
  ↑((I_K.map_to_fractional_ideals K) ((inj_units_K.group_hom K) k)) :=
I_K_f.map_to_fractional_ideal.map_units k

/-- The kernel of `I_K.map_to_fractional_ideals` contains the principal idèles `(k)_v`, for
`k ∈ K*`. -/
lemma I_K.map_to_class_group.map_units_K (k : units K) :
  I_K.map_to_class_group K ((inj_units_K.group_hom K) k) = 1 :=
begin
  simp only [I_K.map_to_class_group, class_group.mk_eq_one_iff, coe_coe],
  use k,
  rw [← I_K.map_to_fractional_ideals.map_units_K k, fractional_ideal.coe_span_singleton],
end

lemma I_K.map_to_fractional_ideals.apply (x : I_K K) : (((I_K.map_to_fractional_ideals K) x) :
  fractional_ideal (non_zero_divisors ↥(𝓞 K)) K) =
  finprod (λ (v : height_one_spectrum ↥(𝓞 K)),
    (v.as_ideal : fractional_ideal (non_zero_divisors ↥(𝓞 K)) K)^
    finite_idele.to_add_valuations ↥(𝓞 K) K ((I_K.fst K) x) v) := rfl

-- Needed to avoid a diamond in mathlib.
--local attribute [-instance] number_field.𝓞_algebra

/-- If the image `x ∈ I_K` under `I_K.map_to_class_group` is the principal fractional ideal
generated by `k ∈ K*`, then for every maximal ideal `v` of the ring of integers of `K`,
`|x_v|_v = |k|_v`. -/
lemma I_K.map_to_class_group.valuation_mem_kernel (x : I_K K) (k : units K)
  (v : height_one_spectrum (𝓞 K))
  (hkx : fractional_ideal.span_singleton (non_zero_divisors ↥(𝓞 K)) (k : K) =
    (((I_K.map_to_fractional_ideals K) x) :
      fractional_ideal (non_zero_divisors ↥(𝓞 K)) K)) :
  valued.v (((I_K.fst K) x).val.val v) = valued.v ((coe : K → v.adic_completion K) k.val) :=
begin
  set nk := classical.some (is_localization.mk'_surjective (non_zero_divisors ↥(𝓞 K))
    (k : K)) with h_nk,
  set dk' := classical.some (classical.some_spec (is_localization.mk'_surjective
    (non_zero_divisors ↥(𝓞 K)) (k : K))) with h_dk',
  set dk : ↥(𝓞 K) := ↑dk' with h_dk,
  have h := classical.some_spec (classical.some_spec (is_localization.mk'_surjective
    (non_zero_divisors ↥(𝓞 K)) (k : K))),
  rw [← h_dk', ← h_nk] at h,
  have h_nk_ne_zero : nk ≠ 0,
  { intro h_contr,
    rw [h_contr, is_localization.mk'_zero] at h,
    exact (units.ne_zero k) (eq.symm h)},
  have h_dk_ne_zero : dk ≠ 0,
  { rw h_dk,
    exact non_zero_divisors.coe_ne_zero _, },
  rw I_K.map_to_fractional_ideals.apply at hkx,
  { have h_exps_v:  ((associates.mk v.as_ideal).count
      (associates.mk (ideal.span {nk})).factors : ℤ) -
      ((associates.mk v.as_ideal).count (associates.mk (ideal.span {dk})).factors : ℤ) =
      finite_idele.to_add_valuations ↥(𝓞 K) K ((I_K.fst K) x) v,
    { rw [← fractional_ideal.count_finprod K v (finite_idele.to_add_valuations ↥(𝓞 K)
        K ((I_K.fst K) x)) (finite_add_support _ _ _), ← hkx,  eq_comm],
      apply fractional_ideal.count_well_defined K v,
      { rw fractional_ideal.span_singleton_ne_zero_iff,
        exact units.ne_zero k, },
      { rw [fractional_ideal.coe_ideal_span_singleton,
          fractional_ideal.span_singleton_mul_span_singleton, ← h, is_fraction_ring.mk'_eq_div,
          h_dk, div_eq_inv_mul], }},
    simp only [finite_idele.to_add_valuations, with_zero.to_integer, eq_neg_iff_eq_neg, neg_sub]
      at h_exps_v,
    conv_rhs {rw [height_one_spectrum.valued_adic_completion_def, units.val_eq_coe], },
    rw [valued.extension_extends, v.adic_valued_apply, ← h, v.valuation_of_mk'],
    have hn : v.int_valuation nk = v.int_valuation_def nk := rfl,
    have hd : v.int_valuation dk = v.int_valuation_def dk := rfl, --TODO : change
    rw [hn, hd],
    rw [height_one_spectrum.int_valuation_def_if_neg,
    height_one_spectrum.int_valuation_def_if_neg, ← with_zero.coe_div, ← of_add_sub, neg_sub_neg,
    ← h_exps_v, of_add_to_add, eq_comm],
    exact classical.some_spec (with_zero.to_integer._proof_1 _),
    { exact h_dk_ne_zero },
    { exact h_nk_ne_zero }},
end

/-- An element `x ∈ I_K` is in the kernel of `C_K → Cl(K)` if and only if there exist `k ∈ K*` and
`y ∈ I_K` such that `x = k*y` and `|y_v|_v = 1` for all `v`. -/
lemma I_K.map_to_class_group.mem_kernel_iff (x : I_K K) :
  I_K.map_to_class_group K x = 1 ↔ ∃ (k : K) (hk : k ≠ 0),
  ∀ v : height_one_spectrum (𝓞 K),
    (finite_idele.to_add_valuations ↥(𝓞 K) K ((I_K.fst K) x) v)
    = -with_zero.to_integer (units.valuation_ne_zero (𝓞 K) K v hk) :=
begin
  rw [I_K.map_to_class_group, class_group.mk_eq_one_iff'],
  refine ⟨λ h, _, λ h, _⟩,
  { obtain ⟨k, hk⟩ := h,
    use [(k : K), k.ne_zero],
    intro v,
    rw [finite_idele.to_add_valuations, neg_inj, with_zero.to_integer,
      with_zero.to_integer, injective.eq_iff multiplicative.to_add.injective],
    apply classical.some_spec2,
    intros a ha,
    rw eq_comm,
    apply classical.some_spec2,
    intros b hb,
    have h_valuations : valued.v (((I_K.fst K) x).val.val v) =
      valued.v ((coe : K → v.adic_completion K) (k : K)),
    { apply I_K.map_to_class_group.valuation_mem_kernel x k v hk.symm },
    rw [← h_valuations, ← hb] at ha,
    rw ← with_zero.coe_inj,
    exact ha, },
    { obtain ⟨k, hk, h_vals⟩ := h,
      use field.units.mk' hk,
      rw [I_K.map_to_fractional_ideals.map_units_K, I_K.map_to_fractional_ideals,
        I_K_f.map_to_fractional_ideals, map_to_fractional_ideals, monoid_hom.coe_comp,
        comp_app, monoid_hom.coe_mk,map_to_fractional_ideals.def, force_noncomputable_def,
        units.coe_mk],
      simp only [map_to_fractional_ideals.val],
      apply finprod_congr,
      intro v,
      rw h_vals v,
      refl, }
  end

variable (K)
/-- The map `C_K → Cl(K)` induced by `I_K.map_to_class_group`. -/
def C_K.map_to_class_group :
  (C_K K) →* (class_group (𝓞 K)) :=
begin
  apply quotient_group.lift (inj_units_K.group_hom K).range I_K.monoid_hom_to_class_group _,
  { intros x hx,
    obtain ⟨k, hk⟩ := hx,
    rw ← hk,
    exact I_K.map_to_class_group.map_units_K k,},
end

/-- The natural map `C_K → Cl(K)` is surjective. -/
lemma C_K.map_to_class_group.surjective :
  surjective (C_K.map_to_class_group K) :=
begin
  intro y,
  obtain ⟨x, hx⟩ := I_K.map_to_class_group.surjective y,
  use [quotient_group.mk x, hx],
end

/-- The natural map `C_K → Cl(K)` is continuous. -/
lemma C_K.map_to_class_group.continuous :
  continuous (C_K.map_to_class_group K) :=
continuous_quot_lift _ I_K.map_to_class_group.continuous

/-- An element `x ∈ C_K` is in the kernel of `C_K → Cl(K)` if and only if `x` comes from an idèle
of the form `k*y`, with `k ∈ K*` and `|y_v|_v = 1` for all `v`. -/
lemma C_K.map_to_class_group.mem_kernel_iff (x : C_K K) :
  C_K.map_to_class_group K x = 1 ↔
  ∃ (k : K) (hk : k ≠ 0), ∀ v : height_one_spectrum (𝓞 K),
    (finite_idele.to_add_valuations ↥(𝓞 K) K
      ((I_K.fst K) (classical.some (quot.exists_rep x))) v)
      = -with_zero.to_integer (units.valuation_ne_zero (𝓞 K) K v hk) :=
begin
  set z := classical.some (quot.exists_rep x) with hz_def,
  have hz := classical.some_spec (quot.exists_rep x),
  have : C_K.map_to_class_group K x = I_K.map_to_class_group K (classical.some (quot.exists_rep x)),
  { rw [← hz_def, ← hz, C_K.map_to_class_group, ← hz_def, quotient_group.lift_quot_mk],
    refl },
  rw this,
  exact I_K.map_to_class_group.mem_kernel_iff _,
end

end number_field

namespace function_field
/-! ### The idèle group of a function field
We define the (finite) idèle group of a function field `F`, with its topological group structure. -/

variables (k F : Type) [field k] [field F] [algebra (polynomial k) F] [algebra (ratfunc k) F]
  [function_field k F] [is_scalar_tower (polynomial k) (ratfunc k) F]
  [is_separable (ratfunc k) F] [decidable_eq (ratfunc k)]

/-- The finite idèle group of the function field `F`. -/
def I_F_f := units (A_F_f k F)
/-- The idèle group of the function field `F`.-/
def I_F := units (A_F k F)

instance : comm_group (I_F_f k F) := units.comm_group
instance : comm_group (I_F k F) := units.comm_group
instance : topological_space (I_F_f k F) :=
finite_idele_group'.topological_space (ring_of_integers k F) F
instance : topological_group (I_F_f k F) :=
finite_idele_group'.topological_group (ring_of_integers k F) F
instance : topological_space (I_F k F) := units.topological_space
instance : topological_group (I_F k F) := units.topological_group

end function_field


/-
Copyright (c) 2022 Violeta Hernández Palacios. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Violeta Hernández Palacios

! This file was ported from Lean 3 source module set_theory.ordinal.natural_ops
! leanprover-community/mathlib commit 740acc0e6f9adf4423f92a485d0456fc271482da
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.SetTheory.Ordinal.Arithmetic
import Mathlib.Tactic.SolveByElim
/-!
# Natural operations on ordinals

The goal of this file is to define natural addition and multiplication on ordinals, also known as
the Hessenberg sum and product, and provide a basic API. The natural addition of two ordinals
`a ♯ b` is recursively defined as the least ordinal greater than `a' ♯ b` and `a ♯ b'` for `a' < a`
and `b' < b`. The natural multiplication `a ⨳ b` is likewise recursively defined as the least
ordinal such that `a ⨳ b ♯ a' ⨳ b'` is greater than `a' ⨳ b ♯ a ⨳ b'` for any `a' < a` and
`b' < b`.

These operations form a rich algebraic structure: they're commutative, associative, preserve order,
have the usual `0` and `1` from ordinals, and distribute over one another.

Moreover, these operations are the addition and multiplication of ordinals when viewed as
combinatorial `Game`s. This makes them particularly useful for game theory.

Finally, both operations admit simple, intuitive descriptions in terms of the Cantor normal form.
The natural addition of two ordinals corresponds to adding their Cantor normal forms as if they were
polynomials in `ω`. Likewise, their natural multiplication corresponds to multiplying the Cantor
normal forms as polynomials.

# Implementation notes

Given the rich algebraic structure of these two operations, we choose to create a type synonym
`NatOrdinal`, where we provide the appropriate instances. However, to avoid casting back and forth
between both types, we attempt to prove and state most results on `Ordinal`.

# Todo

- Define natural multiplication and provide a basic API.
- Prove the characterizations of natural addition and multiplication in terms of the Cantor normal
  form.
-/

universe u v

open Function Order

noncomputable section

/-- A type synonym for ordinals with natural addition and multiplication. -/
def NatOrdinal : Type _ :=
  -- porting note: used to derive LinearOrder & SuccOrder but need to manually define
  Ordinal deriving Zero, Inhabited, One, WellFoundedRelation
#align nat_ordinal NatOrdinal

instance NatOrdinal.linearOrder: LinearOrder NatOrdinal := {Ordinal.linearOrder with}

instance NatOrdinal.succOrder: SuccOrder NatOrdinal := {Ordinal.succOrder with}

/-- The identity function between `Ordinal` and `NatOrdinal`. -/
@[match_pattern]
def Ordinal.toNatOrdinal : Ordinal ≃o NatOrdinal :=
  OrderIso.refl _
#align ordinal.to_nat_ordinal Ordinal.toNatOrdinal

/-- The identity function between `NatOrdinal` and `Ordinal`. -/
@[match_pattern]
def NatOrdinal.toOrdinal : NatOrdinal ≃o Ordinal :=
  OrderIso.refl _
#align nat_ordinal.to_ordinal NatOrdinal.toOrdinal

open Ordinal

namespace NatOrdinal

variable {a b c : NatOrdinal.{u}}

@[simp]
theorem toOrdinal_symm_eq : NatOrdinal.toOrdinal.symm = Ordinal.toNatOrdinal :=
  rfl
#align nat_ordinal.to_ordinal_symm_eq NatOrdinal.toOrdinal_symm_eq

-- porting note: used to use dot notation, but doesn't work in Lean 4 with `OrderIso`
@[simp]
theorem toOrdinal_toNatOrdinal (a : NatOrdinal) : Ordinal.toNatOrdinal (NatOrdinal.toOrdinal a) = a
 := rfl
#align nat_ordinal.to_ordinal_to_nat_ordinal NatOrdinal.toOrdinal_toNatOrdinal

theorem lt_wf : @WellFounded NatOrdinal (· < ·) :=
  Ordinal.lt_wf
#align nat_ordinal.lt_wf NatOrdinal.lt_wf

instance : WellFoundedLT NatOrdinal :=
  Ordinal.wellFoundedLT

instance : IsWellOrder NatOrdinal (· < ·) :=
  Ordinal.isWellOrder

@[simp]
theorem toOrdinal_zero : toOrdinal 0 = 0 :=
  rfl
#align nat_ordinal.to_ordinal_zero NatOrdinal.toOrdinal_zero

@[simp]
theorem toOrdinal_one : toOrdinal 1 = 1 :=
  rfl
#align nat_ordinal.to_ordinal_one NatOrdinal.toOrdinal_one

@[simp]
theorem toOrdinal_eq_zero (a) : toOrdinal a = 0 ↔ a = 0 :=
  Iff.rfl
#align nat_ordinal.to_ordinal_eq_zero NatOrdinal.toOrdinal_eq_zero

@[simp]
theorem toOrdinal_eq_one (a) : toOrdinal a = 1 ↔ a = 1 :=
  Iff.rfl
#align nat_ordinal.to_ordinal_eq_one NatOrdinal.toOrdinal_eq_one

@[simp]
theorem toOrdinal_max : toOrdinal (max a b) = max (toOrdinal a) (toOrdinal b) :=
  rfl
#align nat_ordinal.to_ordinal_max NatOrdinal.toOrdinal_max

@[simp]
theorem toOrdinal_min : toOrdinal (min a b)= min (toOrdinal a) (toOrdinal b) :=
  rfl
#align nat_ordinal.to_ordinal_min NatOrdinal.toOrdinal_min

theorem succ_def (a : NatOrdinal) : succ a = toNatOrdinal (toOrdinal a + 1) :=
  rfl
#align nat_ordinal.succ_def NatOrdinal.succ_def

/-- A recursor for `NatOrdinal`. Use as `induction x using NatOrdinal.rec`. -/
protected def rec {β : NatOrdinal → Sort _} (h : ∀ a, β (toNatOrdinal a)) : ∀ a, β a := fun a =>
  h (toOrdinal a)
#align nat_ordinal.rec NatOrdinal.rec

/-- `Ordinal.induction` but for `NatOrdinal`. -/
theorem induction {p : NatOrdinal → Prop} : ∀ (i) (_ : ∀ j, (∀ k, k < j → p k) → p j), p i :=
  Ordinal.induction
#align nat_ordinal.induction NatOrdinal.induction

end NatOrdinal

namespace Ordinal

variable {a b c : Ordinal.{u}}

@[simp]
theorem toNatOrdinal_symm_eq : toNatOrdinal.symm = NatOrdinal.toOrdinal :=
  rfl
#align ordinal.to_nat_ordinal_symm_eq Ordinal.toNatOrdinal_symm_eq

@[simp]
theorem toNatOrdinal_toOrdinal (a : Ordinal) :  NatOrdinal.toOrdinal (toNatOrdinal a) = a :=
  rfl
#align ordinal.to_nat_ordinal_to_ordinal Ordinal.toNatOrdinal_toOrdinal

@[simp]
theorem toNatOrdinal_zero : toNatOrdinal 0 = 0 :=
  rfl
#align ordinal.to_nat_ordinal_zero Ordinal.toNatOrdinal_zero

@[simp]
theorem toNatOrdinal_one : toNatOrdinal 1 = 1 :=
  rfl
#align ordinal.to_nat_ordinal_one Ordinal.toNatOrdinal_one

@[simp]
theorem toNatOrdinal_eq_zero (a) : toNatOrdinal a = 0 ↔ a = 0 :=
  Iff.rfl
#align ordinal.to_nat_ordinal_eq_zero Ordinal.toNatOrdinal_eq_zero

@[simp]
theorem toNatOrdinal_eq_one (a) : toNatOrdinal a = 1 ↔ a = 1 :=
  Iff.rfl
#align ordinal.to_nat_ordinal_eq_one Ordinal.toNatOrdinal_eq_one

@[simp]
theorem toNatOrdinal_max : toNatOrdinal (max a b) = max (toNatOrdinal a) (toNatOrdinal b ):=
  rfl
#align ordinal.to_nat_ordinal_max Ordinal.toNatOrdinal_max

@[simp]
theorem toNatOrdinal_min :
    toNatOrdinal (linearOrder.min a b) = linearOrder.min (toNatOrdinal a) (toNatOrdinal b) :=
  rfl
#align ordinal.to_nat_ordinal_min Ordinal.toNatOrdinal_min

/-- Natural addition on ordinals `a ♯ b`, also known as the Hessenberg sum, is recursively defined
as the least ordinal greater than `a' ♯ b` and `a ♯ b'` for all `a' < a` and `b' < b`. In contrast
to normal ordinal addition, it is commutative.

Natural addition can equivalently be characterized as the ordinal resulting from adding up
corresponding coefficients in the Cantor normal forms of `a` and `b`. -/
noncomputable def nadd : Ordinal → Ordinal → Ordinal
  | a, b =>
    max (blsub.{u, u} a fun a' _ => nadd a' b) (blsub.{u, u} b fun b' _ => nadd a b')
  termination_by nadd o₁ o₂ => (o₁, o₂)
#align ordinal.nadd Ordinal.nadd

@[inherit_doc]
scoped[NaturalOps] infixl:65 " ♯ " => Ordinal.nadd

open NaturalOps

theorem nadd_def (a b : Ordinal) :
    a ♯ b = max (blsub.{u, u} a fun a' _ => a' ♯ b) (blsub.{u, u} b fun b' _ => a ♯ b') := by
  rw [nadd]
#align ordinal.nadd_def Ordinal.nadd_def

theorem lt_nadd_iff : a < b ♯ c ↔ (∃ b' < b, a ≤ b' ♯ c) ∨ ∃ c' < c, a ≤ b ♯ c' := by
  rw [nadd_def]
  simp [lt_blsub_iff]
#align ordinal.lt_nadd_iff Ordinal.lt_nadd_iff

theorem nadd_lt_nadd_left (h : b < c) (a) : a ♯ b < a ♯ c :=
  lt_nadd_iff.2 (Or.inr ⟨b, h, le_rfl⟩)
#align ordinal.nadd_lt_nadd_left Ordinal.nadd_lt_nadd_left

theorem nadd_lt_nadd_right (h : b < c) (a) : b ♯ a < c ♯ a :=
  lt_nadd_iff.2 (Or.inl ⟨b, h, le_rfl⟩)
#align ordinal.nadd_lt_nadd_right Ordinal.nadd_lt_nadd_right

theorem nadd_le_nadd_left (h : b ≤ c) (a) : a ♯ b ≤ a ♯ c := by
  rcases lt_or_eq_of_le h with (h | rfl)
  · exact (nadd_lt_nadd_left h a).le
  · exact le_rfl
#align ordinal.nadd_le_nadd_left Ordinal.nadd_le_nadd_left

theorem nadd_le_nadd_right (h : b ≤ c) (a) : b ♯ a ≤ c ♯ a := by
  rcases lt_or_eq_of_le h with (h | rfl)
  · exact (nadd_lt_nadd_right h a).le
  · exact le_rfl
#align ordinal.nadd_le_nadd_right Ordinal.nadd_le_nadd_right

variable (a b)

theorem nadd_comm : ∀ a b, a ♯ b = b ♯ a
  | a, b => by
    rw [nadd_def, nadd_def, max_comm]
    congr <;> ext <;> apply nadd_comm
    -- porting note: below was decreasing_by solve_by_elim [PSigma.Lex.left, PSigma.Lex.right]
  termination_by nadd_comm a b => (a,b)
#align ordinal.nadd_comm Ordinal.nadd_comm

theorem blsub_nadd_of_mono {f : ∀ c < a ♯ b, Ordinal.{max u v}}
    (hf : ∀ {i j} (hi hj), i ≤ j → f i hi ≤ f j hj) :
    -- Porting note: needed to add universe hint blsub.{u,v} in the line below
    blsub.{u,v} _ f =
      max (blsub.{u, v} a fun a' ha' => f (a' ♯ b) <| nadd_lt_nadd_right ha' b)
        (blsub.{u, v} b fun b' hb' => f (a ♯ b') <| nadd_lt_nadd_left hb' a) := by
  apply (blsub_le_iff.2 fun i h => _).antisymm (max_le _ _)
  intro i h
  · rcases lt_nadd_iff.1 h with (⟨a', ha', hi⟩ | ⟨b', hb', hi⟩)
    · exact lt_max_of_lt_left ((hf h (nadd_lt_nadd_right ha' b) hi).trans_lt (lt_blsub _ _ ha'))
    · exact lt_max_of_lt_right ((hf h (nadd_lt_nadd_left hb' a) hi).trans_lt (lt_blsub _ _ hb'))
  all_goals
    apply blsub_le_of_brange_subset.{u, u, v}
    rintro c ⟨d, hd, rfl⟩
    apply mem_brange_self
#align ordinal.blsub_nadd_of_mono Ordinal.blsub_nadd_of_mono

theorem nadd_assoc : ∀ a b c, a ♯ b ♯ c = a ♯ (b ♯ c)
  | a, b, c =>
    by
    rw [nadd_def a (b ♯ c), nadd_def, blsub_nadd_of_mono, blsub_nadd_of_mono, max_assoc]
    · congr <;> ext (d hd) <;> apply nadd_assoc
    · exact fun  _ _ h => nadd_le_nadd_left h a
    · exact fun  _ _ h => nadd_le_nadd_right h c
    termination_by' PSigma.lex (inferInstance) (fun _ ↦ inferInstance)
    -- Porting note: above lines replaces
    -- decreasing_by solve_by_elim [PSigma.Lex.left, PSigma.Lex.right]
#align ordinal.nadd_assoc Ordinal.nadd_assoc

@[simp]
theorem nadd_zero : a ♯ 0 = a := by
  induction' a using Ordinal.induction with a IH
  rw [nadd_def, blsub_zero, max_zero_right]
  convert blsub_id a
  rename_i hb
  exact IH _ hb
#align ordinal.nadd_zero Ordinal.nadd_zero

@[simp]
theorem zero_nadd : 0 ♯ a = a := by rw [nadd_comm, nadd_zero]
#align ordinal.zero_nadd Ordinal.zero_nadd

@[simp]
theorem nadd_one : a ♯ 1 = succ a := by
  induction' a using Ordinal.induction with a IH
  rw [nadd_def, blsub_one, nadd_zero, max_eq_right_iff, blsub_le_iff]
  intro i hi
  rwa [IH i hi, succ_lt_succ_iff]
#align ordinal.nadd_one Ordinal.nadd_one

@[simp]
theorem one_nadd : 1 ♯ a = succ a := by rw [nadd_comm, nadd_one]
#align ordinal.one_nadd Ordinal.one_nadd

theorem nadd_succ : a ♯ succ b = succ (a ♯ b) := by rw [← nadd_one (a ♯ b), nadd_assoc, nadd_one]
#align ordinal.nadd_succ Ordinal.nadd_succ

theorem succ_nadd : succ a ♯ b = succ (a ♯ b) := by rw [← one_nadd (a ♯ b), ← nadd_assoc, one_nadd]
#align ordinal.succ_nadd Ordinal.succ_nadd

@[simp]
theorem nadd_nat (n : ℕ) : a ♯ n = a + n := by
  induction' n with n hn
  · simp
  · rw [Nat.cast_succ, add_one_eq_succ, nadd_succ, add_succ, hn]
#align ordinal.nadd_nat Ordinal.nadd_nat

@[simp]
theorem nat_nadd (n : ℕ) : ↑n ♯ a = a + n := by rw [nadd_comm, nadd_nat]
#align ordinal.nat_nadd Ordinal.nat_nadd

theorem add_le_nadd : a + b ≤ a ♯ b := by
  apply b.limitRecOn
  · simp
  · intro c h
    rwa [add_succ, nadd_succ, succ_le_succ_iff]
  · intro c hc H
    simp_rw [← IsNormal.blsub_eq.{u, u} (add_isNormal a) hc, blsub_le_iff]
    exact fun i hi => (H i hi).trans_lt (nadd_lt_nadd_left hi a)
#align ordinal.add_le_nadd Ordinal.add_le_nadd

end Ordinal

open Ordinal

namespace NatOrdinal

instance : Add NatOrdinal :=
  ⟨nadd⟩

instance add_covariantClass_lt : CovariantClass NatOrdinal.{u} NatOrdinal.{u} (· + ·) (· < ·) :=
  ⟨fun a _ _ h => nadd_lt_nadd_left h a⟩
#align nat_ordinal.add_covariant_class_lt NatOrdinal.add_covariantClass_lt

instance add_covariantClass_le : CovariantClass NatOrdinal.{u} NatOrdinal.{u} (· + ·) (· ≤ ·) :=
  ⟨fun a _ _ h => nadd_le_nadd_left h a⟩
#align nat_ordinal.add_covariant_class_le NatOrdinal.add_covariantClass_le

instance add_contravariantClass_le :
    ContravariantClass NatOrdinal.{u} NatOrdinal.{u} (· + ·) (· ≤ ·) :=
  ⟨fun a b c h => by
    by_contra' h'
    exact h.not_lt (add_lt_add_left h' a)⟩
#align nat_ordinal.add_contravariant_class_le NatOrdinal.add_contravariantClass_le

instance : OrderedCancelAddCommMonoid NatOrdinal :=
  { NatOrdinal.linearOrder with
    add := (· + ·)
    add_assoc := nadd_assoc
    add_le_add_left := fun a b => add_le_add_left
    le_of_add_le_add_left := fun a b c => le_of_add_le_add_left
    zero := 0
    zero_add := zero_nadd
    add_zero := nadd_zero
    add_comm := nadd_comm }

instance addMonoidWithOne : AddMonoidWithOne NatOrdinal :=
  AddMonoidWithOne.unary

@[simp]
theorem add_one_eq_succ : ∀ a : NatOrdinal, a + 1 = succ a :=
  nadd_one
#align nat_ordinal.add_one_eq_succ NatOrdinal.add_one_eq_succ

@[simp]
theorem toOrdinal_cast_nat (n : ℕ) : toOrdinal n = n := by
  induction' n with n hn
  · rfl
  · change nadd (toOrdinal n) 1 = n + 1
    rw [hn]
    apply nadd_one
#align nat_ordinal.to_ordinal_cast_nat NatOrdinal.toOrdinal_cast_nat

end NatOrdinal

open NatOrdinal

open NaturalOps

namespace Ordinal

@[simp]
theorem toNatOrdinal_cast_nat (n : ℕ) : toNatOrdinal n = n := by
  rw [← toOrdinal_cast_nat n]
  rfl
#align ordinal.to_nat_ordinal_cast_nat Ordinal.toNatOrdinal_cast_nat

theorem lt_of_nadd_lt_nadd_left : ∀ {a b c}, a ♯ b < a ♯ c → b < c :=
  @lt_of_add_lt_add_left NatOrdinal _ _ _
#align ordinal.lt_of_nadd_lt_nadd_left Ordinal.lt_of_nadd_lt_nadd_left

theorem lt_of_nadd_lt_nadd_right : ∀ {a b c}, b ♯ a < c ♯ a → b < c :=
  @lt_of_add_lt_add_right NatOrdinal _ _ _
#align ordinal.lt_of_nadd_lt_nadd_right Ordinal.lt_of_nadd_lt_nadd_right

theorem le_of_nadd_le_nadd_left : ∀ {a b c}, a ♯ b ≤ a ♯ c → b ≤ c :=
  @le_of_add_le_add_left NatOrdinal _ _ _
#align ordinal.le_of_nadd_le_nadd_left Ordinal.le_of_nadd_le_nadd_left

theorem le_of_nadd_le_nadd_right : ∀ {a b c}, b ♯ a ≤ c ♯ a → b ≤ c :=
  @le_of_add_le_add_right NatOrdinal _ _ _
#align ordinal.le_of_nadd_le_nadd_right Ordinal.le_of_nadd_le_nadd_right

theorem nadd_lt_nadd_iff_left : ∀ (a) {b c}, a ♯ b < a ♯ c ↔ b < c :=
  @add_lt_add_iff_left NatOrdinal _ _ _ _
#align ordinal.nadd_lt_nadd_iff_left Ordinal.nadd_lt_nadd_iff_left

theorem nadd_lt_nadd_iff_right : ∀ (a) {b c}, b ♯ a < c ♯ a ↔ b < c :=
  @add_lt_add_iff_right NatOrdinal _ _ _ _
#align ordinal.nadd_lt_nadd_iff_right Ordinal.nadd_lt_nadd_iff_right

theorem nadd_le_nadd_iff_left : ∀ (a) {b c}, a ♯ b ≤ a ♯ c ↔ b ≤ c :=
  @add_le_add_iff_left NatOrdinal _ _ _ _
#align ordinal.nadd_le_nadd_iff_left Ordinal.nadd_le_nadd_iff_left

theorem nadd_le_nadd_iff_right : ∀ (a) {b c}, b ♯ a ≤ c ♯ a ↔ b ≤ c :=
  @_root_.add_le_add_iff_right NatOrdinal _ _ _ _
#align ordinal.nadd_le_nadd_iff_right Ordinal.nadd_le_nadd_iff_right

theorem nadd_left_cancel : ∀ {a b c}, a ♯ b = a ♯ c → b = c :=
  @_root_.add_left_cancel NatOrdinal _ _
#align ordinal.nadd_left_cancel Ordinal.nadd_left_cancel

theorem nadd_right_cancel : ∀ {a b c}, a ♯ b = c ♯ b → a = c :=
  @_root_.add_right_cancel NatOrdinal _ _
#align ordinal.nadd_right_cancel Ordinal.nadd_right_cancel

theorem nadd_left_cancel_iff : ∀ {a b c}, a ♯ b = a ♯ c ↔ b = c :=
  @add_left_cancel_iff NatOrdinal _ _
#align ordinal.nadd_left_cancel_iff Ordinal.nadd_left_cancel_iff

theorem nadd_right_cancel_iff : ∀ {a b c}, b ♯ a = c ♯ a ↔ b = c :=
  @add_right_cancel_iff NatOrdinal _ _
#align ordinal.nadd_right_cancel_iff Ordinal.nadd_right_cancel_iff

end Ordinal


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import ring_theory.nilpotent
import ring_theory.ideal.quotient_operations

/-!
# Nilpotent elements in quotient rings
-/

lemma ideal.is_radical_iff_quotient_reduced {R : Type*} [comm_ring R] (I : ideal R) :
  I.is_radical ↔ is_reduced (R ⧸ I) :=
by { conv_lhs { rw ← @ideal.mk_ker R _ I },
  exact ring_hom.ker_is_radical_iff_reduced_of_surjective (@ideal.quotient.mk_surjective R _ I) }

variables {R S : Type*} [comm_semiring R] [comm_ring S] [algebra R S] (I : ideal S)

/-- Let `P` be a property on ideals. If `P` holds for square-zero ideals, and if
  `P I → P (J ⧸ I) → P J`, then `P` holds for all nilpotent ideals. -/
lemma ideal.is_nilpotent.induction_on
  (hI : is_nilpotent I)
  {P : ∀ ⦃S : Type*⦄ [comm_ring S], by exactI ∀ I : ideal S, Prop}
  (h₁ : ∀ ⦃S : Type*⦄ [comm_ring S], by exactI ∀ I : ideal S, I ^ 2 = ⊥ → P I)
  (h₂ : ∀ ⦃S : Type*⦄ [comm_ring S], by exactI
    ∀ I J : ideal S, I ≤ J → P I → P (J.map (ideal.quotient.mk I)) → P J) : P I :=
begin
  obtain ⟨n, hI : I ^ n = ⊥⟩ := hI,
  unfreezingI { revert S },
  apply nat.strong_induction_on n,
  clear n,
  introsI n H S _ I hI,
  by_cases hI' : I = ⊥,
  { subst hI', apply h₁, rw [← ideal.zero_eq_bot, zero_pow], exact zero_lt_two },
  cases n,
  { rw [pow_zero, ideal.one_eq_top] at hI,
    haveI := subsingleton_of_bot_eq_top hI.symm,
    exact (hI' (subsingleton.elim _ _)).elim },
  cases n,
  { rw [pow_one] at hI,
    exact (hI' hI).elim },
  apply h₂ (I ^ 2) _ (ideal.pow_le_self two_ne_zero),
  { apply H n.succ _ (I ^ 2),
    { rw [← pow_mul, eq_bot_iff, ← hI, nat.succ_eq_add_one, nat.succ_eq_add_one],
      exact ideal.pow_le_pow (by linarith) },
    { exact le_refl n.succ.succ } },
  { apply h₁, rw [← ideal.map_pow, ideal.map_quotient_self] },
end

lemma is_nilpotent.is_unit_quotient_mk_iff {R : Type*} [comm_ring R] {I : ideal R}
  (hI : is_nilpotent I) {x : R} : is_unit (ideal.quotient.mk I x) ↔ is_unit x :=
begin
  refine ⟨_, λ h, h.map I^.quotient.mk⟩,
  revert x,
  apply ideal.is_nilpotent.induction_on I hI; clear hI I,
  swap,
  { introv e h₁ h₂ h₃,
    apply h₁,
    apply h₂,
    exactI h₃.map ((double_quot.quot_quot_equiv_quot_sup I J).trans
      (ideal.quot_equiv_of_eq (sup_eq_right.mpr e))).symm.to_ring_hom },
  { introv e H,
    resetI,
    obtain ⟨y, hy⟩ := ideal.quotient.mk_surjective (↑(H.unit⁻¹) : S ⧸ I),
    have : ideal.quotient.mk I (x * y) = ideal.quotient.mk I 1,
    { rw [map_one, _root_.map_mul, hy, is_unit.mul_coe_inv] },
    rw ideal.quotient.eq at this,
    have : (x * y - 1) ^ 2 = 0,
    { rw [← ideal.mem_bot, ← e], exact ideal.pow_mem_pow this _ },
    have : x * (y * (2 - x * y)) = 1,
    { rw [eq_comm, ← sub_eq_zero, ← this], ring },
    exact is_unit_of_mul_eq_one _ _ this }
end


import .atom

open list znum

def asubst (i') (ks') : atom → atom
| (atom.le i (k::ks))     := atom.le (i - (k * i')) (comp_add (map_mul k ks') ks)
| (atom.dvd d i (k::ks))  := atom.dvd d (i + (k * i')) (comp_add (map_mul k ks') ks)
| (atom.ndvd d i (k::ks)) := atom.ndvd d (i + (k * i')) (comp_add (map_mul k ks') ks)
| a := a

meta def aval_subst_iff_tac :=
`[unfold asubst, unfold atom.eval, rewrite add_assoc,
  have he : (i' * k + dot_prod (comp_add (map_mul k ks') ks) xs)
            = (dot_prod (k :: ks) ((i' + dot_prod ks' xs) :: xs)),
  rw cons_dot_prod_cons_eq,
  rewrite mul_add, rewrite mul_comm, simp,
  rewrite comp_add_dot_prod,
  simp [dot_prod], apply map_mul_dot_prod,
  rewrite mul_comm at he, rewrite he]

meta def aval_subst_iff_aux :=
`[unfold asubst, unfold atom.eval,
  repeat {rewrite nil_dot_prod}]

lemma aval_subst_iff (i' ks' xs) :
  ∀ a, (asubst i' ks' a).eval xs ↔ a.eval ((i' + dot_prod ks' xs)::xs)
| (atom.le i (k::ks))     :=
  begin
    unfold asubst, simp, unfold atom.eval,
    rewrite znum.add_le_iff_le_sub, simp,
    have he : (i' * k + dot_prod (comp_add (map_mul k ks') ks) xs)
               = (dot_prod (k :: ks) ((i' + dot_prod ks' xs) :: xs)),
    { rewrite cons_dot_prod_cons_eq,
      rewrite mul_add, rewrite mul_comm, simp,
      rewrite comp_add_dot_prod, simp [dot_prod],
     apply map_mul_dot_prod },
    rewrite mul_comm at he, simp at *, rewrite he
  end
| (atom.dvd d i (k::ks))  := by aval_subst_iff_tac
| (atom.ndvd d i (k::ks)) := by aval_subst_iff_tac
| (atom.le i [])     := by aval_subst_iff_aux
| (atom.dvd d i [])  := by aval_subst_iff_aux
| (atom.ndvd d i []) := by aval_subst_iff_aux


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import topology.order.basic
import data.set.intervals.ord_connected_component

/-!
# Linear order is a completely normal Hausdorff topological space

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

In this file we prove that a linear order with order topology is a completely normal Hausdorff
topological space.
-/

open filter set function order_dual
open_locale topology filter interval

variables {X : Type*} [linear_order X] [topological_space X] [order_topology X]
  {a b c : X} {s t : set X}

namespace set

@[simp] lemma ord_connected_component_mem_nhds :
  ord_connected_component s a ∈ 𝓝 a ↔ s ∈ 𝓝 a :=
begin
  refine ⟨λ h, mem_of_superset h ord_connected_component_subset, λ h, _⟩,
  rcases exists_Icc_mem_subset_of_mem_nhds h with ⟨b, c, ha, ha', hs⟩,
  exact mem_of_superset ha' (subset_ord_connected_component ha hs)
end

lemma compl_section_ord_separating_set_mem_nhds_within_Ici (hd : disjoint s (closure t))
  (ha : a ∈ s) :
  (ord_connected_section $ ord_separating_set s t)ᶜ ∈ 𝓝[≥] a :=
begin
  have hmem : tᶜ ∈ 𝓝[≥] a,
  { refine mem_nhds_within_of_mem_nhds _,
    rw [← mem_interior_iff_mem_nhds, interior_compl],
    exact disjoint_left.1 hd ha },
  rcases exists_Icc_mem_subset_of_mem_nhds_within_Ici hmem with ⟨b, hab, hmem', hsub⟩,
  by_cases H : disjoint (Icc a b) (ord_connected_section $ ord_separating_set s t),
  { exact mem_of_superset hmem' (disjoint_left.1 H) },
  { simp only [set.disjoint_left, not_forall, not_not] at H,
    rcases H with ⟨c, ⟨hac, hcb⟩, hc⟩,
    have hsub' : Icc a b ⊆ ord_connected_component tᶜ a,
      from subset_ord_connected_component (left_mem_Icc.2 hab) hsub,
    replace hac : a < c := hac.lt_of_ne (ne.symm $ ne_of_mem_of_not_mem hc $ disjoint_left.1
      (disjoint_left_ord_separating_set.mono_right ord_connected_section_subset) ha),
    refine mem_of_superset (Ico_mem_nhds_within_Ici (left_mem_Ico.2 hac)) (λ x hx hx', _),
    refine hx.2.ne (eq_of_mem_ord_connected_section_of_uIcc_subset hx' hc _),
    refine subset_inter (subset_Union₂_of_subset a ha _) _,
    { exact ord_connected.uIcc_subset infer_instance (hsub' ⟨hx.1, hx.2.le.trans hcb⟩)
        (hsub' ⟨hac.le, hcb⟩) },
    { rcases mem_Union₂.1 (ord_connected_section_subset hx').2 with ⟨y, hyt, hxy⟩,
      refine subset_Union₂_of_subset y hyt (ord_connected.uIcc_subset infer_instance hxy _),
      refine subset_ord_connected_component left_mem_uIcc hxy _,
      suffices : c < y,
      { rw [uIcc_of_ge (hx.2.trans this).le],
        exact ⟨hx.2.le, this.le⟩ },
      refine lt_of_not_le (λ hyc, _),
      have hya : y < a, from not_le.1 (λ hay, hsub ⟨hay, hyc.trans hcb⟩ hyt),
      exact hxy (Icc_subset_uIcc ⟨hya.le, hx.1⟩) ha } }
end

lemma compl_section_ord_separating_set_mem_nhds_within_Iic (hd : disjoint s (closure t))
  (ha : a ∈ s) : (ord_connected_section $ ord_separating_set s t)ᶜ ∈ 𝓝[≤] a :=
have hd' : disjoint (of_dual ⁻¹' s) (closure $ of_dual ⁻¹' t) := hd,
have ha' : to_dual a ∈ of_dual ⁻¹' s := ha,
by simpa only [dual_ord_separating_set, dual_ord_connected_section]
  using compl_section_ord_separating_set_mem_nhds_within_Ici hd' ha'

lemma compl_section_ord_separating_set_mem_nhds (hd : disjoint s (closure t)) (ha : a ∈ s) :
  (ord_connected_section $ ord_separating_set s t)ᶜ ∈ 𝓝 a :=
begin
  rw [← nhds_left_sup_nhds_right, mem_sup],
  exact ⟨compl_section_ord_separating_set_mem_nhds_within_Iic hd ha,
    compl_section_ord_separating_set_mem_nhds_within_Ici hd ha⟩
end

lemma ord_t5_nhd_mem_nhds_set (hd : disjoint s (closure t)) : ord_t5_nhd s t ∈ 𝓝ˢ s :=
bUnion_mem_nhds_set $ λ x hx, ord_connected_component_mem_nhds.2 $
  inter_mem (by { rw [← mem_interior_iff_mem_nhds, interior_compl], exact disjoint_left.1 hd hx })
    (compl_section_ord_separating_set_mem_nhds hd hx)

end set

open set

/-- A linear order with order topology is a completely normal Hausdorff topological space. -/
@[priority 100] instance order_topology.t5_space : t5_space X :=
⟨λ s t h₁ h₂, filter.disjoint_iff.2 ⟨ord_t5_nhd s t, ord_t5_nhd_mem_nhds_set h₂, ord_t5_nhd t s,
  ord_t5_nhd_mem_nhds_set h₁.symm, disjoint_ord_t5_nhd⟩⟩


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

! This file was ported from Lean 3 source module data.nat.bitwise
! leanprover-community/mathlib commit 6afc9b06856ad973f6a2619e3e8a0a8d537a58f2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Lean.Elab.Tactic
import Mathlib.Data.List.Basic
import Mathlib.Data.Nat.Bits
import Mathlib.Data.Nat.Size
import Mathlib.Data.Nat.Order.Lemmas
import Mathlib.Tactic.Linarith
import Mathlib.Tactic.Set

/-!
# Bitwise operations on natural numbers

In the first half of this file, we provide theorems for reasoning about natural numbers from their
bitwise properties. In the second half of this file, we show properties of the bitwise operations
`lor'`, `land'` and `lxor'`, which are defined in core.

## Main results
* `eq_of_testBit_eq`: two natural numbers are equal if they have equal bits at every position.
* `exists_most_significant_bit`: if `n ≠ 0`, then there is some position `i` that contains the most
  significant `1`-bit of `n`.
* `lt_of_testBit`: if `n` and `m` are numbers and `i` is a position such that the `i`-th bit of
  of `n` is zero, the `i`-th bit of `m` is one, and all more significant bits are equal, then
  `n < m`.

## Future work

There is another way to express bitwise properties of natural number: `digits 2`. The two ways
should be connected.

## Keywords

bitwise, and, or, xor
-/

open Function

namespace Nat

set_option linter.deprecated false

@[simp]
theorem bit_false : bit false = bit0 :=
  rfl
#align nat.bit_ff Nat.bit_false

@[simp]
theorem bit_true : bit true = bit1 :=
  rfl
#align nat.bit_tt Nat.bit_true

@[simp]
theorem bit_eq_zero {n : ℕ} {b : Bool} : n.bit b = 0 ↔ n = 0 ∧ b = false := by
  cases b <;> simp [Nat.bit0_eq_zero, Nat.bit1_ne_zero]
#align nat.bit_eq_zero Nat.bit_eq_zero

theorem zero_of_testBit_eq_false {n : ℕ} (h : ∀ i, testBit n i = false) : n = 0 := by
  induction' n using Nat.binaryRec with b n hn
  · rfl
  · have : b = false := by simpa using h 0
    rw [this, bit_false, bit0_val, hn fun i => by rw [← h (i + 1), testBit_succ], mul_zero]
#align nat.zero_of_test_bit_eq_ff Nat.zero_of_testBit_eq_false

@[simp]
theorem zero_testBit (i : ℕ) : testBit 0 i = false := by simp only [testBit, shiftr_zero, bodd_zero]
#align nat.zero_test_bit Nat.zero_testBit

/-- The ith bit is the ith element of `n.bits`. -/
theorem testBit_eq_inth (n i : ℕ) : n.testBit i = n.bits.getI i := by
  induction' i with i ih generalizing n
  · simp [testBit, shiftr, bodd_eq_bits_head, List.getI_zero_eq_headI]
  conv_lhs => rw [← bit_decomp n]
  rw [testBit_succ, ih n.div2, div2_bits_eq_tail]
  cases n.bits <;> simp
#align nat.test_bit_eq_inth Nat.testBit_eq_inth

/-- Bitwise extensionality: Two numbers agree if they agree at every bit position. -/
theorem eq_of_testBit_eq {n m : ℕ} (h : ∀ i, testBit n i = testBit m i) : n = m := by
  induction' n using Nat.binaryRec with b n hn generalizing m
  · simp only [zero_testBit] at h
    exact (zero_of_testBit_eq_false fun i => (h i).symm).symm
  induction' m using Nat.binaryRec with b' m
  · simp only [zero_testBit] at h
    exact zero_of_testBit_eq_false h
  suffices h' : n = m
  · rw [h', show b = b' by simpa using h 0]
  exact hn fun i => by convert h (i + 1) using 1 <;> rw [testBit_succ]
#align nat.eq_of_test_bit_eq Nat.eq_of_testBit_eq

theorem exists_most_significant_bit {n : ℕ} (h : n ≠ 0) :
    ∃ i, testBit n i = true ∧ ∀ j, i < j → testBit n j = false := by
  induction' n using Nat.binaryRec with b n hn
  · exact False.elim (h rfl)
  by_cases h' : n = 0
  · subst h'
    rw [show b = true by
        revert h
        cases b <;> simp]
    refine' ⟨0, ⟨by rw [testBit_zero], fun j hj => _⟩⟩
    obtain ⟨j', rfl⟩ := exists_eq_succ_of_ne_zero (ne_of_gt hj)
    rw [testBit_succ, zero_testBit]
  · obtain ⟨k, ⟨hk, hk'⟩⟩ := hn h'
    refine' ⟨k + 1, ⟨by rw [testBit_succ, hk], fun j hj => _⟩⟩
    obtain ⟨j', rfl⟩ := exists_eq_succ_of_ne_zero (show j ≠ 0 by intro x; subst x; simp at hj)
    exact (testBit_succ _ _ _).trans (hk' _ (lt_of_succ_lt_succ hj))
#align nat.exists_most_significant_bit Nat.exists_most_significant_bit

theorem lt_of_testBit {n m : ℕ} (i : ℕ) (hn : testBit n i = false) (hm : testBit m i = true)
    (hnm : ∀ j, i < j → testBit n j = testBit m j) : n < m := by
  induction' n using Nat.binaryRec with b n hn' generalizing i m
  · contrapose! hm
    rw [le_zero_iff] at hm
    simp [hm]
  induction' m using Nat.binaryRec with b' m hm' generalizing i
  · exact False.elim (Bool.ff_ne_tt ((zero_testBit i).symm.trans hm))
  by_cases hi : i = 0
  · subst hi
    simp only [testBit_zero] at hn hm
    have : n = m :=
      eq_of_testBit_eq fun i => by convert hnm (i + 1) (Nat.zero_lt_succ _) using 1
      <;> rw [testBit_succ]
    rw [hn, hm, this, bit_false, bit_true, bit0_val, bit1_val]
    exact lt_add_one _
  · obtain ⟨i', rfl⟩ := exists_eq_succ_of_ne_zero hi
    simp only [testBit_succ] at hn hm
    have :=
      hn' _ hn hm fun j hj => by convert hnm j.succ (succ_lt_succ hj) using 1 <;> rw [testBit_succ]
    cases b <;> cases b'
    <;> simp only [bit_false, bit_true, bit0_val n, bit1_val n, bit0_val m, bit1_val m]
    <;> linarith only [this]
#align nat.lt_of_test_bit Nat.lt_of_testBit

@[simp]
theorem testBit_two_pow_self (n : ℕ) : testBit (2 ^ n) n = true := by
  rw [testBit, shiftr_eq_div_pow, Nat.div_self (pow_pos (α := ℕ) zero_lt_two n), bodd_one]
#align nat.test_bit_two_pow_self Nat.testBit_two_pow_self

theorem testBit_two_pow_of_ne {n m : ℕ} (hm : n ≠ m) : testBit (2 ^ n) m = false := by
  rw [testBit, shiftr_eq_div_pow]
  cases' hm.lt_or_lt with hm hm
  · rw [Nat.div_eq_zero, bodd_zero]
    exact Nat.pow_lt_pow_of_lt_right one_lt_two hm
  · rw [pow_div hm.le zero_lt_two, ← tsub_add_cancel_of_le (succ_le_of_lt <| tsub_pos_of_lt hm)]
    -- Porting note: XXX why does this make it work?
    rw [(rfl : succ 0 = 1)]
    simp only [ge_iff_le, tsub_le_iff_right, pow_succ, bodd_mul,
      Bool.and_eq_false_eq_eq_false_or_eq_false, or_true]
#align nat.test_bit_two_pow_of_ne Nat.testBit_two_pow_of_ne

theorem testBit_two_pow (n m : ℕ) : testBit (2 ^ n) m = (n = m) := by
  by_cases h : n = m
  · cases h
    simp
  · rw [testBit_two_pow_of_ne h]
    simp [h]
#align nat.test_bit_two_pow Nat.testBit_two_pow

/-- If `f` is a commutative operation on bools such that `f false false = false`, then `bitwise f`
    is also commutative. -/
theorem bitwise'_comm {f : Bool → Bool → Bool} (hf : ∀ b b', f b b' = f b' b)
    (hf' : f false false = false) (n m : ℕ) : bitwise' f n m = bitwise' f m n :=
  suffices bitwise' f = swap (bitwise' f) by conv_lhs => rw [this]
  calc
    bitwise' f = bitwise' (swap f) := congr_arg _ <| funext fun _ => funext <| hf _
    _ = swap (bitwise' f) := bitwise'_swap hf'
#align nat.bitwise_comm Nat.bitwise'_comm

theorem lor'_comm (n m : ℕ) : lor' n m = lor' m n :=
  bitwise'_comm Bool.or_comm rfl n m
#align nat.lor_comm Nat.lor'_comm

theorem land'_comm (n m : ℕ) : land' n m = land' m n :=
  bitwise'_comm Bool.and_comm rfl n m
#align nat.land_comm Nat.land'_comm

theorem lxor'_comm (n m : ℕ) : lxor' n m = lxor' m n :=
  bitwise'_comm Bool.xor_comm rfl n m
#align nat.lxor_comm Nat.lxor'_comm

@[simp]
theorem zero_lxor' (n : ℕ) : lxor' 0 n = n := by
 simp only [Bool.xor_false_left, Nat.bitwise'_zero_left, eq_self_iff_true, Bool.cond_true, lxor']
#align nat.zero_lxor Nat.zero_lxor'

@[simp]
theorem lxor'_zero (n : ℕ) : lxor' n 0 = n := by simp [lxor']
#align nat.lxor_zero Nat.lxor'_zero

@[simp]
theorem zero_land' (n : ℕ) : land' 0 n = 0 := by
  simp only [Nat.bitwise'_zero_left, Bool.cond_false, eq_self_iff_true, land', Bool.false_and]
#align nat.zero_land Nat.zero_land'

@[simp]
theorem land'_zero (n : ℕ) : land' n 0 = 0 := by simp [land']
#align nat.land_zero Nat.land'_zero

@[simp]
theorem zero_lor' (n : ℕ) : lor' 0 n = n := by --simp [lor']
  simp only [Nat.bitwise'_zero_left, Bool.false_or, eq_self_iff_true, Bool.cond_true, Nat.lor']
#align nat.zero_lor Nat.zero_lor'

@[simp]
theorem lor'_zero (n : ℕ) : lor' n 0 = n := by simp [lor']
#align nat.lor_zero Nat.lor'_zero

/-- Proving associativity of bitwise operations in general essentially boils down to a huge case
    distinction, so it is shorter to use this tactic instead of proving it in the general case. -/
macro "bitwise_assoc_tac" : tactic => set_option hygiene false in `(tactic| (
  induction' n using Nat.binaryRec with b n hn generalizing m k
  · simp
  induction' m using Nat.binaryRec with b' m hm
  · simp
  induction' k using Nat.binaryRec with b'' k hk
  -- Porting note: was `simp [hn]`
  -- This is necessary because these are simp lemmas in mathlib
  <;> simp [hn, Bool.or_assoc, Bool.and_assoc]))

theorem lxor'_assoc (n m k : ℕ) : lxor' (lxor' n m) k = lxor' n (lxor' m k) := by bitwise_assoc_tac
#align nat.lxor_assoc Nat.lxor'_assoc

theorem land'_assoc (n m k : ℕ) : land' (land' n m) k = land' n (land' m k) := by bitwise_assoc_tac
#align nat.land_assoc Nat.land'_assoc

theorem lor'_assoc (n m k : ℕ) : lor' (lor' n m) k = lor' n (lor' m k) := by bitwise_assoc_tac
#align nat.lor_assoc Nat.lor'_assoc

@[simp]
theorem lxor'_self (n : ℕ) : lxor' n n = 0 :=
  zero_of_testBit_eq_false fun i => by simp
#align nat.lxor_self Nat.lxor'_self

-- These lemmas match `mul_inv_cancel_right` and `mul_inv_cancel_left`.
theorem lxor_cancel_right (n m : ℕ) : lxor' (lxor' m n) n = m := by
  rw [lxor'_assoc, lxor'_self, lxor'_zero]
#align nat.lxor_cancel_right Nat.lxor_cancel_right

theorem lxor'_cancel_left (n m : ℕ) : lxor' n (lxor' n m) = m := by
  rw [← lxor'_assoc, lxor'_self, zero_lxor']
#align nat.lxor_cancel_left Nat.lxor'_cancel_left

theorem lxor'_right_injective {n : ℕ} : Function.Injective (lxor' n) := fun m m' h => by
  rw [← lxor'_cancel_left n m, ← lxor'_cancel_left n m', h]
#align nat.lxor_right_injective Nat.lxor'_right_injective

theorem lxor'_left_injective {n : ℕ} : Function.Injective fun m => lxor' m n :=
  fun m m' (h : lxor' m n = lxor' m' n) => by
  rw [← lxor_cancel_right n m, ← lxor_cancel_right n m', h]
#align nat.lxor_left_injective Nat.lxor'_left_injective

@[simp]
theorem lxor'_right_inj {n m m' : ℕ} : lxor' n m = lxor' n m' ↔ m = m' :=
  lxor'_right_injective.eq_iff
#align nat.lxor_right_inj Nat.lxor'_right_inj

@[simp]
theorem lxor'_left_inj {n m m' : ℕ} : lxor' m n = lxor' m' n ↔ m = m' :=
  lxor'_left_injective.eq_iff
#align nat.lxor_left_inj Nat.lxor'_left_inj

@[simp]
theorem lxor'_eq_zero {n m : ℕ} : lxor' n m = 0 ↔ n = m := by
  rw [← lxor'_self n, lxor'_right_inj, eq_comm]
#align nat.lxor_eq_zero Nat.lxor'_eq_zero

theorem lxor'_ne_zero {n m : ℕ} : lxor' n m ≠ 0 ↔ n ≠ m :=
  lxor'_eq_zero.not
#align nat.lxor_ne_zero Nat.lxor'_ne_zero

theorem lxor'_trichotomy {a b c : ℕ} (h : a ≠ lxor' b c) :
    lxor' b c < a ∨ lxor' a c < b ∨ lxor' a b < c := by
  set v := lxor' a (lxor' b c) with hv
  -- The xor of any two of `a`, `b`, `c` is the xor of `v` and the third.
  have hab : lxor' a b = lxor' c v := by
    rw [hv]
    conv_rhs =>
      rw [lxor'_comm]
      simp [lxor'_assoc]
  have hac : lxor' a c = lxor' b v := by
    rw [hv]
    conv_rhs =>
      right
      rw [← lxor'_comm]
    rw [← lxor'_assoc, ← lxor'_assoc, lxor'_self, zero_lxor', lxor'_comm]
  have hbc : lxor' b c = lxor' a v := by simp [hv, ← lxor'_assoc]
  -- If `i` is the position of the most significant bit of `v`, then at least one of `a`, `b`, `c`
  -- has a one bit at position `i`.
  obtain ⟨i, ⟨hi, hi'⟩⟩ := exists_most_significant_bit (lxor'_ne_zero.2 h)
  have : testBit a i = true ∨ testBit b i = true ∨ testBit c i = true :=
    by
    contrapose! hi
    simp only [Bool.eq_false_eq_not_eq_true, Ne, testBit_lxor'] at hi⊢
    rw [hi.1, hi.2.1, hi.2.2, Bool.xor_false, Bool.xor_false]
  -- If, say, `a` has a one bit at position `i`, then `a xor v` has a zero bit at position `i`, but
  -- the same bits as `a` in positions greater than `j`, so `a xor v < a`.
  rcases this with (h | h | h)
  on_goal 1 => left ; rw [hbc]
  on_goal 2 => right; left; rw [hac]
  on_goal 3 => right; right; rw [hab]
  all_goals
    exact lt_of_testBit i (by
      -- Porting note: this was originally `simp [h, hi]`
      rw [Nat.testBit_lxor', h, Bool.true_xor,hi]
      rfl
    ) h fun j hj => by
      -- Porting note: this was originally `simp [hi' _ hj]`
      rw [Nat.testBit_lxor', hi' _ hj, Bool.xor_false_right, eq_self_iff_true]
      trivial
#align nat.lxor_trichotomy Nat.lxor'_trichotomy

theorem lt_lxor'_cases {a b c : ℕ} (h : a < lxor' b c) : lxor' a c < b ∨ lxor' a b < c :=
  (or_iff_right fun h' => (h.asymm h').elim).1 <| lxor'_trichotomy h.ne
#align nat.lt_lxor_cases Nat.lt_lxor'_cases

end Nat