import tactic.basic
import .ch07_indprop

open indprop (reflect)
open indprop.reflect

variables {α : Type}
variables {a : α}
variables {s x y : string}

namespace maps

/-
From Coq Require Import Arith.Arith.
From Coq Require Import Bool.Bool.
Require Export Coq.Strings.String.
From Coq Require Import Logic.FunctionalExtensionality.
From Coq Require Import Lists.List.
Import ListNotations.
-/

/-
Definition eqb_string (x y : string) : bool :=
  if string_dec x y then true else false.
-/

def eqb_string (x y : string) : bool :=
  if x = y then tt else ff

/-
Theorem eqb_string_refl : ∀s : string, true = eqb_string s s.
Proof. intros s. unfold eqb_string. destruct (string_dec s s) as [|Hs].
  - reflexivity.
  - destruct Hs. reflexivity.
Qed.
-/

theorem eqb_string_refl (s : string) : tt = eqb_string s s :=
begin
  unfold eqb_string,
  /- need the name for cases but not ite -/
  cases string.has_decidable_eq s s with c h,
    cases c rfl,
  refl,
end

/-
Theorem eqb_string_true_iff : ∀x y : string,
    eqb_string x y = true ↔ x = y.
Proof.
   intros x y.
   unfold eqb_string.
   destruct (string_dec x y) as [|Hs].
   - subst. split. reflexivity. reflexivity.
   - split.
     + intros contra. discriminate contra.
     + intros H. rewrite H in Hs. destruct Hs. reflexivity.
Qed.
-/

/-
TODO: sf never explains subst
-/

theorem eqb_string_tt_iff : eqb_string x y = tt ↔ x = y :=
begin
  unfold eqb_string,
  cases string.has_decidable_eq x y,
    unfold ite,
    simp only [false_iff],
    exact h,
  subst h,
  unfold ite,
  simp only [true_iff, eq_self_iff_true],
end

/-
Theorem eqb_string_false_iff : ∀x y : string,
    eqb_string x y = false ↔ x ≠ y.
Proof.
  intros x y. rewrite <- eqb_string_true_iff.
  rewrite not_true_iff_false. reflexivity. Qed.
-/

theorem eqb_string_ff_iff : eqb_string x y = ff ↔ x ≠ y :=
begin
  rw ne.def,
  rw ←eqb_string_tt_iff,
  rw eq_ff_eq_not_eq_tt,
end

/-
Theorem false_eqb_string : ∀x y : string,
   x ≠ y → eqb_string x y = false.
Proof.
  intros x y. rewrite eqb_string_false_iff.
  intros H. apply H. Qed.
-/

theorem ff_eqb_string (x y : string) (h : x ≠ y)
  : eqb_string x y = ff := eqb_string_ff_iff.mpr h

/-
Definition total_map (A : Type) := string → A.
-/

def total_map (α : Type) := string → α

/-
Definition t_empty {A : Type} (v : A) : total_map A :=
  (fun _ ⇒ v).
-/

def t_empty (v) : total_map α := λ_, v

/-
Definition t_update {A : Type} (m : total_map A)
                    (x : string) (v : A) :=
  fun x' ⇒ if eqb_string x x' then v else m x'.
-/

def t_update (m : total_map α) (x) (v : α) :=
  λx', if eqb_string x x' then v else m x'

/-
Definition examplemap :=
  t_update (t_update (t_empty false) "foo" true)
           "bar" true.
-/

def examplemap :=
  t_update (t_update (t_empty ff) "foo" tt) "bar" tt

/-
Notation "'_' '!->' v" := (t_empty v)
  (at level 100, right associativity).

Example example_empty := (_ !-> false).
-/

/- single _ doesn't work -/
notation `__` ` !→ `:10 v := t_empty v

example := __ !→ ff

/-
Notation "x '!->' v ';' m" := (t_update m x v)
                              (at level 100, v at next level, right associativity).
-/

/- here's how to assign precedence to parts of notation -/
notation x ` !→ `:10 v:5 ` ; ` m := t_update m x v

/-
Definition examplemap' :=
  ( "bar" !-> true;
    "foo" !-> true;
    _ !-> false
  ).
-/

example := "bar" !→ tt ; "foo" !→ tt ; __ !→ ff

/-
Lemma t_apply_empty : ∀(A : Type) (x : string) (v : A),
    (_ !-> v) x = v.
Proof.
  (* FILL IN HERE *) Admitted.
-/

lemma t_apply_empty (x) (v : α) : (__ !→ v) x = v := rfl

/-
Lemma t_update_eq : ∀(A : Type) (m : total_map A) x v,
    (x !-> v ; m) x = v.
Proof.
  (* FILL IN HERE *) Admitted.
-/

lemma t_update_eq (m x) (v : α) : (x !→ v ; m) x = v :=
begin
  unfold t_update,
  unfold eqb_string,
  simp only [if_true, bool.coe_sort_tt, eq_self_iff_true],
end

/-
Theorem t_update_neq : ∀(A : Type) (m : total_map A) x1 x2 v,
    x1 ≠ x2 →
    (x1 !-> v ; m) x2 = m x2.
Proof.
  (* FILL IN HERE *) Admitted.
-/

theorem t_update_neq (m x₁ x₂) (v : α) (h : x₁ ≠ x₂)
  : (x₁ !→ v ; m) x₂ = m x₂ :=
begin
  unfold t_update,
  unfold eqb_string,
  simp only [h, bool.coe_sort_ff, if_false],
end

/-
Lemma t_update_shadow : ∀(A : Type) (m : total_map A) x v1 v2,
    (x !-> v2 ; x !-> v1 ; m) = (x !-> v2 ; m).
Proof.
  (* FILL IN HERE *) Admitted.
-/

lemma t_update_shadow (m x) (v₁ v₂ : α)
  : (x !→ v₂ ; x !→ v₁ ; m) = (x !→ v₂ ; m) :=
begin
  unfold t_update,
  unfold eqb_string,
  funext,
  cases string.has_decidable_eq x x',
    simp only [h, bool.coe_sort_ff, if_false],
  simp only [h, if_true, bool.coe_sort_tt, eq_self_iff_true],
end

lemma eqb_stringP (x y : string) : reflect (x = y) (eqb_string x y) :=
begin
  unfold eqb_string,
  cases string.has_decidable_eq x y,
    exact ReflectF h,
  exact ReflectT h,
end

/-
Theorem t_update_same : ∀(A : Type) (m : total_map A) x,
    (x !-> m x ; m) = m.
Proof.
  (* FILL IN HERE *) Admitted.
-/

theorem t_update_same (m : total_map α) (x) : (x !→ m x ; m) = m :=
begin
  unfold t_update,
  funext,
  have hr, exact eqb_stringP x x',
  revert hr,
  generalize heq : x = x' = h,
  generalize heq' : eqb_string x x' = he,
  intro,
  cases hr with hr' hr',
    subst_vars,
    refl,
  refl,
end

/-
Theorem t_update_permute : ∀(A : Type) (m : total_map A)
                                  v1 v2 x1 x2,
    x2 ≠ x1 →
    (x1 !-> v1 ; x2 !-> v2 ; m)
    =
    (x2 !-> v2 ; x1 !-> v1 ; m).
Proof.
  (* FILL IN HERE *) Admitted.
-/

theorem t_update_permute (m) (v₁ v₂ : α) (x₁ x₂) (h : x₂ ≠ x₁)
  : (x₁ !→ v₁ ; (x₂ !→ v₂ ; m)) = (x₂ !→ v₂ ; (x₁ !→ v₁ ; m)) :=
begin
  unfold t_update,
  funext,
  have eqb₁, exact eqb_stringP x₁ x',
  have eqb₂, exact eqb_stringP x₂ x',
  revert_after x',
  generalize heq₁ : x₁ = x' = h₁,
  generalize heq₁' : eqb_string x₁ x' = h₁',
  generalize heq₂ : x₂ = x' = h₂,
  generalize heq₂' : eqb_string x₂ x' = h₂',
  intros,
  cases eqb₁ with eqb₁' eqb₁',
    cases eqb₂ with eqb₂' eqb₂',
      subst_vars,
      cases h rfl,
    refl,
  refl,
end

/-
Definition partial_map (A : Type) := total_map (option A).

Definition empty {A : Type} : partial_map A :=
  t_empty None.

Definition update {A : Type} (m : partial_map A)
           (x : string) (v : A) :=
  (x !-> Some v ; m).
-/

def partial_map (α) := total_map (option α)

def empty : partial_map α := t_empty none

def update (m x) (v : α) := (x !→ some v ; m)

/-
Notation "x '⊢>' v ';' m" := (update m x v)
  (at level 100, v at next level, right associativity).
-/

notation x ` |→ `:10 v:5 ` ; ` m := update m x v

/-
Notation "x '⊢>' v" := (update empty x v)
  (at level 100).

Example examplepmap :=
  ("Church" ⊢> true ; "Turing" ⊢> false).
-/

notation x ` |→ `:10 v := update empty x v

/-
Lemma apply_empty : ∀(A : Type) (x : string),
    @empty A x = None.
Proof.
  intros. unfold empty. rewrite t_apply_empty.
  reflexivity.
Qed.

Lemma update_eq : ∀(A : Type) (m : partial_map A) x v,
    (x ⊢> v ; m) x = Some v.
Proof.
  intros. unfold update. rewrite t_update_eq.
  reflexivity.
Qed.

Theorem update_neq : ∀(A : Type) (m : partial_map A) x1 x2 v,
    x2 ≠ x1 →
    (x2 ⊢> v ; m) x1 = m x1.
Proof.
  intros A m x1 x2 v H.
  unfold update. rewrite t_update_neq. reflexivity.
  apply H. Qed.

Lemma update_shadow : ∀(A : Type) (m : partial_map A) x v1 v2,
    (x ⊢> v2 ; x ⊢> v1 ; m) = (x ⊢> v2 ; m).
Proof.
  intros A m x v1 v2. unfold update. rewrite t_update_shadow.
  reflexivity.
Qed.

Theorem update_same : ∀(A : Type) (m : partial_map A) x v,
    m x = Some v →
    (x ⊢> v ; m) = m.
Proof.
  intros A m x v H. unfold update. rewrite <- H.
  apply t_update_same.
Qed.

Theorem update_permute : ∀(A : Type) (m : partial_map A)
                                x1 x2 v1 v2,
    x2 ≠ x1 →
    (x1 ⊢> v1 ; x2 ⊢> v2 ; m) = (x2 ⊢> v2 ; x1 ⊢> v1 ; m).
Proof.
  intros A m x1 x2 v1 v2. unfold update.
  apply t_update_permute.
Qed.
-/

lemma apply_empty (α x) : @empty α x = none :=
begin
  unfold empty,
  rw t_apply_empty,
end

lemma update_eq (m x) (v : α) : (x |→ v ; m) x = some v :=
begin
  unfold update,
  rw t_update_eq,
end

theorem update_neq (m x₁ x₂) (v : α) (h : x₂ ≠ x₁)
  : (x₂ |→ v ; m) x₁ = m x₁ :=
begin
  unfold update,
  rwa t_update_neq,
end

theorem update_shadow (m x) (v₁ v₂ : α)
  : (x |→ v₂ ; x |→ v₁ ; m) = (x |→ v₂ ; m) :=
begin
  unfold update,
  rw t_update_shadow,
end

theorem update_same (m : partial_map α) (x v) (h : m x = some v)
  : (x |→ v ; m) = m :=
begin
  unfold update,
  rw ←h,
  rw t_update_same,
end

theorem update_permute (m x₁ x₂) (v₁ v₂ : α) (h : x₂ ≠ x₁)
  : (x₁ |→ v₁ ; x₂ |→ v₂ ; m) = (x₂ |→ v₂ ; x₁ |→ v₁ ; m) :=
begin
  unfold update,
  rwa t_update_permute,
end

end maps


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne
-/
import analysis.complex.basic
import data.complex.exponential

/-!
# Complex and real exponential

In this file we prove continuity of `complex.exp` and `real.exp`. We also prove a few facts about
limits of `real.exp` at infinity.

## Tags

exp
-/

noncomputable theory

open finset filter metric asymptotics set function
open_locale classical topological_space

namespace complex

variables {z y x : ℝ}

lemma exp_bound_sq (x z : ℂ) (hz : ∥z∥ ≤ 1) :
  ∥exp (x + z) - exp x - z • exp x∥ ≤ ∥exp x∥ * ∥z∥ ^ 2 :=
calc ∥exp (x + z) - exp x - z * exp x∥
    = ∥exp x * (exp z - 1 - z)∥ : by { congr, rw [exp_add], ring }
... = ∥exp x∥ * ∥exp z - 1 - z∥ : norm_mul _ _
... ≤ ∥exp x∥ * ∥z∥^2 : mul_le_mul_of_nonneg_left (abs_exp_sub_one_sub_id_le hz) (norm_nonneg _)

lemma locally_lipschitz_exp {r : ℝ} (hr_nonneg : 0 ≤ r) (hr_le : r ≤ 1) (x y : ℂ)
  (hyx : ∥y - x∥ < r) :
  ∥exp y - exp x∥ ≤ (1 + r) * ∥exp x∥ * ∥y - x∥ :=
begin
  have hy_eq : y = x + (y - x), by abel,
  have hyx_sq_le : ∥y - x∥ ^ 2 ≤ r * ∥y - x∥,
  { rw pow_two,
    exact mul_le_mul hyx.le le_rfl (norm_nonneg _) hr_nonneg, },
  have h_sq : ∀ z, ∥z∥ ≤ 1 → ∥exp (x + z) - exp x∥ ≤ ∥z∥ * ∥exp x∥ + ∥exp x∥ * ∥z∥ ^ 2,
  { intros z hz,
    have : ∥exp (x + z) - exp x - z • exp x∥ ≤ ∥exp x∥ * ∥z∥ ^ 2, from exp_bound_sq x z hz,
    rw [← sub_le_iff_le_add',  ← norm_smul z],
    exact (norm_sub_norm_le _ _).trans this, },
  calc ∥exp y - exp x∥ = ∥exp (x + (y - x)) - exp x∥ : by nth_rewrite 0 hy_eq
  ... ≤ ∥y - x∥ * ∥exp x∥ + ∥exp x∥ * ∥y - x∥ ^ 2 : h_sq (y - x) (hyx.le.trans hr_le)
  ... ≤ ∥y - x∥ * ∥exp x∥ + ∥exp x∥ * (r * ∥y - x∥) :
    add_le_add_left (mul_le_mul le_rfl hyx_sq_le (sq_nonneg _) (norm_nonneg _)) _
  ... = (1 + r) * ∥exp x∥ * ∥y - x∥ : by ring,
end

@[continuity] lemma continuous_exp : continuous exp :=
continuous_iff_continuous_at.mpr $
  λ x, continuous_at_of_locally_lipschitz zero_lt_one (2 * ∥exp x∥)
    (locally_lipschitz_exp zero_le_one le_rfl x)

lemma continuous_on_exp {s : set ℂ} : continuous_on exp s :=
continuous_exp.continuous_on

end complex

section complex_continuous_exp_comp

variable {α : Type*}

open complex

lemma filter.tendsto.cexp {l : filter α} {f : α → ℂ} {z : ℂ} (hf : tendsto f l (𝓝 z)) :
  tendsto (λ x, exp (f x)) l (𝓝 (exp z)) :=
(continuous_exp.tendsto _).comp hf

variables [topological_space α] {f : α → ℂ} {s : set α} {x : α}

lemma continuous_within_at.cexp (h : continuous_within_at f s x) :
  continuous_within_at (λ y, exp (f y)) s x :=
h.cexp

lemma continuous_at.cexp (h : continuous_at f x) : continuous_at (λ y, exp (f y)) x :=
h.cexp

lemma continuous_on.cexp (h : continuous_on f s) : continuous_on (λ y, exp (f y)) s :=
λ x hx, (h x hx).cexp

lemma continuous.cexp (h : continuous f) : continuous (λ y, exp (f y)) :=
continuous_iff_continuous_at.2 $ λ x, h.continuous_at.cexp

end complex_continuous_exp_comp

namespace real

@[continuity] lemma continuous_exp : continuous exp :=
complex.continuous_re.comp complex.continuous_of_real.cexp

lemma continuous_on_exp {s : set ℝ} : continuous_on exp s :=
continuous_exp.continuous_on

end real

section real_continuous_exp_comp

variable {α : Type*}

open real

lemma filter.tendsto.exp {l : filter α} {f : α → ℝ} {z : ℝ} (hf : tendsto f l (𝓝 z)) :
  tendsto (λ x, exp (f x)) l (𝓝 (exp z)) :=
(continuous_exp.tendsto _).comp hf

variables [topological_space α] {f : α → ℝ} {s : set α} {x : α}

lemma continuous_within_at.exp (h : continuous_within_at f s x) :
  continuous_within_at (λ y, exp (f y)) s x :=
h.exp

lemma continuous_at.exp (h : continuous_at f x) : continuous_at (λ y, exp (f y)) x :=
h.exp

lemma continuous_on.exp (h : continuous_on f s) : continuous_on (λ y, exp (f y)) s :=
λ x hx, (h x hx).exp

lemma continuous.exp (h : continuous f) : continuous (λ y, exp (f y)) :=
continuous_iff_continuous_at.2 $ λ x, h.continuous_at.exp

end real_continuous_exp_comp

namespace real

variables {x y z : ℝ}

/-- The real exponential function tends to `+∞` at `+∞`. -/
lemma tendsto_exp_at_top : tendsto exp at_top at_top :=
begin
  have A : tendsto (λx:ℝ, x + 1) at_top at_top :=
    tendsto_at_top_add_const_right at_top 1 tendsto_id,
  have B : ∀ᶠ x in at_top, x + 1 ≤ exp x :=
    eventually_at_top.2 ⟨0, λx hx, add_one_le_exp x⟩,
  exact tendsto_at_top_mono' at_top B A
end

/-- The real exponential function tends to `0` at `-∞` or, equivalently, `exp(-x)` tends to `0`
at `+∞` -/
lemma tendsto_exp_neg_at_top_nhds_0 : tendsto (λx, exp (-x)) at_top (𝓝 0) :=
(tendsto_inv_at_top_zero.comp tendsto_exp_at_top).congr (λx, (exp_neg x).symm)

/-- The real exponential function tends to `1` at `0`. -/
lemma tendsto_exp_nhds_0_nhds_1 : tendsto exp (𝓝 0) (𝓝 1) :=
by { convert continuous_exp.tendsto 0, simp }

lemma tendsto_exp_at_bot : tendsto exp at_bot (𝓝 0) :=
(tendsto_exp_neg_at_top_nhds_0.comp tendsto_neg_at_bot_at_top).congr $
  λ x, congr_arg exp $ neg_neg x

lemma tendsto_exp_at_bot_nhds_within : tendsto exp at_bot (𝓝[>] 0) :=
tendsto_inf.2 ⟨tendsto_exp_at_bot, tendsto_principal.2 $ eventually_of_forall exp_pos⟩

/-- The function `exp(x)/x^n` tends to `+∞` at `+∞`, for any natural number `n` -/
lemma tendsto_exp_div_pow_at_top (n : ℕ) : tendsto (λx, exp x / x^n) at_top at_top :=
begin
  refine (at_top_basis_Ioi.tendsto_iff (at_top_basis' 1)).2 (λ C hC₁, _),
  have hC₀ : 0 < C, from zero_lt_one.trans_le hC₁,
  have : 0 < (exp 1 * C)⁻¹ := inv_pos.2 (mul_pos (exp_pos _) hC₀),
  obtain ⟨N, hN⟩ : ∃ N, ∀ k ≥ N, (↑k ^ n : ℝ) / exp 1 ^ k < (exp 1 * C)⁻¹ :=
    eventually_at_top.1 ((tendsto_pow_const_div_const_pow_of_one_lt n
      (one_lt_exp_iff.2 zero_lt_one)).eventually (gt_mem_nhds this)),
  simp only [← exp_nat_mul, mul_one, div_lt_iff, exp_pos, ← div_eq_inv_mul] at hN,
  refine ⟨N, trivial, λ x hx, _⟩, rw set.mem_Ioi at hx,
  have hx₀ : 0 < x, from N.cast_nonneg.trans_lt hx,
  rw [set.mem_Ici, le_div_iff (pow_pos hx₀ _), ← le_div_iff' hC₀],
  calc x ^ n ≤ ⌈x⌉₊ ^ n : pow_le_pow_of_le_left hx₀.le (nat.le_ceil _) _
  ... ≤ exp ⌈x⌉₊ / (exp 1 * C) : (hN _ (nat.lt_ceil.2 hx).le).le
  ... ≤ exp (x + 1) / (exp 1 * C) : div_le_div_of_le (mul_pos (exp_pos _) hC₀).le
    (exp_le_exp.2 $ (nat.ceil_lt_add_one hx₀.le).le)
  ... = exp x / C : by rw [add_comm, exp_add, mul_div_mul_left _ _ (exp_pos _).ne']
end

/-- The function `x^n * exp(-x)` tends to `0` at `+∞`, for any natural number `n`. -/
lemma tendsto_pow_mul_exp_neg_at_top_nhds_0 (n : ℕ) : tendsto (λx, x^n * exp (-x)) at_top (𝓝 0) :=
(tendsto_inv_at_top_zero.comp (tendsto_exp_div_pow_at_top n)).congr $ λx,
  by rw [comp_app, inv_eq_one_div, div_div_eq_mul_div, one_mul, div_eq_mul_inv, exp_neg]

/-- The function `(b * exp x + c) / (x ^ n)` tends to `+∞` at `+∞`, for any natural number
`n` and any real numbers `b` and `c` such that `b` is positive. -/
lemma tendsto_mul_exp_add_div_pow_at_top (b c : ℝ) (n : ℕ) (hb : 0 < b) :
  tendsto (λ x, (b * exp x + c) / x ^ n) at_top at_top :=
begin
  rcases n.eq_zero_or_pos with rfl | hn,
  { simp only [pow_zero, div_one],
    exact (tendsto_exp_at_top.const_mul_at_top hb).at_top_add tendsto_const_nhds },
  refine tendsto.congr' (eventually_eq_of_mem (Ioi_mem_at_top 0) _)
    (((tendsto_exp_div_pow_at_top n).const_mul_at_top hb).at_top_add
      ((tendsto_pow_neg_at_top hn).mul (@tendsto_const_nhds _ _ _ c _))),
  intros x hx,
  simp only [zpow_neg₀ x n],
  ring,
end

/-- The function `(x ^ n) / (b * exp x + c)` tends to `0` at `+∞`, for any natural number
`n` and any real numbers `b` and `c` such that `b` is nonzero. -/
lemma tendsto_div_pow_mul_exp_add_at_top (b c : ℝ) (n : ℕ) (hb : 0 ≠ b) :
  tendsto (λ x, x ^ n / (b * exp x + c)) at_top (𝓝 0) :=
begin
  have H : ∀ d e, 0 < d → tendsto (λ (x:ℝ), x^n / (d * (exp x) + e)) at_top (𝓝 0),
  { intros b' c' h,
    convert (tendsto_mul_exp_add_div_pow_at_top b' c' n h).inv_tendsto_at_top ,
    ext x,
    simpa only [pi.inv_apply] using inv_div.symm },
  cases lt_or_gt_of_ne hb,
  { exact H b c h },
  { convert (H (-b) (-c) (neg_pos.mpr h)).neg,
    { ext x,
      field_simp,
      rw [← neg_add (b * exp x) c, neg_div_neg_eq] },
    { exact neg_zero.symm } },
end

/-- `real.exp` as an order isomorphism between `ℝ` and `(0, +∞)`. -/
def exp_order_iso : ℝ ≃o Ioi (0 : ℝ) :=
strict_mono.order_iso_of_surjective _ (exp_strict_mono.cod_restrict exp_pos) $
  (continuous_subtype_mk _ continuous_exp).surjective
    (by simp only [tendsto_Ioi_at_top, subtype.coe_mk, tendsto_exp_at_top])
    (by simp [tendsto_exp_at_bot_nhds_within])

@[simp] lemma coe_exp_order_iso_apply (x : ℝ) : (exp_order_iso x : ℝ) = exp x := rfl

@[simp] lemma coe_comp_exp_order_iso : coe ∘ exp_order_iso = exp := rfl

@[simp] lemma range_exp : range exp = Ioi 0 :=
by rw [← coe_comp_exp_order_iso, range_comp, exp_order_iso.range_eq, image_univ, subtype.range_coe]

@[simp] lemma map_exp_at_top : map exp at_top = at_top :=
by rw [← coe_comp_exp_order_iso, ← filter.map_map, order_iso.map_at_top, map_coe_Ioi_at_top]

@[simp] lemma comap_exp_at_top : comap exp at_top = at_top :=
by rw [← map_exp_at_top, comap_map exp_injective, map_exp_at_top]

@[simp] lemma tendsto_exp_comp_at_top {α : Type*} {l : filter α} {f : α → ℝ} :
  tendsto (λ x, exp (f x)) l at_top ↔ tendsto f l at_top :=
by rw [← tendsto_comap_iff, comap_exp_at_top]

lemma tendsto_comp_exp_at_top {α : Type*} {l : filter α} {f : ℝ → α} :
  tendsto (λ x, f (exp x)) at_top l ↔ tendsto f at_top l :=
by rw [← tendsto_map'_iff, map_exp_at_top]

@[simp] lemma map_exp_at_bot : map exp at_bot = 𝓝[>] 0 :=
by rw [← coe_comp_exp_order_iso, ← filter.map_map, exp_order_iso.map_at_bot, ← map_coe_Ioi_at_bot]

lemma comap_exp_nhds_within_Ioi_zero : comap exp (𝓝[>] 0) = at_bot :=
by rw [← map_exp_at_bot, comap_map exp_injective]

lemma tendsto_comp_exp_at_bot {α : Type*} {l : filter α} {f : ℝ → α} :
  tendsto (λ x, f (exp x)) at_bot l ↔ tendsto f (𝓝[>] 0) l :=
by rw [← map_exp_at_bot, tendsto_map'_iff]

lemma is_o_pow_exp_at_top {n : ℕ} : is_o (λ x, x^n) real.exp at_top :=
by simpa [is_o_iff_tendsto (λ x hx, ((exp_pos x).ne' hx).elim)]
  using tendsto_div_pow_mul_exp_add_at_top 1 0 n zero_ne_one

end real


import game.Completeness.level01
import tactic

/-
# Chapter 6 : Completeness

## Level 2

The supremum, call it x, of a set A is the least upper bound of A.
In lean, we define the supremum as an upper bound of A
and that ∀ y, if y is an upper bound of A, then x ≤ y.

Prove that for all numbers in a set bounded above,
there exists a number between any number and the supremum.

-/

def upper_bound (A : set ℝ) (x : ℝ) := ∀ a ∈ A, a ≤ x
def is_sup (A : set ℝ) (x : ℝ) := upper_bound A x ∧ ∀ y, upper_bound A y → x ≤ y

example {A : set ℝ} {x : ℝ} (hx : is_sup A x) :
∀ y, y < x → ∃ a ∈ A, y < a :=
begin
  intro h,
  contrapose!,
  exact hx.right h,

end


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

! This file was ported from Lean 3 source module algebra.jordan.basic
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Lie.OfAssociative

/-!
# Jordan rings

Let `A` be a non-unital, non-associative ring. Then `A` is said to be a (commutative, linear) Jordan
ring if the multiplication is commutative and satisfies a weak associativity law known as the
Jordan Identity: for all `a` and `b` in `A`,
```
(a * b) * a^2 = a * (b * a^2)
```
i.e. the operators of multiplication by `a` and `a^2` commute.

A more general concept of a (non-commutative) Jordan ring can also be defined, as a
(non-commutative, non-associative) ring `A` where, for each `a` in `A`, the operators of left and
right multiplication by `a` and `a^2` commute.

Every associative algebra can be equipped with a symmetrized multiplication (characterized by
`sym_alg.sym_mul_sym`) making it into a commutative Jordan algebra (`sym_alg.is_comm_jordan`).
Jordan algebras arising this way are said to be special.

A real Jordan algebra `A` can be introduced by
```lean
variables {A : Type*} [non_unital_non_assoc_ring A] [module ℝ A] [smul_comm_class ℝ A A]
  [is_scalar_tower ℝ A A] [is_comm_jordan A]
```

## Main results

- `two_nsmul_lie_lmul_lmul_add_add_eq_zero` : Linearisation of the commutative Jordan axiom

## Implementation notes

We shall primarily be interested in linear Jordan algebras (i.e. over rings of characteristic not
two) leaving quadratic algebras to those better versed in that theory.

The conventional way to linearise the Jordan axiom is to equate coefficients (more formally, assume
that the axiom holds in all field extensions). For simplicity we use brute force algebraic expansion
and substitution instead.

## Motivation

Every Jordan algebra `A` has a triple product defined, for `a` `b` and `c` in `A` by
$$
{a\,b\,c} = (a * b) * c - (a * c) * b + a * (b * c).
$$
Via this triple product Jordan algebras are related to a number of other mathematical structures:
Jordan triples, partial Jordan triples, Jordan pairs and quadratic Jordan algebras. In addition to
their considerable algebraic interest ([mccrimmon2004]) these structures have been shown to have
deep connections to mathematical physics, functional analysis and differential geometry. For more
information about these connections the interested reader is referred to [alfsenshultz2003],
[chu2012], [friedmanscarr2005], [iordanescu2003] and [upmeier1987].

There are also exceptional Jordan algebras which can be shown not to be the symmetrization of any
associative algebra. The 3x3 matrices of octonions is the canonical example.

Non-commutative Jordan algebras have connections to the Vidav-Palmer theorem
[cabreragarciarodriguezpalacios2014].

## References

* [Cabrera García and Rodríguez Palacios, Non-associative normed algebras. Volume 1]
  [cabreragarciarodriguezpalacios2014]
* [Hanche-Olsen and Størmer, Jordan Operator Algebras][hancheolsenstormer1984]
* [McCrimmon, A taste of Jordan algebras][mccrimmon2004]

-/

variable (A : Type _)

/-- A (non-commutative) Jordan multiplication. -/
class IsJordan [Mul A] where
  lmul_comm_rmul : ∀ a b : A, a * b * a = a * (b * a)
  lmul_lmul_comm_lmul : ∀ a b : A, a * a * (a * b) = a * (a * a * b)
  lmul_lmul_comm_rmul : ∀ a b : A, a * a * (b * a) = a * a * b * a
  lmul_comm_rmul_rmul : ∀ a b : A, a * b * (a * a) = a * (b * (a * a))
  rmul_comm_rmul_rmul : ∀ a b : A, b * a * (a * a) = b * (a * a) * a
#align is_jordan IsJordan

/-- A commutative Jordan multipication -/
class IsCommJordan [Mul A] where
  mul_comm : ∀ a b : A, a * b = b * a
  lmul_comm_rmul_rmul : ∀ a b : A, a * b * (a * a) = a * (b * (a * a))
#align is_comm_jordan IsCommJordan

-- see Note [lower instance priority]
/-- A (commutative) Jordan multiplication is also a Jordan multipication -/
instance (priority := 100) IsCommJordan.toIsJordan [Mul A] [IsCommJordan A] : IsJordan A
    where
  lmul_comm_rmul a b := by rw [IsCommJordan.mul_comm, IsCommJordan.mul_comm a b]
  lmul_lmul_comm_lmul a b := by
    rw [IsCommJordan.mul_comm (a * a) (a * b), IsCommJordan.lmul_comm_rmul_rmul,
      IsCommJordan.mul_comm b (a * a)]
  lmul_comm_rmul_rmul := IsCommJordan.lmul_comm_rmul_rmul
  lmul_lmul_comm_rmul a b := by
    rw [IsCommJordan.mul_comm (a * a) (b * a), IsCommJordan.mul_comm b a,
      IsCommJordan.lmul_comm_rmul_rmul, IsCommJordan.mul_comm, IsCommJordan.mul_comm b (a * a)]
  rmul_comm_rmul_rmul a b := by
    rw [IsCommJordan.mul_comm b a, IsCommJordan.lmul_comm_rmul_rmul, IsCommJordan.mul_comm]
#align is_comm_jordan.to_is_jordan IsCommJordan.toIsJordan

-- see Note [lower instance priority]
/-- Semigroup multiplication satisfies the (non-commutative) Jordan axioms-/
instance (priority := 100) Semigroup.isJordan [Semigroup A] : IsJordan A
    where
  lmul_comm_rmul a b := by rw [mul_assoc]
  lmul_lmul_comm_lmul a b := by rw [mul_assoc, mul_assoc]
  lmul_comm_rmul_rmul a b := by rw [mul_assoc]
  lmul_lmul_comm_rmul a b := by rw [← mul_assoc]
  rmul_comm_rmul_rmul a b := by rw [← mul_assoc, ← mul_assoc]
#align semigroup.is_jordan Semigroup.isJordan

-- see Note [lower instance priority]
instance (priority := 100) CommSemigroup.isCommJordan [CommSemigroup A] : IsCommJordan A
    where
  mul_comm := mul_comm
  lmul_comm_rmul_rmul a b := mul_assoc _ _ _
#align comm_semigroup.is_comm_jordan CommSemigroup.isCommJordan

-- mathport name: exprL
local notation "L" => AddMonoid.End.mulLeft

-- mathport name: exprR
local notation "R" => AddMonoid.End.mulRight

/-!
The Jordan axioms can be expressed in terms of commuting multiplication operators.
-/

section Commute

variable {A} [NonUnitalNonAssocRing A] [IsJordan A]

@[simp]
theorem commute_lmul_rmul (a : A) : Commute (L a) (R a) :=
  AddMonoidHom.ext fun b => (IsJordan.lmul_comm_rmul _ _).symm
#align commute_lmul_rmul commute_lmul_rmul

@[simp]
theorem commute_lmul_lmul_sq (a : A) : Commute (L a) (L (a * a)) :=
  AddMonoidHom.ext fun b => (IsJordan.lmul_lmul_comm_lmul _ _).symm
#align commute_lmul_lmul_sq commute_lmul_lmul_sq

@[simp]
theorem commute_lmul_rmul_sq (a : A) : Commute (L a) (R (a * a)) :=
  AddMonoidHom.ext fun b => (IsJordan.lmul_comm_rmul_rmul _ _).symm
#align commute_lmul_rmul_sq commute_lmul_rmul_sq

@[simp]
theorem commute_lmul_sq_rmul (a : A) : Commute (L (a * a)) (R a) :=
  AddMonoidHom.ext fun b => IsJordan.lmul_lmul_comm_rmul _ _
#align commute_lmul_sq_rmul commute_lmul_sq_rmul

@[simp]
theorem commute_rmul_rmul_sq (a : A) : Commute (R a) (R (a * a)) :=
  AddMonoidHom.ext fun b => (IsJordan.rmul_comm_rmul_rmul _ _).symm
#align commute_rmul_rmul_sq commute_rmul_rmul_sq

end Commute

variable {A} [NonUnitalNonAssocRing A] [IsCommJordan A]

/-!
The endomorphisms on an additive monoid `add_monoid.End` form a `ring`, and this may be equipped
with a Lie Bracket via `ring.has_bracket`.
-/

theorem two_nsmul_lie_lmul_lmul_add_eq_lie_lmul_lmul_add (a b : A) :
    2 • (⁅L a, L (a * b)⁆ + ⁅L b, L (b * a)⁆) = ⁅L (a * a), L b⁆ + ⁅L (b * b), L a⁆ :=
  by
  suffices 2 • ⁅L a, L (a * b)⁆ + 2 • ⁅L b, L (b * a)⁆ + ⁅L b, L (a * a)⁆ + ⁅L a, L (b * b)⁆ = 0 by
    rwa [← sub_eq_zero, ← sub_sub, sub_eq_add_neg, sub_eq_add_neg, lie_skew, lie_skew, nsmul_add]
  convert(commute_lmul_lmul_sq (a + b)).lie_eq
  simp only [add_mul, mul_add, map_add, lie_add, add_lie, IsCommJordan.mul_comm b a,
    (commute_lmul_lmul_sq a).lie_eq, (commute_lmul_lmul_sq b).lie_eq]
  abel
#align two_nsmul_lie_lmul_lmul_add_eq_lie_lmul_lmul_add two_nsmul_lie_lmul_lmul_add_eq_lie_lmul_lmul_add

theorem two_nsmul_lie_lmul_lmul_add_add_eq_zero (a b c : A) :
    2 • (⁅L a, L (b * c)⁆ + ⁅L b, L (c * a)⁆ + ⁅L c, L (a * b)⁆) = 0 :=
  by
  symm
  calc
    0 = ⁅L (a + b + c), L ((a + b + c) * (a + b + c))⁆ := by
      rw [(commute_lmul_lmul_sq (a + b + c)).lie_eq]
    _ =
        ⁅L a + L b + L c,
          L (a * a) + L (a * b) + L (a * c) + (L (b * a) + L (b * b) + L (b * c)) +
            (L (c * a) + L (c * b) + L (c * c))⁆ :=
      by
      rw [add_mul, add_mul, mul_add, mul_add, mul_add, mul_add, mul_add, mul_add, map_add, map_add,
        map_add, map_add, map_add, map_add, map_add, map_add, map_add, map_add]
    _ =
        ⁅L a + L b + L c,
          L (a * a) + L (a * b) + L (c * a) + (L (a * b) + L (b * b) + L (b * c)) +
            (L (c * a) + L (b * c) + L (c * c))⁆ :=
      by rw [IsCommJordan.mul_comm b a, IsCommJordan.mul_comm c a, IsCommJordan.mul_comm c b]
    _ =
        ⁅L a + L b + L c,
          L (a * a) + L (b * b) + L (c * c) + 2 • L (a * b) + 2 • L (c * a) + 2 • L (b * c)⁆ :=
      by
      rw [two_smul, two_smul, two_smul]
      simp only [lie_add, add_lie, commute_lmul_lmul_sq, zero_add, add_zero]
      abel
    _ =
        ⁅L a, L (a * a)⁆ + ⁅L a, L (b * b)⁆ + ⁅L a, L (c * c)⁆ + ⁅L a, 2 • L (a * b)⁆ +
                ⁅L a, 2 • L (c * a)⁆ +
              ⁅L a, 2 • L (b * c)⁆ +
            (⁅L b, L (a * a)⁆ + ⁅L b, L (b * b)⁆ + ⁅L b, L (c * c)⁆ + ⁅L b, 2 • L (a * b)⁆ +
                ⁅L b, 2 • L (c * a)⁆ +
              ⁅L b, 2 • L (b * c)⁆) +
          (⁅L c, L (a * a)⁆ + ⁅L c, L (b * b)⁆ + ⁅L c, L (c * c)⁆ + ⁅L c, 2 • L (a * b)⁆ +
              ⁅L c, 2 • L (c * a)⁆ +
            ⁅L c, 2 • L (b * c)⁆) :=
      by
      rw [add_lie, add_lie, lie_add, lie_add, lie_add, lie_add, lie_add, lie_add, lie_add, lie_add,
        lie_add, lie_add, lie_add, lie_add, lie_add, lie_add, lie_add]
    _ =
        ⁅L a, L (b * b)⁆ + ⁅L a, L (c * c)⁆ + ⁅L a, 2 • L (a * b)⁆ + ⁅L a, 2 • L (c * a)⁆ +
              ⁅L a, 2 • L (b * c)⁆ +
            (⁅L b, L (a * a)⁆ + ⁅L b, L (c * c)⁆ + ⁅L b, 2 • L (a * b)⁆ + ⁅L b, 2 • L (c * a)⁆ +
              ⁅L b, 2 • L (b * c)⁆) +
          (⁅L c, L (a * a)⁆ + ⁅L c, L (b * b)⁆ + ⁅L c, 2 • L (a * b)⁆ + ⁅L c, 2 • L (c * a)⁆ +
            ⁅L c, 2 • L (b * c)⁆) :=
      by
      rw [(commute_lmul_lmul_sq a).lie_eq, (commute_lmul_lmul_sq b).lie_eq,
        (commute_lmul_lmul_sq c).lie_eq, zero_add, add_zero, add_zero]
    _ =
        ⁅L a, L (b * b)⁆ + ⁅L a, L (c * c)⁆ + 2 • ⁅L a, L (a * b)⁆ + 2 • ⁅L a, L (c * a)⁆ +
              2 • ⁅L a, L (b * c)⁆ +
            (⁅L b, L (a * a)⁆ + ⁅L b, L (c * c)⁆ + 2 • ⁅L b, L (a * b)⁆ + 2 • ⁅L b, L (c * a)⁆ +
              2 • ⁅L b, L (b * c)⁆) +
          (⁅L c, L (a * a)⁆ + ⁅L c, L (b * b)⁆ + 2 • ⁅L c, L (a * b)⁆ + 2 • ⁅L c, L (c * a)⁆ +
            2 • ⁅L c, L (b * c)⁆) :=
      by simp only [lie_nsmul]
    _ =
        ⁅L a, L (b * b)⁆ + ⁅L b, L (a * a)⁆ + 2 • (⁅L a, L (a * b)⁆ + ⁅L b, L (a * b)⁆) +
              (⁅L a, L (c * c)⁆ + ⁅L c, L (a * a)⁆ + 2 • (⁅L a, L (c * a)⁆ + ⁅L c, L (c * a)⁆)) +
            (⁅L b, L (c * c)⁆ + ⁅L c, L (b * b)⁆ + 2 • (⁅L b, L (b * c)⁆ + ⁅L c, L (b * c)⁆)) +
          (2 • ⁅L a, L (b * c)⁆ + 2 • ⁅L b, L (c * a)⁆ + 2 • ⁅L c, L (a * b)⁆) :=
      by abel
    _ = 2 • ⁅L a, L (b * c)⁆ + 2 • ⁅L b, L (c * a)⁆ + 2 • ⁅L c, L (a * b)⁆ :=
      by
      rw [add_left_eq_self]
      nth_rw 2 [IsCommJordan.mul_comm a b]
      nth_rw 1 [IsCommJordan.mul_comm c a]
      nth_rw 2 [IsCommJordan.mul_comm b c]
      rw [two_nsmul_lie_lmul_lmul_add_eq_lie_lmul_lmul_add,
        two_nsmul_lie_lmul_lmul_add_eq_lie_lmul_lmul_add,
        two_nsmul_lie_lmul_lmul_add_eq_lie_lmul_lmul_add, ← lie_skew (L (a * a)), ←
        lie_skew (L (b * b)), ← lie_skew (L (c * c)), ← lie_skew (L (a * a)), ←
        lie_skew (L (b * b)), ← lie_skew (L (c * c))]
      abel
    _ = 2 • (⁅L a, L (b * c)⁆ + ⁅L b, L (c * a)⁆ + ⁅L c, L (a * b)⁆) := by rw [nsmul_add, nsmul_add]

#align two_nsmul_lie_lmul_lmul_add_add_eq_zero two_nsmul_lie_lmul_lmul_add_add_eq_zero


/-
Copyright (c) 2019 Neil Strickland. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Neil Strickland
-/

import algebra.group_with_zero.power
import algebra.big_operators.order
import algebra.big_operators.ring
import algebra.big_operators.intervals
import tactic.abel
import data.nat.parity

/-!
# Partial sums of geometric series

This file determines the values of the geometric series $\sum_{i=0}^{n-1} x^i$ and
$\sum_{i=0}^{n-1} x^i y^{n-1-i}$ and variants thereof. We also provide some bounds on the
"geometric" sum of `a/b^i` where `a b : ℕ`.

## Main statements

* `geom_sum_Ico` proves that $\sum_{i=m}^{n-1} x^i=\frac{x^n-x^m}{x-1}$ in a division ring.
* `geom_sum₂_Ico` proves that $\sum_{i=m}^{n-1} x^i=\frac{x^n-y^{n-m}x^m}{x-y}$ in a field.

Several variants are recorded, generalising in particular to the case of a noncommutative ring in
which `x` and `y` commute. Even versions not using division or subtraction, valid in each semiring,
are recorded.
-/

universe u
variable {α : Type u}

open finset mul_opposite

open_locale big_operators

section semiring
variable [semiring α]

lemma geom_sum_succ {x : α} {n : ℕ} :
  ∑ i in range (n + 1), x ^ i = x * ∑ i in range n, x ^ i + 1 :=
by simp only [mul_sum, ←pow_succ, sum_range_succ', pow_zero]

lemma geom_sum_succ' {x : α} {n : ℕ} :
  ∑ i in range (n + 1), x ^ i = x ^ n + ∑ i in range n, x ^ i :=
(sum_range_succ _ _).trans (add_comm _ _)

theorem geom_sum_zero (x : α) :
  ∑ i in range 0, x ^ i = 0 := rfl

theorem geom_sum_one (x : α) :
  ∑ i in range 1, x ^ i = 1 :=
by simp [geom_sum_succ']

@[simp] lemma geom_sum_two {x : α} : ∑ i in range 2, x ^ i = x + 1 :=
by simp [geom_sum_succ']

@[simp] lemma zero_geom_sum : ∀ {n}, ∑ i in range n, (0 : α) ^ i = if n = 0 then 0 else 1
| 0     := by simp
| 1     := by simp
| (n+2) := by { rw geom_sum_succ', simp [zero_geom_sum] }

lemma one_geom_sum (n : ℕ) : ∑ i in range n, (1 : α) ^ i = n :=
by simp

@[simp] lemma op_geom_sum (x : α) (n : ℕ) :
  op (∑ i in range n, x ^ i) = ∑ i in range n, (op x) ^ i :=
by simp

@[simp] lemma op_geom_sum₂ (x y : α) (n : ℕ) :
  op (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) =
    ∑ i in range n, (op y) ^ i * ((op x) ^ (n - 1 - i)) :=
begin
  simp only [op_sum, op_mul, op_pow],
  rw ← sum_range_reflect,
  refine sum_congr rfl (λ j j_in, _),
  rw [mem_range, nat.lt_iff_add_one_le] at j_in,
  congr,
  apply tsub_tsub_cancel_of_le,
  exact le_tsub_of_add_le_right j_in
end

theorem geom_sum₂_with_one (x : α) (n : ℕ) :
  ∑ i in range n, x ^ i * (1 ^ (n - 1 - i)) = ∑ i in range n, x ^ i :=
sum_congr rfl (λ i _, by { rw [one_pow, mul_one] })

/-- $x^n-y^n = (x-y) \sum x^ky^{n-1-k}$ reformulated without `-` signs. -/
protected theorem commute.geom_sum₂_mul_add {x y : α} (h : commute x y) (n : ℕ) :
  (∑ i in range n, (x + y) ^ i * (y ^ (n - 1 - i))) * x + y ^ n = (x + y) ^ n :=
begin
  let f := λ (m i : ℕ), (x + y) ^ i * y ^ (m - 1 - i),
  change (∑ i in range n, (f n) i) * x + y ^ n = (x + y) ^ n,
  induction n with n ih,
  { rw [range_zero, sum_empty, zero_mul, zero_add, pow_zero, pow_zero] },
  { have f_last : f (n + 1) n = (x + y) ^ n :=
     by { dsimp [f],
          rw [← tsub_add_eq_tsub_tsub, nat.add_comm, tsub_self, pow_zero, mul_one] },
    have f_succ : ∀ i, i ∈ range n → f (n + 1) i = y * f n i :=
      λ i hi, by
      { dsimp [f],
        have : commute y ((x + y) ^ i) :=
         (h.symm.add_right (commute.refl y)).pow_right i,
        rw [← mul_assoc, this.eq, mul_assoc, ← pow_succ y (n - 1 - i)],
        congr' 2,
        rw [add_tsub_cancel_right, ← tsub_add_eq_tsub_tsub, add_comm 1 i],
        have : i + 1 + (n - (i + 1)) = n := add_tsub_cancel_of_le (mem_range.mp hi),
        rw [add_comm (i + 1)] at this,
        rw [← this, add_tsub_cancel_right, add_comm i 1, ← add_assoc,
            add_tsub_cancel_right] },
    rw [pow_succ (x + y), add_mul, sum_range_succ_comm, add_mul, f_last, add_assoc],
    rw (((commute.refl x).add_right h).pow_right n).eq,
    congr' 1,
    rw [sum_congr rfl f_succ, ← mul_sum, pow_succ y, mul_assoc, ← mul_add y, ih] }
end

end semiring

@[simp] lemma neg_one_geom_sum [ring α] {n : ℕ} :
  ∑ i in range n, (-1 : α) ^ i = if even n then 0 else 1 :=
begin
  induction n with k hk,
  { simp },
  { simp only [geom_sum_succ', nat.even_succ, hk],
    split_ifs,
    { rw [h.neg_one_pow, add_zero] },
    { rw [(nat.odd_iff_not_even.2 h).neg_one_pow, neg_add_self] } }
end

theorem geom_sum₂_self {α : Type*} [comm_ring α] (x : α) (n : ℕ) :
  ∑ i in range n, x ^ i * (x ^ (n - 1 - i)) = n * x ^ (n-1) :=
calc  ∑ i in finset.range n, x ^ i * x ^ (n - 1 - i)
    = ∑ i in finset.range n, x ^ (i + (n - 1 - i)) : by simp_rw [← pow_add]
... = ∑ i in finset.range n, x ^ (n - 1) : finset.sum_congr rfl
  (λ i hi, congr_arg _ $ add_tsub_cancel_of_le $ nat.le_pred_of_lt $ finset.mem_range.1 hi)
... = (finset.range n).card • (x ^ (n - 1)) : finset.sum_const _
... = n * x ^ (n - 1) : by rw [finset.card_range, nsmul_eq_mul]

/-- $x^n-y^n = (x-y) \sum x^ky^{n-1-k}$ reformulated without `-` signs. -/
theorem geom_sum₂_mul_add [comm_semiring α] (x y : α) (n : ℕ) :
  (∑ i in range n, (x + y) ^ i * (y ^ (n - 1 - i))) * x + y ^ n = (x + y) ^ n :=
(commute.all x y).geom_sum₂_mul_add n

theorem geom_sum_mul_add [semiring α] (x : α) (n : ℕ) :
  (∑ i in range n, (x + 1) ^ i) * x + 1 = (x + 1) ^ n :=
begin
  have := (commute.one_right x).geom_sum₂_mul_add n,
  rw [one_pow, geom_sum₂_with_one] at this,
  exact this
end

protected theorem commute.geom_sum₂_mul [ring α] {x y : α} (h : commute x y) (n : ℕ) :
  (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) * (x - y) = x ^ n - y ^ n :=
begin
  have := (h.sub_left (commute.refl y)).geom_sum₂_mul_add n,
  rw [sub_add_cancel] at this,
  rw [← this, add_sub_cancel]
end

lemma commute.mul_neg_geom_sum₂ [ring α] {x y : α} (h : commute x y) (n : ℕ) :
  (y - x) * (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) = y ^ n - x ^ n :=
begin
  apply op_injective,
  simp only [op_mul, op_sub, op_geom_sum₂, op_pow],
  exact (commute.op h.symm).geom_sum₂_mul n
end

lemma commute.mul_geom_sum₂ [ring α] {x y : α} (h : commute x y) (n : ℕ) :
  (x - y) * (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) = x ^ n - y ^ n :=
by rw [← neg_sub (y ^ n), ← h.mul_neg_geom_sum₂, ← neg_mul, neg_sub]

theorem geom_sum₂_mul [comm_ring α] (x y : α) (n : ℕ) :
  (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) * (x - y) = x ^ n - y ^ n :=
(commute.all x y).geom_sum₂_mul n

theorem geom_sum_mul [ring α] (x : α) (n : ℕ) :
  (∑ i in range n, x ^ i) * (x - 1) = x ^ n - 1 :=
begin
  have := (commute.one_right x).geom_sum₂_mul n,
  rw [one_pow, geom_sum₂_with_one] at this,
  exact this
end

lemma mul_geom_sum [ring α] (x : α) (n : ℕ) :
  (x - 1) * (∑ i in range n, x ^ i) = x ^ n - 1 :=
op_injective $ by simpa using geom_sum_mul (op x) n

theorem geom_sum_mul_neg [ring α] (x : α) (n : ℕ) :
  (∑ i in range n, x ^ i) * (1 - x) = 1 - x ^ n :=
begin
  have := congr_arg has_neg.neg (geom_sum_mul x n),
  rw [neg_sub, ← mul_neg, neg_sub] at this,
  exact this
end

lemma mul_neg_geom_sum [ring α] (x : α) (n : ℕ) :
  (1 - x) * (∑ i in range n, x ^ i) = 1 - x ^ n :=
op_injective $ by simpa using geom_sum_mul_neg (op x) n

protected theorem commute.geom_sum₂ [division_ring α] {x y : α} (h' : commute x y) (h : x ≠ y)
  (n : ℕ) : (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) = (x ^ n - y ^ n) / (x - y) :=
have x - y ≠ 0, by simp [*, -sub_eq_add_neg, sub_eq_iff_eq_add] at *,
by rw [← h'.geom_sum₂_mul, mul_div_cancel _ this]

theorem geom₂_sum [field α] {x y : α} (h : x ≠ y) (n : ℕ) :
  (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) = (x ^ n - y ^ n) / (x - y) :=
(commute.all x y).geom_sum₂ h n

theorem geom_sum_eq [division_ring α] {x : α} (h : x ≠ 1) (n : ℕ) :
  (∑ i in range n, x ^ i) = (x ^ n - 1) / (x - 1) :=
have x - 1 ≠ 0, by simp [*, -sub_eq_add_neg, sub_eq_iff_eq_add] at *,
by rw [← geom_sum_mul, mul_div_cancel _ this]

protected theorem commute.mul_geom_sum₂_Ico [ring α] {x y : α} (h : commute x y) {m n : ℕ}
  (hmn : m ≤ n) :
  (x - y) * (∑ i in finset.Ico m n, x ^ i * y ^ (n - 1 - i)) = x ^ n - x ^ m * y ^ (n - m) :=
begin
  rw [sum_Ico_eq_sub _ hmn],
  have : ∑ k in range m, x ^ k * y ^ (n - 1 - k)
    = ∑ k in range m, x ^ k * (y ^ (n - m) * y ^ (m - 1 - k)),
  { refine sum_congr rfl (λ j j_in, _),
    rw ← pow_add,
    congr,
    rw [mem_range, nat.lt_iff_add_one_le, add_comm] at j_in,
    have h' : n - m + (m - (1 + j)) = n - (1 + j) := tsub_add_tsub_cancel hmn j_in,
    rw [← tsub_add_eq_tsub_tsub m, h', ← tsub_add_eq_tsub_tsub] },
  rw this,
  simp_rw pow_mul_comm y (n-m) _,
  simp_rw ← mul_assoc,
  rw [← sum_mul, mul_sub, h.mul_geom_sum₂, ← mul_assoc,
    h.mul_geom_sum₂, sub_mul, ← pow_add, add_tsub_cancel_of_le hmn,
    sub_sub_sub_cancel_right (x ^ n) (x ^ m * y ^ (n - m)) (y ^ n)],
end

protected theorem commute.geom_sum₂_succ_eq {α : Type u} [ring α] {x y : α}
  (h : commute x y) {n : ℕ} :
  ∑ i in range (n + 1), x ^ i * (y ^ (n - i)) =
    x ^ n + y * (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) :=
begin
  simp_rw [mul_sum, sum_range_succ_comm, tsub_self, pow_zero, mul_one, add_right_inj, ←mul_assoc,
    (h.symm.pow_right _).eq, mul_assoc, ←pow_succ],
  refine sum_congr rfl (λ i hi, _),
  suffices : n - 1 - i + 1 = n - i, { rw this },
  cases n,
  { exact absurd (list.mem_range.mp hi) i.not_lt_zero },
  { rw [tsub_add_eq_add_tsub (nat.le_pred_of_lt (list.mem_range.mp hi)),
        tsub_add_cancel_of_le (nat.succ_le_iff.mpr n.succ_pos)] },
end

theorem geom_sum₂_succ_eq {α : Type u} [comm_ring α] (x y : α)  {n : ℕ} :
  ∑ i in range (n + 1), x ^ i * (y ^ (n - i)) =
    x ^ n + y * (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) :=
(commute.all x y).geom_sum₂_succ_eq

theorem mul_geom_sum₂_Ico [comm_ring α] (x y : α) {m n : ℕ} (hmn : m ≤ n) :
  (x - y) * (∑ i in finset.Ico m n, x ^ i * y ^ (n - 1 - i)) = x ^ n - x ^ m * y ^ (n - m) :=
(commute.all x y).mul_geom_sum₂_Ico hmn

protected theorem commute.geom_sum₂_Ico_mul [ring α] {x y : α} (h : commute x y) {m n : ℕ}
  (hmn : m ≤ n) :
  (∑ i in finset.Ico m n, x ^ i * y ^ (n - 1 - i)) * (x - y) = x ^ n -  y ^ (n - m) * x ^ m :=
begin
  apply op_injective,
  simp only [op_sub, op_mul, op_pow, op_sum],
  have : ∑ k in Ico m n, op y ^ (n - 1 - k) * op x ^ k
    = ∑ k in Ico m n, op x ^ k * op y ^ (n - 1 - k),
  { refine sum_congr rfl (λ k k_in, _),
    apply commute.pow_pow (commute.op h.symm) },
  rw this,
  exact (commute.op h).mul_geom_sum₂_Ico hmn
end

theorem geom_sum_Ico_mul [ring α] (x : α) {m n : ℕ} (hmn : m ≤ n) :
  (∑ i in finset.Ico m n, x ^ i) * (x - 1) = x^n - x^m :=
by rw [sum_Ico_eq_sub _ hmn, sub_mul,
  geom_sum_mul, geom_sum_mul, sub_sub_sub_cancel_right]

theorem geom_sum_Ico_mul_neg [ring α] (x : α) {m n : ℕ} (hmn : m ≤ n) :
  (∑ i in finset.Ico m n, x ^ i) * (1 - x) = x^m - x^n :=
by rw [sum_Ico_eq_sub _ hmn, sub_mul,
  geom_sum_mul_neg, geom_sum_mul_neg, sub_sub_sub_cancel_left]

protected theorem commute.geom_sum₂_Ico [division_ring α] {x y : α} (h : commute x y) (hxy : x ≠ y)
  {m n : ℕ} (hmn : m ≤ n) :
  ∑ i in finset.Ico m n, x ^ i * y ^ (n - 1 - i) = (x ^ n - y ^ (n - m) * x ^ m ) / (x - y) :=
have x - y ≠ 0, by simp [*, -sub_eq_add_neg, sub_eq_iff_eq_add] at *,
by rw [← h.geom_sum₂_Ico_mul hmn, mul_div_cancel _ this]

theorem geom_sum₂_Ico [field α] {x y : α} (hxy : x ≠ y) {m n : ℕ} (hmn : m ≤ n) :
  ∑ i in finset.Ico m n, x ^ i * y ^ (n - 1 - i) = (x ^ n - y ^ (n - m) * x ^ m ) / (x - y) :=
(commute.all x y).geom_sum₂_Ico hxy hmn

theorem geom_sum_Ico [division_ring α] {x : α} (hx : x ≠ 1) {m n : ℕ} (hmn : m ≤ n) :
  ∑ i in finset.Ico m n, x ^ i = (x ^ n - x ^ m) / (x - 1) :=
by simp only [sum_Ico_eq_sub _ hmn, geom_sum_eq hx, div_sub_div_same,
  sub_sub_sub_cancel_right]

theorem geom_sum_Ico' [division_ring α] {x : α} (hx : x ≠ 1) {m n : ℕ} (hmn : m ≤ n) :
  ∑ i in finset.Ico m n, x ^ i = (x ^ m - x ^ n) / (1 - x) :=
by { simp only [geom_sum_Ico hx hmn], convert neg_div_neg_eq (x^m - x^n) (1-x); abel }

lemma geom_sum_Ico_le_of_lt_one [linear_ordered_field α]
  {x : α} (hx : 0 ≤ x) (h'x : x < 1) {m n : ℕ} :
  ∑ i in Ico m n, x ^ i ≤ x ^ m / (1 - x) :=
begin
  rcases le_or_lt m n with hmn | hmn,
  { rw geom_sum_Ico' h'x.ne hmn,
    apply div_le_div (pow_nonneg hx _) _ (sub_pos.2 h'x) le_rfl,
    simpa using pow_nonneg hx _ },
  { rw [Ico_eq_empty, sum_empty],
    { apply div_nonneg (pow_nonneg hx _),
      simpa using h'x.le },
    { simpa using hmn.le } },
end

lemma geom_sum_inv [division_ring α] {x : α} (hx1 : x ≠ 1) (hx0 : x ≠ 0) (n : ℕ) :
  (∑ i in range n, x⁻¹ ^ i) = (x - 1)⁻¹ * (x - x⁻¹ ^ n * x) :=
have h₁ : x⁻¹ ≠ 1, by rwa [inv_eq_one_div, ne.def, div_eq_iff_mul_eq hx0, one_mul],
have h₂ : x⁻¹ - 1 ≠ 0, from mt sub_eq_zero.1 h₁,
have h₃ : x - 1 ≠ 0, from mt sub_eq_zero.1 hx1,
have h₄ : x * (x ^ n)⁻¹ = (x ^ n)⁻¹ * x :=
  nat.rec_on n (by simp)
  (λ n h, by rw [pow_succ, mul_inv_rev, ←mul_assoc, h, mul_assoc, mul_inv_cancel hx0, mul_assoc,
    inv_mul_cancel hx0]),
begin
  rw [geom_sum_eq h₁, div_eq_iff_mul_eq h₂, ← mul_right_inj' h₃,
    ← mul_assoc, ← mul_assoc, mul_inv_cancel h₃],
  simp [mul_add, add_mul, mul_inv_cancel hx0, mul_assoc, h₄, sub_eq_add_neg, add_comm,
    add_left_comm],
end

variables {β : Type*}

theorem ring_hom.map_geom_sum [semiring α] [semiring β] (x : α) (n : ℕ) (f : α →+* β) :
  f (∑ i in range n, x ^ i) = ∑ i in range n, (f x) ^ i :=
by simp [f.map_sum]

theorem ring_hom.map_geom_sum₂ [semiring α] [semiring β] (x y : α) (n : ℕ) (f : α →+* β) :
  f (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) =
    ∑ i in range n, (f x) ^ i * ((f y) ^ (n - 1 - i)) :=
by simp [f.map_sum]

/-! ### Geometric sum with `ℕ`-division -/

lemma nat.pred_mul_geom_sum_le (a b n : ℕ) :
  (b - 1) * ∑ i in range n.succ, a/b^i ≤ a * b - a/b^n :=
calc
  (b - 1) * (∑ i in range n.succ, a/b^i)
      = ∑ i in range n, a/b^(i + 1) * b + a * b
        - (∑ i in range n, a/b^i + a/b^n)
      : by rw [tsub_mul, mul_comm, sum_mul, one_mul, sum_range_succ',
          sum_range_succ, pow_zero, nat.div_one]
  ... ≤ ∑ i in range n, a/b^i + a * b - (∑ i in range n, a/b^i + a/b^n)
      : begin
        refine tsub_le_tsub_right (add_le_add_right (sum_le_sum $ λ i _, _) _) _,
        rw [pow_succ', ←nat.div_div_eq_div_mul],
        exact nat.div_mul_le_self _ _,
      end
  ... = a * b - a/b^n : add_tsub_add_eq_tsub_left _ _ _

lemma nat.geom_sum_le {b : ℕ} (hb : 2 ≤ b) (a n : ℕ) :
  ∑ i in range n, a/b^i ≤ a * b/(b - 1) :=
begin
  refine (nat.le_div_iff_mul_le $ tsub_pos_of_lt hb).2 _,
  cases n,
  { rw [sum_range_zero, zero_mul],
    exact nat.zero_le _ },
  rw mul_comm,
  exact (nat.pred_mul_geom_sum_le a b n).trans tsub_le_self,
end

lemma nat.geom_sum_Ico_le {b : ℕ} (hb : 2 ≤ b) (a n : ℕ) :
  ∑ i in Ico 1 n, a/b^i ≤ a/(b - 1) :=
begin
  cases n,
  { rw [Ico_eq_empty_of_le (zero_le_one' ℕ), sum_empty],
    exact nat.zero_le _ },
  rw ←add_le_add_iff_left a,
  calc
    a + ∑ (i : ℕ) in Ico 1 n.succ, a/b^i
        = a/b^0 + ∑ (i : ℕ) in Ico 1 n.succ, a/b^i : by rw [pow_zero, nat.div_one]
    ... = ∑ i in range n.succ, a/b^i : begin
          rw [range_eq_Ico, ←nat.Ico_insert_succ_left (nat.succ_pos _), sum_insert],
          exact λ h, zero_lt_one.not_le (mem_Ico.1 h).1,
        end
    ... ≤ a * b/(b - 1) : nat.geom_sum_le hb a _
    ... = (a * 1 + a * (b - 1))/(b - 1)
        : by rw [←mul_add, add_tsub_cancel_of_le (one_le_two.trans hb)]
    ... = a + a/(b - 1)
        : by rw [mul_one, nat.add_mul_div_right _ _ (tsub_pos_of_lt hb), add_comm]
end

section order

variables {n : ℕ} {x : α}

lemma geom_sum_pos [ordered_semiring α] (hx : 0 < x) (hn : n ≠ 0) : 0 < ∑ i in range n, x ^ i :=
begin
  refine nat.le_induction _ _ _ (show 1 ≤ n, from hn.bot_lt),
  { simp [@@zero_lt_one _ (nontrivial_of_lt _ _ hx)] },
  intros k hk,
  rw [geom_sum_succ'],
  apply add_pos (pow_pos hx _)
end

lemma geom_sum_pos_and_lt_one [ordered_ring α] (hx : x < 0) (hx' : 0 < x + 1) (hn : 1 < n) :
  0 < ∑ i in range n, x ^ i ∧ ∑ i in range n, x ^ i < 1 :=
begin
  refine nat.le_induction _ _ n (show 2 ≤ n, from hn),
  { rw geom_sum_two,
    exact ⟨hx', (add_lt_iff_neg_right _).2 hx⟩ },
  clear hn n,
  intros n hn ihn,
  rw [geom_sum_succ, add_lt_iff_neg_right, ← neg_lt_iff_pos_add', neg_mul_eq_neg_mul],
  exact ⟨mul_lt_one_of_nonneg_of_lt_one_left (neg_nonneg.2 hx.le)
    (neg_lt_iff_pos_add'.2 hx') ihn.2.le, mul_neg_of_neg_of_pos hx ihn.1⟩
end

lemma geom_sum_alternating_of_lt_neg_one [ordered_ring α] (hx : x + 1 < 0) (hn : 1 < n) :
  if even n then ∑ i in range n, x ^ i < 0 else 1 < ∑ i in range n, x ^ i  :=
begin
  have hx0 : x < 0, from ((le_add_iff_nonneg_right _).2 zero_le_one).trans_lt hx,
  refine nat.le_induction _ _ n (show 2 ≤ n, from hn),
  { simp only [geom_sum_two, hx, true_or, even_bit0, if_true_left_eq_or] },
  clear hn n,
  intros n hn ihn,
  simp only [nat.even_succ, geom_sum_succ],
  by_cases hn' : even n,
  { rw [if_pos hn'] at ihn, rw [if_neg, lt_add_iff_pos_left],
    exact mul_pos_of_neg_of_neg hx0 ihn, exact not_not_intro hn', },
  { rw [if_neg hn'] at ihn, rw [if_pos], swap, { exact hn' },
    have := add_lt_add_right (mul_lt_mul_of_neg_left ihn hx0) 1,
    rw mul_one at this,
    exact this.trans hx }
end

lemma odd.geom_sum_pos [linear_ordered_ring α] (h : odd n) :
  0 < ∑ i in range n, x ^ i :=
begin
  rcases n with (_ | _ | k),
  { exact ((show ¬ odd 0, from dec_trivial) h).elim },
  { simp only [geom_sum_one, zero_lt_one] },
  rw nat.odd_iff_not_even at h,
  rcases lt_trichotomy (x + 1) 0 with hx | hx | hx,
  { have := geom_sum_alternating_of_lt_neg_one hx k.one_lt_succ_succ,
    simp only [h, if_false] at this,
    exact zero_lt_one.trans this },
  { simp only [eq_neg_of_add_eq_zero_left hx, h, neg_one_geom_sum, if_false, zero_lt_one] },
  rcases lt_trichotomy x 0 with hx' | rfl | hx',
  { exact (geom_sum_pos_and_lt_one hx' hx k.one_lt_succ_succ).1 },
  { simp only [zero_geom_sum, nat.succ_ne_zero, if_false, zero_lt_one] },
  { exact geom_sum_pos hx' (by simp only [nat.succ_ne_zero, ne.def, not_false_iff]) }
end

lemma geom_sum_pos_iff [linear_ordered_ring α] (hn : 1 < n) :
  0 < ∑ i in range n, x ^ i ↔ odd n ∨ 0 < x + 1 :=
begin
  refine ⟨λ h, _, _⟩,
  { suffices : ¬ 0 < x + 1 → odd n, by tauto,
    intro hx,
    rw not_lt at hx,
    contrapose! h,
    rw [←nat.even_iff_not_odd] at h,
    rcases hx.eq_or_lt with hx | hx,
    { rw [←neg_neg (1 : α), add_neg_eq_iff_eq_add, zero_add] at hx,
      simp only [hx, neg_one_geom_sum, h, if_true] },
    apply le_of_lt,
    simpa [h] using geom_sum_alternating_of_lt_neg_one hx hn },
  { rintro (hn | hx'),
    { exact hn.geom_sum_pos },
    rcases lt_trichotomy x 0 with hx | rfl | hx,
    { exact (geom_sum_pos_and_lt_one hx hx' hn).1 },
    { simp only [(zero_lt_one.trans hn).ne', zero_geom_sum, if_false, zero_lt_one] },
    { exact geom_sum_pos hx (zero_lt_one.trans hn).ne' } }
end

lemma geom_sum_eq_zero_iff_neg_one [linear_ordered_ring α] (hn : 1 < n) :
  ∑ i in range n, x ^ i = 0 ↔ x = -1 ∧ even n :=
begin
  refine ⟨λ h, _, λ ⟨h, hn⟩, by simp only [h, hn, neg_one_geom_sum, if_true]⟩,
  contrapose! h,
  rcases eq_or_ne x (-1) with rfl | h,
  { simp only [h rfl, neg_one_geom_sum, if_false, ne.def, not_false_iff, one_ne_zero] },
  rw [ne.def, eq_neg_iff_add_eq_zero, ←ne.def] at h,
  rcases h.lt_or_lt with h | h,
  { have := geom_sum_alternating_of_lt_neg_one h hn,
    split_ifs at this,
    { exact this.ne },
    { exact (zero_lt_one.trans this).ne' } },
  apply ne_of_gt,
  rcases lt_trichotomy x 0 with h' | rfl | h',
  { exact (geom_sum_pos_and_lt_one h' h hn).1 },
  { simp only [(pos_of_gt hn).ne', zero_geom_sum, if_false, zero_lt_one] },
  { exact geom_sum_pos h' (pos_of_gt hn).ne' }
end

lemma geom_sum_neg_iff [linear_ordered_ring α] (hn : 1 < n) :
  ∑ i in range n, x ^ i < 0 ↔ even n ∧ x + 1 < 0 :=
by rw [← not_iff_not, not_lt, le_iff_lt_or_eq, eq_comm,
       or_congr (geom_sum_pos_iff hn) (geom_sum_eq_zero_iff_neg_one hn), nat.odd_iff_not_even,
       ← add_eq_zero_iff_eq_neg, not_and, not_lt, le_iff_lt_or_eq, eq_comm,
       ← imp_iff_not_or, or_comm, and_comm, decidable.and_or_imp, or_comm]

end order


import data.int.basic data.pi.algebra

/-! # IMO 2015 A2 -/

namespace IMOSL
namespace IMO2015A2

def fn_eq (f : ℤ → ℤ) := ∀ x y : ℤ, f (x - f y) = f (f x) - f y - 1

namespace extra

/-- Deduce linearity from f(x + 1) - f(x) being constant -/
lemma fn_linear_diff {f : ℤ → ℤ} {c : ℤ} (h : ∀ x : ℤ, f (x + 1) = f x + c) :
  ∀ x : ℤ, f x = c * x + f 0 :=
begin
  suffices : ∀ (x : ℤ) (n : ℕ), f (x + ↑n) = f x + c * ↑n,
  { intros x,
    rcases int.eq_coe_or_neg x with ⟨n, rfl | rfl⟩,
    rw [add_comm, ← this, zero_add],
    rw [add_comm, mul_neg, eq_add_neg_iff_add_eq, ← this, neg_add_self] },
  intros x n,
  induction n with n n_ih,
  rw [int.coe_nat_zero, mul_zero, add_zero, add_zero],
  rw [int.coe_nat_succ, ← add_assoc, h, n_ih, mul_add_one, add_assoc]
end

/-- A criterion for two linear polynomials to be equal -/
lemma linear_eq_match {a b c d : ℤ} (h : ∀ x : ℤ, a * x + b = c * x + d) : a = c ∧ b = d :=
begin
  have h0 := h 0,
  rw [mul_zero, mul_zero, zero_add, zero_add] at h0,
  have h1 := h 1,
  rw [mul_one, mul_one, h0, add_left_inj] at h1,
  exact and.intro h1 h0
end

end extra

section results

variables {f : ℤ → ℤ} (feq : fn_eq f)
include feq

private lemma fn_lem1 (x : ℤ) : f (f x) = f (x + 1) :=
begin
  have h := feq 0 (f 0),
  rw [zero_sub, sub_self, zero_sub] at h,
  have h0 := feq x (-f (f 0)),
  rwa [h, sub_neg_eq_add, sub_neg_eq_add, add_sub_cancel, eq_comm] at h0
end

private lemma fn_lem2 : ∀ x : ℤ, f x = (f (-1) + 1) * x + f 0 :=
begin
  apply extra.fn_linear_diff; intros x,
  rw [add_comm (f x), ← sub_eq_iff_eq_add, ← sub_eq_iff_eq_add, ← fn_lem1 feq, ← feq,
      ← sub_add_cancel (x - f x) 1, ← fn_lem1 feq, sub_sub, add_comm, ← sub_sub, feq,
      fn_lem1 feq, sub_add_cancel, sub_self, zero_sub]
end

end results

/-- Final solution -/
theorem final_solution (f : ℤ → ℤ) :
  fn_eq f ↔ f = -1 ∨ f = (+ 1) :=
begin
  split,
  { intros feq,
    have h := fn_lem2 feq,
    cases eq_or_ne (f (-1) + 1) 0 with h0 h0,
    { simp only [h0, zero_mul, zero_add] at h,
      left; funext x,
      rw [h, ← h (-1), pi.neg_apply, pi.one_apply, ← add_eq_zero_iff_eq_neg, h0] },
    { right; funext x,
      have h1 := fn_lem1 feq x,
      rw [h, h (x + 1), add_left_inj] at h1,
      exact int.eq_of_mul_eq_mul_left h0 h1 } },
  { rintros (rfl | rfl) x y; simp,
    rw [← add_sub_right_comm, sub_sub] }
end

end IMO2015A2
end IMOSL


/-
Copyright (c) 2022 Flemming Hermansen.
Released under Apache 2.0 license as described in
https://www.apache.org/licenses/LICENSE-2.0
Authors: Flemming Hermansen
-/

import algebra.algebra.basic
import order.boolean_algebra
import order.partial_sups

/-
The main result of this file states that
any Boolean algebra (B)
either has a finite set of atoms
or there exists an strictly increasing sequence of elements:
exists_fin_atomset_sup_top_of_not_strict_mono {B : Type*} [hB : boolean_algebra B]
( no_inf_seq : ¬( ∃ (strict_mono_seq : ℕ → B), strict_mono strict_mono_seq ) ) :

1. if there are infinitely many atoms then an increasing sequence of finite sets of atoms
is defined inductively by:
def atomset_of_n_aux {B : Type*} [hB : boolean_algebra B]
(h : ex_inf_atoms B) : ℕ → atomset_aux B
It is proved that the supremum of these finite sets gives a strictly increasing sequence.

2. If there, on the other hand, exists a maximal finite set of atoms (s)
then the supremum of this set is examined:
2a. ⊔ s < ⊤:
Then the complement is not equal to bottom,
and there are no atoms less than or equal to this complement.
Then we define a sequence of strictly decreasing elements:
  def aux_sequence {B : Type*} [hB : boolean_algebra B] (e_init : B)
  (h_na : not_bot_no_atoms_le e_init )
The complement gives a strictly increasing sequence.

2b:  ⊔ s = ⊤: We are done
-/

variables {B : Type*} [boolean_algebra B]
{s : list B}

open_locale classical

noncomputable theory

def sup_list {B} [boolean_algebra B] : list B → B
| [] := ⊥
| (hd :: tl) := hd ⊔ sup_list tl

def not_bot_no_atoms_le (e) : Prop := ⊥ < e ∧ ∀ (e' : B), ⊥ < e' → e' ≤ e → ¬ ⊥ ⋖ e'

def nb_lt {B} [hB : boolean_algebra B] (e' e : B) : Prop := ⊥ < e' ∧ e' < e

def nb_le {B} [hB : boolean_algebra B] (e' e : B) : Prop := ⊥ < e' ∧ e' ≤ e

lemma nb_lt_trans {b e : B}
(h_nb_lt : nb_lt b e) (h_na_le : not_bot_no_atoms_le e) : not_bot_no_atoms_le b :=
begin
  cases h_nb_lt with h_nb_b h_b_lt_e,
  unfold not_bot_no_atoms_le,
  unfold not_bot_no_atoms_le at h_na_le,
  -- have h_nb_e : ⊥ < e, by exact lt_trans h_nb_b h_b_lt_e,
  split, assumption,
  cases h_na_le with h_nb_e h_na_le,
  intros e', specialize h_na_le e',
  intros nb_e', specialize h_na_le nb_e',
  intros le_e'_b,
  have le_e'_e : e' ≤ e, by exact le_of_lt (gt_of_gt_of_ge h_b_lt_e le_e'_b),
  specialize h_na_le le_e'_e,
  assumption,
end

lemma nb_le_trans {b e : B}
(h_nb_le : ⊥ < b ∧ b ≤ e) (h_na_le : not_bot_no_atoms_le e) : not_bot_no_atoms_le b :=
begin
  cases h_nb_le with h_nb_b h_b_le_e,
  unfold not_bot_no_atoms_le,
  unfold not_bot_no_atoms_le at h_na_le,
  -- have h_nb_e : ⊥ < e, by exact lt_trans h_nb_b h_b_lt_e,
  split, assumption,
  cases h_na_le with h_nb_e h_na_le,
  intros e', specialize h_na_le e',
  intros nb_e', specialize h_na_le nb_e',
  intros le_e'_b,
  have le_e'_e : e' ≤ e, by exact (le_trans le_e'_b h_b_le_e),
  specialize h_na_le le_e'_e,
  assumption,
end

lemma ex_nb_lt_of_na_le [hB : boolean_algebra B] (e : B)
(no_atoms_le : not_bot_no_atoms_le e )
: ∃ (e' : B), ⊥ < e' ∧ e' < e :=
begin
  -- First we generate (b : B), such that: nb_lt b e
  cases no_atoms_le with h_not_bot_e h_le_not_atom,
  have not_atom_self : ¬⊥ ⋖ e,
  begin
    specialize h_le_not_atom e h_not_bot_e le_rfl, assumption
  end,
  simp at not_atom_self,
  unfold is_atom at not_atom_self, push_neg at not_atom_self,
  rw bot_lt_iff_ne_bot at h_not_bot_e,
  specialize not_atom_self h_not_bot_e, -- ∃ (b : B), b < e ∧ b ≠ ⊥
  cases not_atom_self with b not_atom_self,
  -- Now use b:
  use b,
  cases not_atom_self with b_lt_e nb_b,
  rw ← bot_lt_iff_ne_bot at nb_b, split, assumption, assumption,
end

lemma inf_incr_list_of_no_disj_atoms_aux' [hB : boolean_algebra B] (e : B) (s : list B)
(no_atoms_le : not_bot_no_atoms_le e )
: ∃ (e' : B), ⊥ < e' ∧ e' < e
∧ ( not_bot_no_atoms_le e' ) :=
begin
  -- First we generate (e' : B), such that: nb_lt e' e
  have ex_nb_lt : ∃ (e' : B), ⊥ < e' ∧ e' < e, by exact ex_nb_lt_of_na_le e no_atoms_le,
  cases ex_nb_lt with e' ex_nb_lt, use e',
  have nb_lt_saved : ⊥ < e' ∧ e' < e, by assumption,
  cases ex_nb_lt with nb_e' lt_e'_e, split, assumption, split, assumption,
  -- goal : not_bot_no_atoms_le e'
  have nb_lt_b_e : nb_lt e' e, by exact  nb_lt_saved,
  by exact nb_lt_trans nb_lt_b_e no_atoms_le,
end

lemma sup_gt_of_disj {B : Type*} [hB : boolean_algebra B] {e e' : B}
(hnbot : e' ≠ ⊥) (h_disj : disjoint e e') : e < e ⊔ e' :=
begin
  -- We have a week form of distributivity with '≤' instead of '='.
  -- have week_distributivity : ( e' ⊓ e ) ⊔ (e' ⊓ e'') ≤  e' ⊓ (e ⊔ e''), by exact le_inf_sup,
  -- Trerefore, we do not get a contradiction from:
  -- ⊥ = e' ⊓ e = e' ⊓ (e ⊔ e') =?= (e' ⊓ e) ⊔ (e' ⊓ e') = ⊥ ⊔ e' = e'
  unfold disjoint at h_disj, rw le_bot_iff at h_disj, rw inf_comm at h_disj, -- e' ⊓ e = ⊥
  by_contradiction h_contra', -- ¬e < e ⊔ e'
  have e_le_self_sup : e ≤ e ⊔ e', by exact le_sup_left,
  have h_contra : e = e ⊔ e', by exact eq_of_le_of_not_lt e_le_self_sup h_contra', -- e = e ⊔ e'
  have he'_le_sup_self : e' ≤ e ⊔ e', by exact le_sup_right,
  have h_inf_sup : e' ⊓ (e ⊔ e') = e', by exact inf_eq_left.mpr he'_le_sup_self, -- e' ⊓ (e ⊔ e') = e'
  rw ← h_contra at h_inf_sup, -- e' ⊓ e = e'
  rw h_disj at h_inf_sup, -- ⊥ = e'
  rw h_inf_sup at hnbot,
  contradiction,
end

lemma contra_pose_p {p1 p2 : Prop} : (p1 ↔ p2) ↔ (¬p1 ↔ ¬ p2) :=
begin
  split,
  begin -- →
  intros h,
    cases h with hp12 hp21,
    split, contrapose, push_neg, assumption,
    contrapose, push_neg, assumption,
  end,
  -- ←
  intros h,
    cases h with hp12 hp21,
    split, contrapose, assumption,
    contrapose, assumption,
end

-- A one-line alternative tactic proof:
def contra_pose_p' {p1 p2 : Prop} : (p1 ↔ p2) ↔ (¬p1 ↔ ¬ p2) :=
begin
  split; intros h; cases h; split; contrapose; try {push_neg}; assumption,
end

def are_atoms (s : finset B) := ∀ e ∈ s, ⊥ ⋖ e

def ex_atom_outside (s : finset B) := ∃ e, e ∉ s ∧ ⊥ ⋖ e

def ex_inf_atoms (B : Type*) [hB : boolean_algebra B] := ∀ (s : finset B), are_atoms s → ex_atom_outside s

lemma finset_induction (B : Type*) [hB : boolean_algebra B] (e : B) {s : finset B} (p : B → Prop) {hn : e ∉ s}
(ps : ∀  e' ∈ s , p e') (pe : p e) : ∀ e' ∈ (finset.cons e s hn) , p e' :=
begin
  simp, split, assumption, assumption,
end

def boolean_algebra_finset_sup {B : Type*} [hB : boolean_algebra B] (s : finset B) : B :=
finset.fold (⊔) (⊥ : B) (λ e : B, e ) s

def mem_le_sup {B : Type*} [hB : boolean_algebra B] (s : finset B) :=
∀ (e : B), e ∈ s → e ≤ boolean_algebra_finset_sup s

lemma le_sup0 (B : Type*) [hB : boolean_algebra B] :
mem_le_sup  (∅ : finset B) :=
begin
    intros e,
    have h_contra : e ∉ ∅, by exact set.not_mem_empty e,
    contradiction,
end

lemma le_sup_step {B : Type*} [hB : boolean_algebra B] ⦃e_new : B⦄ (s : finset B) (h : e_new ∉ s):
mem_le_sup s → mem_le_sup (finset.cons e_new s h) :=
begin
  intros h_mem_le_sup_s,
  unfold mem_le_sup,
  intros e1 hi1, -- e1 ∈ finset.cons e_new s h
  have eq : finset.fold has_sup.sup ⊥ (λ (e : B), e) (finset.cons e_new s h) =
  e_new ⊔ (finset.fold has_sup.sup ⊥ (λ (e : B), e) s), by simp,
  unfold boolean_algebra_finset_sup,
  rw eq,
  rw finset.mem_cons at hi1,
  cases hi1,
  -- e1 = e
  rw hi1,
  exact le_sup_left,
  -- e1 ∈ s
  have h_e1_le : e1 ≤ boolean_algebra_finset_sup s, by exact h_mem_le_sup_s e1 hi1, -- exact hi1 e1 h,
  unfold boolean_algebra_finset_sup at h_e1_le,
  have h_s_le_sup : finset.fold has_sup.sup ⊥ (λ (e : B), e) s ≤
  e_new ⊔ finset.fold has_sup.sup ⊥ (λ (e : B), e) s, by exact le_sup_right,
  exact le_trans h_e1_le h_s_le_sup,
end

lemma members_lt_sup {B : Type*} [hB : boolean_algebra B] (s : finset B) (e : B)
(h_atoms : are_atoms s) (h_atom : ⊥ ⋖ e) : e ∈ s → mem_le_sup s :=
begin
  intros h_e_in_s,
  unfold mem_le_sup,
  exact @finset.cons_induction_on B (@mem_le_sup B hB) s (@le_sup0 B hB) (@le_sup_step B hB ),
end

structure atomset_aux (B : Type*) [hB : boolean_algebra B] :=
(s_old : finset B)
(s : finset B)
(e : B)
(h_e_in_s : e ∈ s)
(h_sub : s_old ⊂ s)
(h_disj : ∀ e' ∈ s_old, disjoint e' e)
(h_atoms : are_atoms s)

lemma eq_of_gt_bot_of_le_atom (e' e : B) (h_atom_e : ⊥ ⋖ e)
(h_gt_bot : ⊥ < e') (hle : e' ≤ e) :
e' = e :=
begin
  unfold covby at h_atom_e,
  --by_contradiction,
  let not_lt_atom' := (h_atom_e.right) h_gt_bot,
  exact eq_of_le_of_not_lt hle not_lt_atom',
end

lemma disj_of_ne_atoms {e' e : B} (h_atom_e' : ⊥ ⋖ e') (h_atom_e : ⊥ ⋖ e)
(hne : e' ≠ e) :
(disjoint e' e) :=
begin
  unfold disjoint,
  by_contradiction,
  have ne_bot : e' ⊓ e ≠ ⊥, by exact ne_of_not_le h,
  have ge_bot : ⊥ ≤ e' ⊓ e, simp,
  have gt_bot : ⊥ < e' ⊓ e, by exact lt_of_le_of_ne ge_bot ne_bot.symm,
  unfold covby at h_atom_e,
  let not_lt_atom := (h_atom_e.right) gt_bot,
  have hle : e' ⊓ e ≤ e, by exact inf_le_right,
  have heq : e' ⊓ e = e, by exact eq_of_le_of_not_lt hle not_lt_atom,
  unfold covby at h_atom_e',
  let not_lt_atom' := (h_atom_e'.right) gt_bot,
  have hle' : e' ⊓ e ≤ e', by exact inf_le_left,
  have heq' : e' ⊓ e = e', by exact eq_of_le_of_not_lt hle' not_lt_atom',
  rw heq at heq',
  rw heq' at hne,
  contradiction,
end

def atomset_of_n_0 {B : Type*} [hB : boolean_algebra B] (h : ex_inf_atoms B) :
 atomset_aux B :=
begin
  let s_old := @finset.empty B,
  have h_atoms : are_atoms s_old,
  begin
    unfold are_atoms,
    intros e h_mem,
    cases h_mem,
  end,
  let p := h s_old h_atoms,
  let e := (classical.some p),

    have he : e ∉ s_old ∧ ⊥ ⋖ e, by exact (classical.some_spec p),
    let s1 := (finset.cons e s_old he.left),
    have h_e_in_s1 : e ∈ s1, by exact finset.mem_cons_self e s_old,
    have hsub: s_old ⊂ s1, by exact finset.ssubset_cons he.left,
    have h_atoms1 : are_atoms s1,
    begin
      apply finset_induction, assumption, exact he.2,
    end,
    have disj : ∀ e' ∈ s_old, disjoint e' e,
    begin
      intros e' h',
      unfold are_atoms at h_atoms,
      let he'_atom := h_atoms e' h',
      apply disj_of_ne_atoms he'_atom he.2,
      by_contradiction,
      let h_contra := he.1,
      rw h at h',
      contradiction,
    end,
    exact ⟨ s_old, s1, e, h_e_in_s1, hsub, disj, h_atoms1 ⟩,
end

def atomset_of_n_step (aux : atomset_aux B) (h : ex_inf_atoms B) :
atomset_aux B :=
begin
  let s := aux.s,
  let h_atoms := aux.h_atoms,
  let p := h s h_atoms,
  let e := (classical.some p),

    have he : e ∉ s ∧ ⊥ ⋖ e, by exact (classical.some_spec p),
    let s1 := (finset.cons e s he.left),
    have h_e_in_s1 : e ∈ s1, by exact finset.mem_cons_self e s,
    have hsub: s ⊂ s1, by exact finset.ssubset_cons he.left,
    have h_atoms1 : are_atoms s1,
    begin
      apply finset_induction, assumption, exact he.2,
    end,
    have disj : ∀ e' ∈ s, disjoint e' e,
    begin
      intros e' h',
      unfold are_atoms at h_atoms,
      let he'_atom := h_atoms e' h',
      apply disj_of_ne_atoms he'_atom he.2,
      by_contradiction,
      let h_contra := he.1,
      rw h at h',
      contradiction,
    end,
    exact ⟨ s, s1, e, h_e_in_s1, hsub, disj, h_atoms1 ⟩,
end

noncomputable
def atomset_of_n_aux {B : Type*} [hB : boolean_algebra B]
(h : ex_inf_atoms B) : ℕ → atomset_aux B
| 0 := atomset_of_n_0 h
| (n+1) :=
begin
  exact atomset_of_n_step (atomset_of_n_aux n) (h : ex_inf_atoms B),
end

def disj_atom_seq {B : Type*} [hB : boolean_algebra B]
(h : ex_inf_atoms B) :
ℕ → B :=
λ n, (atomset_of_n_aux h n).e

lemma atomset_of_n_aux_e_in_s_old1 {B : Type*} [hB : boolean_algebra B]
(h : ex_inf_atoms B) (i : ℕ) :
(atomset_of_n_aux h i).e ∈ (atomset_of_n_aux h (i.succ)).s_old :=
begin
  have h_s_old : (atomset_of_n_aux h (i)).s =
  (atomset_of_n_aux h (i.succ)).s_old :=
  begin
    unfold atomset_of_n_aux atomset_of_n_step,
  end,
  rw ← h_s_old,
  exact (atomset_of_n_aux h i).h_e_in_s,
end

lemma atomset_of_n_aux_subset_s_old {B : Type*} [hB : boolean_algebra B]
(h : ex_inf_atoms B) (i : ℕ) :
(atomset_of_n_aux h i).s_old ⊂ (atomset_of_n_aux h (i.succ)).s_old :=
begin
  have h_s_old : (atomset_of_n_aux h (i)).s =
  (atomset_of_n_aux h (i.succ)).s_old :=
  begin
    unfold atomset_of_n_aux atomset_of_n_step,
  end,
  rw ← h_s_old,
  exact (atomset_of_n_aux h i).h_sub,
end

lemma atomset_of_n_aux_subset_s {B : Type*} [hB : boolean_algebra B]
(h : ex_inf_atoms B) (i : ℕ) :
(atomset_of_n_aux h i).s ⊂ (atomset_of_n_aux h (i.succ)).s :=
begin
  have h_s_old : (atomset_of_n_aux h (i)).s =
  (atomset_of_n_aux h (i.succ)).s_old :=
  begin
    unfold atomset_of_n_aux atomset_of_n_step,
  end,
  rw h_s_old,
  exact (atomset_of_n_aux h i.succ).h_sub,
end

lemma atomset_of_n_aux_e_in_s_old {B : Type*} [hB : boolean_algebra B]
(h : ex_inf_atoms B) {i j : ℕ} (hlt : i < j) :
(atomset_of_n_aux h i).e ∈ (atomset_of_n_aux h j).s_old :=
begin
  let hle := nat.succ_le_of_lt hlt,
  let h_e_in_s_old_succ := atomset_of_n_aux_e_in_s_old1 h i,
  let hsucc_add := nat.add_sub_of_le hle,
  rw ← hsucc_add,
  induction (j - i.succ) with j' hj,
  begin
    rw add_zero, exact atomset_of_n_aux_e_in_s_old1 h i,
  end,
  -- j'.succ:
  rw nat.add_succ,
  let gg := atomset_of_n_aux_subset_s_old h i,
  have h_subset : (atomset_of_n_aux h (i.succ + j')).s_old ⊂ (atomset_of_n_aux h ((i.succ + j').succ)).s_old,
  by exact atomset_of_n_aux_subset_s_old h (i.succ + j'),
  have h_sub : (atomset_of_n_aux h (i.succ + j')).s_old ⊆ (atomset_of_n_aux h (i.succ + j').succ).s_old,
  by apply subset_of_ssubset h_subset,
  exact h_sub hj,
end

lemma disj_atom_seq_is_disjoint {B : Type*} [hB : boolean_algebra B]
(h : ex_inf_atoms B) :
pairwise (disjoint on (disj_atom_seq h)) :=
begin
  rw pairwise_disjoint_on,
  intros m n hlt,
  unfold disj_atom_seq,
  have e_in_s1 : (atomset_of_n_aux h m).e ∈ (atomset_of_n_aux h n).s_old,
  by exact atomset_of_n_aux_e_in_s_old h hlt,
  let disj := (atomset_of_n_aux h n).h_disj (atomset_of_n_aux h m).e e_in_s1,
  exact disj,
end

def inc_atoms {B : Type*} [hB : boolean_algebra B]
(h : ex_inf_atoms B) : ℕ → B :=
partial_sups (disj_atom_seq h)

lemma strict_mono_inc_atoms_step (h : ex_inf_atoms B) (i : ℕ) :
(inc_atoms (h : ex_inf_atoms B) i) < (inc_atoms (h : ex_inf_atoms B) i.succ) :=
begin
  have i_lt_i_succ : i < i.succ, by exact lt_add_one i,
  have h_disj_succ : disjoint (inc_atoms h i) (disj_atom_seq h i.succ),
  by exact partial_sups_disjoint_of_disjoint (disj_atom_seq h) (disj_atom_seq_is_disjoint h) i_lt_i_succ,
  have is_atom: ⊥ ⋖ disj_atom_seq h (i + 1),
  by exact (atomset_of_n_aux h i.succ).h_atoms (atomset_of_n_aux h i.succ).e (atomset_of_n_aux h i.succ).h_e_in_s,
  have h_not_bot : disj_atom_seq h (i + 1) ≠ ⊥, by exact covby.ne' is_atom,
  exact sup_gt_of_disj h_not_bot h_disj_succ,
end

lemma strict_mono_inc_atoms' (h : ex_inf_atoms B)  (i j : ℕ) :
(inc_atoms (h : ex_inf_atoms B) i) < (inc_atoms (h : ex_inf_atoms B) (i + j.succ) ) :=
begin
  induction j,
  -- 0
  exact strict_mono_inc_atoms_step h i,
  -- j.succ
  let h_next :=  strict_mono_inc_atoms_step h (i + j_n).succ,
  rw nat.add_succ, rw nat.add_succ,
  exact lt_trans j_ih h_next,
end

lemma strict_mono_inc_atoms (h : ex_inf_atoms B) :
strict_mono (inc_atoms h) :=
begin
  intros i j hlt,
  let hle := nat.succ_le_of_lt hlt,
  have hsub : i.succ ≤ j → i.succ + (j - i.succ) = j, exact nat.add_sub_of_le,
  let j_eq := hsub hlt,
  rw ← j_eq,
  rw nat.succ_add,
  exact strict_mono_inc_atoms' h i (j - i.succ),
end

-------------------------- infinite increasing sequence from no atoms below
def p_aux (B : Type*) [hB : boolean_algebra B] (e e' : B): Prop :=
e' ≤  e

structure aux (B : Type*) [hB : boolean_algebra B] (e_init : B) :=
--(e_init : B)
(e_prev : B)
(e_free : B)
(h_lt : nb_lt e_free e_prev)
(h_le_init : e_free ≤ e_init) -- used for recursion in aux_step

def aux_init (B : Type*) [hB : boolean_algebra B] (e_init : B)
(h_na : not_bot_no_atoms_le e_init ) : aux B e_init :=
begin
  let e_prev := e_init,
  have ex_b_nb_lt : ∃ (b : B), nb_lt b e_prev,
  by exact ex_nb_lt_of_na_le e_prev h_na,
  -- Does not work: cases ex_b_nb_lt with b nb_lt,
  -- instead, use classical.some and classical.some_spec
  let e_free := classical.some ex_b_nb_lt,
  have nb_lt_b_e : nb_lt e_free e_init, by exact classical.some_spec ex_b_nb_lt,
  let e_act := e_prev \ e_free,
  have h_lt : nb_lt e_free e_prev, by assumption,
  have h_le_init : e_free ≤ e_init, by exact le_of_lt nb_lt_b_e.2,
  exact {e_prev := e_prev, e_free := e_free,
  h_lt := h_lt, h_le_init := h_le_init},
end

def aux_step (B : Type*) [hB : boolean_algebra B] (e_init : B)
(h_na : not_bot_no_atoms_le e_init ) (a : aux B e_init): aux B e_init :=
begin
  let e_prev := a.e_free,
  --have fff : a.e_free ≤ e_init, by exact a.h_le_init,
  have h_nb_le : nb_le a.e_free e_init,
  begin
    unfold nb_le,
    cases a.h_lt with nb hlt,
    split, assumption, exact a.h_le_init,
  end,
  have h_na' : not_bot_no_atoms_le e_prev,
  begin
    exact nb_le_trans h_nb_le h_na,
  end,
  have ex_b_nb_lt : ∃ (b : B), nb_lt b e_prev,
  by exact ex_nb_lt_of_na_le e_prev h_na',
  -- Does not work: cases ex_b_nb_lt with b nb_lt,
  -- instead, use classical.some and classical.some_spec
  let e_free := classical.some ex_b_nb_lt,
  have nb_lt_b_e : nb_lt e_free e_prev, by exact classical.some_spec ex_b_nb_lt,
  let e_act := e_prev \ e_free,
  have h_lt : nb_lt e_free a.e_free, by assumption,
  have h_le_init : e_free ≤ a.e_free, by exact le_of_lt nb_lt_b_e.2,
  have h_le_init : e_free ≤ e_init,
  by exact le_trans (le_of_lt nb_lt_b_e.2) a.h_le_init,
  exact {e_prev := e_prev, e_free := e_free,
  h_lt := h_lt, h_le_init := h_le_init},
end

noncomputable
def aux_sequence {B : Type*} [hB : boolean_algebra B] (e_init : B)
(h_na : not_bot_no_atoms_le e_init )
: ℕ → aux B e_init
| 0 := aux_init B e_init h_na
| (n+1) := aux_step B e_init h_na (aux_sequence n) -- Notice: n is the only parameter

lemma aux_decr1_e_free {B : Type*} [hB : boolean_algebra B] (e_init : B)
(h_na : not_bot_no_atoms_le e_init ) (n : ℕ) :
  (aux_sequence e_init h_na (n + 1 )).e_free <
  (aux_sequence e_init h_na n).e_free :=
  begin
    have prev_of_free : (aux_sequence e_init h_na (n + 1 )).e_prev =
    (aux_sequence e_init h_na n).e_free :=
    begin
      unfold aux_sequence, unfold aux_step,
    end,
    rw ← prev_of_free,
    exact (aux_sequence e_init h_na (n + 1 )).h_lt.2,
  end

lemma aux_decr_k_e_free {B : Type*} [hB : boolean_algebra B] (e_init : B)
(h_na : not_bot_no_atoms_le e_init ) (n : ℕ) :
  --(aux_sequence e_init h_na n).e_init = e_init ∧
  --(aux_sequence e_init h_na n).e_free = (aux_sequence e_init h_na (n+1)).e_prev ∧
  ∀ (k : ℕ),
  (aux_sequence e_init h_na (n + k + 1)).e_free <
  (aux_sequence e_init h_na n).e_free :=
begin
  intros k,
  induction k,
  begin -- k = 0 :
    exact aux_decr1_e_free e_init h_na n,
  end,
  begin -- k + 1 :
    have succ : n + k_n.succ = n + k_n + 1, by refl, rw succ,
    exact lt_trans (aux_decr1_e_free e_init h_na (n + k_n + 1)) k_ih,
  end,
end

lemma compl_lt_compl_iff_lt {B : Type*} {x y : B} [boolean_algebra B] :
yᶜ < xᶜ ↔ x < y :=
begin
  have h_ne_iff_ne : yᶜ ≠ xᶜ ↔ x ≠ y,
  begin
    rw contra_pose_p', push_neg, rw compl_inj_iff, rw eq_comm,
  end,
  rw lt_iff_le_and_ne, rw lt_iff_le_and_ne,
  split,
  begin -- →
    intros h, cases h with h_le h_ne,
    rw ← h_ne_iff_ne, rw ← compl_le_compl_iff_le,
    split, assumption, assumption,
  end,
  begin -- ←
    intros h, cases h with h_le h_ne,
    rw h_ne_iff_ne, rw ← compl_le_compl_iff_le, rw compl_compl, rw compl_compl,
    split, assumption, assumption,
  end,
end

lemma increasing_seq {B : Type*} [hB : boolean_algebra B] (e_init : B)
(h_na : not_bot_no_atoms_le e_init ) :
∀ (n1 n2 : ℕ), n1 < n2 →
(aux_sequence e_init h_na n1).e_freeᶜ < (aux_sequence e_init h_na n2).e_freeᶜ :=
begin
  intros n1 n2 hn12,-- rw compl_le_compl_iff_le,
  rw compl_lt_compl_iff_lt,
  have ex_k : ∃ (k : ℕ), n1.succ + k = n2, by exact nat.le.dest hn12,
  cases ex_k with k h,
  have h1 : n1.succ + k = n1 + k + 1, by rw nat.succ_add,
  rw ← h, rw h1,
  exact aux_decr_k_e_free e_init h_na n1 k,
end

def infinite_sequence_of_no_atoms {B : Type*} [hB : boolean_algebra B] (e_init : B)
(h_na : not_bot_no_atoms_le e_init ) : ℕ → B :=
λ  (n : ℕ), (aux_sequence e_init h_na n).e_freeᶜ

lemma strict_mono_infinite_sequence {B : Type*} [hB : boolean_algebra B] (e_init : B)
(h_na : not_bot_no_atoms_le e_init ) : strict_mono (infinite_sequence_of_no_atoms e_init h_na) :=
-- ∀ (n1 n2 : ℕ), n1 < n2 → (aux_sequence e_init h_na n1).e_freeᶜ < (aux_sequence e_init h_na n2).e_freeᶜ :=
begin
  intros n1 n2 hn12,-- rw compl_le_compl_iff_le,
  unfold infinite_sequence_of_no_atoms,
  rw compl_lt_compl_iff_lt,
  have ex_k : ∃ (k : ℕ), n1.succ + k = n2, by exact nat.le.dest hn12,
  cases ex_k with k h,
  have h1 : n1.succ + k = n1 + k + 1, by rw nat.succ_add,
  rw ← h, rw h1,
  exact aux_decr_k_e_free e_init h_na n1 k,
end

--------------------------------

-- In this section we prove:
-- If there does not exist a strictly increasing sequence of idempotents
-- then there exists a finite set of atoms with supremum equal to the top element.

theorem exists_fin_atomset_sup_top_of_not_strict_mono {B : Type*} [hB : boolean_algebra B]
( no_inf_seq : ¬( ∃ (strict_mono_seq : ℕ → B), strict_mono strict_mono_seq ) ) :
∃ (s : finset B), (∀ e ∈ s, ⊥ ⋖ e) ∧ boolean_algebra_finset_sup s = (⊤ : B) :=
begin
  have no_inf_atomset :  ¬ ex_inf_atoms B ,
  begin
    by_contradiction,
    have h_contra : ∃ (strint_mono_seq : ℕ → B), strict_mono strint_mono_seq,
    begin
      use inc_atoms h,
      exact strict_mono_inc_atoms h,
    end,
    contradiction,
  end,
  unfold ex_inf_atoms at no_inf_atomset, push_neg at no_inf_atomset,
  cases no_inf_atomset with fin_atomset h_dum,
  cases h_dum with h_atoms h_no_atoms_outside,
  -- Now we have a maximal finite set of atoms
  unfold ex_atom_outside at h_no_atoms_outside,

  -- Does not work: pust_neg at h_no_atoms_outside,
  -- Instead we prove a helper lemma:
  have no_atoms_outside' : ∀  (e : B), e ∈ fin_atomset ∨ ¬ (⊥ ⋖ e),
  begin
    revert h_no_atoms_outside, contrapose, push_neg, intros h, exact h,
  end,
  -- Now we will show that the supremum of the finite set atoms is equal to the top:
  have sup_eq_top : boolean_algebra_finset_sup fin_atomset = ⊤,
  begin
    by_contradiction h_not_top,
    -- Does not work: push_neg at h,
    have hh : boolean_algebra_finset_sup fin_atomset ≠  ⊤, by exact h_not_top,
    let lt_top := ne.lt_top hh, --boolean_algebra_finset_sup fin_atomset < ⊤
    let e_init := ( boolean_algebra_finset_sup fin_atomset)ᶜ,
    -- We will show that '⊥ < e_init' and there are no atoms below e_init
    have nb_lt : not_bot_no_atoms_le e_init,
    begin
      unfold not_bot_no_atoms_le,
      split,
      begin -- goal : ⊥ < e_init
        rw ← compl_top,
        exact compl_lt_compl_iff_lt.2 lt_top,
      end,
      begin -- goal: ∀ (e' : B), ⊥ < e' → e' ≤ e_init → ¬⊥ ⋖ e'
        intros e' hnb,
        contrapose,
        push_neg,
        intros e'_atom,
        let no_atoms_outside'' := no_atoms_outside' e',
        rw ← imp_iff_or_not at no_atoms_outside'',
        let e'_in_fin_atomset := no_atoms_outside'' e'_atom, -- e' ∈ fin_atomset
        let e'_lt_sup := (members_lt_sup fin_atomset e' h_atoms e'_atom ) e'_in_fin_atomset  e' e'_in_fin_atomset,
        by_contradiction h_lt_e_init,
        let e'le_inf_compl := le_inf e'_lt_sup h_lt_e_init,
        rw inf_compl_self at e'le_inf_compl,
        rw ← eq_bot_iff at e'le_inf_compl,
        rw e'le_inf_compl at e'_atom,
        cases e'_atom,
        let absurd := (ne_of_lt e'_atom_left), -- ⊥ ≠ ⊥
        contradiction,
      end,
    end,
    -- Now we get a contradiction by constructing a strictly increasing sequence of atoms
    have h_contra : ∃ (strint_mono_seq : ℕ → B), strict_mono strint_mono_seq,
    begin
      use (infinite_sequence_of_no_atoms e_init nb_lt),
      exact strict_mono_infinite_sequence e_init nb_lt,
    end,
    contradiction,
  end,
  use fin_atomset, exact and.intro h_atoms sup_eq_top,
end


import .group_representation
universe variables u v w w' w'' w'''

open linear_map

variables {G : Type u} [group G] {R : Type v}[ring R]

namespace morphism
variables {M : Type w}  [add_comm_group M] [module R M]
          {M' : Type w'} [add_comm_group M'] [module R M']

/--
  a morphism `f : ρ ⟶ π` between representation is a linear map `f.ℓ : M(ρ) →ₗ[R] M(π)` satisfying
    `f.ℓ ∘   ρ g  = π g  ∘   f.ℓ` has function on `set`.
-/
structure morphism  (ρ : group_representation G R M) (π : group_representation G R M') : Type (max w w') :=
  (ℓ : M →ₗ[R] M')
  (commute : ∀(g : G), ℓ ∘   ρ g  = π g  ∘   ℓ)

infixr ` ⟶ `:25 := morphism

@[ext]lemma ext  {ρ : group_representation G R M} {ρ'  : group_representation G R M'} ( f g : ρ ⟶ ρ') :
(f.ℓ)  = g.ℓ  → f = g :=
begin
    intros,
    cases f,cases g , congr'; try {assumption},
end
variables (ρ : group_representation G R M)
variables  (ρ'  : group_representation G R M')

instance : has_coe_to_fun (morphism ρ ρ') := ⟨_,λ f, f.ℓ.to_fun⟩

lemma coersion (f : ρ ⟶ ρ') : ⇑f = (f.ℓ) := rfl

theorem commute_apply ( f : ρ ⟶  ρ') (x : M) (g : G) : f ( ρ g x) = ρ' g (f x ) :=
begin
      erw ←  function.comp_apply f,
      erw f.commute,
      exact rfl,
end

def one (ρ : group_representation G R M) : ρ ⟶ ρ :=
{ ℓ         := linear_map.id,
  commute   := λ g, rfl
}
notation `𝟙` := one
end morphism


import analysis.topology.topological_space
noncomputable theory

local attribute [instance] classical.prop_decidable

universe u

section is_prime_ideal

class is_ideal (α : Type u) [comm_ring α] (S : set α) : Prop :=
(zero_mem : (0 : α) ∈ S)
(add_mem : ∀ {x y}, x ∈ S → y ∈ S → x + y ∈ S)
(mul_mem : ∀ {x y}, x ∈ S → x * y ∈ S)

class is_prime_ideal {α : Type u} [comm_ring α] (S : set α) extends is_ideal α S : Prop :=
(ne_univ : S ≠ set.univ)
(mem_or_mem_of_mul_mem : ∀ {x y : α}, x * y ∈ S → x ∈ S ∨ y ∈ S)

theorem is_prime_ideal.one_not_mem {α : Type u} [comm_ring α] (S : set α) [is_prime_ideal S] :
  (1:α) ∉ S :=
λ h, is_prime_ideal.ne_univ S $ set.ext $ λ z,
⟨λ hz, trivial,
 λ hz, calc z = 1 * z : by simp
          ... ∈ S : is_ideal.mul_mem h⟩

end is_prime_ideal

def topological_space.of_closed {α : Type u} (T : set (set α))
  (H1 : ∅ ∈ T)
  (H2 : ∀ A ⊆ T, ⋂₀ A ∈ T)
  (H3 : ∀ A B ∈ T, A ∪ B ∈ T) :
  topological_space α :=
{ is_open := λ X, -X ∈ T,
  is_open_univ := by simp [H1],
  is_open_inter := λ s t hs ht, by simpa [set.compl_inter] using H3 (-s) (-t) hs ht,
  is_open_sUnion := λ s hs, by rw set.compl_sUnion; exact H2 (set.compl '' s) (λ z ⟨y, hy, hz⟩, by simpa [hz.symm] using hs y hy) }

section generate

variables {α : Type u} [comm_ring α] (S : set α)

def generate : set α :=
{ x | ∀ (T : set α) [is_ideal α T], S ⊆ T → x ∈ T }

instance generate.is_ideal : is_ideal α (generate S) :=
{ zero_mem := λ T ht hst, @@is_ideal.zero_mem _ T ht,
  add_mem  := λ x y hx hy T ht hst, @@is_ideal.add_mem _ ht (@hx T ht hst) (@hy T ht hst),
  mul_mem  := λ x y hx T ht hst, @@is_ideal.mul_mem _ ht (@hx T ht hst) }

theorem subset_generate : S ⊆ generate S :=
λ x hx T ht hst, hst hx

end generate

class t0_space (α : Type u) [topological_space α] :=
(t0 : ∀ x y, x ≠ y → ∃ U:set α, is_open U ∧ (xor (x ∈ U) (y ∈ U)))

section Zariski

parameters (α : Type u) [comm_ring α]

def X := {P : set α // is_prime_ideal P}

def V : set α → set X :=
λ E, {P | E ⊆ P.val}

theorem V_set_eq_V_generate (S : set α) : V S = V (generate S) :=
set.ext $ λ P,
⟨λ hp z hz, @hz P.val P.property.to_is_ideal hp,
 λ hp z hz, hp $ subset_generate S hz⟩

def Zariski : topological_space X :=
topological_space.of_closed {A | ∃ E, V E = A}
  ⟨{(1:α)}, set.ext $ λ ⟨P, hp⟩,
     ⟨λ h, @@is_prime_ideal.one_not_mem _ P hp $ by simpa [V] using h,
      λ h, false.elim h⟩⟩
(λ T ht, ⟨⋃₀ {E | ∃ A ∈ T, V E = A}, set.ext $ λ ⟨P, hp⟩,
   ⟨λ hpv A hat,
      begin
        cases ht hat with E he,
        rw ← he,
        intros z hz,
        apply hpv,
        existsi E,
        existsi (⟨A, hat, he⟩ : ∃ A ∈ T, V E = A),
        exact hz
      end,
    λ hz x ⟨E, ⟨A, H, hvea⟩, hxe⟩,
      begin
        have h1 := hz A H,
        rw ← hvea at h1,
        exact h1 hxe,
      end⟩⟩)
(λ A B ⟨Ea, ha⟩ ⟨Eb, hb⟩,
   ⟨generate Ea ∩ generate Eb,
    set.ext $ λ ⟨P, hp⟩,
    ⟨λ hz, or_iff_not_and_not.2 $ λ ⟨hpa, hpb⟩,
       begin
         rw ← ha at hpa,
         rw ← hb at hpb,
         cases not_forall.1 hpa with wa hwa,
         cases not_forall.1 hpb with wb hwb,
         cases not_imp.1 hwa with hwa1 hwa2,
         cases not_imp.1 hwb with hwb1 hwb2,
         have : wa * wb ∈ generate Ea ∩ generate Eb,
         { split,
           { apply is_ideal.mul_mem (subset_generate Ea hwa1) },
           { rw mul_comm,
             apply is_ideal.mul_mem (subset_generate Eb hwb1) } },
         cases is_prime_ideal.mem_or_mem_of_mul_mem (hz this) with hwap hwbp,
         exact hwa (λ h, hwap),
         exact hwb (λ h, hwbp),
       end,
     λ hz y ⟨hy1, hy2⟩, or.cases_on hz
       (λ hpa, begin
          rw ← ha at hpa,
          rw V_set_eq_V_generate at hpa,
          exact hpa hy1
        end)
       (λ hpb, begin
          rw ← hb at hpb,
          rw V_set_eq_V_generate at hpb,
          exact hpb hy2
        end)⟩⟩)

instance Zariski.t0 : @t0_space X Zariski :=
begin
  constructor,
  intros x y hxy,
  cases x with x hx,
  cases y with y hy,
  have h1 : ¬ x = y,
  { intro h,
    apply hxy,
    exact subtype.eq h },
  rw set.set_eq_def at h1,
  rw not_forall at h1,
  cases h1 with z hz,
  existsi -(V {z}),
  split,
  { existsi {z},
    rw set.compl_compl },
  rw iff_def at hz,
  rw not_and_distrib at hz,
  cases hz;
  rw not_imp at hz,
  { cases hz with hzx hzy,
    right,
    split,
    { intro h,
      apply hzy,
      apply h,
      exact set.mem_singleton z },
    { intro h,
      apply h,
      intros m hm,
      rw set.mem_singleton_iff at hm,
      rw hm,
      exact hzx } },
  { cases hz with hzy hzx,
    left,
    split,
    { intro h,
      apply hzx,
      apply h,
      exact set.mem_singleton z },
    { intro h,
      apply h,
      intros m hm,
      rw set.mem_singleton_iff at hm,
      rw hm,
      exact hzy } }
end

end Zariski


import linear_algebra.basic
import ring_theory.algebra
import deprecated.ring

universes v w

section smul_id
variables {α : Type v} {β : Type w}
variables [comm_ring α] [add_comm_group β] [module α β] (a : α)

def smul_id : β →ₗ[α] β := a • linear_map.id

lemma smul_id_apply (x : β) : ((smul_id a : β →ₗ[α] β) : β → β) x = a • x := rfl

instance smul_id.is_semiring_hom :
is_semiring_hom (smul_id : α → β →ₗ[α] β) := {
  map_zero := begin unfold smul_id, ext, simp end,
  map_one := begin unfold smul_id, ext, simp end,
  map_add := begin unfold smul_id, simp [add_smul] end,
  map_mul := begin unfold smul_id, intros, ext, simp [mul_smul] end
}

instance smul_id.is_ring_hom :
is_ring_hom (smul_id : α → β →ₗ[α] β) := {
  map_one := smul_id.is_semiring_hom.map_one,
  map_add := smul_id.is_semiring_hom.map_add,
  map_mul := smul_id.is_semiring_hom.map_mul
}

def smul_id_ring_hom : α →+* (β →ₗ[α] β) := ring_hom.of (smul_id : α → β →ₗ[α] β)

-- TODO: merge with this?
#check module.endomorphism_algebra
#check algebra_map

instance : algebra α (β →ₗ[α] β) :=
  (smul_id_ring_hom : α →+* (β →ₗ[α] β)).to_algebra'
  begin
    intros a f,
    simp only [smul_id_ring_hom, ring_hom.coe_of],
    dunfold smul_id,
    ext,
    simp,
  end

end smul_id


import .vec_cone data.real.basic

variables {k m n : nat}

namespace cone_program

structure primal (m n : nat) :=
(obf : colvec (fin n) ℝ)
(lhs : matrix (fin m) (fin n) ℝ)
(rhs : colvec (fin m) ℝ)

open matrix

variables (K : set (colvec (fin n) ℝ)) (K' : set (colvec (fin n) ℝ))

local infix ` ⬝ ` : 70 := matrix.mul
local notation x , `ᵀ` := transpose x

def primal.feasible (P : primal m n) (x : colvec (fin n) ℝ) : Prop :=
P.lhs ⬝ x = P.rhs ∧ x ∈ K

def primal.optimal (P : primal m n) (x : colvec (fin n) ℝ) : Prop :=
let c := P.obf in
P.feasible K x ∧ ∀ y, P.feasible K y → ⟪ c, x ⟫ ≤ ⟪ c, y ⟫

structure dual (m n : nat) :=
(obf : colvec (fin m) ℝ)
(lhs : matrix (fin m) (fin n) ℝ)
(rhs : colvec (fin n) ℝ)

def dual.feasible (D : dual m n) (y : colvec (fin m) ℝ) : Prop :=
D.rhs - D.lhsᵀ ⬝ y ∈ K'

def dual.optimal (D : dual m n) (y : colvec (fin m) ℝ) : Prop :=
let b := D.obf in
D.feasible K' y ∧ ∀ x, D.feasible K' x → ⟪ x, b ⟫ ≤ ⟪ y, b ⟫

def primal.to_dual (P : primal m n) : dual m n :=
⟨P.rhs, P.lhs, P.obf⟩

lemma cone_duality
(P : primal m n) (x : colvec (fin n) ℝ) (y : colvec (fin m) ℝ)
(hx : P.feasible K x) (hy : P.to_dual.feasible (dual_cone K) y) :
⟪ P.to_dual.obf, y ⟫ ≤ ⟪ P.obf, x ⟫ :=
begin
  let c := P.obf,
  let A := P.lhs,
  let b := P.rhs,

  have h : ⟪ b, y ⟫ = ⟪ c, x ⟫ - ⟪ x, c - Aᵀ ⬝ y ⟫  - ⟪ y, A ⬝ x - b ⟫ ,
  {
    rw [real_inner_product_space.inner_sub_right,
        real_inner_product_space.inner_sub_right, colvec.inner_mul],
    simp [real_inner_product_space.inner_comm x c, real_inner_product_space.inner_comm y b],
  },
  have h_ge_0: 0 ≤ ⟪ x, c - Aᵀ ⬝ y ⟫,
  { let H := hy x hx.2,
    unfold primal.to_dual at H,
    dsimp at H,
    exact H },
  have h_eq_0 : ⟪ y, A ⬝ x - b ⟫ = 0,
    by simp [hx.1],
  show ⟪ b, y ⟫ ≤ ⟪ c, x ⟫,
  calc ⟪ b, y ⟫ = ⟪ c, x ⟫ - ⟪ x, c - Aᵀ ⬝ y ⟫  - ⟪ y, A ⬝ x - b ⟫ : h
    ... = ⟪ c, x ⟫ - ⟪ x, c - Aᵀ ⬝ y ⟫                            : by rw [h_eq_0]; simp
    ... ≤ ⟪ c, x ⟫                                               : (sub_le_self_iff _).2 h_ge_0
end

end cone_program


import ring_theory.principal_ideal_domain
import data.zmod.basic

import ring_theory

namespace int

open euclidean_domain ideal is_ring_hom ideal.quotient

def nℤ (n : ℕ) : ideal ℤ := span {(n : ℤ)}

lemma nℤ_maximal (p : ℕ) : nat.prime p → is_maximal (nℤ p) :=
assume h₀ : nat.prime p,
have prime (p : ℤ), from iff.mp nat.prime_iff_prime_int h₀,
have irreducible (p : ℤ), from irreducible_of_prime this,
show is_maximal (nℤ p), from principal_ideal_domain.is_maximal_of_irreducible this

lemma bot_not_maximal : ¬(is_maximal (⊥ : ideal ℤ)) :=
assume h : is_maximal ⊥,
let J := nℤ 2 in
have J ≠ (⊥ : ideal ℤ), from
  assume h₁ : J = ⊥,
  have h2 : (2 : ℤ) = 0, from iff.mp span_singleton_eq_bot h₁,
  have h2n : (2 : ℤ) ≠ 0, from iff.mpr int.coe_nat_ne_zero (nat.succ_ne_zero 1),
  absurd h2 h2n,
have ⊥ < J, from (iff.mpr lattice.bot_lt_iff_ne_bot ‹J ≠ (⊥ : ideal ℤ)›),
have J = ⊤, from and.right ‹is_maximal ⊥› J this,
have J ≠ ⊤, from and.left (nℤ_maximal 2 nat.prime_two),
absurd ‹J = ⊤› ‹J ≠ ⊤›

lemma ideal_eq_nℤ (I : ideal ℤ) : ∃ n : ℕ, I = nℤ n :=
have ∃ m : ℤ, I = span {m}, from (principal_ideal_domain.principal I).principal,
let ⟨m, _⟩ := this in
have I = nℤ (nat_abs m), from
calc
    I = span {m}                                : by assumption
  ... = (span {m}) * ⊤                          : by rw mul_top
  ... = (span {m}) * (span {(norm_unit m : ℤ)}) : by rw [iff.mpr (@span_singleton_eq_top _ _ ↑(norm_unit m)) ⟨(norm_unit m), refl (norm_unit m)⟩]
  ... = span {m * (norm_unit m : ℤ)}            : by simp [span_mul_span]
  ... = span {(nat_abs m : ℤ)}                  : by rw coe_nat_abs_eq_mul_norm_unit,
show ∃ n : ℕ, I = nℤ n, from ⟨nat_abs m, this⟩

lemma prime_ideal_eq_nℤ (I : ideal ℤ) [is_prime I] :
∃ p : ℕ, I = nℤ p ∧ (p = 0 ∨ nat.prime p) :=
have ∃ n : ℕ, I = nℤ n, from ideal_eq_nℤ I,
let ⟨n, h⟩ := this in
or.elim (nat.eq_zero_or_eq_succ_pred n)
  (assume h₀ : n = 0,
   show ∃ p : ℕ, I = nℤ p ∧ (p = 0 ∨ nat.prime p), from  ⟨n, h, or.inl h₀⟩)
  (assume h₁ : n = nat.succ (nat.pred n),
   have n ≠ 0, from eq.symm h₁ ▸ nat.succ_ne_zero (nat.pred n),
   have (n : ℤ) ≠ 0, from λ h, this (int.of_nat.inj h),
   have is_prime (nℤ n), from h ▸ ‹is_prime I›,
   have prime (n : ℤ), from iff.mp (span_singleton_prime ‹(n : ℤ) ≠ 0›) this,
   have nat.prime n, from iff.mpr nat.prime_iff_prime_int this,
   show ∃ p : ℕ, I = nℤ p ∧ (p = 0 ∨ nat.prime p), from  ⟨n, h, or.inr this⟩)

lemma maximal_ideal_eq_nℤ (I : ideal ℤ) [is_maximal I] :
∃ p : ℕ, I = nℤ p ∧ nat.prime p :=
have ∃ p : ℕ, I = nℤ p ∧ (p = 0 ∨ nat.prime p), from prime_ideal_eq_nℤ I,
let ⟨p, hI, hp⟩ := this in
or.elim hp
  (assume h₀ : p = 0,
   have (p : ℤ) = 0, from int.of_nat.inj_eq.mpr h₀,
   have I = ⊥, from eq.symm hI ▸ iff.mpr span_singleton_eq_bot this,
   absurd ‹is_maximal I› (eq.symm this ▸ bot_not_maximal))
  (assume h₁ : nat.prime p,
   show ∃ p : ℕ, I = nℤ p ∧ nat.prime p, from ⟨p, hI, h₁⟩)

def ℤmodnℤ (n : ℕ) : Type* := ideal.quotient (nℤ n)

instance ℤmodnℤ_comm_ring (n : ℕ) : comm_ring (ℤmodnℤ n) :=
ideal.quotient.comm_ring (nℤ n)

def ℤmodnℤ_equiv_zmod (n : ℕ+) : ℤmodnℤ n ≃r zmod n :=
let n' : ℤ := n in
let ι : ℤ → zmod n := int.cast in
have hI : (nℤ n) ≤ ker ι, from span_le.mpr $ set.singleton_subset_iff.mpr $ mem_ker.mpr $ zmod.eq_zero_iff_dvd_int.mpr $ dvd_refl n,
show quotient (nℤ n) ≃r zmod n, from
{ to_fun := factor ι (nℤ n) hI,
  inv_fun := λ m, ideal.quotient.mk (nℤ n) (m.val),
  left_inv :=
    assume x : quotient (nℤ n),
    suffices ∀ y : ℤ, (λ m : zmod n, ideal.quotient.mk (nℤ n) (m.val)) ((factor ι (nℤ n) hI) (ideal.quotient.mk (nℤ n) y)) = ideal.quotient.mk (nℤ n) y,
      from quotient.induction_on' x this,
    assume y : ℤ,
    have y - y % n' = n' * (y / n'), from
    calc
      y - y % n' = y % n' + n' * (y / n') - y % n' : by rw (int.mod_add_div y n')
             ... = n' * (y / n')                   : by rw (add_sub_cancel'),
    have n' ∣ y - y % n', from dvd_of_mul_right_eq (y / n') (eq.symm this),
    have n' ∣ y - ((ι y).val : ℤ), from eq.symm (@zmod.coe_val_cast_int n y) ▸ this,
    begin
      unfold,
      rw (factor_commutes hI),
      apply eq.symm,
      apply ideal.quotient.eq.mpr,
      apply mem_span_singleton.mpr,
      assumption,
    end,
  right_inv :=
    assume x : zmod n,
    eq.symm (@factor_commutes _ _ _ _ _ _ _ hI x.val) ▸ zmod.cast_val x,
  hom := factor_to_ring_hom' }

def zmod_equiv_ℤmodnℤ (n : ℕ+) : zmod n ≃r ℤmodnℤ n :=
ring_equiv.symm (ℤmodnℤ_equiv_zmod n)

instance ℤmodnℤ_fintype (n : ℕ+) : fintype (ℤmodnℤ n) :=
(fintype.of_equiv (zmod n) $ ring_equiv.to_equiv $ zmod_equiv_ℤmodnℤ n)

lemma quotient_nℤ_card (n : ℕ+) : fintype.card (ℤmodnℤ n) = n :=
have h₁ : fintype.card (ℤmodnℤ n) = fintype.card (zmod n), from (fintype.of_equiv_card $ ring_equiv.to_equiv $ zmod_equiv_ℤmodnℤ n),
have h₂ : fintype.card (zmod n) = n, from zmod.card_zmod n,
show fintype.card (ℤmodnℤ n) = n, from eq.trans h₁ h₂

--def ℤmodnℤ_equiv_zmodp (p : ℕ) (hp : nat.prime p) : (ℤmodnℤ p) ≃r zmodp p hp :=
--ℤmodnℤ_equiv_zmod ⟨p, hp.pos⟩

end int