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

The real numbers ℝ.

They are constructed as the topological completion of ℚ. With the following steps:
(1) prove that ℚ forms a uniform space.
(2) subtraction and addition are uniform continuous functions in this space
(3) for multiplication and inverse this only holds on bounded subsets
(4) ℝ is defined as separated Cauchy filters over ℚ (the separation requires a quotient construction)
(5) extend the uniform continuous functions along the completion
(6) proof field properties using the principle of extension of identities

TODO

generalizations:
* topological groups & rings
* order topologies
* Archimedean fields

-/
import logic.function topology.metric_space.basic topology.algebra.uniform_group
       topology.algebra.ring tactic.linarith

noncomputable theory
open classical set lattice filter topological_space metric
local attribute [instance] prop_decidable

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

instance : metric_space ℚ :=
metric_space.induced coe rat.cast_injective real.metric_space

theorem rat.dist_eq (x y : ℚ) : dist x y = abs (x - y) := rfl

instance : metric_space ℤ :=
begin
  letI M := metric_space.induced coe int.cast_injective real.metric_space,
  refine @metric_space.replace_uniformity _ int.uniform_space M
    (le_antisymm refl_le_uniformity $ λ r ru,
      mem_uniformity_dist.2 ⟨1, zero_lt_one, λ a b h,
      mem_principal_sets.1 ru $ dist_le_zero.1 (_ : (abs (a - b) : ℝ) ≤ 0)⟩),
  simpa using (@int.cast_le ℝ _ _ 0).2 (int.lt_add_one_iff.1 $
    (@int.cast_lt ℝ _ (abs (a - b)) 1).1 $ by simpa using h)
end

theorem uniform_continuous_of_rat : uniform_continuous (coe : ℚ → ℝ) :=
uniform_continuous_comap

theorem uniform_embedding_of_rat : uniform_embedding (coe : ℚ → ℝ) :=
uniform_embedding_comap rat.cast_injective

theorem dense_embedding_of_rat : dense_embedding (coe : ℚ → ℝ) :=
uniform_embedding_of_rat.dense_embedding $
λ x, mem_closure_iff_nhds.2 $ λ t ht,
let ⟨ε,ε0, hε⟩ := mem_nhds_iff.1 ht in
let ⟨q, h⟩ := exists_rat_near x ε0 in
ne_empty_iff_exists_mem.2 ⟨_, hε (mem_ball'.2 h), q, rfl⟩

theorem embedding_of_rat : embedding (coe : ℚ → ℝ) := dense_embedding_of_rat.embedding

theorem continuous_of_rat : continuous (coe : ℚ → ℝ) := uniform_continuous_of_rat.continuous

theorem real.uniform_continuous_add : uniform_continuous (λp : ℝ × ℝ, p.1 + p.2) :=
metric.uniform_continuous_iff.2 $ λ ε ε0,
let ⟨δ, δ0, Hδ⟩ := rat_add_continuous_lemma abs ε0 in
⟨δ, δ0, λ a b h, let ⟨h₁, h₂⟩ := max_lt_iff.1 h in Hδ h₁ h₂⟩

-- TODO(Mario): Find a way to use rat_add_continuous_lemma
theorem rat.uniform_continuous_add : uniform_continuous (λp : ℚ × ℚ, p.1 + p.2) :=
uniform_embedding_of_rat.uniform_continuous_iff.2 $ by simp [(∘)]; exact
((uniform_continuous_fst.comp uniform_continuous_of_rat).prod_mk
  (uniform_continuous_snd.comp uniform_continuous_of_rat)).comp real.uniform_continuous_add

theorem real.uniform_continuous_neg : uniform_continuous (@has_neg.neg ℝ _) :=
metric.uniform_continuous_iff.2 $ λ ε ε0, ⟨_, ε0, λ a b h,
  by rw dist_comm at h; simpa [real.dist_eq] using h⟩

theorem rat.uniform_continuous_neg : uniform_continuous (@has_neg.neg ℚ _) :=
metric.uniform_continuous_iff.2 $ λ ε ε0, ⟨_, ε0, λ a b h,
  by rw dist_comm at h; simpa [rat.dist_eq] using h⟩

instance : uniform_add_group ℝ :=
uniform_add_group.mk' real.uniform_continuous_add real.uniform_continuous_neg

instance : uniform_add_group ℚ :=
uniform_add_group.mk' rat.uniform_continuous_add rat.uniform_continuous_neg

instance : topological_add_group ℝ := by apply_instance
instance : topological_add_group ℚ := by apply_instance

instance : orderable_topology ℚ :=
induced_orderable_topology _ (λ x y, rat.cast_lt) (@exists_rat_btwn _ _ _)

lemma real.is_topological_basis_Ioo_rat :
  @is_topological_basis ℝ _ (⋃(a b : ℚ) (h : a < b), {Ioo a b}) :=
is_topological_basis_of_open_of_nhds
  (by simp [is_open_Ioo] {contextual:=tt})
  (assume a v hav hv,
    let ⟨l, u, hl, hu, h⟩ := (mem_nhds_unbounded (no_top _) (no_bot _)).mp (mem_nhds_sets hv hav),
        ⟨q, hlq, hqa⟩ := exists_rat_btwn hl,
        ⟨p, hap, hpu⟩ := exists_rat_btwn hu in
    ⟨Ioo q p,
      by simp; exact ⟨q, p, rat.cast_lt.1 $ lt_trans hqa hap, rfl⟩,
      ⟨hqa, hap⟩, assume a' ⟨hqa', ha'p⟩, h _ (lt_trans hlq hqa') (lt_trans ha'p hpu)⟩)

instance : second_countable_topology ℝ :=
⟨⟨(⋃(a b : ℚ) (h : a < b), {Ioo a b}),
  by simp [countable_Union, countable_Union_Prop],
  real.is_topological_basis_Ioo_rat.2.2⟩⟩

/- TODO(Mario): Prove that these are uniform isomorphisms instead of uniform embeddings
lemma uniform_embedding_add_rat {r : ℚ} : uniform_embedding (λp:ℚ, p + r) :=
_

lemma uniform_embedding_mul_rat {q : ℚ} (hq : q ≠ 0) : uniform_embedding ((*) q) :=
_ -/

lemma real.uniform_continuous_inv (s : set ℝ) {r : ℝ} (r0 : 0 < r) (H : ∀ x ∈ s, r ≤ abs x) :
  uniform_continuous (λp:s, p.1⁻¹) :=
metric.uniform_continuous_iff.2 $ λ ε ε0,
let ⟨δ, δ0, Hδ⟩ := rat_inv_continuous_lemma abs ε0 r0 in
⟨δ, δ0, λ a b h, Hδ (H _ a.2) (H _ b.2) h⟩

lemma real.uniform_continuous_abs : uniform_continuous (abs : ℝ → ℝ) :=
metric.uniform_continuous_iff.2 $ λ ε ε0,
  ⟨ε, ε0, λ a b, lt_of_le_of_lt (abs_abs_sub_abs_le_abs_sub _ _)⟩

lemma real.continuous_abs : continuous (abs : ℝ → ℝ) :=
real.uniform_continuous_abs.continuous

lemma rat.uniform_continuous_abs : uniform_continuous (abs : ℚ → ℚ) :=
metric.uniform_continuous_iff.2 $ λ ε ε0,
  ⟨ε, ε0, λ a b h, lt_of_le_of_lt
    (by simpa [rat.dist_eq] using abs_abs_sub_abs_le_abs_sub _ _) h⟩

lemma rat.continuous_abs : continuous (abs : ℚ → ℚ) :=
rat.uniform_continuous_abs.continuous

lemma real.tendsto_inv {r : ℝ} (r0 : r ≠ 0) : tendsto (λq, q⁻¹) (nhds r) (nhds r⁻¹) :=
by rw ← abs_pos_iff at r0; exact
tendsto_of_uniform_continuous_subtype
  (real.uniform_continuous_inv {x | abs r / 2 < abs x} (half_pos r0) (λ x h, le_of_lt h))
  (mem_nhds_sets (real.continuous_abs _ $ is_open_lt' (abs r / 2)) (half_lt_self r0))

lemma real.continuous_inv' : continuous (λa:{r:ℝ // r ≠ 0}, a.val⁻¹) :=
continuous_iff_continuous_at.mpr $ assume ⟨r, hr⟩,
  (continuous_iff_continuous_at.mp continuous_subtype_val _).comp (real.tendsto_inv hr)

lemma real.continuous_inv [topological_space α] {f : α → ℝ} (h : ∀a, f a ≠ 0) (hf : continuous f) :
  continuous (λa, (f a)⁻¹) :=
show continuous ((has_inv.inv ∘ @subtype.val ℝ (λr, r ≠ 0)) ∘ λa, ⟨f a, h a⟩),
  from (continuous_subtype_mk _ hf).comp real.continuous_inv'

lemma real.uniform_continuous_mul_const {x : ℝ} : uniform_continuous ((*) x) :=
metric.uniform_continuous_iff.2 $ λ ε ε0, begin
  cases no_top (abs x) with y xy,
  have y0 := lt_of_le_of_lt (abs_nonneg _) xy,
  refine ⟨_, div_pos ε0 y0, λ a b h, _⟩,
  rw [real.dist_eq, ← mul_sub, abs_mul, ← mul_div_cancel' ε (ne_of_gt y0)],
  exact mul_lt_mul' (le_of_lt xy) h (abs_nonneg _) y0
end

lemma real.uniform_continuous_mul (s : set (ℝ × ℝ))
  {r₁ r₂ : ℝ} (r₁0 : 0 < r₁) (r₂0 : 0 < r₂)
  (H : ∀ x ∈ s, abs (x : ℝ × ℝ).1 < r₁ ∧ abs x.2 < r₂) :
  uniform_continuous (λp:s, p.1.1 * p.1.2) :=
metric.uniform_continuous_iff.2 $ λ ε ε0,
let ⟨δ, δ0, Hδ⟩ := rat_mul_continuous_lemma abs ε0 r₁0 r₂0 in
⟨δ, δ0, λ a b h,
  let ⟨h₁, h₂⟩ := max_lt_iff.1 h in Hδ (H _ a.2).1 (H _ b.2).2 h₁ h₂⟩

protected lemma real.continuous_mul : continuous (λp : ℝ × ℝ, p.1 * p.2) :=
continuous_iff_continuous_at.2 $ λ ⟨a₁, a₂⟩,
tendsto_of_uniform_continuous_subtype
  (real.uniform_continuous_mul
    ({x | abs x < abs a₁ + 1}.prod {x | abs x < abs a₂ + 1})
    (lt_of_le_of_lt (abs_nonneg _) (lt_add_one _))
    (lt_of_le_of_lt (abs_nonneg _) (lt_add_one _))
    (λ x, id))
  (mem_nhds_sets
    (is_open_prod
      (real.continuous_abs _ $ is_open_gt' (abs a₁ + 1))
      (real.continuous_abs _ $ is_open_gt' (abs a₂ + 1)))
    ⟨lt_add_one (abs a₁), lt_add_one (abs a₂)⟩)

instance : topological_ring ℝ :=
{ continuous_mul := real.continuous_mul, ..real.topological_add_group }

instance : topological_semiring ℝ := by apply_instance

lemma rat.continuous_mul : continuous (λp : ℚ × ℚ, p.1 * p.2) :=
embedding_of_rat.continuous_iff.2 $ by simp [(∘)]; exact
((continuous_fst.comp continuous_of_rat).prod_mk
  (continuous_snd.comp continuous_of_rat)).comp real.continuous_mul

instance : topological_ring ℚ :=
{ continuous_mul := rat.continuous_mul, ..rat.topological_add_group }

theorem real.ball_eq_Ioo (x ε : ℝ) : ball x ε = Ioo (x - ε) (x + ε) :=
set.ext $ λ y, by rw [mem_ball, real.dist_eq,
  abs_sub_lt_iff, sub_lt_iff_lt_add', and_comm, sub_lt]; refl

theorem real.Ioo_eq_ball (x y : ℝ) : Ioo x y = ball ((x + y) / 2) ((y - x) / 2) :=
by rw [real.ball_eq_Ioo, ← sub_div, add_comm, ← sub_add,
  add_sub_cancel', add_self_div_two, ← add_div,
  add_assoc, add_sub_cancel'_right, add_self_div_two]

lemma real.totally_bounded_Ioo (a b : ℝ) : totally_bounded (Ioo a b) :=
metric.totally_bounded_iff.2 $ λ ε ε0, begin
  rcases exists_nat_gt ((b - a) / ε) with ⟨n, ba⟩,
  rw [div_lt_iff' ε0, sub_lt_iff_lt_add'] at ba,
  let s := (λ i:ℕ, a + ε * i) '' {i:ℕ | i < n},
  refine ⟨s, finite_image _ ⟨set.fintype_lt_nat _⟩, λ x h, _⟩,
  rcases h with ⟨ax, xb⟩,
  let i : ℕ := ⌊(x - a) / ε⌋.to_nat,
  have : (i : ℤ) = ⌊(x - a) / ε⌋ :=
    int.to_nat_of_nonneg (floor_nonneg.2 $ le_of_lt (div_pos (sub_pos.2 ax) ε0)),
  simp, refine ⟨_, ⟨i, _, rfl⟩, _⟩,
  { rw [← int.coe_nat_lt, this],
    refine int.cast_lt.1 (lt_of_le_of_lt (floor_le _) _),
    rw [int.cast_coe_nat, div_lt_iff' ε0, sub_lt_iff_lt_add'],
    exact lt_trans xb ba },
  { rw [real.dist_eq, ← int.cast_coe_nat, this, abs_of_nonneg,
        ← sub_sub, sub_lt_iff_lt_add'],
    { have := lt_floor_add_one ((x - a) / ε),
      rwa [div_lt_iff' ε0, mul_add, mul_one] at this },
    { have := floor_le ((x - a) / ε),
      rwa [ge, sub_nonneg, ← le_sub_iff_add_le', ← le_div_iff' ε0] } }
end

lemma real.totally_bounded_ball (x ε : ℝ) : totally_bounded (ball x ε) :=
by rw real.ball_eq_Ioo; apply real.totally_bounded_Ioo

lemma real.totally_bounded_Ico (a b : ℝ) : totally_bounded (Ico a b) :=
let ⟨c, ac⟩ := no_bot a in totally_bounded_subset
  (by exact λ x ⟨h₁, h₂⟩, ⟨lt_of_lt_of_le ac h₁, h₂⟩)
  (real.totally_bounded_Ioo c b)

lemma real.totally_bounded_Icc (a b : ℝ) : totally_bounded (Icc a b) :=
let ⟨c, bc⟩ := no_top b in totally_bounded_subset
  (by exact λ x ⟨h₁, h₂⟩, ⟨h₁, lt_of_le_of_lt h₂ bc⟩)
  (real.totally_bounded_Ico a c)

lemma rat.totally_bounded_Icc (a b : ℚ) : totally_bounded (Icc a b) :=
begin
  have := totally_bounded_preimage uniform_embedding_of_rat (real.totally_bounded_Icc a b),
  rwa (set.ext (λ q, _) : Icc _ _ = _), simp
end

-- TODO(Mario): Generalize to first-countable uniform spaces?
instance : complete_space ℝ :=
⟨λ f cf, begin
  let g : ℕ → {ε:ℝ//ε>0} := λ n, ⟨n.to_pnat'⁻¹, inv_pos (nat.cast_pos.2 n.to_pnat'.pos)⟩,
  choose S hS hS_dist using show ∀n:ℕ, ∃t ∈ f.sets, ∀ x y ∈ t, dist x y < g n, from
    assume n, let ⟨t, tf, h⟩ := (metric.cauchy_iff.1 cf).2 (g n).1 (g n).2 in ⟨t, tf, h⟩,
  let F : ℕ → set ℝ := λn, ⋂i≤n, S i,
  have hF : ∀n, F n ∈ f.sets := assume n, Inter_mem_sets (finite_le_nat n) (λ i _, hS i),
  have hF_dist : ∀n, ∀ x y ∈ F n, dist x y < g n :=
    assume n x y hx hy,
    have F n ⊆ S n := bInter_subset_of_mem (le_refl n),
    (hS_dist n) _ _ (this hx) (this hy),
  choose G hG using assume n:ℕ, inhabited_of_mem_sets cf.1 (hF n),
  have hg : ∀ ε > 0, ∃ n, ∀ j ≥ n, (g j : ℝ) < ε,
  { intros ε ε0,
    cases exists_nat_gt ε⁻¹ with n hn,
    refine ⟨n, λ j nj, _⟩,
    have hj := lt_of_lt_of_le hn (nat.cast_le.2 nj),
    have j0 := lt_trans (inv_pos ε0) hj,
    have jε := (inv_lt j0 ε0).2 hj,
    rwa ← pnat.to_pnat'_coe (nat.cast_pos.1 j0) at jε },
  let c : cau_seq ℝ abs,
  { refine ⟨λ n, G n, λ ε ε0, _⟩,
    cases hg _ ε0 with n hn,
    refine ⟨n, λ j jn, _⟩,
    have : F j ⊆ F n :=
      bInter_subset_bInter_left (λ i h, @le_trans _ _ i n j h jn),
    exact lt_trans (hF_dist n _ _ (this (hG j)) (hG n)) (hn _ $ le_refl _) },
  refine ⟨cau_seq.lim c, λ s h, _⟩,
  rcases metric.mem_nhds_iff.1 h with ⟨ε, ε0, hε⟩,
  cases exists_forall_ge_and (hg _ $ half_pos ε0)
    (cau_seq.equiv_lim c _ $ half_pos ε0) with n hn,
  cases hn _ (le_refl _) with h₁ h₂,
  refine sets_of_superset _ (hF n) (subset.trans _ $
    subset.trans (ball_half_subset (G n) h₂) hε),
  exact λ x h, lt_trans ((hF_dist n) x (G n) h (hG n)) h₁
end⟩

lemma tendsto_coe_nat_real_at_top_iff {f : α → ℕ} {l : filter α} :
  tendsto (λ n, (f n : ℝ)) l at_top ↔ tendsto f l at_top :=
tendsto_at_top_embedding (assume a₁ a₂, nat.cast_le) $
  assume r, let ⟨n, hn⟩ := exists_nat_gt r in ⟨n, le_of_lt hn⟩

lemma tendsto_coe_nat_real_at_top_at_top : tendsto (coe : ℕ → ℝ) at_top at_top :=
tendsto_coe_nat_real_at_top_iff.2 tendsto_id

lemma tendsto_coe_int_real_at_top_iff {f : α → ℤ} {l : filter α} :
  tendsto (λ n, (f n : ℝ)) l at_top ↔ tendsto f l at_top :=
tendsto_at_top_embedding (assume a₁ a₂, int.cast_le) $
  assume r, let ⟨n, hn⟩ := exists_nat_gt r in
  ⟨(n:ℤ), le_of_lt $ by rwa [int.cast_coe_nat]⟩

lemma tendsto_coe_int_real_at_top_at_top : tendsto (coe : ℤ → ℝ) at_top at_top :=
tendsto_coe_int_real_at_top_iff.2 tendsto_id

section

lemma closure_of_rat_image_lt {q : ℚ} : closure ((coe:ℚ → ℝ) '' {x | q < x}) = {r | ↑q ≤ r} :=
subset.antisymm
  ((closure_subset_iff_subset_of_is_closed (is_closed_ge' _)).2
    (image_subset_iff.2 $ λ p h, le_of_lt $ (@rat.cast_lt ℝ _ _ _).2 h)) $
λ x hx, mem_closure_iff_nhds.2 $ λ t ht,
let ⟨ε, ε0, hε⟩ := metric.mem_nhds_iff.1 ht in
let ⟨p, h₁, h₂⟩ := exists_rat_btwn ((lt_add_iff_pos_right x).2 ε0) in
ne_empty_iff_exists_mem.2 ⟨_, hε (show abs _ < _,
    by rwa [abs_of_nonneg (le_of_lt $ sub_pos.2 h₁), sub_lt_iff_lt_add']),
  p, rat.cast_lt.1 (@lt_of_le_of_lt ℝ _ _ _ _ hx h₁), rfl⟩

/- TODO(Mario): Put these back only if needed later
lemma closure_of_rat_image_le_eq {q : ℚ} : closure ((coe:ℚ → ℝ) '' {x | q ≤ x}) = {r | ↑q ≤ r} :=
_

lemma closure_of_rat_image_le_le_eq {a b : ℚ} (hab : a ≤ b) :
  closure (of_rat '' {q:ℚ | a ≤ q ∧ q ≤ b}) = {r:ℝ | of_rat a ≤ r ∧ r ≤ of_rat b} :=
_-/

lemma compact_Icc {a b : ℝ} : compact (Icc a b) :=
compact_of_totally_bounded_is_closed
  (real.totally_bounded_Icc a b)
  (is_closed_inter (is_closed_ge' a) (is_closed_le' b))

instance : proper_space ℝ :=
{ compact_ball := λx r, by rw closed_ball_Icc; apply compact_Icc }

open real

lemma real.intermediate_value {f : ℝ → ℝ} {a b t : ℝ}
  (hf : ∀ x, a ≤ x → x ≤ b → tendsto f (nhds x) (nhds (f x)))
  (ha : f a ≤ t) (hb : t ≤ f b) (hab : a ≤ b) : ∃ x : ℝ, a ≤ x ∧ x ≤ b ∧ f x = t :=
let x := real.Sup {x | f x ≤ t ∧ a ≤ x ∧ x ≤ b} in
have hx₁ : ∃ y, ∀ g ∈ {x | f x ≤ t ∧ a ≤ x ∧ x ≤ b}, g ≤ y := ⟨b, λ _ h, h.2.2⟩,
have hx₂ : ∃ y, y ∈ {x | f x ≤ t ∧ a ≤ x ∧ x ≤ b} := ⟨a, ha, le_refl _, hab⟩,
have hax : a ≤ x, from le_Sup _ hx₁ ⟨ha, le_refl _, hab⟩,
have hxb : x ≤ b, from (Sup_le _ hx₂ hx₁).2 (λ _ h, h.2.2),
⟨x, hax, hxb,
  eq_of_forall_dist_le $ λ ε ε0,
    let ⟨δ, hδ0, hδ⟩ := metric.tendsto_nhds_nhds.1 (hf _ hax hxb) ε ε0 in
    (le_total t (f x)).elim
      (λ h, le_of_not_gt $ λ hfε, begin
        rw [dist_eq, abs_of_nonneg (sub_nonneg.2 h)] at hfε,
        refine mt (Sup_le {x | f x ≤ t ∧ a ≤ x ∧ x ≤ b} hx₂ hx₁).2
          (not_le_of_gt (sub_lt_self x (half_pos hδ0)))
          (λ g hg, le_of_not_gt
            (λ hgδ, not_lt_of_ge hg.1
              (lt_trans (lt_sub.1 hfε) (sub_lt_of_sub_lt
                (lt_of_le_of_lt (le_abs_self _) _))))),
        rw abs_sub,
        exact hδ (abs_sub_lt_iff.2 ⟨lt_of_le_of_lt (sub_nonpos.2 (le_Sup _ hx₁ hg)) hδ0,
          by simp only [x] at *; linarith⟩)
        end)
      (λ h, le_of_not_gt $ λ hfε, begin
        rw [dist_eq, abs_of_nonpos (sub_nonpos.2 h)] at hfε,
        exact mt (le_Sup {x | f x ≤ t ∧ a ≤ x ∧ x ≤ b})
          (λ h : ∀ k, k ∈ {x | f x ≤ t ∧ a ≤ x ∧ x ≤ b} → k ≤ x,
            not_le_of_gt ((lt_add_iff_pos_left x).2 (half_pos hδ0))
              (h _ ⟨le_trans (le_sub_iff_add_le.2 (le_trans (le_abs_self _)
                    (le_of_lt (hδ $ by rw [dist_eq, add_sub_cancel, abs_of_nonneg (le_of_lt (half_pos hδ0))];
                      exact half_lt_self hδ0))))
                  (by linarith),
                le_trans hax (le_of_lt ((lt_add_iff_pos_left _).2 (half_pos hδ0))),
                le_of_not_gt (λ hδy, not_lt_of_ge hb (lt_of_le_of_lt
                  (show f b ≤ f b - f x - ε + t, by linarith)
                  (add_lt_of_neg_of_le
                    (sub_neg_of_lt (lt_of_le_of_lt (le_abs_self _)
                      (@hδ b (abs_sub_lt_iff.2 ⟨by simp only [x] at *; linarith,
                        by linarith⟩))))
                    (le_refl _))))⟩))
          hx₁
        end)⟩

lemma real.intermediate_value' {f : ℝ → ℝ} {a b t : ℝ}
  (hf : ∀ x, a ≤ x → x ≤ b → tendsto f (nhds x) (nhds (f x)))
  (ha : t ≤ f a) (hb : f b ≤ t) (hab : a ≤ b) : ∃ x : ℝ, a ≤ x ∧ x ≤ b ∧ f x = t :=
let ⟨x, hx₁, hx₂, hx₃⟩ := @real.intermediate_value
  (λ x, - f x) a b (-t) (λ x hax hxb, tendsto_neg (hf x hax hxb))
  (neg_le_neg ha) (neg_le_neg hb) hab in
⟨x, hx₁, hx₂, neg_inj hx₃⟩

lemma real.bounded_iff_bdd_below_bdd_above {s : set ℝ} : bounded s ↔ bdd_below s ∧ bdd_above s :=
⟨begin
  assume bdd,
  rcases (bounded_iff_subset_ball 0).1 bdd with ⟨r, hr⟩, -- hr : s ⊆ closed_ball 0 r
  rw closed_ball_Icc at hr, -- hr : s ⊆ Icc (0 - r) (0 + r)
  exact ⟨⟨-r, λy hy, by simpa using (hr hy).1⟩, ⟨r, λy hy, by simpa using (hr hy).2⟩⟩
end,
begin
  rintros ⟨⟨m, hm⟩, ⟨M, hM⟩⟩,
  have I : s ⊆ Icc m M := λx hx, ⟨hm x hx, hM x hx⟩,
  have : Icc m M = closed_ball ((m+M)/2) ((M-m)/2) :=
    by rw closed_ball_Icc; congr; ring,
  rw this at I,
  exact bounded.subset I bounded_closed_ball
end⟩

end


variables p q : Prop

theorem and_swap : p ∧ q ↔ q ∧ p :=
  iff.intro
    (assume h : p ∧ q,
      show q ∧ p, from ⟨h.right, h.left⟩)
    (assume h : q ∧ p,
      show p ∧ q, from ⟨h.right, h.left⟩)

#check and_swap


/-
Try to solve this level with exactly one line, using the `rwa` tactic.
-/

variables {X : Type} -- hide

/- Lemma : no-side-bar
Let A be a set and x ∈ A, using the assumption A ∪ A = A, we obtain that x ∈ B.
-/
lemma example_on_rwa (A : set X) (x : X) (h1 : x ∈ A) (h2 : A ∪ A = A) : x ∈ A ∪ A :=
begin
  rwa h2,

end


-- Pruebas en Lean de P ∧ Q → Q ∧ P
-- ================================

-- ----------------------------------------------------
-- Ej. 1. Demostrar que
--    P ∧ Q → Q ∧ P
-- ----------------------------------------------------

import tactic

variables (P Q : Prop)

-- 1ª demostración
example : P ∧ Q → Q ∧ P :=
assume h : P ∧ Q,
have hP : P,
  from and.left h,
have hQ : Q,
  from and.right h,
show Q ∧ P,
  from and.intro hQ hP

-- 2ª demostración
example : P ∧ Q → Q ∧ P :=
assume h : P ∧ Q,
have hP : P,
  from h.left,
have hQ : Q,
  from h.right,
show Q ∧ P,
  from ⟨hQ, hP⟩

-- 3ª demostración
example : P ∧ Q → Q ∧ P :=
assume h : P ∧ Q,
have hP : P,
  from h.1,
have hQ : Q,
  from h.2,
show Q ∧ P,
  from ⟨hQ, hP⟩

-- 4ª demostración
example : P ∧ Q → Q ∧ P :=
assume h : P ∧ Q,
have hP : P := h.1,
have hQ : Q := h.2,
show Q ∧ P,
  from ⟨hQ, hP⟩

-- 5ª demostración
example : P ∧ Q → Q ∧ P :=
assume h : P ∧ Q,
show Q ∧ P,
  from ⟨h.2, h.1⟩

-- 6ª demostración
example : P ∧ Q → Q ∧ P :=
assume h : P ∧ Q, ⟨h.2, h.1⟩

-- 7ª demostración
example : P ∧ Q → Q ∧ P :=
λ h, ⟨h.2, h.1⟩

-- 8ª demostración
example : P ∧ Q → Q ∧ P :=
begin
  intro h,
  cases h with hP hQ,
  split,
  { exact hQ, },
  { exact hP, },
end

-- 9ª demostración
example : P ∧ Q → Q ∧ P :=
begin
  rintro ⟨hP, hQ⟩,
  exact ⟨hQ, hP⟩,
end

-- 10ª demostración
example : P ∧ Q → Q ∧ P :=
λ ⟨hP, hQ⟩, ⟨hQ, hP⟩

-- 11ª demostración
example : P ∧ Q → Q ∧ P :=
-- by library_search
and.comm.mp

-- 12ª demostración
example : P ∧ Q → Q ∧ P :=
and.swap

-- 13ª demostración
example : P ∧ Q → Q ∧ P:=
-- by hint
by tauto

-- 13ª demostración
example : P ∧ Q → Q ∧ P :=
by finish


/-
Copyright © 2020 Nicolò Cavalleri. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Nicolò Cavalleri.
-/

import geometry.manifold.times_cont_mdiff
import topology.continuous_map

/-!
# Smooth bundled map

In this file we define the type `times_cont_mdiff_map` of `n` times continuously differentiable
bundled maps.
-/

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{E : Type*} [normed_group E] [normed_space 𝕜 E]
{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
{H : Type*} [topological_space H]
{H' : Type*} [topological_space H']
(I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H')
(M : Type*) [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
(M' : Type*) [topological_space M'] [charted_space H' M'] [smooth_manifold_with_corners I' M']
{E'' : Type*} [normed_group E''] [normed_space 𝕜 E'']
{H'' : Type*} [topological_space H'']
{I'' : model_with_corners 𝕜 E'' H''}
{M'' : Type*} [topological_space M''] [charted_space H'' M''] [smooth_manifold_with_corners I'' M'']
(n : with_top ℕ)

/-- Bundled `n` times continuously differentiable maps. -/
@[protect_proj]
structure times_cont_mdiff_map :=
(to_fun                  : M → M')
(times_cont_mdiff_to_fun : times_cont_mdiff I I' n to_fun)

/-- Bundled smooth maps. -/
@[reducible] def smooth_map := times_cont_mdiff_map I I' M M' ⊤

localized "notation `C^` n `⟮` I `, ` M `; ` I' `, ` M' `⟯` :=
  times_cont_mdiff_map I I' M M' n" in manifold
localized "notation `C^` n `⟮` I `, ` M `; ` k `⟯` :=
  times_cont_mdiff_map I (model_with_corners_self k k) M k n" in manifold

open_locale manifold

namespace times_cont_mdiff_map

variables {I} {I'} {M} {M'} {n}

instance : has_coe_to_fun C^n⟮I, M; I', M'⟯ := ⟨_, times_cont_mdiff_map.to_fun⟩
instance : has_coe C^n⟮I, M; I', M'⟯ C(M, M') :=
⟨λ f, ⟨f.to_fun, f.times_cont_mdiff_to_fun.continuous⟩⟩

variables {f g : C^n⟮I, M; I', M'⟯}

protected lemma times_cont_mdiff (f : C^n⟮I, M; I', M'⟯) :
  times_cont_mdiff I I' n f := f.times_cont_mdiff_to_fun

protected lemma smooth (f : C^∞⟮I, M; I', M'⟯) :
  smooth I I' f := f.times_cont_mdiff_to_fun

lemma coe_inj ⦃f g : C^n⟮I, M; I', M'⟯⦄ (h : (f : M → M') = g) : f = g :=
by cases f; cases g; cases h; refl

@[ext] theorem ext (h : ∀ x, f x = g x) : f = g :=
by cases f; cases g; congr'; exact funext h

/-- The identity as a smooth map. -/
def id : C^n⟮I, M; I, M⟯ := ⟨id, times_cont_mdiff_id⟩

/-- The composition of smooth maps, as a smooth map. -/
def comp (f : C^n⟮I', M'; I'', M''⟯) (g : C^n⟮I, M; I', M'⟯) : C^n⟮I, M; I'', M''⟯ :=
{ to_fun := λ a, f (g a),
  times_cont_mdiff_to_fun := f.times_cont_mdiff_to_fun.comp g.times_cont_mdiff_to_fun, }

@[simp] lemma comp_apply (f : C^n⟮I', M'; I'', M''⟯) (g : C^n⟮I, M; I', M'⟯) (x : M) :
  f.comp g x = f (g x) := rfl

instance [inhabited M'] : inhabited C^n⟮I, M; I', M'⟯ :=
⟨⟨λ _, default _, times_cont_mdiff_const⟩⟩

/-- Constant map as a smooth map -/
def const (y : M') : C^n⟮I, M; I', M'⟯ := ⟨λ x, y, times_cont_mdiff_const⟩

end times_cont_mdiff_map

open_locale manifold

instance continuous_linear_map.has_coe_to_times_cont_mdiff_map :
  has_coe (E →L[𝕜] E') C^n⟮𝓘(𝕜, E), E; 𝓘(𝕜, E'), E'⟯ :=
⟨λ f, ⟨f.to_fun, f.times_cont_mdiff⟩⟩


import algebra.ring data.equiv.basic

open ring

structure ring_isom (R : Type*) (F : Type*) [ring R] [ring F] extends equiv R F :=
(isom_is_hom : is_ring_hom (equiv.to_fun to_equiv))

section ring_isom

variables {R : Type*} {F : Type*} [ring R] [ring F]

open ring_isom

def isom (Hs : ring_isom R F) := (equiv.to_fun Hs.to_equiv)

instance (Hs : ring_isom R F) : is_ring_hom (isom Hs) := ring_isom.isom_is_hom Hs

def ring_isom.map_add (Hs : ring_isom R F) (x y : R) :
isom Hs (x + y) = isom Hs x + isom Hs y := is_ring_hom.map_add (isom Hs)

def ring_isom.map_mul (Hs : ring_isom R F) (x y : R) :
isom Hs (x * y) = isom Hs x * isom Hs y := is_ring_hom.map_mul (isom Hs)

def ring_isom.map_one (Hs : ring_isom R F) :
isom Hs (1) = 1 := is_ring_hom.map_one (isom Hs)

lemma isom_is_bijective (Hs : ring_isom R F) :
function.bijective (isom Hs) := equiv.bijective Hs.to_equiv

lemma isom_zero (Hs : ring_isom R F) :
isom Hs (0 : R) = 0 :=
begin
have H : ∃ (a : R), isom Hs (a) = 0,
    exact (isom_is_bijective Hs).right 0,
cases H with a H,
have He : isom Hs (a) * isom Hs (0) = 0,
    rw H,
    simp,
rw ←ring_isom.map_mul at He,
rw ring.mul_zero at He,
exact He,
end

lemma isom_zero_iff (Hs : ring_isom R F) (x : R) :
isom Hs x = 0 ↔ x = 0 :=
begin
split,
    intros H,
    rw ←isom_zero Hs at H,
    exact (function.injective.eq_iff (isom_is_bijective Hs).left).mp H,

    intros H,
    rw H,
    rw isom_zero,
end

lemma isom_neg_one (Hs : ring_isom R F) :
isom Hs (-1 : R) = -1 :=
begin
have H2 : isom Hs (-1 + 1) = 0,
    rw neg_add_self,
    rw isom_zero,
rw ring_isom.map_add at H2,
rw add_eq_zero_iff_eq_neg at H2,
rw ring_isom.map_one at H2,
exact H2,
end

lemma isom_neg (Hs : ring_isom R F) (x : R) :
isom Hs (-x) = -(isom Hs x) :=
begin
rw ←neg_one_mul,
rw ring_isom.map_mul,
rw isom_neg_one,
rw neg_one_mul,
end

end ring_isom

def ring_auto {R : Type*} [ring R] := ring_isom R R

class is_ring_anti_hom {R : Type*} {F :Type*} [ring R] [ring F] (f : R → F) : Prop :=
(map_add : ∀ {x y : R}, f (x + y) = f x + f y)
(map_mul : ∀ {x y : R}, f (x * y) = f y * f x)
(map_one : f 1 = 1)

structure ring_anti_isom (R : Type*) (F : Type*) [ring R] [ring F] extends equiv R F :=
(anti_isom_is_anti_hom : is_ring_anti_hom (equiv.to_fun to_equiv))

section ring_anti_isom

variables {R : Type*} {F : Type*} [ring R] [ring F]

open ring_anti_isom

def anti_isom (Hs : ring_anti_isom R F) := (equiv.to_fun Hs.to_equiv)

instance (Hs : ring_anti_isom R F) : is_ring_anti_hom (anti_isom Hs) := ring_anti_isom.anti_isom_is_anti_hom Hs

def ring_anti_isom.map_add (Hs : ring_anti_isom R F) (x y : R) :
anti_isom Hs (x + y) = anti_isom Hs x + anti_isom Hs y := is_ring_anti_hom.map_add (anti_isom Hs)

def ring_anti_isom.map_mul (Hs : ring_anti_isom R F) (x y : R) :
anti_isom Hs (x * y) = anti_isom Hs y * anti_isom Hs x := is_ring_anti_hom.map_mul (anti_isom Hs)

def ring_anti_isom.map_one (Hs : ring_anti_isom R F) :
anti_isom Hs (1) = 1 := is_ring_anti_hom.map_one (anti_isom Hs)

lemma anti_isom_is_bijective (Hs : ring_anti_isom R F) :
function.bijective (anti_isom Hs) := equiv.bijective Hs.to_equiv

lemma anti_isom_zero (Hs : ring_anti_isom R F) :
anti_isom Hs (0 : R) = 0 :=
begin
have H : ∃ (a : R), anti_isom Hs (a) = 0,
    exact (anti_isom_is_bijective Hs).right 0,
cases H with a H,
have He : anti_isom Hs (a) * anti_isom Hs (0) = 0,
    rw H,
    simp,
rw ←ring_anti_isom.map_mul at He,
rw ring.zero_mul at He,
exact He,
end

lemma anti_isom_zero_iff (Hs : ring_anti_isom R F) (x : R) :
anti_isom Hs x = 0 ↔ x = 0 :=
begin
split,
    intros H,
    rw ←anti_isom_zero Hs at H,
    exact (function.injective.eq_iff (anti_isom_is_bijective Hs).left).mp H,

    intros H,
    rw H,
    rw anti_isom_zero,
end

lemma anti_isom_neg_one (Hs : ring_anti_isom R F) :
anti_isom Hs (-1 : R) = -1 :=
begin
have H2 : anti_isom Hs (-1 + 1) = 0,
    rw neg_add_self,
    rw anti_isom_zero,
rw ring_anti_isom.map_add at H2,
rw add_eq_zero_iff_eq_neg at H2,
rw ring_anti_isom.map_one at H2,
exact H2,
end

lemma anti_isom_neg (Hs : ring_anti_isom R F) (x : R) :
anti_isom Hs (-x) = -(anti_isom Hs x) :=
begin
rw ←neg_one_mul,
rw ring_anti_isom.map_mul,
rw anti_isom_neg_one,
rw mul_neg_one,
end

end ring_anti_isom

def comm_ring.hom_to_anti_hom {R : Type*} {F : Type*} [comm_ring R] [comm_ring F] (f : R → F) [is_ring_hom f] :
is_ring_anti_hom f :=
{
map_add := λ {x y : R}, is_ring_hom.map_add f,
map_mul := begin intros, have He : mul x y = x * y, refl, rw He, rw mul_comm, rw is_ring_hom.map_mul f, refl, end,
map_one := is_ring_hom.map_one f,
}

def comm_ring.anti_hom_to_hom {R : Type*} {F : Type*} [comm_ring R] [comm_ring F] (f : R → F) [is_ring_anti_hom f] :
is_ring_hom f :=
{
map_add := λ {x y : R}, is_ring_anti_hom.map_add f,
map_mul := begin begin intros, have He : mul x y = x * y, refl, rw He, rw mul_comm, rw is_ring_anti_hom.map_mul f, refl, end, end,
map_one := is_ring_anti_hom.map_one f,
}

instance ring_isom.to_is_ring_hom {R : Type*} {F : Type*} [ring R] [ring F] (Hs : ring_isom R F) :
is_ring_hom Hs.to_equiv.to_fun := Hs.isom_is_hom

instance ring_anti_isom.to_is_ring_anti_hom {R : Type*} {F : Type*} [ring R] [ring F] (Hs : ring_anti_isom R F) :
is_ring_anti_hom Hs.to_equiv.to_fun := Hs.anti_isom_is_anti_hom

def comm_ring.isom_to_anti_isom {R : Type*} {F : Type*} [comm_ring R] [comm_ring F] (Hs : ring_isom R F) :
ring_anti_isom R F :=
{
to_equiv := Hs.to_equiv,
anti_isom_is_anti_hom := comm_ring.hom_to_anti_hom (isom Hs),
}

def comm_ring.anti_isom_to_isom {R : Type*} {F : Type*} [comm_ring R] [comm_ring F] (Hs : ring_anti_isom R F) :
ring_isom R F :=
{
to_equiv := Hs.to_equiv,
isom_is_hom := comm_ring.anti_hom_to_hom (anti_isom Hs),
}

def ring_anti_auto {R : Type*} [ring R] := ring_anti_isom R R

structure ring_invo (R : Type*) [ring R] extends ring_anti_isom R R :=
(invo_comp_self : ∀ (x : R), (equiv.to_fun to_equiv) (((equiv.to_fun to_equiv) x)) = x)

open ring_invo

section ring_invo

variables {R : Type*} [ring R]

def invo (Hi : ring_invo R) := equiv.to_fun (ring_anti_isom.to_equiv Hi.to_ring_anti_isom)

def ring_invo.map_add (Hi : ring_invo R) (x y : R) :
invo Hi (x + y) = invo Hi (x) + invo Hi (y) := ring_anti_isom.map_add (Hi.to_ring_anti_isom) x y

def ring_invo.map_mul (Hi : ring_invo R) (x y : R) :
invo Hi (x * y) = invo Hi (y) * invo Hi (x) := ring_anti_isom.map_mul (Hi.to_ring_anti_isom) x y

def ring_invo.map_one (Hi : ring_invo R) :
invo Hi (1 : R) = 1 := ring_anti_isom.map_one (Hi.to_ring_anti_isom)

def invo_invo (Hi : ring_invo R) (x : R) :
invo Hi (invo Hi (x)) = x := invo_comp_self Hi x

lemma invo_is_bijective (Hi : ring_invo R):
function.bijective (invo Hi) := equiv.bijective (ring_invo.to_ring_anti_isom Hi).to_equiv

lemma invo_zero (Hi : ring_invo R) :
invo Hi (0 : R) = 0 := anti_isom_zero (Hi.to_ring_anti_isom)

lemma invo_zero_iff (Hi : ring_invo R) (x : R) :
invo Hi x = 0 ↔ x = 0 := anti_isom_zero_iff (Hi.to_ring_anti_isom) x

lemma invo_neg_one (Hi : ring_invo R) :
invo Hi (-1 : R) = -1 := anti_isom_neg_one (Hi.to_ring_anti_isom)

lemma invo_neg (Hi : ring_invo R) (x : R) :
invo Hi (-x) = -(invo Hi x) := anti_isom_neg (Hi.to_ring_anti_isom) x

end ring_invo

def id_is_equiv (R : Type*) : equiv R R :=
⟨id, id, begin dunfold function.left_inverse, intros, simp, end, begin dunfold function.right_inverse, dunfold function.left_inverse, intros, simp, end⟩

def id_is_isom (R : Type*) [ring R] : ring_isom R R :=
⟨id_is_equiv R, begin have He : (id_is_equiv R).to_fun = id, refl, rw He, simp end, begin have He : (id_is_equiv R).to_fun = id, refl, rw He, simp end, begin have He : (id_is_equiv R).to_fun = id, refl, rw He, simp end⟩

def id_is_anti_isom (R : Type*) [comm_ring R] : ring_anti_isom R R := comm_ring.isom_to_anti_isom (id_is_isom R)

def id_is_invo (R : Type*) [comm_ring R] : ring_invo R :=
⟨id_is_anti_isom R, begin have He : ((id_is_anti_isom R).to_equiv).to_fun = id, refl, rw He, simp end⟩


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_numbertheory_85 :
  1 * 3^3 + 2 * 3^2 + 2*3 + 2 = 53 :=
begin
  norm_num,
end


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.int.basic
import data.nat.cast

open nat

namespace int

/- cast (injection into groups with one) -/

@[simp, push_cast] theorem nat_cast_eq_coe_nat : ∀ n,
  @coe ℕ ℤ (@coe_to_lift _ _ nat.cast_coe) n =
  @coe ℕ ℤ (@coe_to_lift _ _ (@coe_base _ _ int.has_coe)) n
| 0     := rfl
| (n+1) := congr_arg (+(1:ℤ)) (nat_cast_eq_coe_nat n)

/-- Coercion `ℕ → ℤ` as a `ring_hom`. -/
def of_nat_hom : ℕ →+* ℤ := ⟨coe, rfl, int.of_nat_mul, rfl, int.of_nat_add⟩

section cast
variables {α : Type*}

section
variables [has_zero α] [has_one α] [has_add α] [has_neg α]

/-- Canonical homomorphism from the integers to any ring(-like) structure `α` -/
protected def cast : ℤ → α
| (n : ℕ) := n
| -[1+ n] := -(n+1)

-- see Note [coercion into rings]
@[priority 900] instance cast_coe : has_coe_t ℤ α := ⟨int.cast⟩

@[simp, norm_cast] theorem cast_zero : ((0 : ℤ) : α) = 0 := rfl

theorem cast_of_nat (n : ℕ) : (of_nat n : α) = n := rfl
@[simp, norm_cast] theorem cast_coe_nat (n : ℕ) : ((n : ℤ) : α) = n := rfl
theorem cast_coe_nat' (n : ℕ) :
  (@coe ℕ ℤ (@coe_to_lift _ _ nat.cast_coe) n : α) = n :=
by simp

@[simp, norm_cast] theorem cast_neg_succ_of_nat (n : ℕ) : (-[1+ n] : α) = -(n + 1) := rfl

end

@[simp, norm_cast] theorem cast_one [add_monoid α] [has_one α] [has_neg α] :
  ((1 : ℤ) : α) = 1 := nat.cast_one

@[simp] theorem cast_sub_nat_nat [add_group α] [has_one α] (m n) :
  ((int.sub_nat_nat m n : ℤ) : α) = m - n :=
begin
  unfold sub_nat_nat, cases e : n - m,
  { simp [sub_nat_nat, e, nat.le_of_sub_eq_zero e] },
  { rw [sub_nat_nat, cast_neg_succ_of_nat, ← nat.cast_succ, ← e,
        nat.cast_sub $ _root_.le_of_lt $ nat.lt_of_sub_eq_succ e, neg_sub] },
end

@[simp, norm_cast] theorem cast_neg_of_nat [add_group α] [has_one α] :
  ∀ n, ((neg_of_nat n : ℤ) : α) = -n
| 0     := neg_zero.symm
| (n+1) := rfl

@[simp, norm_cast] theorem cast_add [add_group α] [has_one α] : ∀ m n, ((m + n : ℤ) : α) = m + n
| (m : ℕ) (n : ℕ) := nat.cast_add _ _
| (m : ℕ) -[1+ n] := by simpa only [sub_eq_add_neg] using cast_sub_nat_nat _ _
| -[1+ m] (n : ℕ) := (cast_sub_nat_nat _ _).trans $ sub_eq_of_eq_add $
  show (n:α) = -(m+1) + n + (m+1),
  by rw [add_assoc, ← cast_succ, ← nat.cast_add, add_comm,
         nat.cast_add, cast_succ, neg_add_cancel_left]
| -[1+ m] -[1+ n] := show -((m + n + 1 + 1 : ℕ) : α) = -(m + 1) + -(n + 1),
  begin
    rw [← neg_add_rev, ← nat.cast_add_one, ← nat.cast_add_one, ← nat.cast_add],
    apply congr_arg (λ x:ℕ, -(x:α)),
    ac_refl
  end

@[simp, norm_cast] theorem cast_neg [add_group α] [has_one α] : ∀ n, ((-n : ℤ) : α) = -n
| (n : ℕ) := cast_neg_of_nat _
| -[1+ n] := (neg_neg _).symm

@[simp, norm_cast] theorem cast_sub [add_group α] [has_one α] (m n) : ((m - n : ℤ) : α) = m - n :=
by simp [sub_eq_add_neg]

@[simp, norm_cast] theorem cast_mul [ring α] : ∀ m n, ((m * n : ℤ) : α) = m * n
| (m : ℕ) (n : ℕ) := nat.cast_mul _ _
| (m : ℕ) -[1+ n] := (cast_neg_of_nat _).trans $
  show (-(m * (n + 1) : ℕ) : α) = m * -(n + 1),
  by rw [nat.cast_mul, nat.cast_add_one, neg_mul_eq_mul_neg]
| -[1+ m] (n : ℕ) := (cast_neg_of_nat _).trans $
  show (-((m + 1) * n : ℕ) : α) = -(m + 1) * n,
  by rw [nat.cast_mul, nat.cast_add_one, neg_mul_eq_neg_mul]
| -[1+ m] -[1+ n] := show (((m + 1) * (n + 1) : ℕ) : α) = -(m + 1) * -(n + 1),
  by rw [nat.cast_mul, nat.cast_add_one, nat.cast_add_one, neg_mul_neg]

/-- `coe : ℤ → α` as an `add_monoid_hom`. -/
def cast_add_hom (α : Type*) [add_group α] [has_one α] : ℤ →+ α := ⟨coe, cast_zero, cast_add⟩

@[simp] lemma coe_cast_add_hom [add_group α] [has_one α] : ⇑(cast_add_hom α) = coe := rfl

/-- `coe : ℤ → α` as a `ring_hom`. -/
def cast_ring_hom (α : Type*) [ring α] : ℤ →+* α := ⟨coe, cast_one, cast_mul, cast_zero, cast_add⟩

@[simp] lemma coe_cast_ring_hom [ring α] : ⇑(cast_ring_hom α) = coe := rfl

lemma cast_commute [ring α] (m : ℤ) (x : α) : commute ↑m x :=
int.cases_on m (λ n, n.cast_commute x) (λ n, ((n+1).cast_commute x).neg_left)

lemma cast_comm [ring α] (m : ℤ) (x : α) : (m : α) * x = x * m :=
(cast_commute m x).eq

lemma commute_cast [ring α] (x : α) (m : ℤ) : commute x m :=
(m.cast_commute x).symm

@[simp, norm_cast]
theorem coe_nat_bit0 (n : ℕ) : (↑(bit0 n) : ℤ) = bit0 ↑n := by {unfold bit0, simp}

@[simp, norm_cast]
theorem coe_nat_bit1 (n : ℕ) : (↑(bit1 n) : ℤ) = bit1 ↑n := by {unfold bit1, unfold bit0, simp}

@[simp, norm_cast] theorem cast_bit0 [ring α] (n : ℤ) : ((bit0 n : ℤ) : α) = bit0 n := cast_add _ _

@[simp, norm_cast] theorem cast_bit1 [ring α] (n : ℤ) : ((bit1 n : ℤ) : α) = bit1 n :=
by rw [bit1, cast_add, cast_one, cast_bit0]; refl

lemma cast_two [ring α] : ((2 : ℤ) : α) = 2 := by simp

theorem cast_mono [ordered_ring α] : monotone (coe : ℤ → α) :=
begin
  intros m n h,
  rw ← sub_nonneg at h,
  lift n - m to ℕ using h with k,
  rw [← sub_nonneg, ← cast_sub, ← h_1, cast_coe_nat],
  exact k.cast_nonneg
end

@[simp] theorem cast_nonneg [ordered_ring α] [nontrivial α] : ∀ {n : ℤ}, (0 : α) ≤ n ↔ 0 ≤ n
| (n : ℕ) := by simp
| -[1+ n] := have -(n:α) < 1, from lt_of_le_of_lt (by simp) zero_lt_one,
             by simpa [(neg_succ_lt_zero n).not_le, ← sub_eq_add_neg, le_neg] using this.not_le

@[simp, norm_cast] theorem cast_le [ordered_ring α] [nontrivial α] {m n : ℤ} :
  (m : α) ≤ n ↔ m ≤ n :=
by rw [← sub_nonneg, ← cast_sub, cast_nonneg, sub_nonneg]

theorem cast_strict_mono [ordered_ring α] [nontrivial α] : strict_mono (coe : ℤ → α) :=
strict_mono_of_le_iff_le $ λ m n, cast_le.symm

@[simp, norm_cast] theorem cast_lt [ordered_ring α] [nontrivial α] {m n : ℤ} :
  (m : α) < n ↔ m < n :=
cast_strict_mono.lt_iff_lt

@[simp] theorem cast_nonpos [ordered_ring α] [nontrivial α] {n : ℤ} : (n : α) ≤ 0 ↔ n ≤ 0 :=
by rw [← cast_zero, cast_le]

@[simp] theorem cast_pos [ordered_ring α] [nontrivial α] {n : ℤ} : (0 : α) < n ↔ 0 < n :=
by rw [← cast_zero, cast_lt]

@[simp] theorem cast_lt_zero [ordered_ring α] [nontrivial α] {n : ℤ} : (n : α) < 0 ↔ n < 0 :=
by rw [← cast_zero, cast_lt]

@[simp, norm_cast] theorem cast_min [linear_ordered_ring α] {a b : ℤ} :
  (↑(min a b) : α) = min a b :=
monotone.map_min cast_mono

@[simp, norm_cast] theorem cast_max [linear_ordered_ring α] {a b : ℤ} :
  (↑(max a b) : α) = max a b :=
monotone.map_max cast_mono

@[simp, norm_cast] theorem cast_abs [linear_ordered_ring α] {q : ℤ} :
  ((abs q : ℤ) : α) = abs q :=
by simp [abs]

lemma coe_int_dvd [comm_ring α] (m n : ℤ) (h : m ∣ n) :
  (m : α) ∣ (n : α) :=
ring_hom.map_dvd (int.cast_ring_hom α) h

end cast

end int

open int

namespace add_monoid_hom

variables {A : Type*}

/-- Two additive monoid homomorphisms `f`, `g` from `ℤ` to an additive monoid are equal
if `f 1 = g 1`. -/
@[ext] theorem ext_int [add_monoid A] {f g : ℤ →+ A} (h1 : f 1 = g 1) : f = g :=
have f.comp (int.of_nat_hom : ℕ →+ ℤ) = g.comp (int.of_nat_hom : ℕ →+ ℤ) := ext_nat h1,
have ∀ n : ℕ, f n = g n := ext_iff.1 this,
ext $ λ n, int.cases_on n this $ λ n, eq_on_neg (this $ n + 1)

variables [add_group A] [has_one A]

theorem eq_int_cast_hom (f : ℤ →+ A) (h1 : f 1 = 1) : f = int.cast_add_hom A :=
ext_int $ by simp [h1]

theorem eq_int_cast (f : ℤ →+ A) (h1 : f 1 = 1) : ∀ n : ℤ, f n = n :=
ext_iff.1 (f.eq_int_cast_hom h1)

end add_monoid_hom

namespace monoid_hom
variables {M : Type*} [monoid M]
open multiplicative

@[ext] theorem ext_mint {f g : multiplicative ℤ →* M} (h1 : f (of_add 1) = g (of_add 1)) : f = g :=
monoid_hom.ext $ add_monoid_hom.ext_iff.mp $
  @add_monoid_hom.ext_int _ _ f.to_additive g.to_additive h1

/-- If two `monoid_hom`s agree on `-1` and the naturals then they are equal. -/
@[ext] theorem ext_int {f g : ℤ →* M}
  (h_neg_one : f (-1) = g (-1))
  (h_nat : f.comp int.of_nat_hom.to_monoid_hom = g.comp int.of_nat_hom.to_monoid_hom) :
  f = g :=
begin
  ext (x | x),
  { exact (monoid_hom.congr_fun h_nat x : _), },
  { rw [int.neg_succ_of_nat_eq, ← neg_one_mul, f.map_mul, g.map_mul],
    congr' 1,
    exact_mod_cast (monoid_hom.congr_fun h_nat (x + 1) : _), }
end

end monoid_hom

namespace monoid_with_zero_hom

variables {M : Type*} [monoid_with_zero M]

/-- If two `monoid_with_zero_hom`s agree on `-1` and the naturals then they are equal. -/
@[ext] theorem ext_int {f g : monoid_with_zero_hom ℤ M}
  (h_neg_one : f (-1) = g (-1))
  (h_nat : f.comp int.of_nat_hom.to_monoid_with_zero_hom =
           g.comp int.of_nat_hom.to_monoid_with_zero_hom) :
  f = g :=
to_monoid_hom_injective $ monoid_hom.ext_int h_neg_one $ monoid_hom.ext (congr_fun h_nat : _)

/-- If two `monoid_with_zero_hom`s agree on `-1` and the _positive_ naturals then they are equal. -/
theorem ext_int' {φ₁ φ₂ : monoid_with_zero_hom ℤ M}
  (h_neg_one : φ₁ (-1) = φ₂ (-1)) (h_pos : ∀ n : ℕ, 0 < n → φ₁ n = φ₂ n) : φ₁ = φ₂ :=
ext_int h_neg_one $ ext_nat h_pos

end monoid_with_zero_hom

namespace ring_hom

variables {α : Type*} {β : Type*} [ring α] [ring β]

@[simp] lemma eq_int_cast (f : ℤ →+* α) (n : ℤ) : f n  = n :=
f.to_add_monoid_hom.eq_int_cast f.map_one n

lemma eq_int_cast' (f : ℤ →+* α) : f = int.cast_ring_hom α :=
ring_hom.ext f.eq_int_cast

@[simp] lemma map_int_cast (f : α →+* β) (n : ℤ) : f n = n :=
(f.comp (int.cast_ring_hom α)).eq_int_cast n

lemma ext_int {R : Type*} [semiring R] (f g : ℤ →+* R) : f = g :=
coe_add_monoid_hom_injective $ add_monoid_hom.ext_int $ f.map_one.trans g.map_one.symm

instance int.subsingleton_ring_hom {R : Type*} [semiring R] : subsingleton (ℤ →+* R) :=
⟨ring_hom.ext_int⟩

end ring_hom

@[simp, norm_cast] theorem int.cast_id (n : ℤ) : ↑n = n :=
((ring_hom.id ℤ).eq_int_cast n).symm


/-
Copyright (c) 2022 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import category_theory.preadditive.opposite
import algebra.category.Module.basic
import algebra.category.Group.preadditive

/-!
# The Yoneda embedding for preadditive categories

The Yoneda embedding for preadditive categories sends an object `Y` to the presheaf sending an
object `X` to the group of morphisms `X ⟶ Y`. At each point, we get an additional `End Y`-module
structure.

We also show that this presheaf is additive and that it is compatible with the normal Yoneda
embedding in the expected way and deduce that the preadditive Yoneda embedding is fully faithful.

## TODO
* The Yoneda embedding is additive itself

-/

universes v u

open category_theory.preadditive opposite

namespace category_theory

variables {C : Type u} [category.{v} C] [preadditive C]

/--
The Yoneda embedding for preadditive categories sends an object `Y` to the presheaf sending an
object `X` to the `End Y`-module of morphisms `X ⟶ Y`.
-/
@[simps]
def preadditive_yoneda_obj (Y : C) : Cᵒᵖ ⥤ Module.{v} (End Y) :=
{ obj := λ X, Module.of _ (X.unop ⟶ Y),
  map := λ X X' f,
  { to_fun := λ g, f.unop ≫ g,
    map_add' := λ g g', comp_add _ _ _ _ _ _,
    map_smul' := λ r g, eq.symm $ category.assoc _ _ _ } }

/--
The Yoneda embedding for preadditive categories sends an object `Y` to the presheaf sending an
object `X` to the group of morphisms `X ⟶ Y`. At each point, we get an additional `End Y`-module
structure, see `preadditive_yoneda_obj`.
-/
@[simps]
def preadditive_yoneda : C ⥤ (Cᵒᵖ ⥤ AddCommGroup.{v}) :=
{ obj := λ Y, preadditive_yoneda_obj Y ⋙ forget₂ _ _,
  map := λ Y Y' f,
  { app := λ X,
    { to_fun := λ g, g ≫ f,
      map_zero' := limits.zero_comp,
      map_add' := λ g g', add_comp _ _ _ _ _ _ },
    naturality' := λ X X' g, AddCommGroup.ext _ _ _ _ $ λ x, category.assoc _ _ _ },
  map_id' := λ X, by { ext, simp },
  map_comp' := λ X Y Z f g, by { ext, simp } }

/--
The Yoneda embedding for preadditive categories sends an object `X` to the copresheaf sending an
object `Y` to the `End X`-module of morphisms `X ⟶ Y`.
-/
@[simps]
def preadditive_coyoneda_obj (X : Cᵒᵖ) : C ⥤ Module.{v} (End X) :=
{ obj := λ Y, Module.of _ (unop X ⟶ Y),
  map := λ Y Y' f,
  { to_fun := λ g, g ≫ f,
    map_add' := λ g g', add_comp _ _ _ _ _ _,
    map_smul' := λ r g, category.assoc _ _ _ } }

/--
The Yoneda embedding for preadditive categories sends an object `X` to the copresheaf sending an
object `Y` to the group of morphisms `X ⟶ Y`. At each point, we get an additional `End X`-module
structure, see `preadditive_coyoneda_obj`.
-/
@[simps]
def preadditive_coyoneda : Cᵒᵖ ⥤ (C ⥤ AddCommGroup.{v}) :=
{ obj := λ X, preadditive_coyoneda_obj X ⋙ forget₂ _ _,
  map := λ X X' f,
  { app := λ Y,
    { to_fun := λ g, f.unop ≫ g,
      map_zero' := limits.comp_zero,
      map_add' := λ g g', comp_add _ _ _ _ _ _ },
    naturality' := λ Y Y' g, AddCommGroup.ext _ _ _ _ $ λ x, eq.symm $ category.assoc _ _ _ },
  map_id' := λ X, by { ext, simp },
  map_comp' := λ X Y Z f g, by { ext, simp } }

instance additive_yoneda_obj (X : C) : functor.additive (preadditive_yoneda_obj X) := {}
instance additive_yoneda_obj' (X : C) : functor.additive (preadditive_yoneda.obj X) := {}
instance additive_coyoneda_obj (X : Cᵒᵖ) : functor.additive (preadditive_coyoneda_obj X) := {}
instance additive_coyoneda_obj' (X : Cᵒᵖ) : functor.additive (preadditive_coyoneda.obj X) := {}

/--
Composing the preadditive yoneda embedding with the forgetful functor yields the regular
Yoneda embedding.
-/
@[simp] lemma whiskering_preadditive_yoneda : preadditive_yoneda ⋙
  (whiskering_right Cᵒᵖ AddCommGroup (Type v)).obj (forget AddCommGroup) = yoneda :=
rfl

/--
Composing the preadditive yoneda embedding with the forgetful functor yields the regular
Yoneda embedding.
-/
@[simp] lemma whiskering_preadditive_coyoneda : preadditive_coyoneda ⋙
  (whiskering_right C AddCommGroup (Type v)).obj (forget AddCommGroup) = coyoneda :=
rfl

instance preadditive_yoneda_full : full (preadditive_yoneda : C ⥤ Cᵒᵖ ⥤ AddCommGroup) :=
let yoneda_full : full (preadditive_yoneda ⋙
  (whiskering_right Cᵒᵖ AddCommGroup (Type v)).obj (forget AddCommGroup)) := yoneda.yoneda_full in
by exactI full.of_comp_faithful preadditive_yoneda
  ((whiskering_right Cᵒᵖ AddCommGroup (Type v)).obj (forget AddCommGroup))

instance preadditive_coyoneda_full : full (preadditive_coyoneda : Cᵒᵖ ⥤ C ⥤ AddCommGroup) :=
let coyoneda_full : full (preadditive_coyoneda ⋙
  (whiskering_right C AddCommGroup (Type v)).obj (forget AddCommGroup)) :=
    coyoneda.coyoneda_full in
by exactI full.of_comp_faithful preadditive_coyoneda
  ((whiskering_right C AddCommGroup (Type v)).obj (forget AddCommGroup))

instance preadditive_yoneda_faithful : faithful (preadditive_yoneda : C ⥤ Cᵒᵖ ⥤ AddCommGroup) :=
faithful.of_comp_eq whiskering_preadditive_yoneda

instance preadditive_coyoneda_faithful :
  faithful (preadditive_coyoneda : Cᵒᵖ ⥤ C ⥤ AddCommGroup) :=
faithful.of_comp_eq whiskering_preadditive_coyoneda

end category_theory


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_numbertheory_132 :
  2004 % 12 = 0 :=
begin
  norm_num,
end


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

import meta.rb_map
import tactic.ring
import tactic.linarith.lemmas

/-!
# Datatypes for `linarith`

Some of the data structures here are used in multiple parts of the tactic.
We split them into their own file.

This file also contains a few convenient auxiliary functions.
-/

declare_trace linarith

open native

namespace linarith

/-- A shorthand for tracing when the `trace.linarith` option is set to true. -/
meta def linarith_trace {α} [has_to_tactic_format α] (s : α) : tactic unit :=
tactic.when_tracing `linarith (tactic.trace s)

/--
A shorthand for tracing the types of a list of proof terms
when the `trace.linarith` option is set to true.
-/
meta def linarith_trace_proofs (s : string := "") (l : list expr) : tactic unit :=
tactic.when_tracing `linarith $ do
  tactic.trace s, l.mmap tactic.infer_type >>= tactic.trace

/-! ### Linear expressions -/

/--
A linear expression is a list of pairs of variable indices and coefficients,
representing the sum of the products of each coefficient with its corresponding variable.

Some functions on `linexp` assume that `n : ℕ` occurs at most once as the first element of a pair,
and that the list is sorted in decreasing order of the first argument.
This is not enforced by the type but the operations here preserve it.
-/
@[reducible]
def linexp : Type := list (ℕ × ℤ)

namespace linexp
/--
Add two `linexp`s together componentwise.
Preserves sorting and uniqueness of the first argument.
-/
meta def add : linexp → linexp → linexp
| [] a := a
| a [] := a
| (a@(n1,z1)::t1) (b@(n2,z2)::t2) :=
  if n1 < n2 then b::add (a::t1) t2
  else if n2 < n1 then a::add t1 (b::t2)
  else let sum := z1 + z2 in if sum = 0 then add t1 t2 else (n1, sum)::add t1 t2

/-- `l.scale c` scales the values in `l` by `c` without modifying the order or keys. -/
def scale (c : ℤ) (l : linexp) : linexp :=
if c = 0 then []
else if c = 1 then l
else l.map $ λ ⟨n, z⟩, (n, z*c)

/--
`l.get n` returns the value in `l` associated with key `n`, if it exists, and `none` otherwise.
This function assumes that `l` is sorted in decreasing order of the first argument,
that is, it will return `none` as soon as it finds a key smaller than `n`.
-/
def get (n : ℕ) : linexp → option ℤ
| [] := none
| ((a, b)::t) :=
  if a < n then none
  else if a = n then some b
  else get t

/--
`l.contains n` is true iff `n` is the first element of a pair in `l`.
-/
def contains (n : ℕ) : linexp → bool := option.is_some ∘ get n

/--
`l.zfind n` returns the value associated with key `n` if there is one, and 0 otherwise.
-/
def zfind (n : ℕ) (l : linexp) : ℤ :=
match l.get n with
| none := 0
| some v := v
end

/-- `l.vars` returns the list of variables that occur in `l`. -/
def vars (l : linexp) : list ℕ :=
l.map prod.fst

/--
Defines a lex ordering on `linexp`. This function is performance critical.
-/
def cmp : linexp → linexp → ordering
| [] [] := ordering.eq
| [] _ := ordering.lt
| _ [] := ordering.gt
| ((n1,z1)::t1) ((n2,z2)::t2) :=
  if n1 < n2 then ordering.lt
  else if n2 < n1 then ordering.gt
  else if z1 < z2 then ordering.lt
  else if z2 < z1 then ordering.gt
  else cmp t1 t2

end linexp

/-! ### Inequalities -/

/-- The three-element type `ineq` is used to represent the strength of a comparison between
terms. -/
@[derive decidable_eq, derive inhabited]
inductive ineq : Type
| eq | le | lt

namespace ineq

/--
`max R1 R2` computes the strength of the sum of two inequalities. If `t1 R1 0` and `t2 R2 0`,
then `t1 + t2 (max R1 R2) 0`.
-/
def max : ineq → ineq → ineq
| lt a := lt
| a lt := lt
| le a := le
| a le := le
| eq eq := eq

/-- `ineq` is ordered `eq < le < lt`. -/
def cmp : ineq → ineq → ordering
| eq eq := ordering.eq
| eq _ := ordering.lt
| le le := ordering.eq
| le lt := ordering.lt
| lt lt := ordering.eq
| _ _ := ordering.gt

/-- Prints an `ineq` as the corresponding infix symbol. -/
def to_string : ineq → string
| eq := "="
| le := "≤"
| lt := "<"

/-- Finds the name of a multiplicative lemma corresponding to an inequality strength. -/
meta def to_const_mul_nm : ineq → name
| lt := ``mul_neg
| le := ``mul_nonpos
| eq := ``mul_eq

instance : has_to_string ineq := ⟨ineq.to_string⟩

meta instance : has_to_format ineq := ⟨λ i, ineq.to_string i⟩

end ineq

/-! ### Comparisons with 0 -/

/--
The main datatype for FM elimination.
Variables are represented by natural numbers, each of which has an integer coefficient.
Index 0 is reserved for constants, i.e. `coeffs.find 0` is the coefficient of 1.
The represented term is `coeffs.sum (λ ⟨k, v⟩, v * Var[k])`.
str determines the strength of the comparison -- is it < 0, ≤ 0, or = 0?
-/
@[derive inhabited]
structure comp : Type :=
(str : ineq)
(coeffs : linexp)

/-- `c.vars` returns the list of variables that appear in the linear expression contained in `c`. -/
def comp.vars : comp → list ℕ :=
linexp.vars ∘ comp.coeffs

/-- `comp.coeff_of c a` projects the coefficient of variable `a` out of `c`. -/
def comp.coeff_of (c : comp) (a : ℕ) : ℤ :=
c.coeffs.zfind a

/-- `comp.scale c n` scales the coefficients of `c` by `n`. -/
def comp.scale (c : comp) (n : ℕ) : comp :=
{ c with coeffs := c.coeffs.scale n }

/--
`comp.add c1 c2` adds the expressions represented by `c1` and `c2`.
The coefficient of variable `a` in `c1.add c2`
is the sum of the coefficients of `a` in `c1` and `c2`.
 -/
meta def comp.add (c1 c2 : comp) : comp :=
⟨c1.str.max c2.str, c1.coeffs.add c2.coeffs⟩

/-- `comp` has a lex order. First the `ineq`s are compared, then the `coeff`s. -/
meta def comp.cmp : comp → comp → ordering
| ⟨str1, coeffs1⟩ ⟨str2, coeffs2⟩ :=
  match str1.cmp str2 with
  | ordering.lt := ordering.lt
  | ordering.gt := ordering.gt
  | ordering.eq := coeffs1.cmp coeffs2
  end

/--
A `comp` represents a contradiction if its expression has no coefficients and its strength is <,
that is, it represents the fact `0 < 0`.
 -/
meta def comp.is_contr (c : comp) : bool := c.coeffs.empty ∧ c.str = ineq.lt

meta instance comp.to_format : has_to_format comp :=
⟨λ p, to_fmt p.coeffs ++ to_string p.str ++ "0"⟩

/-! ### Parsing into linear form -/

/-! ### Control -/

/--
A preprocessor transforms a proof of a proposition into a proof of a different propositon.
The return type is `list expr`, since some preprocessing steps may create multiple new hypotheses,
and some may remove a hypothesis from the list.
A "no-op" preprocessor should return its input as a singleton list.
-/
meta structure preprocessor : Type :=
(name : string)
(transform : expr → tactic (list expr))

/--
Some preprocessors need to examine the full list of hypotheses instead of working item by item.
As with `preprocessor`, the input to a `global_preprocessor` is replaced by, not added to, its
output.
-/
meta structure global_preprocessor : Type :=
(name : string)
(transform : list expr → tactic (list expr))

/--
Some preprocessors perform branching case splits. A `branch` is used to track one of these case
splits. The first component, an `expr`, is the goal corresponding to this branch of the split,
given as a metavariable. The `list expr` component is the list of hypotheses for `linarith`
in this branch. Every `expr` in this list should be type correct in the context of the associated
goal.
-/
meta def branch : Type := expr × list expr

/--
Some preprocessors perform branching case splits.
A `global_branching_preprocessor` produces a list of branches to run.
Each branch is independent, so hypotheses that appear in multiple branches should be duplicated.
The preprocessor is responsible for making sure that each branch contains the correct goal
metavariable.
-/
meta structure global_branching_preprocessor : Type :=
(name : string)
(transform : list expr → tactic (list branch))

/--
A `preprocessor` lifts to a `global_preprocessor` by folding it over the input list.
-/
meta def preprocessor.globalize (pp : preprocessor) : global_preprocessor :=
{ name := pp.name,
  transform := list.mfoldl (λ ret e, do l' ← pp.transform e, return (l' ++ ret)) [] }

/--
A `global_preprocessor` lifts to a `global_branching_preprocessor` by producing only one branch.
-/
meta def global_preprocessor.branching (pp : global_preprocessor) : global_branching_preprocessor :=
{ name := pp.name,
  transform := λ l, do g ← tactic.get_goal, singleton <$> prod.mk g <$> pp.transform l }

/--
`process pp l` runs `pp.transform` on `l` and returns the result,
tracing the result if `trace.linarith` is on.
-/
meta def global_branching_preprocessor.process (pp : global_branching_preprocessor)
  (l : list expr) :
  tactic (list branch) :=
do l ← pp.transform l,
   when (l.length > 1) $
     linarith_trace format!"Preprocessing: {pp.name} has branched, with branches:",
   l.mmap' $ λ l, tactic.set_goals [l.1] >>
     linarith_trace_proofs (to_string format!"Preprocessing: {pp.name}") l.2,
   return l

meta instance preprocessor_to_gb_preprocessor :
  has_coe preprocessor global_branching_preprocessor :=
⟨global_preprocessor.branching ∘ preprocessor.globalize⟩

meta instance global_preprocessor_to_gb_preprocessor :
  has_coe global_preprocessor global_branching_preprocessor :=
⟨global_preprocessor.branching⟩

/--
A `certificate_oracle` is a function `produce_certificate : list comp → ℕ → tactic (rb_map ℕ ℕ)`.
`produce_certificate hyps max_var` tries to derive a contradiction from the comparisons in `hyps`
by eliminating all variables ≤ `max_var`.
If successful, it returns a map `coeff : ℕ → ℕ` as a certificate.
This map represents that we can find a contradiction by taking the sum  `∑ (coeff i) * hyps[i]`.

The default `certificate_oracle` used by `linarith` is
`linarith.fourier_motzkin.produce_certificate`.
-/
meta def certificate_oracle : Type :=
list comp → ℕ → tactic (rb_map ℕ ℕ)

/-- A configuration object for `linarith`. -/
meta structure linarith_config : Type :=
(discharger : tactic unit := `[ring])
(restrict_type : option Type := none)
(restrict_type_reflect : reflected restrict_type . tactic.apply_instance)
(exfalso : bool := tt)
(transparency : tactic.transparency := reducible)
(split_hypotheses : bool := tt)
(split_ne : bool := ff)
(preprocessors : option (list global_branching_preprocessor) := none)
(oracle : option certificate_oracle := none)

/--
`cfg.update_reducibility reduce_semi` will change the transparency setting of `cfg` to
`semireducible` if `reduce_semi` is true. In this case, it also sets the discharger to `ring!`,
since this is typically needed when using stronger unification.
-/
meta def linarith_config.update_reducibility (cfg : linarith_config) (reduce_semi : bool) :
  linarith_config :=
if reduce_semi then { cfg with transparency := semireducible, discharger := `[ring!] }
else cfg

/-!
### Auxiliary functions

These functions are used by multiple modules, so we put them here for accessibility.
-/

open tactic

/--
`get_rel_sides e` returns the left and right hand sides of `e` if `e` is a comparison,
and fails otherwise.
This function is more naturally in the `option` monad, but it is convenient to put in `tactic`
for compositionality.
 -/
meta def get_rel_sides : expr → tactic (expr × expr)
| `(%%a < %%b) := return (a, b)
| `(%%a ≤ %%b) := return (a, b)
| `(%%a = %%b) := return (a, b)
| `(%%a ≥ %%b) := return (a, b)
| `(%%a > %%b) := return (a, b)
| _ := tactic.failed

/--
`parse_into_comp_and_expr e` checks if `e` is of the form `t < 0`, `t ≤ 0`, or `t = 0`.
If it is, it returns the comparison along with `t`.
 -/
meta def parse_into_comp_and_expr : expr → option (ineq × expr)
| `(%%e < 0) := (ineq.lt, e)
| `(%%e ≤ 0) := (ineq.le, e)
| `(%%e = 0) := (ineq.eq, e)
| _ := none

/--
`mk_single_comp_zero_pf c h` assumes that `h` is a proof of `t R 0`.
It produces a pair `(R', h')`, where `h'` is a proof of `c*t R' 0`.
Typically `R` and `R'` will be the same, except when `c = 0`, in which case `R'` is `=`.
If `c = 1`, `h'` is the same as `h` -- specifically, it does *not* change the type to `1*t R 0`.
-/
meta def mk_single_comp_zero_pf (c : ℕ) (h : expr) : tactic (ineq × expr) :=
do tp ← infer_type h,
  some (iq, e) ← return $ parse_into_comp_and_expr tp,
  if c = 0 then
    do e' ← mk_app ``zero_mul [e], return (ineq.eq, e')
  else if c = 1 then return (iq, h)
  else
    do tp ← (prod.snd <$> (infer_type h >>= get_rel_sides)) >>= infer_type,
       c ← tp.of_nat c,
       cpos ← to_expr ``(%%c > 0),
       (_, ex) ← solve_aux cpos `[norm_num, done],
       e' ← mk_app iq.to_const_mul_nm [h, ex],
       return (iq, e')

end linarith


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.finset.pointwise
import order.filter.pointwise

/-!
# Ensuring priority of the `ℕ` and `ℤ` actions over pointwise ones

See Note [pointwise nat action].
-/

open_locale pointwise

variables {α β : Type*} [add_group α] [decidable_eq α] [group β] [decidable_eq β]

-- It is ok for the proofs to stop being `rfl`, but these statements should remain true
example (s : set α) (n : ℕ) : n • s = nsmul_rec n s := rfl
example (s : set α) (n : ℤ) : n • s = zsmul_rec n s := rfl
example (s : set β) (n : ℕ) : s ^ n = npow_rec n s := rfl
example (s : set β) (n : ℤ) : s ^ n = zpow_rec n s := rfl
example (s : finset α) (n : ℕ) : n • s = nsmul_rec n s := rfl
example (s : finset α) (n : ℤ) : n • s = zsmul_rec n s := rfl
example (s : finset β) (n : ℕ) : s ^ n = npow_rec n s := rfl
example (s : finset β) (n : ℤ) : s ^ n = zpow_rec n s := rfl
example (s : filter α) (n : ℕ) : n • s = nsmul_rec n s := rfl
example (s : filter α) (n : ℤ) : n • s = zsmul_rec n s := rfl
example (s : filter β) (n : ℕ) : s ^ n = npow_rec n s := rfl
example (s : filter β) (n : ℤ) : s ^ n = zpow_rec n s := rfl

example : 2 • ({2, 3} : finset ℕ) = {4, 5, 6} := rfl
example : ({2, 3}^2 : finset ℕ) = {4, 6, 9} := rfl


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

import algebra.big_operators.basic
import data.finset.option

/-!
# Lemmas about products and sums over finite sets in `option α`

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

In this file we prove formulas for products and sums over `finset.insert_none s` and
`finset.erase_none s`.
-/

open_locale big_operators
open function

namespace finset

variables {α M : Type*} [comm_monoid M]

@[simp, to_additive] lemma prod_insert_none (f : option α → M) (s : finset α) :
  ∏ x in s.insert_none, f x = f none * ∏ x in s, f (some x) :=
by simp [insert_none]

@[to_additive] lemma prod_erase_none (f : α → M) (s : finset (option α)) :
  ∏ x in s.erase_none, f x = ∏ x in s, option.elim 1 f x :=
by classical;
calc ∏ x in s.erase_none, f x = ∏ x in s.erase_none.map embedding.some, option.elim 1 f x :
  (prod_map s.erase_none embedding.some $ option.elim 1 f).symm
... = ∏ x in s.erase none, option.elim 1 f x : by rw map_some_erase_none
... = ∏ x in s, option.elim 1 f x : prod_erase _ rfl

end finset


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

! This file was ported from Lean 3 source module tactic.omega.nat.preterm
! leanprover-community/mathlib commit a0735864ba72769da4b378673d3dbe2453924fde
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.Omega.Term

/-
Linear natural number arithmetic terms in pre-normalized form.
-/
open Tactic

namespace Omega

namespace Nat

/-- The shadow syntax for arithmetic terms. All constants are reified to `cst`
(e.g., `5` is reified to `cst 5`) and all other atomic terms are reified to
`exp` (e.g., `5 * (list.length l)` is reified to `exp 5 \`(list.length l)`).
`exp` accepts a coefficient of type `nat` as its first argument because
multiplication by constant is allowed by the omega test. -/
unsafe inductive exprterm : Type
  | cst : Nat → exprterm
  | exp : Nat → expr → exprterm
  | add : exprterm → exprterm → exprterm
  | sub : exprterm → exprterm → exprterm
#align omega.nat.exprterm omega.nat.exprterm

/-- Similar to `exprterm`, except that all exprs are now replaced with
de Brujin indices of type `nat`. This is akin to generalizing over
the terms represented by the said exprs. -/
inductive Preterm : Type
  | cst : Nat → preterm
  | var : Nat → Nat → preterm
  | add : preterm → preterm → preterm
  | sub : preterm → preterm → preterm
  deriving has_reflect, DecidableEq, Inhabited
#align omega.nat.preterm Omega.Nat.Preterm

-- mathport name: preterm.cst
scoped notation "&" k => Omega.Nat.Preterm.cst k

-- mathport name: preterm.var
scoped infixl:300 " ** " => Omega.Nat.Preterm.var

-- mathport name: preterm.add
scoped notation t " +* " s => Omega.Nat.Preterm.add t s

-- mathport name: preterm.sub
scoped notation t " -* " s => Omega.Nat.Preterm.sub t s

namespace Preterm

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/-- Helper tactic for proof by induction over preterms -/
unsafe def induce (tac : tactic Unit := tactic.skip) : tactic Unit :=
  sorry
#align omega.nat.preterm.induce omega.nat.preterm.induce

/-- Preterm evaluation -/
def val (v : Nat → Nat) : Preterm → Nat
  | &i => i
  | i ** n => if i = 1 then v n else v n * i
  | t1 +* t2 => t1.val + t2.val
  | t1 -* t2 => t1.val - t2.val
#align omega.nat.preterm.val Omega.Nat.Preterm.val

@[simp]
theorem val_const {v : Nat → Nat} {m : Nat} : (&m).val v = m :=
  rfl
#align omega.nat.preterm.val_const Omega.Nat.Preterm.val_const

@[simp]
theorem val_var {v : Nat → Nat} {m n : Nat} : (m ** n).val v = m * v n :=
  by
  simp only [val]; by_cases h1 : m = 1
  rw [if_pos h1, h1, one_mul]
  rw [if_neg h1, mul_comm]
#align omega.nat.preterm.val_var Omega.Nat.Preterm.val_var

@[simp]
theorem val_add {v : Nat → Nat} {t s : Preterm} : (t +* s).val v = t.val v + s.val v :=
  rfl
#align omega.nat.preterm.val_add Omega.Nat.Preterm.val_add

@[simp]
theorem val_sub {v : Nat → Nat} {t s : Preterm} : (t -* s).val v = t.val v - s.val v :=
  rfl
#align omega.nat.preterm.val_sub Omega.Nat.Preterm.val_sub

/-- Fresh de Brujin index not used by any variable in argument -/
def freshIndex : Preterm → Nat
  | &_ => 0
  | i ** n => n + 1
  | t1 +* t2 => max t1.freshIndex t2.freshIndex
  | t1 -* t2 => max t1.freshIndex t2.freshIndex
#align omega.nat.preterm.fresh_index Omega.Nat.Preterm.freshIndex

/-- If variable assignments `v` and `w` agree on all variables that occur
in term `t`, the value of `t` under `v` and `w` are identical. -/
theorem val_constant (v w : Nat → Nat) :
    ∀ t : Preterm, (∀ x < t.freshIndex, v x = w x) → t.val v = t.val w
  | &n, h1 => rfl
  | m ** n, h1 => by
    simp only [val_var]
    apply congr_arg fun y => m * y
    apply h1 _ (lt_add_one _)
  | t +* s, h1 => by
    simp only [val_add]
    have ht := val_constant t fun x hx => h1 _ (lt_of_lt_of_le hx (le_max_left _ _))
    have hs := val_constant s fun x hx => h1 _ (lt_of_lt_of_le hx (le_max_right _ _))
    rw [ht, hs]
  | t -* s, h1 => by
    simp only [val_sub]
    have ht := val_constant t fun x hx => h1 _ (lt_of_lt_of_le hx (le_max_left _ _))
    have hs := val_constant s fun x hx => h1 _ (lt_of_lt_of_le hx (le_max_right _ _))
    rw [ht, hs]
#align omega.nat.preterm.val_constant Omega.Nat.Preterm.val_constant

def repr : Preterm → String
  | &i => i.repr
  | i ** n => i.repr ++ "*x" ++ n.repr
  | t1 +* t2 => "(" ++ t1.repr ++ " + " ++ t2.repr ++ ")"
  | t1 -* t2 => "(" ++ t1.repr ++ " - " ++ t2.repr ++ ")"
#align omega.nat.preterm.repr Omega.Nat.Preterm.repr

@[simp]
def addOne (t : Preterm) : Preterm :=
  t +* &1
#align omega.nat.preterm.add_one Omega.Nat.Preterm.addOne

/-- Preterm is free of subtractions -/
def SubFree : Preterm → Prop
  | &m => True
  | m ** n => True
  | t +* s => t.SubFree ∧ s.SubFree
  | _ -* _ => False
#align omega.nat.preterm.sub_free Omega.Nat.Preterm.SubFree

end Preterm

open List.Func

-- get notation for list.func.set
/-- Return a term (which is in canonical form by definition)
    that is equivalent to the input preterm -/
@[simp]
def canonize : Preterm → Term
  | &m => ⟨↑m, []⟩
  | m ** n => ⟨0, [] {n ↦ ↑m}⟩
  | t +* s => Term.add (canonize t) (canonize s)
  | _ -* _ => ⟨0, []⟩
#align omega.nat.canonize Omega.Nat.canonize

@[simp]
theorem val_canonize {v : Nat → Nat} :
    ∀ {t : Preterm}, t.SubFree → ((canonize t).val fun x => ↑(v x)) = t.val v
  | &i, h1 => by simp only [canonize, preterm.val_const, term.val, coeffs.val_nil, add_zero]
  | i ** n, h1 => by
    simp only [preterm.val_var, coeffs.val_set, term.val, zero_add, Int.ofNat_mul, canonize]
  | t +* s, h1 => by
    simp only [val_canonize h1.left, val_canonize h1.right, Int.ofNat_add, canonize, term.val_add,
      preterm.val_add]
#align omega.nat.val_canonize Omega.Nat.val_canonize

end Nat

end Omega


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

import data.equiv.basic
import data.set.finite
import group_theory.perm.sign

/-! # Equivalence between fintypes

This file contains some basic results on equivalences where one or both
sides of the equivalence are `fintype`s.

# Main definitions

 - `function.embedding.to_equiv_range`: computably turn an embedding of a
   fintype into an `equiv` of the domain to its range
 - `equiv.perm.via_embedding : perm α → (α ↪ β) → perm β` extends the domain of
   a permutation, fixing everything outside the range of the embedding

# Implementation details

 - `function.embedding.to_equiv_range` uses a computable inverse, but one that has poor
   computational performance, since it operates by exhaustive search over the input `fintype`s.
-/

variables {α β : Type*} [fintype α] [decidable_eq β] (e : equiv.perm α) (f : α ↪ β)

/--
Computably turn an embedding `f : α ↪ β` into an equiv `α ≃ set.range f`,
if `α` is a `fintype`. Has poor computational performance, due to exhaustive searching in
constructed inverse. When a better inverse is known, use `equiv.of_left_inverse'` or
`equiv.of_left_inverse` instead. This is the computable version of `equiv.of_injective`.
-/
def function.embedding.to_equiv_range : α ≃ set.range f :=
⟨λ a, ⟨f a, set.mem_range_self a⟩, f.inv_of_mem_range, λ _, by simp, λ _, by simp⟩

@[simp] lemma function.embedding.to_equiv_range_apply (a : α) :
  f.to_equiv_range a = ⟨f a, set.mem_range_self a⟩ := rfl

@[simp] lemma function.embedding.to_equiv_range_symm_apply_self (a : α) :
  f.to_equiv_range.symm ⟨f a, set.mem_range_self a⟩ = a :=
by simp [equiv.symm_apply_eq]

lemma function.embedding.to_equiv_range_eq_of_injective :
  f.to_equiv_range = equiv.of_injective f f.injective :=
by { ext, simp }

/--
Extend the domain of `e : equiv.perm α`, mapping it through `f : α ↪ β`.
Everything outside of `set.range f` is kept fixed. Has poor computational performance,
due to exhaustive searching in constructed inverse due to using `function.embedding.to_equiv_range`.
When a better `α ≃ set.range f` is known, use `equiv.perm.via_set_range`.
-/
def equiv.perm.via_embedding : equiv.perm β :=
e.extend_domain f.to_equiv_range

@[simp] lemma equiv.perm.via_embedding_apply_image (a : α) :
  e.via_embedding f (f a) = f (e a) :=
begin
  rw equiv.perm.via_embedding,
  convert equiv.perm.extend_domain_apply_image e _ _
end

lemma equiv.perm.via_embedding_apply_mem_range {b : β} (h : b ∈ set.range f) :
  e.via_embedding f b = f (e (f.inv_of_mem_range ⟨b, h⟩)) :=
by simpa [equiv.perm.via_embedding, equiv.perm.extend_domain_apply_subtype, h]

lemma equiv.perm.via_embedding_apply_not_mem_range {b : β} (h : b ∉ set.range f) :
  e.via_embedding f b = b :=
by rwa [equiv.perm.via_embedding, equiv.perm.extend_domain_apply_not_subtype]

@[simp] lemma equiv.perm.via_embedding_sign [decidable_eq α] [fintype β] :
  equiv.perm.sign (e.via_embedding f) = equiv.perm.sign e :=
by simp [equiv.perm.via_embedding]

namespace equiv
variables {p q : α → Prop} [decidable_pred p] [decidable_pred q]

/-- If `e` is an equivalence between two subtypes of a fintype `α`, `e.to_compl`
is an equivalence between the complement of those subtypes.

See also `equiv.compl`, for a computable version when a term of type
`{e' : α ≃ α // ∀ x : {x // p x}, e' x = e x}` is known. -/
noncomputable def to_compl (e : {x // p x} ≃ {x // q x}) : {x // ¬ p x} ≃ {x // ¬ q x} :=
classical.choice (fintype.card_eq.mp (fintype.card_compl_eq_card_compl (fintype.card_congr e)))

/-- If `e` is an equivalence between two subtypes of a fintype `α`, `e.extend_subtype`
is a permutation of `α` acting like `e` on the subtypes and doing something arbitrary outside.

Note that when `p = q`, `equiv.perm.subtype_congr e (equiv.refl _)` can be used instead. -/
noncomputable abbreviation extend_subtype (e : {x // p x} ≃ {x // q x}) : perm α :=
subtype_congr e e.to_compl

lemma extend_subtype_apply_of_mem (e : {x // p x} ≃ {x // q x}) (x) (hx : p x) :
  e.extend_subtype x = e ⟨x, hx⟩ :=
by { dunfold extend_subtype,
     simp only [subtype_congr, equiv.trans_apply, equiv.sum_congr_apply],
     -- `p` gets turned into `λ x, p x` which `rw` doesn't like, so we have to use `erw`
     erw [equiv.set.sum_compl_symm_apply_of_mem hx, sum.map_inl,
          equiv.set.sum_compl_apply_inl q] }

lemma extend_subtype_mem (e : {x // p x} ≃ {x // q x}) (x) (hx : p x) :
  q (e.extend_subtype x) :=
by { convert (e ⟨x, hx⟩).2,
     rw [e.extend_subtype_apply_of_mem _ hx, subtype.val_eq_coe] }

lemma extend_subtype_apply_of_not_mem (e : {x // p x} ≃ {x // q x}) (x) (hx : ¬ p x) :
  e.extend_subtype x = e.to_compl ⟨x, hx⟩ :=
by { dunfold extend_subtype,
    simp only [subtype_congr, equiv.trans_apply, equiv.sum_congr_apply],
    -- `p` gets turned into `λ x, p x` which `rw` doesn't like, so we have to use `erw`
    erw [equiv.set.sum_compl_symm_apply_of_not_mem hx, sum.map_inr,
         equiv.set.sum_compl_apply_inr q] }

lemma extend_subtype_not_mem (e : {x // p x} ≃ {x // q x}) (x) (hx : ¬ p x) :
  ¬ q (e.extend_subtype x) :=
by { convert (e.to_compl ⟨x, hx⟩).2,
     rw [e.extend_subtype_apply_of_not_mem _ hx, subtype.val_eq_coe] }

end equiv


/-
Copyright (c) 2021 Ashvni Narayanan. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Ashvni Narayanan, Anne Baanen
-/

import algebra.field
import data.rat.basic
import ring_theory.algebraic
import ring_theory.dedekind_domain
import ring_theory.integral_closure

/-!
# Number fields

This file defines a number field and the ring of integers corresponding to it.

## Main definitions

 - `is_number_field` defines a number field as a field which has characteristic zero and is finite
    dimensional over ℚ.
 - `ring_of_integers` defines the ring of integers (or number ring) corresponding to a number field
    as the integral closure of ℤ in the number field.

## Main results

 - `is_dedekind_domain_of_ring_of_integers`: Shows that the ring of integers of a number field is a
    Dedekind domain.

## Implementation notes

The definitions that involve a field of fractions choose a canonical field of fractions,
but are independent of that choice.

## References

* [D. Marcus, *Number Fields*][marcus1977number]
* [J.W.S. Cassels, A. Frölich, *Algebraic Number Theory*][cassels1967algebraic]
* [P. Samuel, *Algebraic Theory of Numbers*][samuel1970algebraic]

## Tags

number field, ring of integers
-/

/-- A number field is a field which has characteristic zero and is finite
dimensional over ℚ. -/
class is_number_field (K : Type*) [field K] : Prop :=
[cz : char_zero K]
[fd : finite_dimensional ℚ K]

open function
open_locale classical big_operators

namespace number_field
variables (K : Type*) [field K] [is_number_field K]

@[priority 100] -- See note [lower instance priority]
instance char_zero : char_zero K := is_number_field.cz

lemma finite_dimensional_of_number_field : finite_dimensional ℚ K := is_number_field.fd

lemma is_algebraic_of_number_field : algebra.is_algebraic ℚ K :=
  @algebra.is_algebraic_of_finite ℚ K _ _ _ (finite_dimensional_of_number_field K)

/-- The ring of integers (or number ring) corresponding to a number field
is the integral closure of ℤ in the number field. -/
@[nolint unused_arguments] -- There are multiple definitions of rings of integers.
def ring_of_integers := integral_closure ℤ K

namespace ring_of_integers

open fraction_map
local attribute [class] algebra.is_algebraic

-- TODO: we should make `fraction_map` extend `algebra`, so we don't need to add these instances.
instance : algebra int.fraction_map.codomain K := rat.algebra_rat
instance is_scalar_tower_int_rat :
  @is_scalar_tower ℤ int.fraction_map.codomain K int.fraction_map.algebra.to_has_scalar _ _ :=
is_scalar_tower.of_algebra_map_eq (λ x, by simp)
instance : char_zero int.fraction_map.codomain := show char_zero ℚ, by apply_instance
instance : finite_dimensional int.fraction_map.codomain K := ‹is_number_field K›.fd
instance : algebra.is_algebraic int.fraction_map.codomain K := is_algebraic_of_number_field K

variables {K}

lemma is_integral_coe (x : ring_of_integers K) : is_integral ℤ (x : K) :=
x.2

lemma char_zero.algebra_map_injective {R : Type*} [semiring R] [char_zero R]
  [algebra ℕ R] : function.injective (algebra_map ℕ R) :=
λ x y hxy, by simpa using hxy

lemma char_zero.of_algebra_map_injective {R : Type*} [semiring R] [algebra ℕ R]
  (h : function.injective (algebra_map ℕ R)) : char_zero R :=
⟨λ x y hxy, h (by simpa using hxy)⟩

lemma char_zero.iff_algebra_map_injective {R : Type*} [semiring R] [algebra ℕ R] :
  char_zero R ↔ function.injective (algebra_map ℕ R) :=
⟨λ h, @char_zero.algebra_map_injective _ _ h _,
 char_zero.of_algebra_map_injective⟩

variables (K)

instance : char_zero (ring_of_integers K) :=
char_zero.of_algebra_map_injective (injective.of_comp
  (show injective (algebra_map _ K ∘ _),
   from
   have inj : injective (algebra_map ℕ K) := char_zero.algebra_map_injective,
   have tower : is_scalar_tower ℕ (ring_of_integers K) K := infer_instance,
   by rwa [@is_scalar_tower.algebra_map_eq ℕ (ring_of_integers K) K _ _ _ _ _ _ (by convert tower)] at inj))

instance integral_closure_int.is_dedekind_domain : is_dedekind_domain (integral_closure ℤ K) :=
is_dedekind_domain.integral_closure int.fraction_map (principal_ideal_ring.is_dedekind_domain _)

instance is_dedekind_domain_of_ring_of_integers : is_dedekind_domain (ring_of_integers K) :=
integral_closure_int.is_dedekind_domain K

/-- `ring_of_integers.fraction_map K` is the map `O_K → K`, as a `fraction_map`. -/
protected def fraction_map : fraction_map (ring_of_integers K) K :=
integral_closure.fraction_map_of_finite_extension K int.fraction_map

end ring_of_integers

end number_field

namespace rat

open fraction_map
open number_field

instance rat.finite_dimensional : finite_dimensional ℚ ℚ :=
(infer_instance : is_noetherian ℚ ℚ)

instance rat.is_number_field : is_number_field ℚ :=
{ cz := infer_instance,
  fd := by { convert rat.finite_dimensional,
             -- The vector space structure of `ℚ` over itself can arise in multiple ways:
             -- all fields are vector spaces over themselves (used in `rat.finite_dimensional`)
             -- all fields have a canonical embedding of `ℚ` (used in `is_number_field`).
             -- Show that these coincide:
             ext, simp [algebra.smul_def] } }

lemma subalgebra.coe_algebra_map {R A : Type*} [comm_semiring R] [comm_semiring A] [algebra R A]
  (S : subalgebra R A) :
  ⇑(algebra_map S A) = (coe : S → A) :=
rfl

noncomputable def rat.ring_of_integers_equiv : ring_of_integers ℚ ≃+* ℤ :=
ring_equiv.symm $
ring_equiv.of_bijective (algebra_map ℤ (ring_of_integers ℚ))
  ⟨λ x y hxy, int.cast_injective $
      show (x : ring_of_integers ℚ) = (y : ring_of_integers ℚ), by simpa using hxy,
   λ y, begin
     obtain ⟨x, hx⟩ := @unique_factorization_monoid.integer_of_integral ℤ ℚ _ _ _
       fraction_map.int.fraction_map (y : ℚ) (ring_of_integers.is_integral_coe y),
     use x,
     refine subtype.coe_injective _,
     rw [← hx, ← subalgebra.coe_algebra_map, ← is_scalar_tower.algebra_map_apply ℤ _ _,
         ring_hom.eq_int_cast (algebra_map ℤ ℚ), ring_hom.eq_int_cast],
     -- Again we have to show the vector space structures on ℚ coincide.
     convert @is_scalar_tower.of_algebra_map_eq ℤ (ring_of_integers ℚ) ℚ _ _ _ _ _ _ _,
     { ext, simp [algebra.smul_def] },
     { simp }
   end⟩

end rat


/-
Copyright (c) 2022 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.linear.basic
import category_theory.preadditive.biproducts
import linear_algebra.matrix.invariant_basis_number

/-!
# Hom orthogonal families.

A family of objects in a category with zero morphisms is "hom orthogonal" if the only
morphism between distinct objects is the zero morphism.

We show that in any category with zero morphisms and finite biproducts,
a morphism between biproducts drawn from a hom orthogonal family `s : ι → C`
can be decomposed into a block diagonal matrix with entries in the endomorphism rings of the `s i`.

When the category is preadditive, this decomposition is an additive equivalence,
and intertwines composition and matrix multiplication.
When the category is `R`-linear, the decomposition is an `R`-linear equivalence.

If every object in the hom orthogonal family has an endomorphism ring with invariant basis number
(e.g. if each object in the family is simple, so its endomorphism ring is a division ring,
or otherwise if each endomorphism ring is commutative),
then decompositions of an object as a biproduct of the family have uniquely defined multiplicities.
We state this as:
```
lemma hom_orthogonal.equiv_of_iso (o : hom_orthogonal s) {f : α → ι} {g : β → ι}
  (i : ⨁ (λ a, s (f a)) ≅ ⨁ (λ b, s (g b))) : ∃ e : α ≃ β, ∀ a, g (e a) = f a
```

This is preliminary to defining semisimple categories.
-/

open_locale classical matrix

open category_theory.limits

universes v u

namespace category_theory

variables {C : Type u} [category.{v} C]

/-- A family of objects is "hom orthogonal" if
there is at most one morphism between distinct objects.

(In a category with zero morphisms, that must be the zero morphism.) -/
def hom_orthogonal {ι : Type*} (s : ι → C) : Prop :=
∀ i j, i ≠ j → subsingleton (s i ⟶ s j)

namespace hom_orthogonal

variables {ι : Type*} {s : ι → C}

lemma eq_zero [has_zero_morphisms C] (o : hom_orthogonal s)
  {i j : ι} (w : i ≠ j) (f : s i ⟶ s j) : f = 0 :=
by { haveI := o i j w, apply subsingleton.elim, }

section
variables [has_zero_morphisms C] [has_finite_biproducts C]

/-- Morphisms between two direct sums over a hom orthogonal family `s : ι → C`
are equivalent to block diagonal matrices,
with blocks indexed by `ι`,
and matrix entries in `i`-th block living in the endomorphisms of `s i`. -/
@[simps] noncomputable
def matrix_decomposition
  (o : hom_orthogonal s) {α β : Type} [fintype α] [fintype β] {f : α → ι} {g : β → ι} :
  (⨁ (λ a, s (f a)) ⟶ ⨁ (λ b, s (g b))) ≃
    Π (i : ι), matrix (g ⁻¹' {i}) (f ⁻¹' {i}) (End (s i)) :=
{ to_fun := λ z i j k,
    eq_to_hom (by { rcases k with ⟨k, ⟨⟩⟩, simp, }) ≫
      biproduct.components z k j ≫ eq_to_hom (by { rcases j with ⟨j, ⟨⟩⟩, simp, }),
  inv_fun := λ z, biproduct.matrix (λ j k, if h : f j = g k then
      z (f j) ⟨k, by simp [h]⟩ ⟨j, by simp⟩ ≫ eq_to_hom (by simp [h])
    else
      0),
  left_inv := λ z, begin
    ext j k,
    simp only [category.assoc, biproduct.lift_π, biproduct.ι_matrix],
    split_ifs,
    { simp, refl, },
    { symmetry, apply o.eq_zero h, },
  end,
  right_inv := λ z, begin
    ext i ⟨j, w⟩ ⟨k, ⟨⟩⟩,
    simp only [set.mem_preimage, set.mem_singleton_iff],
    simp [w.symm], refl,
  end, }

end

section
variables [preadditive C] [has_finite_biproducts C]

/-- `hom_orthogonal.matrix_decomposition` as an additive equivalence. -/
@[simps] noncomputable
def matrix_decomposition_add_equiv
  (o : hom_orthogonal s) {α β : Type} [fintype α] [fintype β] {f : α → ι} {g : β → ι} :
  (⨁ (λ a, s (f a)) ⟶ ⨁ (λ b, s (g b))) ≃+
    Π (i : ι), matrix (g ⁻¹' {i}) (f ⁻¹' {i}) (End (s i)) :=
{ map_add' := λ w z, by { ext, dsimp [biproduct.components], simp, },
  ..o.matrix_decomposition, }.

@[simp]
lemma matrix_decomposition_id
  (o : hom_orthogonal s) {α : Type} [fintype α] {f : α → ι} (i : ι) :
  o.matrix_decomposition (𝟙 (⨁ (λ a, s (f a)))) i = 1 :=
begin
  ext ⟨b, ⟨⟩⟩ ⟨a⟩,
  simp only [set.mem_preimage, set.mem_singleton_iff] at j_property,
  simp only [category.comp_id, category.id_comp, category.assoc, End.one_def, eq_to_hom_refl,
    matrix.one_apply, hom_orthogonal.matrix_decomposition_apply, biproduct.components],
  split_ifs with h,
  { cases h, simp, },
  { convert comp_zero,
    simpa using biproduct.ι_π_ne _ (ne.symm h), },
end

lemma matrix_decomposition_comp
  (o : hom_orthogonal s)
  {α β γ : Type} [fintype α] [fintype β] [fintype γ] {f : α → ι} {g : β → ι} {h : γ → ι}
  (z : (⨁ (λ a, s (f a)) ⟶ ⨁ (λ b, s (g b)))) (w : (⨁ (λ b, s (g b)) ⟶ ⨁ (λ c, s (h c))))
  (i : ι) :
  o.matrix_decomposition (z ≫ w) i = o.matrix_decomposition w i ⬝ o.matrix_decomposition z i :=
begin
  ext ⟨c, ⟨⟩⟩ ⟨a⟩,
  simp only [set.mem_preimage, set.mem_singleton_iff] at j_property,
  simp only [matrix.mul_apply, limits.biproduct.components,
    hom_orthogonal.matrix_decomposition_apply,
    category.comp_id, category.id_comp, category.assoc, End.mul_def,
    eq_to_hom_refl, eq_to_hom_trans_assoc, finset.sum_congr],
  conv_lhs { rw [←category.id_comp w, ←biproduct.total], },
  simp only [preadditive.sum_comp, preadditive.comp_sum],
  apply finset.sum_congr_set,
  { intros, simp, refl, },
  { intros b nm,
    simp only [set.mem_preimage, set.mem_singleton_iff] at nm,
    simp only [category.assoc],
    convert comp_zero,
    convert comp_zero,
    convert comp_zero,
    convert comp_zero,
    apply o.eq_zero nm, },
end

section
variables {R : Type*} [semiring R] [linear R C]

/-- `hom_orthogonal.matrix_decomposition` as an `R`-linear equivalence. -/
@[simps] noncomputable
def matrix_decomposition_linear_equiv
(o : hom_orthogonal s)
  {α β : Type} [fintype α] [fintype β] {f : α → ι} {g : β → ι} :
  (⨁ (λ a, s (f a)) ⟶ ⨁ (λ b, s (g b))) ≃ₗ[R]
    Π (i : ι), matrix (g ⁻¹' {i}) (f ⁻¹' {i}) (End (s i)) :=
{ map_smul' := λ w z, by { ext, dsimp [biproduct.components], simp, },
  ..o.matrix_decomposition_add_equiv, }

end

/-!
The hypothesis that `End (s i)` has invariant basis number is automatically satisfied
if `s i` is simple (as then `End (s i)` is a division ring).
-/
variables [∀ i, invariant_basis_number (End (s i))]

/--
Given a hom orthogonal family `s : ι → C`
for which each `End (s i)` is a ring with invariant basis number (e.g. if each `s i` is simple),
if two direct sums over `s` are isomorphic, then they have the same multiplicities.
-/
lemma equiv_of_iso (o : hom_orthogonal s)
  {α β : Type} [fintype α] [fintype β] {f : α → ι} {g : β → ι}
  (i : ⨁ (λ a, s (f a)) ≅ ⨁ (λ b, s (g b))) :
  ∃ e : α ≃ β, ∀ a, g (e a) = f a :=
begin
  refine ⟨equiv.of_preimage_equiv _, λ a, equiv.of_preimage_equiv_map _ _⟩,
  intro c,
  apply nonempty.some,
  apply cardinal.eq.1,
  simp only [cardinal.mk_fintype, nat.cast_inj],
  exact matrix.square_of_invertible
    (o.matrix_decomposition i.inv c) (o.matrix_decomposition i.hom c)
    (by { rw ←o.matrix_decomposition_comp, simp, })
    (by { rw ←o.matrix_decomposition_comp, simp, })
end

end

end hom_orthogonal

end category_theory