/-
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 adeles_R

/-!
# The finite idèle group of a Dedekind domain
We define the finite idèle group of a Dedekind domain `R` and show that if `R` has Krull dimension
1, then there is an injective group homomorphism from the units of the field of fractions of `R` to
its finite adèle ring.

We prove that there is a continuous surjective group homomorphism from the finite idèle group of `R`
to the group of invertible fractional ideals of `R` and compute the kernel of this map.

## Main definitions
- `finite_idele_group'` : The finite idèle group of `R`, defined as unit group of `A_R_f R`.
- `inj_units_K` : The diagonal inclusion of `K*` in `finite_idele_group' R K`.
- `map_to_fractional_ideals` : The group homomorphism from `finite_idele_group' R K` to the group
  of `Fr(R)` of invertible fractional_ideals of `R` sending a finite idèle `x` to the product
  `∏_v v^(val_v(x_v))`, where `val_v` denotes the additive `v`-adic valuation.

## Main results
- `inj_units_K.group_hom` : `inj_units_K` is a group homomorphism.
- `inj_units_K.injective` : `inj_units_K` is injective for every Dedekind domain of Krull
  dimension 1.
- `map_to_fractional_ideals.surjective` : `map_to_fractional_ideals` is surjective.
- `map_to_fractional_ideals.continuous` : `map_to_fractional_ideals` is continuous when the group
  of fractional ideals is given the discrete topology.
- `map_to_fractional_ideals.mem_kernel_iff` : A finite idèle `x` is in the kernel of
`map_to_fractional_ideals` if and only if `|x_v|_v = 1` for all `v`.

## Implementation notes
As in `adeles_R`, we are only interested on Dedekind domains of Krull dimension 1.

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

## Tags
finite idèle group, dedekind domain, fractional ideal
-/

noncomputable theory
open_locale big_operators classical

open set function is_dedekind_domain

variables (R : Type) (K : Type) [comm_ring R] [is_domain R] [is_dedekind_domain R] [field K]
  [algebra R K] [is_fraction_ring R K] (v : height_one_spectrum R)

/-! ### The finite idèle group of a Dedekind domain -/

/--The finite idèle group of `R` is the unit group of its finite adèle ring. -/
def finite_idele_group' := units (finite_adele_ring' R K)

instance : topological_space (finite_idele_group' R K) := units.topological_space
instance : comm_group (finite_idele_group' R K) := units.comm_group
instance : topological_group (finite_idele_group' R K) := units.topological_group
instance : uniform_space (finite_idele_group' R K) := topological_group.to_uniform_space _
instance : uniform_group (finite_idele_group' R K) := topological_comm_group_is_uniform

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

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

/-- The diagonal inclusion `k ↦ (k)_v` of `K*` into the finite idèle group of `R`. -/
def inj_units_K : units K → finite_idele_group' R K :=
λ x, ⟨inj_K R K x.val, inj_K R K x.inv, right_inv R K x, left_inv R K x⟩

@[simp]
lemma inj_units_K.map_one : inj_units_K R K 1 = 1 :=
by {rw inj_units_K, simp only [inj_K.map_one], refl,}

@[simp]
lemma inj_units_K.map_mul (x y : units K) :
  inj_units_K R K (x*y) = (inj_units_K R K x) * (inj_units_K R K y) :=
begin
  rw inj_units_K, ext v,
  simp_rw [units.val_eq_coe, units.coe_mul, units.coe_mk, inj_K.map_mul],
end

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

/-- If `height_one_spectrum R` is nonempty, then `inj_units_K` is injective. Note that the
nonemptiness hypothesis is satisfied for every Dedekind domain that is not a field. -/
lemma inj_units_K.injective [inh : inhabited (height_one_spectrum R)] :
  injective (inj_units_K.group_hom R K) :=
begin
  rw ← monoid_hom.ker_eq_bot_iff,
  ext x,
  rw [monoid_hom.mem_ker, subgroup.mem_bot, inj_units_K.group_hom, monoid_hom.coe_mk, inj_units_K,
    ← units.eq_iff, units.coe_mk, units.val_eq_coe, ← units.eq_iff],
  exact injective.eq_iff (inj_K.injective R K),
end

lemma prod_val_inv_eq_one (x : finite_idele_group' R K) :
  (x.val.val v) * (x.inv.val v) = 1  :=
begin
  rw [ ← pi.mul_apply, mul_apply_val, units.val_inv, subtype.val_eq_coe, ← one_def,
    subtype.coe_mk, pi.one_apply],
end

lemma v_comp.ne_zero (x : finite_idele_group' R K) :
  (x.val.val v) ≠ 0 := left_ne_zero_of_mul_eq_one (prod_val_inv_eq_one R K v x)

lemma valuation_val_inv (x : finite_idele_group' R K) :
  (valued.v (x.val.val v) : (with_zero (multiplicative ℤ))) * (valued.v (x.inv.val v)) = 1 :=
by rw [← valuation.map_mul, prod_val_inv_eq_one, valuation.map_one]

lemma valuation_inv (x : finite_idele_group' R K) :
  (valued.v (x.inv.val v)) = (valued.v (x.val.val v))⁻¹ :=
begin
  rw [← mul_one (valued.v (x.val.val v))⁻¹,eq_inv_mul_iff_mul_eq₀, valuation_val_inv],
  { exact (valuation.ne_zero_iff _).mpr (v_comp.ne_zero R K v x) }
end

/-- 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 restricted_product (x : finite_idele_group' R K) :
  ({ v : height_one_spectrum R | (¬ (x.val.val v) ∈ v.adic_completion_integers K) } ∪
    { v : height_one_spectrum R | ¬ (x.inv.val v) ∈ v.adic_completion_integers K }).finite :=
finite.union x.val.property x.inv.property

/-- For any finite idèle `x`, there are finitely many maximal ideals `v` of `R` for which
`|x_v|_v ≠ 1`. -/
lemma finite_exponents (x : finite_idele_group' R K) : set.finite
  { v : height_one_spectrum R | (valued.v (x.val.val v) : with_zero (multiplicative ℤ)) ≠ 1 } :=
begin
  have h_subset : { v : height_one_spectrum R |
    (valued.v (x.val.val v) : with_zero (multiplicative ℤ)) ≠ 1 } ⊆
  { v : height_one_spectrum R | ¬ (x.val.val v) ∈ v.adic_completion_integers K } ∪
  { v : height_one_spectrum R | ¬ (x.inv.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 : (valued.v (x.val.val v) : (with_zero (multiplicative ℤ))) *
        (valued.v (x.inv.val v)) = 1 :=valuation_val_inv R K v x,
      have h_inv : (1 : with_zero (multiplicative ℤ)) < (valued.v (x.inv.val v)),
      { have hx : (valued.v (x.val.val v) : with_zero (multiplicative ℤ)) ≠ 0,
        { rw [valuation.ne_zero_iff],
          exact left_ne_zero_of_mul_eq_one (prod_val_inv_eq_one R K v x),},
        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 (restricted_product R K x) h_subset,
end

/-- For any `k ∈ K*` and any maximal ideal `v` of `R`, the valuation `|k|_v` is nonzero. -/
lemma units.valuation_ne_zero {k : K} (hk : k ≠ 0) :
(valued.v ((coe : K → (v.adic_completion K)) k) : with_zero (multiplicative ℤ)) ≠ 0 :=
begin
  rw [valuation.ne_zero_iff, ← uniform_space.completion.coe_zero,
    injective.ne_iff uniform_space.completion.coe_inj],
  exact hk,
  apply_instance,
end

/-- The integer number corresponding to a nonzero `x` in `with_zero (multiplicative ℤ)`. -/
def with_zero.to_integer {x : with_zero (multiplicative ℤ)} (hx : x ≠ 0) : ℤ :=
multiplicative.to_add (classical.some (with_zero.ne_zero_iff_exists.mp hx))

/-- Given a finite idèle `x`, for each maximal ideal `v` of `R` we obtain an integer that
represents the additive `v`-adic valuation of the component `x_v` of `x`. -/
def finite_idele.to_add_valuations (x : finite_idele_group' R K) :
  Π (v : height_one_spectrum R), ℤ :=
λ v, -(with_zero.to_integer ((valuation.ne_zero_iff valued.v).mpr (v_comp.ne_zero R K v x)))

lemma finite_idele.to_add_valuations.map_one :
  finite_idele.to_add_valuations R K (1 : finite_idele_group' R K) =
    λ (v : height_one_spectrum R), (0 : ℤ) :=
begin
  rw finite_idele.to_add_valuations,
  ext v,
  rw [with_zero.to_integer, ← to_add_one, ← to_add_inv],
  apply congr_arg multiplicative.to_add,
  rw [inv_eq_one, ← with_zero.coe_inj, classical.some_spec
  (with_zero.to_integer._proof_1 (finite_idele.to_add_valuations._proof_1 R K 1 v))],
  exact valuation.map_one _,
end

lemma finite_idele.to_add_valuations.map_mul (x y : finite_idele_group' R K) :
finite_idele.to_add_valuations R K (x * y) =
(finite_idele.to_add_valuations R K x) + (finite_idele.to_add_valuations R K y) :=
begin
  rw [finite_idele.to_add_valuations, finite_idele.to_add_valuations,
    finite_idele.to_add_valuations],
  ext v,
  simp only [pi.add_apply],
  rw [← neg_add, neg_inj, with_zero.to_integer, with_zero.to_integer, with_zero.to_integer,
    ← to_add_mul],
  apply congr_arg,
  rw [← with_zero.coe_inj, with_zero.coe_mul,
    classical.some_spec (with_zero.to_integer._proof_1 _),
    classical.some_spec (with_zero.to_integer._proof_1 _),
    classical.some_spec (with_zero.to_integer._proof_1 _)],
  exact valuation.map_mul valued.v _ _,
end

/-- For any finite idèle `x`, there are finitely many maximal ideals `v` of `R` for which
the additive `v`-adic valuation of `x_v` is nonzero. -/
lemma finite_add_support (x : finite_idele_group' R K ) :
  ∀ᶠ (v : height_one_spectrum R) in filter.cofinite, finite_idele.to_add_valuations R K x v = 0 :=
begin
  have h := finite_exponents R K x,
  rw finite_idele.to_add_valuations,
  simp_rw [neg_eq_zero, with_zero.to_integer],
  have h_subset : {v : height_one_spectrum R | ¬multiplicative.to_add (classical.some
    (with_zero.to_integer._proof_1 ((valued.v.ne_zero_iff ).mpr (v_comp.ne_zero R K v x)))) = 0}
    ⊆ {v : height_one_spectrum R | (valued.v (x.val.val v) : with_zero (multiplicative ℤ)) ≠ 1},
  { intros v hv,
    set y := (classical.some (with_zero.to_integer._proof_1
      ((valued.v.ne_zero_iff ).mpr (v_comp.ne_zero R K v x)))) with hy,
    rw mem_set_of_eq,
    by_contradiction h,
    have y_spec := classical.some_spec
      (with_zero.to_integer._proof_1 ((valued.v.ne_zero_iff ).mpr (v_comp.ne_zero R K v x))),
    rw [← hy, h, ← with_zero.coe_one, with_zero.coe_inj] at y_spec,
    simp_rw [← to_add_one] at hv,
    rw [mem_set_of_eq, ← hy, y_spec] at hv,
    exact hv (eq.refl _), },
  exact finite.subset (finite_exponents R K x) h_subset
end

/-- For any finite idèle `x`, there are finitely many maximal ideals `v` of `R` for which
`v^(finite_idele.to_add_valuations R K x v)` is not the fractional ideal `(1)`.  -/
lemma finite_support (x : finite_idele_group' R K ) : (mul_support (λ (v : height_one_spectrum R),
  (v.as_ideal :
    fractional_ideal (non_zero_divisors R) K) ^ finite_idele.to_add_valuations R K x v)).finite :=
begin
  have h_subset :
    {v : height_one_spectrum R | (v.as_ideal : fractional_ideal (non_zero_divisors R) K) ^
      finite_idele.to_add_valuations R K x v ≠ 1} ⊆
    { v : height_one_spectrum R | (valued.v (x.val.val v) : with_zero (multiplicative ℤ)) ≠ 1 },
  { intros v,
    rw mem_set_of_eq, rw mem_set_of_eq,
    contrapose!,
    intro hv,
    suffices : finite_idele.to_add_valuations R K x v = 0,
    { rw this, exact zpow_zero _ },
    rw finite_idele.to_add_valuations,
    simp only [with_zero.to_integer],
    rw [← to_add_one, ← to_add_inv],
    apply congr_arg,
    rw [inv_eq_one, ← with_zero.coe_inj, classical.some_spec (with_zero.to_integer._proof_1 _)],
    exact hv, },
  exact finite.subset (finite_exponents R K x) h_subset,
end

/-- For any finite idèle `x`, there are finitely many maximal ideals `v` of `R` for which
`v^-(finite_idele.to_add_valuations R K x v)` is not the fractional ideal `(1)`.  -/
lemma finite_support' (x : finite_idele_group' R K ) :
  (mul_support (λ (v : height_one_spectrum R), (v.as_ideal :
    fractional_ideal (non_zero_divisors R) K) ^ -finite_idele.to_add_valuations R K x v)).finite :=
begin
  have h : {v : height_one_spectrum R | (v.as_ideal : fractional_ideal (non_zero_divisors R) K) ^
    -finite_idele.to_add_valuations R K x v ≠ 1} =
    {v : height_one_spectrum R | (v.as_ideal : fractional_ideal (non_zero_divisors R) K) ^
      finite_idele.to_add_valuations R K x v ≠ 1},
  { ext v,
    rw [mem_set_of_eq, mem_set_of_eq, ne.def, ne.def, zpow_neg, inv_eq_one], },
  rw [mul_support, h],
  exact finite_support R K x,
end

/-- The map from `finite_idele_group' R K` to the fractional_ideals of `R` 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 map_to_fractional_ideals.val :
  (finite_idele_group' R K) → (fractional_ideal (non_zero_divisors R) K) := λ x,
∏ᶠ (v : height_one_spectrum R), (v.as_ideal : fractional_ideal (non_zero_divisors R) K)^
  (finite_idele.to_add_valuations R K x v)

def map_to_fractional_ideals.group_hom : monoid_hom
  (finite_idele_group' R K)  (fractional_ideal (non_zero_divisors R) K) :=
{ to_fun := map_to_fractional_ideals.val R K,
  map_one' := by { simp_rw [map_to_fractional_ideals.val, finite_idele.to_add_valuations.map_one,
    zpow_zero, finprod_one],},
  map_mul' := λ x y,
  begin
    rw [map_to_fractional_ideals.val],
    dsimp only,
    rw finite_idele.to_add_valuations.map_mul,
    simp_rw pi.add_apply,
    rw ← finprod_mul_distrib (finite_support R K x) (finite_support R K y),
    apply finprod_congr,
    intro v,
    rw zpow_add₀,
    { rw [ne.def, fractional_ideal.coe_ideal_eq_zero_iff],
      exact v.ne_bot},
  end }

/-- The map from `finite_idele_group' R K` to the fractional_ideals of `R` 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 map_to_fractional_ideals.inv :
  (finite_idele_group' R K) → (fractional_ideal (non_zero_divisors R) K) := λ x,
∏ᶠ (v : height_one_spectrum R), (v.as_ideal : fractional_ideal (non_zero_divisors R) K)^
  (-finite_idele.to_add_valuations R K x v)

lemma finite_idele.to_add_valuations.mul_inv (x : finite_idele_group' R K):
  map_to_fractional_ideals.val R K x * map_to_fractional_ideals.inv R K x = 1 :=
begin
  rw [map_to_fractional_ideals.val, map_to_fractional_ideals.inv],
  dsimp only,
  rw ← finprod_mul_distrib (finite_support R K x) (finite_support' R K x),
  rw ← finprod_one,
  apply finprod_congr ,
  intro v,
  rw ← zpow_add₀,
  rw [add_right_neg, zpow_zero],
  { rw [ne.def, fractional_ideal.coe_ideal_eq_zero_iff],
      exact v.ne_bot },
end

lemma finite_idele.to_add_valuations.inv_mul (x : finite_idele_group' R K):
  map_to_fractional_ideals.inv R K x * map_to_fractional_ideals.val R K x = 1 :=
by simpa [mul_comm] using (finite_idele.to_add_valuations.mul_inv R K x)

/-- The map from `finite_idele_group' R K` to the units of the fractional_ideals of `R` 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 map_to_fractional_ideals.def :
  (finite_idele_group' R K) → (units (fractional_ideal (non_zero_divisors R) K)) :=
force_noncomputable $ λ x, ⟨map_to_fractional_ideals.val R K x, map_to_fractional_ideals.inv R K x,
  finite_idele.to_add_valuations.mul_inv R K x, finite_idele.to_add_valuations.inv_mul R K x⟩

/-- `map_to_fractional_ideals.def` is a group homomorphism. -/
def map_to_fractional_ideals : monoid_hom
  (finite_idele_group' R K)  (units (fractional_ideal (non_zero_divisors R) K)) :=
{ to_fun := map_to_fractional_ideals.def R K,
  map_one' := by {
    rw [map_to_fractional_ideals.def, force_noncomputable_def, ← units.eq_iff, units.coe_mk,
      units.coe_one],
    exact (map_to_fractional_ideals.group_hom R K).map_one', },
  map_mul' := λ x y,
  begin
    rw [map_to_fractional_ideals.def,force_noncomputable_def, ← units.eq_iff, units.coe_mul,
      units.coe_mk, units.coe_mk, units.coe_mk],
    exact (map_to_fractional_ideals.group_hom R K).map_mul' x y,
  end }

variables {R K}
lemma val_property {a : Π v : height_one_spectrum R, v.adic_completion K}
  (ha : ∀ᶠ v : height_one_spectrum R in filter.cofinite,
    (valued.v (a v) : with_zero (multiplicative ℤ)) = 1)
  (h_ne_zero : ∀ v : height_one_spectrum R, a v ≠ 0) :
  ∀ᶠ v : height_one_spectrum R in filter.cofinite, a v ∈ v.adic_completion_integers K :=
begin
  rw filter.eventually_cofinite at ha ⊢,
  simp_rw adic_completion.is_integer,
  have h_subset :
    {x : height_one_spectrum R | ¬(valued.v (a x) : with_zero (multiplicative ℤ)) ≤ 1} ⊆
    {x : height_one_spectrum R | ¬(valued.v (a x) : with_zero (multiplicative ℤ)) = 1},
  { intros v hv,
    exact ne_of_gt (not_le.mp hv), },
  exact finite.subset ha h_subset,
end

lemma inv_property {a : Π v : height_one_spectrum R, v.adic_completion K}
  (ha : ∀ᶠ v : height_one_spectrum R in filter.cofinite,
    (valued.v (a v) : with_zero (multiplicative ℤ)) = 1)
  (h_ne_zero : ∀ v : height_one_spectrum R, a v ≠ 0) :
  ∀ᶠ v : height_one_spectrum R in filter.cofinite, (a v)⁻¹ ∈ v.adic_completion_integers K :=
begin
  rw filter.eventually_cofinite at ha ⊢,
  simp_rw [adic_completion.is_integer, not_le],
  have h_subset : {x : height_one_spectrum R |
    1 < (valued.v (a x)⁻¹ : with_zero (multiplicative ℤ)) } ⊆
    {x : height_one_spectrum R | ¬(valued.v (a x) : with_zero (multiplicative ℤ)) = 1},
  { intros v hv,
    rw [mem_set_of_eq, map_inv₀] at hv,
    rw [mem_set_of_eq, ←inv_inj, inv_one],
    exact ne_of_gt hv, },
  exact finite.subset ha h_subset,
end

lemma right_inv' {a : Π v : height_one_spectrum R, v.adic_completion K}
  (ha : ∀ᶠ v : height_one_spectrum R in filter.cofinite,
    (valued.v (a v) : with_zero (multiplicative ℤ)) = 1)
  (h_ne_zero : ∀ v : height_one_spectrum R, a v ≠ 0)  :
  (⟨a, val_property ha h_ne_zero⟩ : finite_adele_ring' R K) *
  ⟨(λ v : height_one_spectrum R, (a v)⁻¹), inv_property ha h_ne_zero⟩ = 1 :=
begin
  ext v,
  unfold_projs,
  simp only [mul'],
  rw [subtype.coe_mk, subtype.coe_mk, pi.mul_apply, if_neg (h_ne_zero v)],
  apply uniform_space.completion.mul_hat_inv_cancel,
  exact h_ne_zero v,
end

lemma left_inv' {a : Π v : height_one_spectrum R, v.adic_completion K}
  (ha : ∀ᶠ v : height_one_spectrum R in filter.cofinite,
    (valued.v (a v) : with_zero (multiplicative ℤ)) = 1)
  (h_ne_zero : ∀ v : height_one_spectrum R, a v ≠ 0) :
  (⟨(λ v : height_one_spectrum R, (a v)⁻¹), inv_property ha h_ne_zero⟩ : finite_adele_ring' R K) *
  ⟨a, val_property ha h_ne_zero⟩ = 1 :=
by { rw mul_comm, exact right_inv' ha h_ne_zero}

/-- If `a = (a_v)_v ∈ ∏_v K_v` is such that `|a_v|_v ≠ 1` for all but finitely many `v` and
`a_v ≠ 0` for all `v`, then `a` is a finite idèle  of `R`. -/
def idele.mk (a : Π v : height_one_spectrum R, v.adic_completion K)
  (ha : ∀ᶠ v : height_one_spectrum R in filter.cofinite,
    (valued.v (a v) : with_zero (multiplicative ℤ)) = 1)
  (h_ne_zero : ∀ v : height_one_spectrum R, a v ≠ 0) :
  finite_idele_group' R K :=
⟨⟨a, val_property ha h_ne_zero⟩,
  ⟨(λ v : height_one_spectrum R, (a v)⁻¹), inv_property ha h_ne_zero⟩, right_inv' ha h_ne_zero,
  left_inv' ha h_ne_zero⟩

lemma map_to_fractional_ideals.inv_eq_inv (x : finite_idele_group' R K)
  (I : units (fractional_ideal (non_zero_divisors R) K))
  (hxI : map_to_fractional_ideals.val R K (x) = I.val) :
  map_to_fractional_ideals.inv R K (x) = I.inv :=
begin
  have h_inv : I.val * (map_to_fractional_ideals.inv R K (x)) = 1,
  { rw ← hxI, exact finite_idele.to_add_valuations.mul_inv R K _ },
  exact eq_comm.mp (units.inv_eq_of_mul_eq_one_right h_inv),
end

variables (R K)
/-- A finite idèle `(pi_v)_v`, where each `pi_v` is a uniformizer for the `v`-adic valuation. -/
def pi.unif : Π v : height_one_spectrum R, v.adic_completion K :=
λ v : height_one_spectrum R, (coe : K → (v.adic_completion K))
  (classical.some (v.valuation_exists_uniformizer K))

lemma pi.unif.ne_zero : ∀ v : height_one_spectrum R, pi.unif R K v ≠ 0 :=
begin
  intro v,
  rw [pi.unif, ← uniform_space.completion.coe_zero,
    injective.ne_iff (@uniform_space.completion.coe_inj K v.adic_valued.to_uniform_space _)],
  exact v.valuation_uniformizer_ne_zero K,
end

variables {R K}
lemma idele.mk'.val {exps : Π v : height_one_spectrum R, ℤ}
  (h_exps : ∀ᶠ (v : height_one_spectrum R) in filter.cofinite, exps v = 0) :
  ∀ᶠ (v : height_one_spectrum R) in filter.cofinite,
    pi.unif R K v ^ exps v ∈ v.adic_completion_integers K :=
begin
  rw filter.eventually_cofinite at h_exps ⊢,
  simp_rw adic_completion.is_integer,
  have h_subset : {x : height_one_spectrum R |
    ¬ (valued.v (pi.unif R K x ^ exps x) : with_zero (multiplicative ℤ)) ≤ 1} ⊆
    {x : height_one_spectrum R | ¬exps x = 0},
  { intros v hv,
    rw mem_set_of_eq at hv ⊢,
    intro h_zero,
    rw [h_zero, zpow_zero, valuation.map_one, not_le, lt_self_iff_false] at hv,
    exact hv, },
    exact finite.subset h_exps h_subset,
end

lemma idele.mk'.inv {exps : Π v : height_one_spectrum R, ℤ}
  (h_exps : ∀ᶠ (v : height_one_spectrum R) in filter.cofinite, exps v = 0) :
  ∀ᶠ (v : height_one_spectrum R) in filter.cofinite,
    pi.unif R K v ^-exps v ∈ v.adic_completion_integers K :=
begin
  rw filter.eventually_cofinite at h_exps ⊢,
  simp_rw adic_completion.is_integer,
  have h_subset : {x : height_one_spectrum R |
    ¬ (valued.v (pi.unif R K x ^ -exps x) : with_zero (multiplicative ℤ))  ≤ 1} ⊆
    {x : height_one_spectrum R | ¬exps x = 0},
  { intros v hv,
    rw mem_set_of_eq at hv ⊢,
    intro h_zero,
    rw [h_zero, neg_zero, zpow_zero, valuation.map_one, not_le, lt_self_iff_false] at hv,
    exact hv, },
    exact finite.subset h_exps h_subset,
end

lemma idele.mk'.mul_inv {exps : Π v : height_one_spectrum R, ℤ}
  (h_exps : ∀ᶠ (v : height_one_spectrum R) in filter.cofinite, exps v = 0) :
  (⟨λ (v : height_one_spectrum R), pi.unif R K v ^ exps v,
    idele.mk'.val h_exps⟩ : finite_adele_ring' R K) *
    ⟨λ (v : height_one_spectrum R), pi.unif R K v ^ -exps v, idele.mk'.inv h_exps⟩ = 1 :=
begin
  ext v,
  unfold_projs,
  simp only [mul'],
  rw [subtype.coe_mk, subtype.coe_mk, pi.mul_apply, zpow_eq_pow, zpow_eq_pow,
    ← zpow_add₀ (pi.unif.ne_zero R K v)],
  have : (exps v).neg = - exps v := rfl,
  rw [this, add_right_neg, zpow_zero],
  refl,
end

lemma idele.mk'.inv_mul {exps : Π v : height_one_spectrum R, ℤ}
  (h_exps : ∀ᶠ (v : height_one_spectrum R) in filter.cofinite, exps v = 0) :
  (⟨λ (v : height_one_spectrum R), pi.unif R K v ^-exps v,
    idele.mk'.inv h_exps⟩ : finite_adele_ring' R K) *
    ⟨λ (v : height_one_spectrum R), pi.unif R K v ^ exps v, idele.mk'.val h_exps⟩ = 1 :=
begin
  rw mul_comm, exact idele.mk'.mul_inv h_exps,
end

variables (R K)
/-- Given a collection `exps` of integers indexed by the maximal ideals `v` of `R`, of which only
finitely many are allowed to be nonzero, `(pi_v^(exps v))_v` is a finite idèle of `R`. -/
def idele.mk' {exps : Π v : height_one_spectrum R, ℤ} (h_exps : ∀ᶠ (v : height_one_spectrum R) in
  filter.cofinite, exps v = 0) : finite_idele_group' R K :=
⟨⟨λ v : height_one_spectrum R, (pi.unif R K v)^exps v, idele.mk'.val h_exps⟩,
  ⟨λ v : height_one_spectrum R, (pi.unif R K v)^-exps v, idele.mk'.inv h_exps⟩,
  idele.mk'.mul_inv h_exps, idele.mk'.inv_mul h_exps⟩

variables {R K}
lemma idele.mk'.valuation_ne_zero {exps : Π v : height_one_spectrum R, ℤ}
  (h_exps : ∀ᶠ (v : height_one_spectrum R) in filter.cofinite, exps v = 0) :
  (valued.v ((idele.mk' R K h_exps).val.val v) : with_zero (multiplicative ℤ)) ≠ 0 :=
begin
  rw [ne.def, valuation.zero_iff],
  simp only [idele.mk'],
  intro h,
  exact pi.unif.ne_zero R K v (zpow_eq_zero h),
end

variables (R K)
/-- `map_to_fractional_ideals` is surjective. -/
lemma map_to_fractional_ideals.surjective : surjective (map_to_fractional_ideals R K) :=
begin
  rintro ⟨I, I_inv, hval_inv, hinv_val⟩,
  obtain ⟨a, J, ha, haJ⟩ := fractional_ideal.exists_eq_span_singleton_mul I,
  have hI_ne_zero : I ≠ 0 := left_ne_zero_of_mul_eq_one hval_inv,
  have hI := fractional_ideal.factorization I hI_ne_zero haJ,
  have h_exps : ∀ᶠ v : height_one_spectrum R in filter.cofinite,
  ((associates.mk v.as_ideal).count (associates.mk J).factors : ℤ) -
    ((associates.mk v.as_ideal).count (associates.mk (ideal.span {a})).factors) = 0 :=
   fractional_ideal.finite_factors hI_ne_zero haJ,
  use idele.mk' R K h_exps,
  rw map_to_fractional_ideals,
  simp only [map_to_fractional_ideals.def, force_noncomputable_def, monoid_hom.coe_mk],
  have H : map_to_fractional_ideals.val R K (idele.mk' R K h_exps) = I,
  { simp only [map_to_fractional_ideals.val, finite_idele.to_add_valuations, ← hI],
    apply finprod_congr,
    intro v,
    apply congr_arg,
    have hv : (valued.v ((idele.mk' R K h_exps).val.val v) : with_zero (multiplicative ℤ)) ≠ 0 :=
    idele.mk'.valuation_ne_zero v h_exps,
    rw with_zero.to_integer,
    set x := classical.some (with_zero.to_integer._proof_1 hv) with hx_def,
    have hx := classical.some_spec (with_zero.to_integer._proof_1 hv),
    rw ← hx_def at hx ⊢,
    simp only [idele.mk', pi.unif] at hx,
    rw [map_zpow₀, height_one_spectrum.valued_adic_completion_def,
      valued.extension_extends, v.adic_valued_apply, classical.some_spec
      (v.valuation_exists_uniformizer K), ← with_zero.coe_zpow, with_zero.coe_inj] at hx,
    rw [hx, ← of_add_zsmul, to_add_of_add, algebra.id.smul_eq_mul, mul_neg,
          mul_one, neg_neg] },
  exact ⟨H, map_to_fractional_ideals.inv_eq_inv _ ⟨I, I_inv, hval_inv, hinv_val⟩ H⟩,
end

variables {R K}
/-- A finite idèle `x` is in the kernel of `map_to_fractional_ideals` if and only if `|x_v|_v = 1`
for all `v`. -/
lemma map_to_fractional_ideals.mem_kernel_iff (x : finite_idele_group' R K) :
  map_to_fractional_ideals R K x = 1 ↔
  ∀ v : height_one_spectrum R, finite_idele.to_add_valuations R K x v = 0 :=
begin
  rw [map_to_fractional_ideals, monoid_hom.coe_mk, map_to_fractional_ideals.def,
    force_noncomputable_def],
  simp_rw map_to_fractional_ideals.val,
  rw [units.ext_iff, units.coe_mk, units.coe_one],
  refine ⟨λ h_ker, _, λ h_val, _⟩,
  { intro v,
    rw [← fractional_ideal.count_finprod K v (finite_idele.to_add_valuations R K x),
      ← fractional_ideal.count_one K v, h_ker],
    exact finite_add_support R K x, },
  { rw ← @finprod_one _ (height_one_spectrum R) _,
    apply finprod_congr,
    intro v,
    rw [h_val v, zpow_zero _] }
end

variables (R K)
/-- The additive `v`-adic valuation of `x_v` equals 0 if and only if `|x_v|_v = 1`-/
lemma finite_idele.to_add_valuations.comp_eq_zero_iff (x : finite_idele_group' R K) :
  finite_idele.to_add_valuations R K x v = 0 ↔
  (valued.v (x.val.val v) : with_zero (multiplicative ℤ)) = 1 :=
begin
  set y := classical.some (with_zero.to_integer._proof_1
    (finite_idele.to_add_valuations._proof_1 R K x v)) with hy,
  have hy_spec := classical.some_spec (with_zero.to_integer._proof_1
    (finite_idele.to_add_valuations._proof_1 R K x v)),
  rw ← hy at hy_spec,
  rw [finite_idele.to_add_valuations, neg_eq_zero ,with_zero.to_integer, ← to_add_one, ← hy,
    ← hy_spec, ← with_zero.coe_one, with_zero.coe_inj],
  refine ⟨λ h_eq, by rw [← of_add_to_add y, ← of_add_to_add 1, h_eq], λ h_eq, by rw h_eq⟩,
end

/-- `|x_v|_v = 1` if and only if both `x_v` and `x⁻¹_v` are in `R_v`. -/
lemma finite_idele.valuation_eq_one_iff (x : finite_idele_group' R K) :
  (valued.v (x.val.val v) : with_zero (multiplicative ℤ)) = 1 ↔
  x.val.val v ∈ v.adic_completion_integers K ∧ x⁻¹.val.val v ∈ v.adic_completion_integers K :=
begin
  rw [adic_completion.is_integer, adic_completion.is_integer],
  refine ⟨λ h_one, _, λ h_int, _⟩,
  { have h_mul := valuation_val_inv R K v x,
    rw [h_one, one_mul] at h_mul,
    exact ⟨ le_of_eq h_one, le_of_eq h_mul ⟩ , },
  { have : x.inv = x⁻¹.val := rfl,
    rw [← this, valuation_inv, ← inv_one, inv_le_inv₀, inv_one] at h_int,
    rw [eq_iff_le_not_lt, not_lt],
    exact h_int,
    { exact (valuation.ne_zero_iff _).mpr (v_comp.ne_zero R K v x)},
    { exact one_ne_zero }}
end

/-- `map_to_fractional_ideals` is continuous, where the codomain is given the discrete topology. -/
lemma map_to_fractional_ideals.continuous : continuous (map_to_fractional_ideals R K) :=
begin
  apply uniform_continuous.continuous,
  rw uniform_group.uniform_continuous_iff_open_ker,
  have h_ker : ((map_to_fractional_ideals R K).ker : set (finite_idele_group' R K)) =
    { x : units(finite_adele_ring' R K) |
       ∀ v : height_one_spectrum R, finite_idele.to_add_valuations R K x v = 0 },
  { ext x,
    exact map_to_fractional_ideals.mem_kernel_iff x, },
  change is_open ↑((map_to_fractional_ideals R K).ker),
  rw h_ker,
  use {p : (finite_adele_ring' R K × (finite_adele_ring' R K)ᵐᵒᵖ) |
    ∀ v : height_one_spectrum R, (p.1.val v) ∈ v.adic_completion_integers K ∧
    ((mul_opposite.unop p.2).val v) ∈ v.adic_completion_integers K},
  split,
  { have : prod.topological_space.is_open
      {p : finite_adele_ring' R K × (finite_adele_ring' R K)ᵐᵒᵖ | ∀ (v : height_one_spectrum R),
        p.fst.val v ∈ v.adic_completion_integers K ∧
        (mul_opposite.unop p.snd).val v ∈ v.adic_completion_integers K}  ↔ is_open
      {p : finite_adele_ring' R K × (finite_adele_ring' R K)ᵐᵒᵖ | ∀ (v : height_one_spectrum R),
        p.fst.val v ∈ v.adic_completion_integers K ∧
        (mul_opposite.unop p.snd).val v ∈ v.adic_completion_integers K} := by refl,
    rw this, clear this,
    rw [is_open_prod_iff],
    intros x y hxy,
    rw mem_set_of_eq at hxy,
    use {x : finite_adele_ring' R K | ∀ (v : height_one_spectrum R),
      x.val v ∈ v.adic_completion_integers K},
    use {x : (finite_adele_ring' R K )ᵐᵒᵖ | ∀ (v : height_one_spectrum R),
      (mul_opposite.unop x).val v ∈ v.adic_completion_integers K},
    refine ⟨finite_adele_ring'.is_open_integer_subring R K,
      finite_adele_ring'.is_open_integer_subring_opp R K, λ v, (hxy v).1, λ v, (hxy v).2, _⟩,
    { intros p hp v,
      exact ⟨ hp.1 v, hp.2 v⟩, }},
  { rw preimage_set_of_eq,
    ext x,
    rw [mem_set_of_eq, units.embed_product, monoid_hom.coe_mk, mul_opposite.unop_op],
    simp_rw [finite_idele.to_add_valuations.comp_eq_zero_iff, finite_idele.valuation_eq_one_iff],
    refl, },
end


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Johannes Hölzl

Semigroup, monoid, group and module structures on product spaces.
-/

import data.prod linear_algebra.basic algebra.pi_instances
open set function

namespace prod
variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}

section module
variables [ring α] [module α β] [module α γ] [module α δ]
include α

lemma is_linear_map_prod_fst : is_linear_map (prod.fst : β × γ → β) :=
⟨assume x y, rfl, assume x y, rfl⟩

lemma is_linear_map_prod_snd : is_linear_map (prod.snd : β × γ → γ) :=
⟨assume x y, rfl, assume x y, rfl⟩

lemma is_linear_map_prod_mk {f : δ → β} {g : δ → γ} (hf : is_linear_map f) (hg : is_linear_map g):
  is_linear_map (λd, (f d, g d)) :=
⟨assume x y, mk.inj_iff.mpr ⟨hf.add _ _, hg.add _ _⟩,
  assume x y, mk.inj_iff.mpr ⟨hf.smul _ _, hg.smul _ _⟩⟩

lemma is_linear_map_prod_inl : is_linear_map (prod.inl : β → β × γ) :=
is_linear_map_prod_mk is_linear_map.id is_linear_map.map_zero

lemma is_linear_map_prod_inr : is_linear_map (prod.inr : γ → β × γ) :=
is_linear_map_prod_mk is_linear_map.map_zero is_linear_map.id

instance {s : set β} {t : set γ} [is_submodule s] [is_submodule t] : is_submodule (set.prod s t) :=
@is_submodule.inter_submodule _ _ _ _ _ _
  (is_submodule.preimage is_linear_map_prod_fst) (is_submodule.preimage is_linear_map_prod_snd)

lemma span_prod {s : set β} {t : set γ} : span (set.prod s t) ⊆ set.prod (span s) (span t) :=
span_minimal prod.is_submodule (set.prod_mono subset_span subset_span)

lemma span_inl_union_inr {s : set β} {t : set γ} :
  span (inl '' s ∪ inr '' t) = set.prod (span s) (span t) :=
span_eq prod.is_submodule
  (set.union_subset
    (set.image_subset_iff.mpr $ assume b hbs, ⟨subset_span hbs, is_submodule.zero⟩)
    (set.image_subset_iff.mpr $ assume c hct, ⟨is_submodule.zero, subset_span hct⟩))
  (assume ⟨b, c⟩ ⟨hb, hc⟩,
  begin
    simp [span_union, span_image_of_linear_map is_linear_map_prod_inl,
      span_image_of_linear_map is_linear_map_prod_inr],
    exact ⟨b, 0, ⟨b, hb, rfl⟩, 0, c, ⟨c, hc, rfl⟩,
      mk.inj_iff.mpr ⟨(add_zero _).symm, (zero_add _).symm⟩⟩
  end)

lemma linear_independent_inl_union_inr {s : set β} {t : set γ}
  (hs : linear_independent s) (ht : linear_independent t) :
  linear_independent (inl '' s ∪ inr '' t) :=
linear_independent_union
  (hs.image is_linear_map_prod_inl $ assume a ha b hb eq, injective_inl eq)
  (ht.image is_linear_map_prod_inr $ assume a ha b hb eq, injective_inr eq)
  (subset.antisymm
    (by rw [span_image_of_linear_map is_linear_map_prod_inl,
      span_image_of_linear_map is_linear_map_prod_inr];
      exact assume ⟨b, c⟩ ⟨⟨b', hb', beq⟩, ⟨c', hc', ceq⟩⟩,
        have c = 0, from (prod.mk.inj beq).2.symm,
        have b = 0, from (prod.mk.inj ceq).1.symm,
        by simp *; refl)
    (by simp [is_submodule.zero]))

lemma is_basis_inl_union_inr {s : set β} {t : set γ}
  (hs : is_basis s) (ht : is_basis t) : is_basis (inl '' s ∪ inr '' t) :=
⟨linear_independent_inl_union_inr hs.1 ht.1,
  by rw [span_inl_union_inr]; exact assume ⟨b, c⟩, ⟨hs.2 b, ht.2 c⟩⟩

end module

end prod


import data.nat.basic
import data.nat.modeq
import data.nat.prime_norm_num
import data.zmod.basic
import data.int.basic

import tactic.linarith
import tactic.norm_num
import tactic.interval_cases

/-
Polish Mathematical Olympiad 1998, Problem 4

Prove that the sequence {a_n} defined by a_1 = 1 and

     a_n = a_{n - 1} + a_{⌊n/2⌋}        n = 2,3,4,...

contains infinitely many integers divisible by 7.

-/

def a : ℕ → ℕ
| 0 := 1 -- unused dummy value
| 1 := 1
| (nat.succ n) :=
           have hp : n < n.succ := lt_add_one n,
           have h2 : (n.succ / 2) < n.succ := nat.div_lt_self' n 0,
           a n + a (n.succ / 2)

lemma a_1_is_1 : a 1 = 1 := by simp [a]
lemma a_2_is_2 : a 2 = 2 := by simp [a]

lemma a_5_is_7 : a 5 = 7 :=
begin
  have h3 : a 3 = 3 := by { simp[a], norm_num, rw [a_1_is_1] },
  have h4 : a 4 = 5 := by { simp[a], norm_num, rw [a_1_is_1, a_2_is_2] },
  have h5 : a 5 = 7 := by { simp[a], norm_num, rw [a_1_is_1, a_2_is_2] },
  exact h5
end

lemma a_recurrence (n : ℕ) (hn : 2 ≤ n) :
  a n = a (n - 1) + a (n / 2) :=
begin
  cases n,
  { exact (nat.not_succ_le_zero _ hn).elim },
  cases n,
  { exact (nat.not_succ_le_self _ hn).elim },
  simp only [a, nat.succ_sub_succ_eq_sub, tsub_zero],
end

lemma lemma1 (n : ℕ) (npos : 0 < n) : 2 * (n - 1) + 1 = 2 * n - 1 :=
begin
  cases n,
  { exfalso, exact lt_asymm npos npos },
  { finish, },
end

lemma lemma2 (n : ℕ) : (2 * n + 1) / 2 = n :=
begin
  have h1 : ¬ 2 ∣ 2 * n + 1,
  { intro h,
    have h1: 2 ∣ 2 * n := dvd.intro n rfl,
    have : 2 ∣ 1 := (nat.dvd_add_right h1).mp h,
    rw nat.dvd_one at this,
    exact nat.succ_succ_ne_one 0 this },
  have h2 := nat.succ_div_of_not_dvd h1,
  rw [h2],
  exact nat.mul_div_right n zero_lt_two,
end

def a' : ℕ → zmod 7
| n := ⟨(a n) % 7, nat.mod_lt _ (by norm_num)⟩

lemma a'_5_is_0 : a' 5 = 0 :=
begin
  simp [a',a],
  norm_num,
  simp_rw [a_1_is_1, a_2_is_2],
  ring_nf,
end

lemma a'_recurrence (n : ℕ) (hn : 2 ≤ n) :
  a' n = a' (n - 1) + a' (n / 2) :=
begin
  ext,
  have : (a' n).val = (a' (n - 1) + a' (n / 2)).val,
  { rw [zmod.val_add],
    simp_rw [a', a_recurrence n hn],
    rw [zmod.val],
    simp },
  exact this,
end

lemma lemma3
  (N0 : ℕ)
  (k : zmod 7)
  (hk : k ≠ 0)
  (hN : ∀ i : ℕ, i < 7 → a' (N0 + i) = a' N0 + k * i) :
  (∃ i : ℕ, i < 7 ∧ a' (N0 + i) = 0) :=
begin
  haveI hp : fact (nat.prime 7) := ⟨by norm_num⟩,
  let ii := - (a' N0) / k,
  use ii.val,
  split,
  { exact zmod.val_lt ii },
  { have := hN ii.val (zmod.val_lt ii),
    rw [this, zmod.nat_cast_val, zmod.cast_id', id.def, mul_div_cancel' _ hk],
    exact add_neg_self (a' N0) }
end

lemma lemma6 (n : ℕ) : (4 * (n - 1) + 1 + 3) / 2 = (2 * (n - 1) + 1 + 1) :=
begin
  have : (4 * (n - 1) + 1 + 3) = 2 * (2 * (n - 1) + 1 + 1) := by ring,
  rw [this,nat.mul_div_right],
  exact two_pos,
end

lemma lemma6' (n : ℕ) : (4 * (n - 1) + 1 + 4) / 2 = (2 * (n - 1) + 1 + 1) :=
begin
  have h1 : (4 * (n - 1) + 1 + 4) = 2 * (2 * (n - 1) + 1 + 1) + 1 := by linarith,
  rw [h1],
  exact lemma2 (2 * (n - 1) + 1 + 1),
end

lemma lemma7 (n : ℕ) : (4 * (n - 1) + 1 + 5) / 2 = (2 * (n - 1) + 1 + 2) :=
begin
  have : (4 * (n - 1) + 1 + 5) = 2 * (2 * (n - 1) + 1 + 2) := by ring,
  finish
end

lemma lemma7' (n : ℕ) : (4 * (n - 1) + 1 + 6) / 2 = (2 * (n - 1) + 1 + 2) :=
begin
  have h1 : (4 * (n - 1) + 1 + 6) = 2 * (2 * (n - 1) + 1 + 2) + 1 := by ring,
  rw [h1],
  exact lemma2 (2 * (n - 1) + 1 + 2),
end

lemma can_get_a_later_one_zmod :
  (∀ N : ℕ, a' N = 0 → (∃ M : ℕ, N < M ∧ a' M = 0)) :=
begin
  intros n hn,

  obtain (hlt : n < 2) | (hlte : 2 ≤ n) := lt_or_ge n 2,
  { use 5,
    split,
    { calc n < 2 : hlt
         ... < 5 : by norm_num },
    {exact a'_5_is_0} },

  let n1 : ℕ := 2 * (n - 1) + 1,

  -- a' (2 * n - 1), a' (2 * n), and a' (2 * n + 1) are all equal

  have npos := calc 0 < 2 : by norm_num
                  ... ≤ n : hlte,
  have hn1v : n1 = 2 * n - 1 := lemma1 n npos,
  have hn2: 2 ≤ n1 + 1,
  { have : 1 ≤ n1 := le_add_self,
    exact nat.succ_le_succ this },

  have hn3: 2 ≤ n1 + 2 := le_add_self,

  let an1 := a' n1,

  have hn1 : (n1 + 1) = 2 * n,
  { have hrw : (n1 + 1) = 2 * (n - 1) + 1 + 1 := rfl,
    rw [hrw],
    cases n,
    { exfalso, exact lt_asymm npos npos },
    { refl } },

  have ha1 : a' (n1 + 1) = an1 + a' n,
  { have haa : a' (n1 + 1) = a' n1 + a' (n1.succ / 2) := a'_recurrence (n1 + 1) hn2,
    have h2n1 : 2 * n / 2 = n := by norm_num,
    have h2n1' : (n1 + 1) / 2 = n := by { rw [hn1, h2n1] },
    rw [haa, h2n1'] },

  have hn1' : n1 + 2 = 2 * n + 1,
  { have hrw : (n1 + 2) = 2 * (n - 1) + 1 + 1 + 1 := rfl,
    rw [hrw],
    cases n,
    { exfalso, exact lt_asymm npos npos },
    { refl } },

  have ha2 : a' (n1 + 2) = a' (n1 + 1) +  a' n,
  { have haa : a' (n1 + 2) = a' (n1 + 1) + a' (n1.succ.succ / 2) := a'_recurrence (n1 + 2) hn3,
    have h1 : (2 * n + 1) / 2 = n := lemma2 n,
    have hn1v' : 2 * n = n1 + 1,
    { have hrw : n1 + 1 = 2 * (n - 1) + 1 + 1 := rfl,
      rw [hrw],
      cases n,
      { exfalso, exact lt_asymm npos npos },
      { refl } },
    rw [haa],
    congr,
    have : n1.succ.succ = (n1 + 1 + 1) := rfl,
    rw this,
    rw [← hn1v', h1] },

  have ha1' : a' (n1 + 1) = a' n1,
  { rw [hn] at ha1,
    simp at ha1,
    exact ha1 },

  have ha2' : a' (n1 + 2) = a' n1,
  { rw [hn, ha1'] at ha2,
    simp at ha2,
    exact ha2 },

  clear ha1 ha2,

  have : ∀ i, i ≤ 2 → a' (n1 + i) = a' n1,
  { intros i hi,
    interval_cases i,
    { exact ha1' },
    { exact ha2' } },

  -- then the seven elements beginning with a (4 * n - 3) will all have different
  -- residues mod 7.

/-

  let n4 := 4 * n - 3,
  -- a (n4 + 1) = a n4 + a n1
  -- a (n4 + 2) = a (n4 + 1) + a n1
  -- a (n4 + 3) = a (n4 + 2) + a (n1 + 1)
  -- a (n4 + 4) = a (n4 + 3) + a (n1 + 1)
  -- a (n4 + 5) = a (n4 + 4) + a (n1 + 2)
  -- a (n4 + 6) = a (n4 + 5) + a (n1 + 2)

-/

  -- n2 = 4 * n - 3
  --   = 4 * (n - 1) + 1
  let n2: ℕ := 4 * (n - 1) + 1,

  have hii : ∀ i, i < 6 → a' (n2 + i + 1) = a' (n2 + i) + a' n1,
  { intros i hi,
    have hn2ge2 : 2 ≤ n2 + i + 1 := by linarith,
    have hr := a'_recurrence (n2 + i + 1) hn2ge2,
    interval_cases i,
    { suffices : (n2 + 1) / 2 = n1, by { rwa [this] at hr },
      have : (4 * (n - 1) + 1 + 1) = 2 * (2 * (n - 1) + 1) := by ring,
      simp only [this, nat.succ_pos', nat.mul_div_right], },
    { suffices hn1 : (n2 + 2) / 2 = n1, by { rwa [hn1] at hr },
      have h1 : (4 * (n - 1) + 1 + 2) = 2 * (2 * (n - 1) + 1) + 1 := by ring,
      rw [h1],
      exact lemma2 (2 * (n - 1) + 1)},
    { have hn1 : (n2 + 3) / 2 = n1 + 1 := lemma6 n,
      rw [hn1, ha1'] at hr,
      exact hr},
    { have hn1 : (n2 + 4) / 2 = n1 + 1 := lemma6' n,
      rw [hn1, ha1'] at hr,
      exact hr},
    { have hn1 : (n2 + 5) / 2 = n1 + 2 := lemma7 n,
      rw [hn1, ha2'] at hr,
      exact hr},
    { have hn1 : (n2 + 6) / 2 = n1 + 2 := lemma7' n,
      rw [hn1, ha2'] at hr,
      exact hr} },

  have hik : ∀ i, i < 7 → a' (n2 + i) = a' n2 + a' n1 * i,
  { intros i,
    induction i with p hp,
    { intro, simp, },
    { intro hpi7,
      have hpi6 : p < 6 := nat.succ_lt_succ_iff.mp hpi7,
      have hinc := hii p hpi6,
      have hadd : n2 + p + 1 = n2 + p.succ := rfl,
      have hi6 : p < 7 := nat.lt.step hpi6,
      have hpp := hp hi6,
      have hp1: (p.succ : zmod 7) = (p : zmod 7) + 1 := by norm_cast,
      rw [←hadd, hinc, hpp, hp1],
      ring_nf} },

  obtain (haez : a' n1 = 0) | (hanez : ¬ a' n1 = 0) := em (a' n1 = 0),
  { use n1,
    split,
    { linarith },
    { exact haez }},

  { have := lemma3 n2 (a' n1) hanez hik,
    obtain ⟨ii, hii7, hia'⟩ := this,
    use (n2 + ii),
    split,
    { linarith },
    { assumption } }
end

lemma can_get_a_later_one :
  (∀ N : ℕ, 7 ∣ a N → (∃ M : ℕ, N < M ∧ 7 ∣ a M)) :=
begin
  intros n hn,
  have ha' : a' n = 0,
  { have : a' n = ⟨a n % 7, nat.mod_lt _ (by norm_num)⟩ := by simp[a'],
    rw [this],
    congr,
    exact nat.mod_eq_zero_of_dvd hn, },
  obtain ⟨m, hmgt, hm7⟩ := can_get_a_later_one_zmod n ha',
  use m,
  use hmgt,
  unfold a' at hm7,
  have : a m % 7 = 0,
  { injections_and_clear,
    assumption, },
  exact nat.dvd_of_mod_eq_zero this
end

lemma strengthen
  {P : ℕ → Prop}
  (h : ∀ N : ℕ, P N → (∃ M : ℕ, N < M ∧ P M))
  (he : ∃ N : ℕ, P N) :
  (∀ N : ℕ, ∃ M : ℕ, N < M ∧ P M) :=
begin
  obtain ⟨N0, hn0⟩ := he,
  intro N,
  refine nat.rec_on N _ _,
  { obtain (hlt : 0 < N0) | (hlte : N0 ≤ 0) := lt_or_ge 0 N0,
    { exact ⟨N0, hlt, hn0⟩},
    { have heq : N0 = 0 := eq_bot_iff.mpr hlte,
      rw [heq] at hn0,
      exact h 0 hn0 } },
  { intros pn hpn,
    obtain ⟨m, hm, hmp⟩ := hpn,
    obtain (hlt : pn + 1 < m) |  (hlte : m ≤ pn + 1) := lt_or_ge (pn + 1) m,
    { exact ⟨m, hlt, hmp⟩ },
    { have heq : m = pn + 1,
      { have h1 : pn < m := hm,
        have h2 : m ≤ pn + 1 := hlte,
        have h3 : m = pn + 1 := le_antisymm hlte hm,
        exact h3 },
      rw [heq] at hmp,
      exact h (pn.succ) hmp } }
end

theorem poland1998_q4 : (∀ N : ℕ, ∃ M : ℕ, N < M ∧ 7 ∣ a M) :=
begin
  have he: 7 ∣ a 5 := by rw [a_5_is_7],
  exact strengthen can_get_a_later_one ⟨5, he⟩,
end


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.nat.modeq
import Mathlib.tactic.ring
import Mathlib.PostPort

namespace Mathlib

namespace int

/-- `a ≡ b [ZMOD n]` when `a % n = b % n`. -/
def modeq (n : ℤ) (a : ℤ) (b : ℤ) := a % n = b % n

namespace modeq

protected theorem refl {n : ℤ} (a : ℤ) : modeq n a a := rfl

protected theorem symm {n : ℤ} {a : ℤ} {b : ℤ} : modeq n a b → modeq n b a := Eq.symm

protected theorem trans {n : ℤ} {a : ℤ} {b : ℤ} {c : ℤ} : modeq n a b → modeq n b c → modeq n a c :=
  Eq.trans

theorem coe_nat_modeq_iff {a : ℕ} {b : ℕ} {n : ℕ} : modeq ↑n ↑a ↑b ↔ nat.modeq n a b := sorry

protected instance decidable {n : ℤ} {a : ℤ} {b : ℤ} : Decidable (modeq n a b) :=
  eq.mpr sorry (int.decidable_eq (a % n) (b % n))

theorem modeq_zero_iff {n : ℤ} {a : ℤ} : modeq n a 0 ↔ n ∣ a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (modeq n a 0 ↔ n ∣ a)) (equations._eqn_1 n a 0)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a % n = 0 % n ↔ n ∣ a)) (zero_mod n)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a % n = 0 ↔ n ∣ a)) (propext (dvd_iff_mod_eq_zero n a))))
        (iff.refl (a % n = 0))))

theorem modeq_iff_dvd {n : ℤ} {a : ℤ} {b : ℤ} : modeq n a b ↔ n ∣ b - a := sorry

theorem modeq_of_dvd_of_modeq {n : ℤ} {m : ℤ} {a : ℤ} {b : ℤ} (d : m ∣ n) (h : modeq n a b) :
    modeq m a b :=
  iff.mpr modeq_iff_dvd (dvd_trans d (iff.mp modeq_iff_dvd h))

theorem modeq_mul_left' {n : ℤ} {a : ℤ} {b : ℤ} {c : ℤ} (hc : 0 ≤ c) (h : modeq n a b) :
    modeq (c * n) (c * a) (c * b) :=
  sorry

theorem modeq_mul_right' {n : ℤ} {a : ℤ} {b : ℤ} {c : ℤ} (hc : 0 ≤ c) (h : modeq n a b) :
    modeq (n * c) (a * c) (b * c) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (modeq (n * c) (a * c) (b * c))) (mul_comm a c)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (modeq (n * c) (c * a) (b * c))) (mul_comm b c)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (modeq (n * c) (c * a) (c * b))) (mul_comm n c)))
        (modeq_mul_left' hc h)))

theorem modeq_add {n : ℤ} {a : ℤ} {b : ℤ} {c : ℤ} {d : ℤ} (h₁ : modeq n a b) (h₂ : modeq n c d) :
    modeq n (a + c) (b + d) :=
  sorry

theorem modeq_add_cancel_left {n : ℤ} {a : ℤ} {b : ℤ} {c : ℤ} {d : ℤ} (h₁ : modeq n a b)
    (h₂ : modeq n (a + c) (b + d)) : modeq n c d :=
  sorry

theorem modeq_add_cancel_right {n : ℤ} {a : ℤ} {b : ℤ} {c : ℤ} {d : ℤ} (h₁ : modeq n c d)
    (h₂ : modeq n (a + c) (b + d)) : modeq n a b :=
  modeq_add_cancel_left h₁
    (eq.mp (Eq._oldrec (Eq.refl (modeq n (c + a) (b + d))) (add_comm b d))
      (eq.mp (Eq._oldrec (Eq.refl (modeq n (a + c) (b + d))) (add_comm a c)) h₂))

theorem mod_modeq (a : ℤ) (n : ℤ) : modeq n (a % n) a := mod_mod a n

theorem modeq_neg {n : ℤ} {a : ℤ} {b : ℤ} (h : modeq n a b) : modeq n (-a) (-b) := sorry

theorem modeq_sub {n : ℤ} {a : ℤ} {b : ℤ} {c : ℤ} {d : ℤ} (h₁ : modeq n a b) (h₂ : modeq n c d) :
    modeq n (a - c) (b - d) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (modeq n (a - c) (b - d))) (sub_eq_add_neg a c)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (modeq n (a + -c) (b - d))) (sub_eq_add_neg b d)))
      (modeq_add h₁ (modeq_neg h₂)))

theorem modeq_mul_left {n : ℤ} {a : ℤ} {b : ℤ} (c : ℤ) (h : modeq n a b) :
    modeq n (c * a) (c * b) :=
  sorry

theorem modeq_mul_right {n : ℤ} {a : ℤ} {b : ℤ} (c : ℤ) (h : modeq n a b) :
    modeq n (a * c) (b * c) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (modeq n (a * c) (b * c))) (mul_comm a c)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (modeq n (c * a) (b * c))) (mul_comm b c)))
      (modeq_mul_left c h))

theorem modeq_mul {n : ℤ} {a : ℤ} {b : ℤ} {c : ℤ} {d : ℤ} (h₁ : modeq n a b) (h₂ : modeq n c d) :
    modeq n (a * c) (b * d) :=
  modeq.trans (modeq_mul_left a h₂) (modeq_mul_right d h₁)

theorem modeq_of_modeq_mul_left {n : ℤ} {a : ℤ} {b : ℤ} (m : ℤ) (h : modeq (m * n) a b) :
    modeq n a b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (modeq n a b)) (propext modeq_iff_dvd)))
    (dvd.trans (dvd_mul_left n m)
      (eq.mp (Eq._oldrec (Eq.refl (modeq (m * n) a b)) (propext modeq_iff_dvd)) h))

theorem modeq_of_modeq_mul_right {n : ℤ} {a : ℤ} {b : ℤ} (m : ℤ) :
    modeq (n * m) a b → modeq n a b :=
  mul_comm m n ▸ modeq_of_modeq_mul_left m

theorem modeq_and_modeq_iff_modeq_mul {a : ℤ} {b : ℤ} {m : ℤ} {n : ℤ}
    (hmn : nat.coprime (nat_abs m) (nat_abs n)) : modeq m a b ∧ modeq n a b ↔ modeq (m * n) a b :=
  sorry

theorem gcd_a_modeq (a : ℕ) (b : ℕ) : modeq (↑b) (↑a * nat.gcd_a a b) ↑(nat.gcd a b) := sorry

theorem modeq_add_fac {a : ℤ} {b : ℤ} {n : ℤ} (c : ℤ) (ha : modeq n a b) : modeq n (a + n * c) b :=
  sorry

theorem mod_coprime {a : ℕ} {b : ℕ} (hab : nat.coprime a b) : ∃ (y : ℤ), modeq (↑b) (↑a * y) 1 :=
  sorry

theorem exists_unique_equiv (a : ℤ) {b : ℤ} (hb : 0 < b) : ∃ (z : ℤ), 0 ≤ z ∧ z < b ∧ modeq b z a :=
  sorry

theorem exists_unique_equiv_nat (a : ℤ) {b : ℤ} (hb : 0 < b) : ∃ (z : ℕ), ↑z < b ∧ modeq b (↑z) a :=
  sorry

end modeq

@[simp] theorem mod_mul_right_mod (a : ℤ) (b : ℤ) (c : ℤ) : a % (b * c) % b = a % b :=
  modeq.modeq_of_modeq_mul_right c (modeq.mod_modeq a (b * c))

@[simp] theorem mod_mul_left_mod (a : ℤ) (b : ℤ) (c : ℤ) : a % (b * c) % c = a % c :=
  modeq.modeq_of_modeq_mul_left b (modeq.mod_modeq a (b * c))

end Mathlib


import ..sequence
import .basic
import ..mynat.induction
import ..mynat.nat_sub

namespace hidden
namespace myring

open sequence
open myring

variables {α : Type} [myring α]
variables a b c d : α
variables m n k : mynat
variables term f g : sequence α
variables (op: α → α → α) (dflt: α)

@[simp] theorem sum_zero: sum term 0 = 0 := rfl

@[simp]
theorem sum_succ: sum term (mynat.succ n) = sum term n + term n := rfl

@[simp]
theorem sum_one: sum term 1 = term 0 :=
begin
  apply zero_add,
end

@[simp] theorem prod_zero: product term 0 = 1 := rfl

@[simp]
theorem prod_succ:
product term (mynat.succ n) = product term n * term n := rfl

@[simp]
theorem prod_one: product term 1 = term 0 :=
begin
  apply one_mul,
end

-- theorem constant_sum: ∀ n : mynat, sum ↑(1 : α) n = n
-- | zero := rfl
-- | (succ n) := by rw [sum_succ, constant_sum, coe_triv, add_one_succ]

theorem mul_sum: ∀ n, sum (↑a * f) n = a * (sum f n)
| mynat.zero     := begin
  rw mynat.zz,
  change (↑a * f).sum 0 = a * 0,
  rw mul_zero,
  refl,
end
| (mynat.succ n) := by rw [sum_succ, sum_succ, mul_add, mul_sum, coe_mul]

theorem sum_distr: ∀ n, sum (f + g) n = (sum f n) + (sum g n)
| mynat.zero     := begin
  rw mynat.zz,
  change 0 = 0 + (0 : α),
  rw add_zero,
end
| (mynat.succ n) := by conv {
  rw [sum_succ, sum_succ, sum_succ, sum_distr, addition],
  to_rhs,
  rw [←add_assoc, add_assoc (sum f n), add_comm (f n),
      ←add_assoc (sum f n), add_assoc],
}

theorem sum_cancel: (∀ n, sum f n = sum g n) ↔ ∀ n, f n = g n :=
begin
  split, {
    assume h,
    intro n,
    have hsn := h (mynat.succ n),
    repeat {rw sum_succ at hsn},
    rw h n at hsn,
    apply add_cancel_left (g.sum n),
    assumption,
  }, {
    assume h n,
    induction n with n hn,
      refl,
    rw [sum_succ, sum_succ, hn, h n],
  },
end

theorem apply_accumulate:
(∀ n, f n = g n) → accumulate op dflt f k = accumulate op dflt g k :=
begin
  assume h,
  induction k with k hk, {
    refl,
  }, {
    dsimp [accumulate],
    rw h,
    rw hk,
  },
end

theorem apply_sum:
(∀ n, f n = g n) → sum f k = sum g k :=
λ h, apply_accumulate k f g (+) 0 h

theorem apply_prod:
(∀ n, f n = g n) → product f k = product g k :=
λ h, apply_accumulate k f g (*) 1 h

theorem accumulate_tail
[hcomm: is_commutative _ op]
[hassoc: is_associative _ op]:
accumulate op dflt f (mynat.succ n) =
op (accumulate op dflt (λ k, f (mynat.succ k)) n) (f 0) :=
begin
  induction n with n hn, {
    refl,
  }, {
    unfold accumulate at *,
    rw hn,
    ac_refl,
  },
end

theorem sum_tail:
sum f (mynat.succ n) = sum (λ k, f (mynat.succ k)) n + f 0 :=
accumulate_tail n f (+) 0

theorem prod_tail:
product f (mynat.succ n) = product (λ k, f (mynat.succ k)) n * f 0 :=
accumulate_tail n f (*) 1

private theorem restricted_mpr {m : mynat} {f g : sequence α}
(h : ∀ n, n < m → f n = g n) : ∀ n, n ≤ m → sum f n = sum g n
| mynat.zero := λ _, rfl
| (mynat.succ n) := (assume hnm, by rw [sum_succ, sum_succ,
  restricted_mpr n (@mynat.le_cancel_strong n m 1 hnm),
  h n (mynat.lt_iff_succ_le.mpr hnm)])

-- this might be necessary/useful when working with -, since it lets
-- you basically assume k < n in order to rewrite the terms
theorem sum_cancel_restricted: (∀ n, n ≤ m → sum f n = sum g n) ↔
(∀ n, n < m → f n = g n) := ⟨assume h n hnm,
have hsn : _ := h (mynat.succ n) (mynat.lt_iff_succ_le.mp hnm),
by {rw [sum_succ, sum_succ, h n (mynat.lt_impl_le hnm)] at hsn,
    from add_cancel_left _ _ _ hsn},
restricted_mpr⟩

private theorem add_two: ∀ k, k + 2 = mynat.succ (mynat.succ k) := (λ k, rfl)

theorem sum_reverse:
sum f n = sum (λ k, f (n - mynat.succ k)) n :=
begin
  revert n f,
  -- easy way to access the n - 2 case of IH
  apply duo_induction
    (λ n, ∀ f, sum f n =
      sum (λ k, f (n - mynat.succ k)) n), {
    intro f,
    refl,
  }, {
    intro f,
    refl,
  }, {
    intro n,
    assume h_ih _,
    intro f,
    rw [add_two, sum_succ, sum_tail, h_ih,
        sum_succ, sum_tail, mynat.sub_succ_succ,
        mynat.sub_zero, mynat.sub_self_eq_zero],
    conv {
      congr,
      rw [add_assoc, add_comm],
      skip,
      rw [add_assoc, add_comm],
      congr,
      rw add_comm,
    },
    apply add_left,
    -- help lean with type inference a bit
    have h_aesthetic := @mynat.le_refl n,
    revert h_aesthetic,
    apply (sum_cancel_restricted _ _ _).mpr,
    intro m,
    assume hmn,
    congr,
    rw [mynat.sub_succ_succ, mynat.sub_succ_succ],
    cases mynat.sub_succ_converse hmn with d hd,
    symmetry,
    rw [mynat.sub_succ_rearrange, mynat.sub_succ, hd, mynat.succ_sub_one],
    from mynat.sub_succ_rearrange.mp hd,
  },
end

theorem sum_split:
sum f (n + m) = sum f n + sum (λ k, f (n + k)) m :=
begin
  induction m with m hm, {
    symmetry,
    from add_zero _,
  }, {
    rw mynat.add_succ,
    rw sum_succ,
    rw hm,
    rw sum_succ,
    rw add_assoc,
  },
end

theorem sum_split_lots:
sum f (n * m) =
sum (λ k, sum (λ ℓ, f (ℓ + k * n)) n) m :=
begin
  induction m with m ih_m generalizing f, {
    refl,
  }, {
    rw mynat.mul_succ,
    rw sum_split,
    conv {
      to_lhs,
      rw add_comm,
      congr,
      rw ih_m _,
    },
    rw sum_tail,
    apply congr, {
      apply congr, refl,
      apply (sum_cancel _ _).mpr,
      intro k,
      apply (sum_cancel _ _).mpr,
      intro ℓ,
      rw mynat.succ_mul,
      ac_refl,
    }, {
      apply (sum_cancel _ _).mpr,
      intro ℓ,
      rw mynat.zero_mul,
      refl,
    },
  },
end

theorem sum_square_limit_swap
(f: mynat → mynat → α):
sum (λ k, sum (λ ℓ, f k ℓ) n) m =
sum (λ ℓ, sum (λ k, f k ℓ) m) n :=
begin
  induction m with m ih_m, {
    conv {
      to_lhs,
      change (0: α),
    },
    induction n with n ih_n, {
      refl,
    }, {
      symmetry,
      rw ih_n,
      from add_zero _,
    },
  }, {
    rw sum_succ,
    rw ih_m,
    clear ih_m,
    induction n with n ih_n, {
      from add_zero _,
    }, {
      conv {
        to_rhs,
        rw sum_succ,
        rw ←ih_n,
      },
      repeat {rw sum_succ},
      repeat {rw add_assoc},
      apply congr, refl,
      rw add_comm,
      repeat {rw add_assoc},
      apply congr, refl,
      from add_comm _ _,
    },
  },
end

theorem sum_triangle_limit_swap
(f: mynat → mynat → α):
sum (λ k, sum (λ ℓ, f k ℓ) k.succ) n =
sum (λ ℓ, sum (λ k, f (k + ℓ) ℓ) (n - ℓ)) n :=
begin
  induction n with n ih_n, {
    refl,
  }, {
    rw sum_succ,
    rw ih_n, clear ih_n,
    rw sum_succ,
    rw sum_succ,
    rw mynat.succ_sub_self,
    repeat {rw ←add_assoc},
    apply congr, {
      apply congr, refl,
      rw ←sum_distr,
      apply (sum_cancel_restricted n _ _).mpr, {
        intro ℓ,
        assume hln,
        have: n.succ - ℓ = (n - ℓ).succ, {
          cases mynat.sub_succ_converse hln with w hw,
          rw hw,
          rw mynat.sub_succ_rearrange at hw,
          rw hw,
          rw ←mynat.succ_add,
          rw mynat.add_sub,
        },
        rw this, clear this,
        rw sum_succ,
        dsimp only [],
        conv {
          to_lhs,
          change (sum (λ (k : mynat), f (k + ℓ) ℓ) (n - ℓ) + f n ℓ),
        },
        apply congr, {
          refl,
        }, {
          rw mynat.sub_add_condition.mpr (mynat.lt_impl_le hln),
        },
      }, {
        refl,
      },
    }, {
      conv {
        to_rhs,
        change 0 + f (0 + n) n,
      },
      rw zero_add,
      rw mynat.zero_add,
    },
  },
end

theorem prod_congr:
(∀ k, f k = g k) → (∀ n, product f n = product g n) :=
begin
  assume heq,
  intro n,
  induction n with n hn, {
    refl,
  }, {
    repeat {rw prod_succ},
    rw hn,
    rw heq n,
  },
end

end myring
end hidden