/-
Copyright (c) 2022 María Inés de Frutos-Fernández, Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: María Inés de Frutos-Fernández, Yaël Dillies
-/
import tactic.positivity
import data.real.nnreal

/-!
# Group seminorms

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

This file defines norms and seminorms in a group. A group seminorm is a function to the reals which
is positive-semidefinite and subadditive. A norm further only maps zero to zero.

## Main declarations

* `add_group_seminorm`: A function `f` from an additive group `G` to the reals that preserves zero,
  takes nonnegative values, is subadditive and such that `f (-x) = f x` for all `x`.
* `nonarch_add_group_seminorm`: A function `f` from an additive group `G` to the reals that
  preserves zero, takes nonnegative values, is nonarchimedean and such that `f (-x) = f x`
  for all `x`.
* `group_seminorm`: A function `f` from a group `G` to the reals that sends one to zero, takes
  nonnegative values, is submultiplicative and such that `f x⁻¹ = f x` for all `x`.
* `add_group_norm`: A seminorm `f` such that `f x = 0 → x = 0` for all `x`.
* `nonarch_add_group_norm`: A nonarchimedean seminorm `f` such that `f x = 0 → x = 0` for all `x`.
* `group_norm`: A seminorm `f` such that `f x = 0 → x = 1` for all `x`.

## Notes

The corresponding hom classes are defined in `analysis.order.hom.basic` to be used by absolute
values.

We do not define `nonarch_add_group_seminorm` as an extension of `add_group_seminorm` to avoid
having a superfluous `add_le'` field in the resulting structure. The same applies to
`nonarch_add_group_norm`.

## References

* [H. H. Schaefer, *Topological Vector Spaces*][schaefer1966]

## Tags

norm, seminorm
-/

set_option old_structure_cmd true

open set
open_locale nnreal

variables {ι R R' E F G : Type*}

/-- A seminorm on an additive group `G` is a function `f : G → ℝ` that preserves zero, is
subadditive and such that `f (-x) = f x` for all `x`. -/
@[protect_proj]
structure add_group_seminorm (G : Type*) [add_group G] extends zero_hom G ℝ :=
(add_le' : ∀ r s, to_fun (r + s) ≤ to_fun r + to_fun s)
(neg' : ∀ r, to_fun (-r) = to_fun r)

/-- A seminorm on a group `G` is a function `f : G → ℝ` that sends one to zero, is submultiplicative
and such that `f x⁻¹ = f x` for all `x`. -/
@[to_additive, protect_proj]
structure group_seminorm (G : Type*) [group G] :=
(to_fun : G → ℝ)
(map_one' : to_fun 1 = 0)
(mul_le' : ∀ x y, to_fun (x * y) ≤ to_fun x + to_fun y)
(inv' : ∀ x, to_fun x⁻¹ = to_fun x)

/-- A nonarchimedean seminorm on an additive group `G` is a function `f : G → ℝ` that preserves
zero, is nonarchimedean and such that `f (-x) = f x` for all `x`. -/
@[protect_proj]
structure nonarch_add_group_seminorm (G : Type*) [add_group G] extends zero_hom G ℝ :=
(add_le_max' : ∀ r s, to_fun (r + s) ≤ max (to_fun r) (to_fun s))
(neg' : ∀ r, to_fun (-r) = to_fun r)

/-! NOTE: We do not define `nonarch_add_group_seminorm` as an extension of `add_group_seminorm`
  to avoid having a superfluous `add_le'` field in the resulting structure. The same applies to
  `nonarch_add_group_norm` below. -/

/-- A norm on an additive group `G` is a function `f : G → ℝ` that preserves zero, is subadditive
and such that `f (-x) = f x` and `f x = 0 → x = 0` for all `x`. -/
@[protect_proj]
structure add_group_norm (G : Type*) [add_group G] extends add_group_seminorm G :=
(eq_zero_of_map_eq_zero' : ∀ x, to_fun x = 0 → x = 0)

/-- A seminorm on a group `G` is a function `f : G → ℝ` that sends one to zero, is submultiplicative
and such that `f x⁻¹ = f x` and `f x = 0 → x = 1` for all `x`. -/
@[protect_proj, to_additive]
structure group_norm (G : Type*) [group G] extends group_seminorm G :=
(eq_one_of_map_eq_zero' : ∀ x, to_fun x = 0 → x = 1)

/-- A nonarchimedean norm on an additive group `G` is a function `f : G → ℝ` that preserves zero, is
nonarchimedean and such that `f (-x) = f x` and `f x = 0 → x = 0` for all `x`. -/
@[protect_proj]
structure nonarch_add_group_norm (G : Type*) [add_group G] extends nonarch_add_group_seminorm G :=
(eq_zero_of_map_eq_zero' : ∀ x, to_fun x = 0 → x = 0)

attribute [nolint doc_blame] add_group_seminorm.to_zero_hom add_group_norm.to_add_group_seminorm
  group_norm.to_group_seminorm nonarch_add_group_seminorm.to_zero_hom
  nonarch_add_group_norm.to_nonarch_add_group_seminorm

attribute [to_additive] group_norm.to_group_seminorm

/-- `nonarch_add_group_seminorm_class F α` states that `F` is a type of nonarchimedean seminorms on
the additive group `α`.

You should extend this class when you extend `nonarch_add_group_seminorm`. -/
@[protect_proj]
class nonarch_add_group_seminorm_class (F : Type*) (α : out_param $ Type*) [add_group α]
  extends nonarchimedean_hom_class F α ℝ :=
(map_zero (f : F) : f 0 = 0)
(map_neg_eq_map' (f : F) (a : α) : f (-a) = f a)

/-- `nonarch_add_group_norm_class F α` states that `F` is a type of nonarchimedean norms on the
additive group `α`.

You should extend this class when you extend `nonarch_add_group_norm`. -/
@[protect_proj]
class nonarch_add_group_norm_class (F : Type*) (α : out_param $ Type*) [add_group α]
  extends nonarch_add_group_seminorm_class F α :=
(eq_zero_of_map_eq_zero (f : F) {a : α} : f a = 0 → a = 0)

section nonarch_add_group_seminorm_class
variables [add_group E] [nonarch_add_group_seminorm_class F E] (f : F) (x y : E)
include E

lemma map_sub_le_max : f (x - y) ≤ max (f x) (f y) :=
by { rw [sub_eq_add_neg, ← nonarch_add_group_seminorm_class.map_neg_eq_map' f y],
     exact map_add_le_max _ _ _ }

end nonarch_add_group_seminorm_class

@[priority 100] -- See note [lower instance priority]
instance nonarch_add_group_seminorm_class.to_add_group_seminorm_class [add_group E]
  [nonarch_add_group_seminorm_class F E] :
  add_group_seminorm_class F E ℝ :=
{ map_add_le_add := λ f x y, begin
    have h_nonneg : ∀ a, 0 ≤ f a,
    { intro a,
      rw [← nonarch_add_group_seminorm_class.map_zero f, ← sub_self a],
      exact le_trans (map_sub_le_max _ _ _) (by rw max_self (f a)) },
    exact le_trans (map_add_le_max _ _ _)
      (max_le (le_add_of_nonneg_right (h_nonneg _)) (le_add_of_nonneg_left (h_nonneg _))),
  end,
  map_neg_eq_map := nonarch_add_group_seminorm_class.map_neg_eq_map',
  ..‹nonarch_add_group_seminorm_class F E› }

@[priority 100] -- See note [lower instance priority]
instance nonarch_add_group_norm_class.to_add_group_norm_class [add_group E]
  [nonarch_add_group_norm_class F E] :
  add_group_norm_class F E ℝ :=
{ map_add_le_add := map_add_le_add,
  map_neg_eq_map := nonarch_add_group_seminorm_class.map_neg_eq_map',
  ..‹nonarch_add_group_norm_class F E› }

/-! ### Seminorms -/

namespace group_seminorm
section group
variables [group E] [group F] [group G] {p q : group_seminorm E}

@[to_additive] instance group_seminorm_class : group_seminorm_class (group_seminorm E) E ℝ :=
{ coe := λ f, f.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_one_eq_zero := λ f, f.map_one',
  map_mul_le_add := λ f, f.mul_le',
  map_inv_eq_map := λ f, f.inv' }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`. -/
@[to_additive "Helper instance for when there's too many metavariables to apply
`fun_like.has_coe_to_fun`. "]
instance : has_coe_to_fun (group_seminorm E) (λ _, E → ℝ) := ⟨group_seminorm.to_fun⟩

@[simp, to_additive] lemma to_fun_eq_coe : p.to_fun = p := rfl

@[ext, to_additive] lemma ext : (∀ x, p x = q x) → p = q := fun_like.ext p q

@[to_additive] instance : partial_order (group_seminorm E) :=
partial_order.lift _ fun_like.coe_injective

@[to_additive] lemma le_def : p ≤ q ↔ (p : E → ℝ) ≤ q := iff.rfl
@[to_additive] lemma lt_def : p < q ↔ (p : E → ℝ) < q := iff.rfl

@[simp, to_additive, norm_cast] lemma coe_le_coe : (p : E → ℝ) ≤ q ↔ p ≤ q := iff.rfl
@[simp, to_additive, norm_cast] lemma coe_lt_coe : (p : E → ℝ) < q ↔ p < q := iff.rfl

variables (p q) (f : F →* E)

@[to_additive] instance : has_zero (group_seminorm E) :=
⟨{ to_fun := 0,
  map_one' := pi.zero_apply _,
  mul_le' := λ _ _, (zero_add _).ge,
  inv' := λ x, rfl}⟩

@[simp, to_additive, norm_cast] lemma coe_zero : ⇑(0 : group_seminorm E) = 0 := rfl
@[simp, to_additive] lemma zero_apply (x : E) : (0 : group_seminorm E) x = 0 := rfl

@[to_additive] instance : inhabited (group_seminorm E) := ⟨0⟩

@[to_additive] instance : has_add (group_seminorm E) :=
⟨λ p q,
  { to_fun := λ x, p x + q x,
    map_one' := by rw [map_one_eq_zero p, map_one_eq_zero q, zero_add],
    mul_le' := λ _ _, (add_le_add (map_mul_le_add p _ _) $ map_mul_le_add q _ _).trans_eq $
      add_add_add_comm _ _ _ _,
    inv' := λ x, by rw [map_inv_eq_map p, map_inv_eq_map q] }⟩

@[simp, to_additive] lemma coe_add : ⇑(p + q) = p + q := rfl
@[simp, to_additive] lemma add_apply (x : E) : (p + q) x = p x + q x := rfl

-- TODO: define `has_Sup` too, from the skeleton at
-- https://github.com/leanprover-community/mathlib/pull/11329#issuecomment-1008915345
@[to_additive] instance : has_sup (group_seminorm E) :=
⟨λ p q,
  { to_fun := p ⊔ q,
    map_one' :=
      by rw [pi.sup_apply, ←map_one_eq_zero p, sup_eq_left, map_one_eq_zero p, map_one_eq_zero q],
    mul_le' := λ x y, sup_le
      ((map_mul_le_add p x y).trans $ add_le_add le_sup_left le_sup_left)
      ((map_mul_le_add q x y).trans $ add_le_add le_sup_right le_sup_right),
    inv' := λ x, by rw [pi.sup_apply, pi.sup_apply, map_inv_eq_map p, map_inv_eq_map q] }⟩

@[simp, to_additive, norm_cast] lemma coe_sup : ⇑(p ⊔ q) = p ⊔ q := rfl
@[simp, to_additive] lemma sup_apply (x : E) : (p ⊔ q) x = p x ⊔ q x := rfl

@[to_additive] instance : semilattice_sup (group_seminorm E) :=
fun_like.coe_injective.semilattice_sup _ coe_sup

/-- Composition of a group seminorm with a monoid homomorphism as a group seminorm. -/
@[to_additive "Composition of an additive group seminorm with an additive monoid homomorphism as an
additive group seminorm."]
def comp (p : group_seminorm E) (f : F →* E) : group_seminorm F :=
{ to_fun := λ x, p (f x),
  map_one' := by rw [f.map_one, map_one_eq_zero p],
  mul_le' := λ _ _, (congr_arg p $ f.map_mul _ _).trans_le $ map_mul_le_add p _ _,
  inv' := λ x, by rw [map_inv, map_inv_eq_map p] }

@[simp, to_additive] lemma coe_comp : ⇑(p.comp f) = p ∘ f := rfl
@[simp, to_additive] lemma comp_apply (x : F) : (p.comp f) x = p (f x) := rfl
@[simp, to_additive] lemma comp_id : p.comp (monoid_hom.id _) = p := ext $ λ _, rfl
@[simp, to_additive] lemma comp_zero : p.comp (1 : F →* E) = 0 := ext $ λ _, map_one_eq_zero p
@[simp, to_additive] lemma zero_comp : (0 : group_seminorm E).comp f = 0 := ext $ λ _, rfl

@[to_additive] lemma comp_assoc (g : F →* E) (f : G →* F) : p.comp (g.comp f) = (p.comp g).comp f :=
ext $ λ _, rfl

@[to_additive] lemma add_comp (f : F →* E) : (p + q).comp f = p.comp f + q.comp f := ext $ λ _, rfl

variables {p q}

@[to_additive] lemma comp_mono (hp : p ≤ q) : p.comp f ≤ q.comp f := λ _, hp _

end group

section comm_group
variables [comm_group E] [comm_group F] (p q : group_seminorm E) (x y : E)

@[to_additive] lemma comp_mul_le (f g : F →* E) : p.comp (f * g) ≤ p.comp f + p.comp g :=
λ _, map_mul_le_add p _ _

@[to_additive] lemma mul_bdd_below_range_add {p q : group_seminorm E} {x : E} :
  bdd_below (range $ λ y, p y + q (x / y)) :=
⟨0, by { rintro _ ⟨x, rfl⟩, dsimp, positivity }⟩

@[to_additive] noncomputable instance : has_inf (group_seminorm E) :=
⟨λ p q,
  { to_fun := λ x, ⨅ y, p y + q (x / y),
    map_one' := cinfi_eq_of_forall_ge_of_forall_gt_exists_lt (λ x, by positivity)
        (λ r hr, ⟨1, by rwa [div_one, map_one_eq_zero p, map_one_eq_zero q, add_zero]⟩),
    mul_le' := λ x y, le_cinfi_add_cinfi $ λ u v, begin
      refine cinfi_le_of_le mul_bdd_below_range_add (u * v) _,
      rw [mul_div_mul_comm, add_add_add_comm],
      exact add_le_add (map_mul_le_add p _ _) (map_mul_le_add q _ _),
    end,
    inv' := λ x, (inv_surjective.infi_comp _).symm.trans $
      by simp_rw [map_inv_eq_map p, ←inv_div', map_inv_eq_map q] }⟩

@[simp, to_additive] lemma inf_apply : (p ⊓ q) x = ⨅ y, p y + q (x / y) := rfl

@[to_additive] noncomputable instance : lattice (group_seminorm E) :=
{ inf := (⊓),
  inf_le_left := λ p q x, cinfi_le_of_le mul_bdd_below_range_add x $
    by rw [div_self', map_one_eq_zero q, add_zero],
  inf_le_right := λ p q x, cinfi_le_of_le mul_bdd_below_range_add (1 : E) $
    by simp only [div_one, map_one_eq_zero p, zero_add],
  le_inf := λ a b c hb hc x, le_cinfi $ λ u, (le_map_add_map_div a _ _).trans $
    add_le_add (hb _) (hc _),
  ..group_seminorm.semilattice_sup }

end comm_group
end group_seminorm

/- TODO: All the following ought to be automated using `to_additive`. The problem is that it doesn't
see that `has_smul R ℝ` should be fixed because `ℝ` is fixed. -/

namespace add_group_seminorm
variables [add_group E] [has_smul R ℝ] [has_smul R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ]
  (p : add_group_seminorm E)

instance [decidable_eq E] : has_one (add_group_seminorm E) :=
⟨{ to_fun := λ x, if x = 0 then 0 else 1,
  map_zero' := if_pos rfl,
  add_le' := λ x y, begin
    by_cases hx : x = 0,
    { rw [if_pos hx, hx, zero_add, zero_add] },
    { rw if_neg hx,
      refine le_add_of_le_of_nonneg _ _; split_ifs; norm_num }
  end,
  neg' := λ x, by simp_rw neg_eq_zero }⟩

@[simp] lemma apply_one [decidable_eq E] (x : E) :
  (1 : add_group_seminorm E) x = if x = 0 then 0 else 1 := rfl

/-- Any action on `ℝ` which factors through `ℝ≥0` applies to an `add_group_seminorm`. -/
instance : has_smul R (add_group_seminorm E) :=
⟨λ r p,
  { to_fun := λ x, r • p x,
    map_zero' := by simp only [←smul_one_smul ℝ≥0 r (_ : ℝ), nnreal.smul_def, smul_eq_mul,
      map_zero, mul_zero],
    add_le' := λ _ _, begin
      simp only [←smul_one_smul ℝ≥0 r (_ : ℝ), nnreal.smul_def, smul_eq_mul],
      exact (mul_le_mul_of_nonneg_left (map_add_le_add _ _ _) $ nnreal.coe_nonneg _).trans_eq
        (mul_add _ _ _),
    end,
    neg' := λ x, by rw map_neg_eq_map }⟩

@[simp, norm_cast] lemma coe_smul (r : R) (p : add_group_seminorm E) : ⇑(r • p) = r • p := rfl
@[simp]

instance [has_smul R' ℝ] [has_smul R' ℝ≥0] [is_scalar_tower R' ℝ≥0 ℝ]
  [has_smul R R'] [is_scalar_tower R R' ℝ] :
  is_scalar_tower R R' (add_group_seminorm E) :=
⟨λ r a p, ext $ λ x, smul_assoc r a (p x)⟩

lemma smul_sup (r : R) (p q : add_group_seminorm E) : r • (p ⊔ q) = r • p ⊔ r • q :=
have real.smul_max : ∀ x y : ℝ, r • max x y = max (r • x) (r • y),
from λ x y, by simpa only [←smul_eq_mul, ←nnreal.smul_def, smul_one_smul ℝ≥0 r (_ : ℝ)]
                     using mul_max_of_nonneg x y (r • 1 : ℝ≥0).prop,
ext $ λ x, real.smul_max _ _

end add_group_seminorm

namespace nonarch_add_group_seminorm
section add_group
variables [add_group E] [add_group F] [add_group G] {p q : nonarch_add_group_seminorm E}

instance nonarch_add_group_seminorm_class :
  nonarch_add_group_seminorm_class (nonarch_add_group_seminorm E) E :=
{ coe := λ f, f.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_add_le_max := λ f, f.add_le_max',
  map_zero := λ f, f.map_zero',
  map_neg_eq_map' := λ f, f.neg', }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`. -/
instance : has_coe_to_fun (nonarch_add_group_seminorm E) (λ _, E → ℝ) :=
⟨nonarch_add_group_seminorm.to_fun⟩

@[simp] lemma to_fun_eq_coe : p.to_fun = p := rfl

@[ext] lemma ext : (∀ x, p x = q x) → p = q := fun_like.ext p q

noncomputable instance : partial_order (nonarch_add_group_seminorm E) :=
partial_order.lift _ fun_like.coe_injective

lemma le_def : p ≤ q ↔ (p : E → ℝ) ≤ q := iff.rfl
lemma lt_def : p < q ↔ (p : E → ℝ) < q := iff.rfl

@[simp, norm_cast] lemma coe_le_coe : (p : E → ℝ) ≤ q ↔ p ≤ q := iff.rfl
@[simp, norm_cast] lemma coe_lt_coe : (p : E → ℝ) < q ↔ p < q := iff.rfl

variables (p q) (f : F →+ E)

instance : has_zero (nonarch_add_group_seminorm E) :=
⟨{ to_fun := 0,
  map_zero' := pi.zero_apply _,
  add_le_max' := λ r s, by simp only [pi.zero_apply, max_eq_right],
  neg' := λ x, rfl}⟩

@[simp, norm_cast] lemma coe_zero : ⇑(0 : nonarch_add_group_seminorm E) = 0 := rfl
@[simp] lemma zero_apply (x : E) : (0 : nonarch_add_group_seminorm E) x = 0 := rfl

instance : inhabited (nonarch_add_group_seminorm E) := ⟨0⟩

-- TODO: define `has_Sup` too, from the skeleton at
-- https://github.com/leanprover-community/mathlib/pull/11329#issuecomment-1008915345
instance : has_sup (nonarch_add_group_seminorm E) :=
⟨λ p q,
  { to_fun := p ⊔ q,
    map_zero' := by rw [pi.sup_apply, ←map_zero p, sup_eq_left, map_zero p, map_zero q],
    add_le_max' := λ x y, sup_le
      ((map_add_le_max p x y).trans $ max_le_max le_sup_left le_sup_left)
      ((map_add_le_max q x y).trans $ max_le_max le_sup_right le_sup_right),
    neg' := λ x, by rw [pi.sup_apply, pi.sup_apply, map_neg_eq_map p, map_neg_eq_map q] }⟩

@[simp, norm_cast] lemma coe_sup : ⇑(p ⊔ q) = p ⊔ q := rfl
@[simp] lemma sup_apply (x : E) : (p ⊔ q) x = p x ⊔ q x := rfl

noncomputable instance : semilattice_sup (nonarch_add_group_seminorm E) :=
fun_like.coe_injective.semilattice_sup _ coe_sup

end add_group

section add_comm_group
variables [add_comm_group E] [add_comm_group F] (p q : nonarch_add_group_seminorm E) (x y : E)

lemma add_bdd_below_range_add {p q : nonarch_add_group_seminorm E} {x : E} :
  bdd_below (range $ λ y, p y + q (x - y)) :=
⟨0, by { rintro _ ⟨x, rfl⟩, dsimp, positivity }⟩

end add_comm_group
end nonarch_add_group_seminorm

namespace group_seminorm
variables [group E] [has_smul R ℝ] [has_smul R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ]

@[to_additive add_group_seminorm.has_one]
instance [decidable_eq E] : has_one (group_seminorm E) :=
⟨{ to_fun := λ x, if x = 1 then 0 else 1,
  map_one' := if_pos rfl,
  mul_le' := λ x y, begin
    by_cases hx : x = 1,
    { rw [if_pos hx, hx, one_mul, zero_add] },
    { rw if_neg hx,
      refine le_add_of_le_of_nonneg _ _; split_ifs; norm_num }
  end,
  inv' := λ x, by simp_rw inv_eq_one }⟩

@[simp, to_additive add_group_seminorm.apply_one] lemma apply_one [decidable_eq E] (x : E) :
  (1 : group_seminorm E) x = if x = 1 then 0 else 1 := rfl

/-- Any action on `ℝ` which factors through `ℝ≥0` applies to an `add_group_seminorm`. -/
@[to_additive add_group_seminorm.has_smul] instance : has_smul R (group_seminorm E) :=
⟨λ r p,
  { to_fun := λ x, r • p x,
    map_one' := by simp only [←smul_one_smul ℝ≥0 r (_ : ℝ), nnreal.smul_def, smul_eq_mul,
      map_one_eq_zero p, mul_zero],
    mul_le' := λ _ _, begin
      simp only [←smul_one_smul ℝ≥0 r (_ : ℝ), nnreal.smul_def, smul_eq_mul],
      exact (mul_le_mul_of_nonneg_left (map_mul_le_add p _ _) $ nnreal.coe_nonneg _).trans_eq
        (mul_add _ _ _),
    end,
    inv' := λ x, by rw map_inv_eq_map p }⟩

@[to_additive add_group_seminorm.is_scalar_tower]
instance [has_smul R' ℝ] [has_smul R' ℝ≥0] [is_scalar_tower R' ℝ≥0 ℝ] [has_smul R R']
  [is_scalar_tower R R' ℝ] : is_scalar_tower R R' (group_seminorm E) :=
⟨λ r a p, ext $ λ x, smul_assoc r a $ p x⟩

@[simp, to_additive add_group_seminorm.coe_smul, norm_cast]
lemma coe_smul (r : R) (p : group_seminorm E) : ⇑(r • p) = r • p := rfl

@[simp, to_additive add_group_seminorm.smul_apply]
lemma smul_apply (r : R) (p : group_seminorm E) (x : E) : (r • p) x = r • p x := rfl

@[to_additive add_group_seminorm.smul_sup]
lemma smul_sup (r : R) (p q : group_seminorm E) : r • (p ⊔ q) = r • p ⊔ r • q :=
have real.smul_max : ∀ x y : ℝ, r • max x y = max (r • x) (r • y),
from λ x y, by simpa only [←smul_eq_mul, ←nnreal.smul_def, smul_one_smul ℝ≥0 r (_ : ℝ)]
                     using mul_max_of_nonneg x y (r • 1 : ℝ≥0).prop,
ext $ λ x, real.smul_max _ _

end group_seminorm

namespace nonarch_add_group_seminorm
variables [add_group E] [has_smul R ℝ] [has_smul R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ]

instance [decidable_eq E] : has_one (nonarch_add_group_seminorm E) :=
⟨{ to_fun := λ x, if x = 0 then 0 else 1,
  map_zero' := if_pos rfl,
  add_le_max' := λ x y, begin
    by_cases hx : x = 0,
    { rw [if_pos hx, hx, zero_add], exact le_max_of_le_right (le_refl _) },
    { rw if_neg hx, split_ifs; norm_num }
  end,
  neg' := λ x, by simp_rw neg_eq_zero }⟩

@[simp] lemma apply_one [decidable_eq E] (x : E) :
  (1 : nonarch_add_group_seminorm E) x = if x = 0 then 0 else 1 := rfl

/-- Any action on `ℝ` which factors through `ℝ≥0` applies to a `nonarch_add_group_seminorm`. -/
instance : has_smul R (nonarch_add_group_seminorm E) :=
⟨λ r p,
  { to_fun := λ x, r • p x,
    map_zero' := by simp only [←smul_one_smul ℝ≥0 r (_ : ℝ), nnreal.smul_def, smul_eq_mul,
      map_zero p, mul_zero],
    add_le_max' := λ x y, begin
      simp only [←smul_one_smul ℝ≥0 r (_ : ℝ), nnreal.smul_def, smul_eq_mul,
        ← mul_max_of_nonneg _ _ nnreal.zero_le_coe],
      exact mul_le_mul_of_nonneg_left (map_add_le_max p _ _) nnreal.zero_le_coe,
    end,
    neg' := λ x, by rw map_neg_eq_map p }⟩

instance [has_smul R' ℝ] [has_smul R' ℝ≥0] [is_scalar_tower R' ℝ≥0 ℝ] [has_smul R R']
  [is_scalar_tower R R' ℝ] : is_scalar_tower R R' (nonarch_add_group_seminorm E) :=
⟨λ r a p, ext $ λ x, smul_assoc r a $ p x⟩

@[simp, norm_cast] lemma coe_smul (r : R) (p : nonarch_add_group_seminorm E) : ⇑(r • p) = r • p :=
rfl

@[simp]
lemma smul_apply (r : R) (p : nonarch_add_group_seminorm E) (x : E) : (r • p) x = r • p x := rfl

lemma smul_sup (r : R) (p q : nonarch_add_group_seminorm E) : r • (p ⊔ q) = r • p ⊔ r • q :=
have real.smul_max : ∀ x y : ℝ, r • max x y = max (r • x) (r • y),
from λ x y, by simpa only [←smul_eq_mul, ←nnreal.smul_def, smul_one_smul ℝ≥0 r (_ : ℝ)]
                     using mul_max_of_nonneg x y (r • 1 : ℝ≥0).prop,
ext $ λ x, real.smul_max _ _

end nonarch_add_group_seminorm

/-! ### Norms -/

namespace group_norm
section group
variables [group E] [group F] [group G] {p q : group_norm E}

@[to_additive] instance group_norm_class : group_norm_class (group_norm E) E ℝ :=
{ coe := λ f, f.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_one_eq_zero := λ f, f.map_one',
  map_mul_le_add := λ f, f.mul_le',
  map_inv_eq_map := λ f, f.inv',
  eq_one_of_map_eq_zero := λ f, f.eq_one_of_map_eq_zero' }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
@[to_additive "Helper instance for when there's too many metavariables to apply
`fun_like.has_coe_to_fun` directly. "]
instance : has_coe_to_fun (group_norm E) (λ _, E → ℝ) := fun_like.has_coe_to_fun

@[simp, to_additive] lemma to_fun_eq_coe : p.to_fun = p := rfl

@[ext, to_additive] lemma ext : (∀ x, p x = q x) → p = q := fun_like.ext p q

@[to_additive] instance : partial_order (group_norm E) :=
partial_order.lift _ fun_like.coe_injective

@[to_additive] lemma le_def : p ≤ q ↔ (p : E → ℝ) ≤ q := iff.rfl
@[to_additive] lemma lt_def : p < q ↔ (p : E → ℝ) < q := iff.rfl

@[simp, to_additive, norm_cast] lemma coe_le_coe : (p : E → ℝ) ≤ q ↔ p ≤ q := iff.rfl
@[simp, to_additive, norm_cast] lemma coe_lt_coe : (p : E → ℝ) < q ↔ p < q := iff.rfl

variables (p q) (f : F →* E)

@[to_additive] instance : has_add (group_norm E) :=
⟨λ p q, { eq_one_of_map_eq_zero' := λ x hx, of_not_not $ λ h,
            hx.not_gt $ add_pos (map_pos_of_ne_one p h) (map_pos_of_ne_one q h),
          ..p.to_group_seminorm + q.to_group_seminorm }⟩

@[simp, to_additive] lemma coe_add : ⇑(p + q) = p + q := rfl
@[simp, to_additive] lemma add_apply (x : E) : (p + q) x = p x + q x := rfl

-- TODO: define `has_Sup`
@[to_additive] instance : has_sup (group_norm E) :=
⟨λ p q,
  { eq_one_of_map_eq_zero' := λ x hx, of_not_not $ λ h, hx.not_gt $
      lt_sup_iff.2 $ or.inl $ map_pos_of_ne_one p h,
    ..p.to_group_seminorm ⊔ q.to_group_seminorm }⟩

@[simp, to_additive, norm_cast] lemma coe_sup : ⇑(p ⊔ q) = p ⊔ q := rfl
@[simp, to_additive] lemma sup_apply (x : E) : (p ⊔ q) x = p x ⊔ q x := rfl

@[to_additive] instance : semilattice_sup (group_norm E) :=
fun_like.coe_injective.semilattice_sup _ coe_sup

end group
end group_norm

namespace add_group_norm
variables [add_group E] [decidable_eq E]

instance : has_one (add_group_norm E) :=
⟨{ eq_zero_of_map_eq_zero' := λ x, zero_ne_one.ite_eq_left_iff.1,
  ..(1 : add_group_seminorm E) }⟩

@[simp] lemma apply_one (x : E) : (1 : add_group_norm E) x = if x = 0 then 0 else 1 := rfl

instance : inhabited (add_group_norm E) := ⟨1⟩

end add_group_norm

namespace group_norm
variables [group E] [decidable_eq E]

@[to_additive add_group_norm.has_one] instance : has_one (group_norm E) :=
⟨{ eq_one_of_map_eq_zero' := λ x, zero_ne_one.ite_eq_left_iff.1,
  ..(1 : group_seminorm E) }⟩

@[simp, to_additive add_group_norm.apply_one]
lemma apply_one (x : E) : (1 : group_norm E) x = if x = 1 then 0 else 1 := rfl

@[to_additive] instance : inhabited (group_norm E) := ⟨1⟩

end group_norm

namespace nonarch_add_group_norm
section add_group
variables [add_group E] [add_group F] {p q : nonarch_add_group_norm E}

instance nonarch_add_group_norm_class :
  nonarch_add_group_norm_class (nonarch_add_group_norm E) E :=
{ coe := λ f, f.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_add_le_max := λ f, f.add_le_max',
  map_zero := λ f, f.map_zero',
  map_neg_eq_map' := λ f, f.neg',
  eq_zero_of_map_eq_zero := λ f, f.eq_zero_of_map_eq_zero' }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`. -/
noncomputable instance : has_coe_to_fun (nonarch_add_group_norm E) (λ _, E → ℝ) :=
fun_like.has_coe_to_fun

@[simp] lemma to_fun_eq_coe : p.to_fun = p := rfl

@[ext] lemma ext : (∀ x, p x = q x) → p = q := fun_like.ext p q

noncomputable instance : partial_order (nonarch_add_group_norm E) :=
partial_order.lift _ fun_like.coe_injective

lemma le_def : p ≤ q ↔ (p : E → ℝ) ≤ q := iff.rfl
lemma lt_def : p < q ↔ (p : E → ℝ) < q := iff.rfl

@[simp, norm_cast] lemma coe_le_coe : (p : E → ℝ) ≤ q ↔ p ≤ q := iff.rfl
@[simp, norm_cast] lemma coe_lt_coe : (p : E → ℝ) < q ↔ p < q := iff.rfl

variables (p q) (f : F →+ E)

instance : has_sup (nonarch_add_group_norm E) :=
⟨λ p q,
  { eq_zero_of_map_eq_zero' := λ x hx, of_not_not $ λ h, hx.not_gt $
      lt_sup_iff.2 $ or.inl $ map_pos_of_ne_zero p h,
    ..p.to_nonarch_add_group_seminorm ⊔ q.to_nonarch_add_group_seminorm }⟩

@[simp, norm_cast] lemma coe_sup : ⇑(p ⊔ q) = p ⊔ q := rfl
@[simp] lemma sup_apply (x : E) : (p ⊔ q) x = p x ⊔ q x := rfl

noncomputable instance : semilattice_sup (nonarch_add_group_norm E) :=
fun_like.coe_injective.semilattice_sup _ coe_sup

instance [decidable_eq E] : has_one (nonarch_add_group_norm E) :=
⟨{ eq_zero_of_map_eq_zero' := λ x, zero_ne_one.ite_eq_left_iff.1,
  ..(1 : nonarch_add_group_seminorm E) }⟩

@[simp] lemma apply_one [decidable_eq E] (x : E) :
  (1 : nonarch_add_group_norm E) x = if x = 0 then 0 else 1 := rfl

instance [decidable_eq E] : inhabited (nonarch_add_group_norm E) := ⟨1⟩

end add_group
end nonarch_add_group_norm


import Analysis.Filter

/-- A topological space on `α` is predicate `is_open` on `Set α` such that
  - the whole set is open;
  - the intersection of two open sets is open;
  - and the union of a collection of open sets is open. -/
class topologicalSpace (α : Type u) where
  is_open : Set α → Prop
  is_open_univ : is_open Set.univ
  is_open_inter : ∀ s t, is_open s → is_open t → is_open (s ∩ t)
  is_open_Union : ∀ (s : Set (Set α)) (hs : ∀ t ∈ s, is_open t),
    is_open (⋃ t ∈ s, t)

-- Short hand so we don't need to write `topologicalSpace` all the time
def is_open [topologicalSpace α] (s : Set α) := topologicalSpace.is_open s

def is_open_univ [topologicalSpace α] : is_open (Set.univ : Set α) :=
topologicalSpace.is_open_univ

def is_open_inter [topologicalSpace α] {s t : Set α}
  (hs : is_open s) (ht : is_open t) : is_open (s ∩ t) :=
topologicalSpace.is_open_inter s t hs ht

def is_open_Union [topologicalSpace α] (s : Set (Set α))
  (hs : ∀ t ∈ s, is_open t) : is_open (⋃ t ∈ s, t : Set α) :=
topologicalSpace.is_open_Union s hs

namespace topologicalSpace

open Set Filter

theorem ext (π τ : topologicalSpace α) (h : π.is_open = τ.is_open) : π = τ := by
  cases π; cases τ; subst h; rfl

variable [topologicalSpace α]

set_option pp.all true

theorem is_openEmpty : is_open (∅ : Set α) :=
UnionEmpty ▸ is_open_Union ∅ (λ _ h => False.elim h)

class Hausdorff (α : Type u) [topologicalSpace α] where
  t2 : ∀ (x y : α) (hxy : x ≠ y),
    ∃ u v : Set α, is_open u ∧ is_open v ∧ x ∈ u ∧ y ∈ v ∧ u ∩ v = ∅

section Hausdorff

variable [Hausdorff α]

theorem t2 (x y : α) (hxy : x ≠ y) :
  ∃ u v : Set α, is_open u ∧ is_open v ∧ x ∈ u ∧ y ∈ v ∧ u ∩ v = ∅ :=
Hausdorff.t2 x y hxy

/-- A filter `F` on a Hausdorff space `X` has at most one limit -/
theorem tendstoUnique {x y : α} {F : Filter α} [H : neBot F]
  (hx : F ⟶ x) (hy : F ⟶ y) : x = y := by
  apply Classical.byContradiction
  intro h
  cases t2 x y h with | intro u huv =>
  cases huv      with | intro v huv =>
  let ⟨hu₁, ⟨hv₁, ⟨hu₂, ⟨hv₂, huv⟩⟩⟩⟩ := huv
  exact H.ne_bot <| (eqBotIff F).2 <| huv ▸ inter_sets _
    (preimageId u ▸ hx u ((memNeighbourhoodIff x u).2 hu₂))
    (preimageId v ▸ hy v ((memNeighbourhoodIff y v).2 hv₂))

/-- The filter generate by the union of two neighbourhoods. -/
def aux (x y : α) : Filter α :=
  generatedFrom ((𝓝 x) ∪ 𝓝 y)

theorem auxTendstoLeft (x y : α) : aux x y ⟶ x := by
  rw [tendstoNeighberhoodIff]
  intro z hz
  apply leGeneratedFrom ((𝓝 x) ∪ 𝓝 y) z
  rw [memIff, memPrincipalIff] at hz
  exact Or.inl <| Filter.sets_of_superset _ (selfMemPrincipal _) hz

theorem auxTendstoRight (x y : α) : aux x y ⟶ y := by
  rw [tendstoNeighberhoodIff]
  intro z hz
  apply leGeneratedFrom ((𝓝 x) ∪ 𝓝 y) z
  rw [memIff, memPrincipalIff] at hz
  exact Or.inr <| Filter.sets_of_superset _ (selfMemPrincipal _) hz

/-- A topological space is Hausdorff if all filter `F` has a unique limit. -/
def HausdorffOfTendstoUnique
  (hF : ∀ (F : Filter α) x y (hy : F ⟶ y) (hx : F ⟶ x), x = y) :
  Hausdorff α :=
{ t2 := λ x y hxy => False.elim <| hxy <|
  hF (aux x y) x y (auxTendstoRight x y) (auxTendstoLeft x y) }

end Hausdorff

end topologicalSpace


/-
Copyright (c) 2021 Alena Gusakov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alena Gusakov
-/
import combinatorics.simple_graph.basic
import data.set.finite
/-!
# Strongly regular graphs

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

## Main definitions

* `G.is_SRG_with n k ℓ μ` (see `simple_graph.is_SRG_with`) is a structure for
  a `simple_graph` satisfying the following conditions:
  * The cardinality of the vertex set is `n`
  * `G` is a regular graph with degree `k`
  * The number of common neighbors between any two adjacent vertices in `G` is `ℓ`
  * The number of common neighbors between any two nonadjacent vertices in `G` is `μ`

## TODO
- Prove that the parameters of a strongly regular graph
  obey the relation `(n - k - 1) * μ = k * (k - ℓ - 1)`
- Prove that if `I` is the identity matrix and `J` is the all-one matrix,
  then the adj matrix `A` of SRG obeys relation `A^2 = kI + ℓA + μ(J - I - A)`
-/

open finset

universes u

namespace simple_graph
variables {V : Type u}
variables [fintype V] [decidable_eq V]
variables (G : simple_graph V) [decidable_rel G.adj]

/--
A graph is strongly regular with parameters `n k ℓ μ` if
 * its vertex set has cardinality `n`
 * it is regular with degree `k`
 * every pair of adjacent vertices has `ℓ` common neighbors
 * every pair of nonadjacent vertices has `μ` common neighbors
-/
structure is_SRG_with (n k ℓ μ : ℕ) : Prop :=
(card : fintype.card V = n)
(regular : G.is_regular_of_degree k)
(of_adj : ∀ (v w : V), G.adj v w → fintype.card (G.common_neighbors v w) = ℓ)
(of_not_adj : ∀ (v w : V), v ≠ w → ¬G.adj v w → fintype.card (G.common_neighbors v w) = μ)

variables {G} {n k ℓ μ : ℕ}

/-- Empty graphs are strongly regular. Note that `ℓ` can take any value
  for empty graphs, since there are no pairs of adjacent vertices. -/
lemma bot_strongly_regular :
  (⊥ : simple_graph V).is_SRG_with (fintype.card V) 0 ℓ 0 :=
{ card := rfl,
  regular := bot_degree,
  of_adj := λ v w h, h.elim,
  of_not_adj := λ v w h, begin
    simp only [card_eq_zero, filter_congr_decidable, fintype.card_of_finset, forall_true_left,
      not_false_iff, bot_adj],
    ext,
    simp [mem_common_neighbors],
  end }

/-- Complete graphs are strongly regular. Note that `μ` can take any value
  for complete graphs, since there are no distinct pairs of non-adjacent vertices. -/
lemma is_SRG_with.top :
  (⊤ : simple_graph V).is_SRG_with (fintype.card V) (fintype.card V - 1) (fintype.card V - 2) μ :=
{ card := rfl,
  regular := is_regular_of_degree.top,
  of_adj := λ v w h, begin
    rw card_common_neighbors_top,
    exact h,
  end,
  of_not_adj := λ v w h h', false.elim $ by simpa using h }

lemma is_SRG_with.card_neighbor_finset_union_eq {v w : V} (h : G.is_SRG_with n k ℓ μ) :
  (G.neighbor_finset v ∪ G.neighbor_finset w).card =
    2 * k - fintype.card (G.common_neighbors v w) :=
begin
  apply @nat.add_right_cancel _ (fintype.card (G.common_neighbors v w)),
  rw [nat.sub_add_cancel, ← set.to_finset_card],
  { simp [neighbor_finset, common_neighbors, set.to_finset_inter, finset.card_union_add_card_inter,
      h.regular.degree_eq, two_mul], },
  { apply le_trans (card_common_neighbors_le_degree_left _ _ _),
    simp [h.regular.degree_eq, two_mul], },
end

/-- Assuming `G` is strongly regular, `2*(k + 1) - m` in `G` is the number of vertices that are
  adjacent to either `v` or `w` when `¬G.adj v w`. So it's the cardinality of
  `G.neighbor_set v ∪ G.neighbor_set w`. -/
lemma is_SRG_with.card_neighbor_finset_union_of_not_adj {v w : V} (h : G.is_SRG_with n k ℓ μ)
  (hne : v ≠ w) (ha : ¬G.adj v w) :
  (G.neighbor_finset v ∪ G.neighbor_finset w).card = 2 * k - μ :=
begin
  rw ← h.of_not_adj v w hne ha,
  apply h.card_neighbor_finset_union_eq,
end

lemma is_SRG_with.card_neighbor_finset_union_of_adj {v w : V} (h : G.is_SRG_with n k ℓ μ)
  (ha : G.adj v w) :
  (G.neighbor_finset v ∪ G.neighbor_finset w).card = 2 * k - ℓ :=
begin
  rw ← h.of_adj v w ha,
  apply h.card_neighbor_finset_union_eq,
end

lemma compl_neighbor_finset_sdiff_inter_eq {v w : V} :
  (G.neighbor_finset v)ᶜ \ {v} ∩ ((G.neighbor_finset w)ᶜ \ {w}) =
    (G.neighbor_finset v)ᶜ ∩ (G.neighbor_finset w)ᶜ \ ({w} ∪ {v}) :=
by { ext, rw ← not_iff_not, simp [imp_iff_not_or, or_assoc, or_comm, or.left_comm], }

lemma sdiff_compl_neighbor_finset_inter_eq {v w : V} (h : G.adj v w) :
  (G.neighbor_finset v)ᶜ ∩ (G.neighbor_finset w)ᶜ \ ({w} ∪ {v}) =
    (G.neighbor_finset v)ᶜ ∩ (G.neighbor_finset w)ᶜ :=
begin
  ext,
  simp only [and_imp, mem_union, mem_sdiff, mem_compl, and_iff_left_iff_imp,
    mem_neighbor_finset, mem_inter, mem_singleton],
  rintros hnv hnw (rfl|rfl),
  { exact hnv h, },
  { apply hnw, rwa adj_comm, },
end

lemma is_SRG_with.compl_is_regular (h : G.is_SRG_with n k ℓ μ) :
  Gᶜ.is_regular_of_degree (n - k - 1) :=
begin
  rw [← h.card, nat.sub_sub, add_comm, ←nat.sub_sub],
  exact h.regular.compl,
end

lemma is_SRG_with.card_common_neighbors_eq_of_adj_compl (h : G.is_SRG_with n k ℓ μ)
  {v w : V} (ha : Gᶜ.adj v w) :
  fintype.card ↥(Gᶜ.common_neighbors v w) = n - (2 * k - μ) - 2 :=
begin
  simp only [←set.to_finset_card, common_neighbors, set.to_finset_inter, neighbor_set_compl,
    set.to_finset_diff, set.to_finset_singleton, set.to_finset_compl, ←neighbor_finset_def],
  simp_rw compl_neighbor_finset_sdiff_inter_eq,
  have hne : v ≠ w := ne_of_adj _ ha,
  rw compl_adj at ha,
  rw [card_sdiff, ← insert_eq, card_insert_of_not_mem, card_singleton, ← finset.compl_union],
  { change (1 + 1) with 2,
    rw [card_compl, h.card_neighbor_finset_union_of_not_adj hne ha.2, ← h.card], },
  { simp only [hne.symm, not_false_iff, mem_singleton], },
  { intro u,
    simp only [mem_union, mem_compl, mem_neighbor_finset, mem_inter, mem_singleton],
    rintro (rfl|rfl);
    simpa [adj_comm] using ha.2, },
end

lemma is_SRG_with.card_common_neighbors_eq_of_not_adj_compl (h : G.is_SRG_with n k ℓ μ)
  {v w : V} (hn : v ≠ w) (hna : ¬Gᶜ.adj v w)  :
  fintype.card ↥(Gᶜ.common_neighbors v w) = n - (2 * k - ℓ) :=
begin
  simp only [←set.to_finset_card, common_neighbors, set.to_finset_inter, neighbor_set_compl,
    set.to_finset_diff, set.to_finset_singleton, set.to_finset_compl, ←neighbor_finset_def],
  simp only [not_and, not_not, compl_adj] at hna,
  have h2' := hna hn,
  simp_rw [compl_neighbor_finset_sdiff_inter_eq, sdiff_compl_neighbor_finset_inter_eq h2'],
  rwa [← finset.compl_union, card_compl, h.card_neighbor_finset_union_of_adj, ← h.card],
end

/-- The complement of a strongly regular graph is strongly regular. -/
lemma is_SRG_with.compl (h : G.is_SRG_with n k ℓ μ) :
  Gᶜ.is_SRG_with n (n - k - 1) (n - (2 * k - μ) - 2) (n - (2 * k - ℓ)) :=
{ card := h.card,
  regular := h.compl_is_regular,
  of_adj := λ v w ha, h.card_common_neighbors_eq_of_adj_compl ha,
  of_not_adj := λ v w hn hna, h.card_common_neighbors_eq_of_not_adj_compl hn hna, }

end simple_graph


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

! This file was ported from Lean 3 source module linear_algebra.free_algebra
! leanprover-community/mathlib commit cd3434749bf1f6a8155cb53b2705f08b74371f2a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.Basis
import Mathbin.Algebra.FreeAlgebra
import Mathbin.LinearAlgebra.FinsuppVectorSpace

/-!
# Linear algebra properties of `free_algebra R X`

This file provides a `free_monoid X` basis on the `free_algebra R X`, and uses it to show the
dimension of the algebra is the cardinality of `list X`
-/

universe u v

namespace FreeAlgebra

/-- The `free_monoid X` basis on the `free_algebra R X`,
mapping `[x₁, x₂, ..., xₙ]` to the "monomial" `1 • x₁ * x₂ * ⋯ * xₙ` -/
@[simps]
noncomputable def basisFreeMonoid (R : Type u) (X : Type v) [CommRing R] :
    Basis (FreeMonoid X) R (FreeAlgebra R X) :=
  Finsupp.basisSingleOne.map
    (equivMonoidAlgebraFreeMonoid.symm.toLinearEquiv : _ ≃ₗ[R] FreeAlgebra R X)
#align free_algebra.basis_free_monoid FreeAlgebra.basisFreeMonoid

-- TODO: generalize to `X : Type v`
theorem dim_eq {K : Type u} {X : Type max u v} [Field K] :
    Module.rank K (FreeAlgebra K X) = Cardinal.mk (List X) :=
  (Cardinal.lift_inj.mp (basisFreeMonoid K X).mk_eq_dim).symm
#align free_algebra.dim_eq FreeAlgebra.dim_eq

end FreeAlgebra


import tactic

-- Упражнения в этом файле сосредоточены на свойствах функций: инъекции, сюръекции и биекции.
-- По большей части заимствовано из курса Formalising Mathematics:
-- https://github.com/ImperialCollegeLondon/formalising-mathematics/blob/master/src/week_1/Part_C_functions.lean
-- https://github.com/ImperialCollegeLondon/formalising-mathematics/blob/master/src/week_4/Part_A_sets.lean

open function

-- Определим namespace, чтобы не пересекаться по названиям со стандартной библиотекой
namespace itmo.lean

-- Определим типы `X, Y, Z`, функции `f : X → Y`, `g : Y → Z` и вспомогательные элементы `(x : X) (y : Y) (z : Z)`
variables {X Y Z : Type} {f : X → Y} {g : Y → Z} (x : X) (y : Y) (z : Z)

-- Функция `f` является инъекцией, если из `f a = f b` следует, что `a = b` (то есть, для разных входов она выдает разные результаты)
lemma injective_def : injective f ↔ ∀ a b : X, f a = f b → a = b :=
begin
  -- верно по определению
  refl,
end

-- Тождественная функция id : X → X определена, как `id x = x`:
lemma id_def : id x = x :=
begin
  refl
end

/-- Тождественная функция инъективна -/
lemma injective_id : injective (id : X → X) :=
begin
  sorry,
end

-- Композиция функций `g ∘ f` (∘ = \o или \circ) определена, как `(g ∘ f) x = g (f x)`
lemma comp_def : (g ∘ f) x = g (f x) :=
begin
  -- верно по определению
  refl,
end

/-- Композиция инъекций является инъекцией -/
lemma injective_comp (hf : injective f) (hg : injective g) : injective (g ∘ f) :=
begin
  sorry,
end

-- Функция `f : X → Y` называется сюръекцией, если для любого `y : Y` существует `x : X`, что `f x = y`
lemma surjective_def : surjective f ↔ ∀ y : Y, ∃ x : X, f x = y :=
begin
  -- верно по определению
  refl
end

/-- Тождественная функция - сюръекция -/
lemma surjective_id : surjective (id : X → X) :=
begin
  sorry,
end

-- Композиция сюръекций является сюръекцией
lemma surjective_comp (hf : surjective f) (hg : surjective g) : surjective (g ∘ f) :=
begin
  sorry,
end

-- Функция `f` называется биекцией, если она является инъекцией и сюръекцией
lemma bijective_def : bijective f ↔ injective f ∧ surjective f :=
begin
  -- верно по определению
  refl
end

-- Используйте доказанные ранее утверждения, чтобы доказать, что тождественная функция - биекция
lemma bijective_id : bijective (id : X → X) :=
begin
  sorry,
end

-- Композиция биекций является биекцией
lemma bijective_comp (hf : bijective f) (hg : bijective g) : bijective (g ∘ f) :=
begin
  sorry,
end

variables (S : set X) (T : set Y)

-- Образ множества `S : set X` под действием функции `f : X → Y` обозначается как `(f '' S) : set Y`
-- `y ∈ f '' S` по определению равно `∃ x : X, x ∈ S ∧ f x = y`
-- В стандартной библиотеке это называется `set.image : (X → Y) → set X → set Y`
#check set.image
example : set.image f S = f '' S := rfl

lemma mem_image : y ∈ f '' S = ∃ x : X, x ∈ S ∧ f x = y :=
begin
  refl,
end

-- Образ тождественной функции
lemma image_id : id '' S = S :=
begin
  ext x,
  split,
  { rintro ⟨x₁, x₁S, hx₁⟩,
    rw [← hx₁, id],
    exact x₁S, },
  { intro xS,
    use x,
    rw id,
    use xS,
    -- оставшая цель закрыта с помощью `refl` после `use`
  }
end

-- `simp` справится с такой целью, потому что в стандартной библиотеке есть функция `set.image_id'`, помеченная атрибутом `@[simp]`, что включает ее в список используемых `simp` лемм
example : id '' S = S :=
begin
  ext, simp,
end

-- Это хорошее место, чтобы опробовать `rintro ⟨...⟩` и `refine ⟨...⟩`
-- Тактика `refine` очень похожа на `exact` и `apply`, но к тому же позволяет писать `_` в некоторых местах, генерируя цели для пропущенных аргументов
-- Например, пусть у нас есть состояние
-- x : X
-- xS : x ∈ S
-- h: (g ∘ f) x = z
-- ⊢ z ∈ g '' (f '' S)
-- После применения `refine ⟨f x, _, h⟩`, цель меняется на
-- ⊢ f x ∈ f '' S
-- Если подчеркиваний нет, и все корректно, `refine` закроет цель

lemma image_comp (S : set X) : (g ∘ f) '' S = g '' (f '' S) :=
begin
  sorry,
end

-- Если `f` - инъекция, то функция `λ S, f '' S` (то есть функция, которая переводит множество `S` в `f '' S`) - тоже
-- Тактика `dsimp` (`definitional simp`) действует так же, как `simp`, но использует только равенства, верные по определению
-- С помощью `dsimp` можно упростить "очевидные" выражения, такие, как применения λ-функций:
-- `h : (λ (S : set X), f '' S) S = (λ (S : set X), f '' S) T`
-- `dsimp at h`
-- `h : f '' S = f '' T`
-- Аналогично `simp`, `dsimp only [h₁, h₂, h₃]` будет применять только леммы `h₁`, `h₂` и `h₃`, а `dsimp only at h` не будет применять дополнительных лемм (но, например, раскроет применения лямбд и подобные вещи)

-- Для себя я нашел полезным доказать лемму `image_subset_of_subset: ∀ S T, f '' S ⊆ f '' T → S ⊆ T`
lemma image_injective : injective f → injective (λ S, f '' S) :=
begin
  sorry,
end

-- Прообраз функции `f : X → Y` обозначается `f ⁻¹' : set Y → set X
-- По определению: `x ∈ f ⁻¹' T ↔ f x ∈ T`
lemma mem_preimage : x ∈ f ⁻¹' T ↔ f x ∈ T :=
begin
  refl,
end

lemma comp_preimage (T : set Z) : (g ∘ f) ⁻¹' T = f ⁻¹' (g ⁻¹' T) :=
begin
  sorry,
end

lemma preimage_injective (hf : surjective f) : injective (λ T, f ⁻¹' T) :=
begin
  sorry,
end

lemma image_surjective (hf : surjective f) : surjective (λ S, f '' S) :=
begin
  sorry,
end

lemma preimage_surjective (hf : injective f) : surjective (λ S, f ⁻¹' S) :=
begin
  sorry,
end

variables (ι : Type)

-- Образ объединения множеств `G i` под функцией `f`, равен объединению образов множеств `G i`
-- Используйте `set.mem_Union` для переписывания
lemma image_Union (G : ι → set X) :  f '' (⋃ (i : ι), G i) = ⋃ (i : ι), f '' (G i) :=
begin
  sorry,
end

-- Прообраз объединения множеств равен объединению прообразов
-- Используйте `set.mem_bUnion_iff` для переписывания
lemma preimage_bUnion (F : ι → set Y) (Z : set ι) :
  f ⁻¹' (⋃ (i ∈ Z), F i) = ⋃ (i ∈ Z), f ⁻¹' (F i) :=
begin
  sorry,
end

end itmo.lean


/-
Copyright (c) 2021 Thomas Browning. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Thomas Browning
-/
import group_theory.subsemigroup.centralizer
import group_theory.submonoid.center

/-!
# Centralizers of magmas and monoids

## Main definitions

* `submonoid.centralizer`: the centralizer of a subset of a monoid
* `add_submonoid.centralizer`: the centralizer of a subset of an additive monoid

We provide `subgroup.centralizer`, `add_subgroup.centralizer` in other files.
-/

variables {M : Type*} {S T : set M}

namespace submonoid
section
variables [monoid M] (S)

/-- The centralizer of a subset of a monoid `M`. -/
@[to_additive "The centralizer of a subset of an additive monoid."]
def centralizer : submonoid M :=
{ carrier := S.centralizer,
  one_mem' := S.one_mem_centralizer,
  mul_mem' := λ a b, set.mul_mem_centralizer }

@[simp, norm_cast, to_additive] lemma coe_centralizer : ↑(centralizer S) = S.centralizer := rfl

lemma centralizer_to_subsemigroup : (centralizer S).to_subsemigroup = subsemigroup.centralizer S :=
rfl

lemma _root_.add_submonoid.centralizer_to_add_subsemigroup {M} [add_monoid M] (S : set M) :
  (add_submonoid.centralizer S).to_add_subsemigroup = add_subsemigroup.centralizer S :=
rfl

attribute [to_additive add_submonoid.centralizer_to_add_subsemigroup]
  submonoid.centralizer_to_subsemigroup

variables {S}

@[to_additive] lemma mem_centralizer_iff {z : M} : z ∈ centralizer S ↔ ∀ g ∈ S, g * z = z * g :=
iff.rfl

@[to_additive] instance decidable_mem_centralizer [decidable_eq M] [fintype M]
  [decidable_pred (∈ S)] : decidable_pred (∈ centralizer S) :=
λ _, decidable_of_iff' _ mem_centralizer_iff

@[to_additive]
lemma centralizer_le (h : S ⊆ T) : centralizer T ≤ centralizer S :=
set.centralizer_subset h

variables (M)

@[simp, to_additive]
lemma centralizer_univ : centralizer set.univ = center M :=
set_like.ext' (set.centralizer_univ M)

end

end submonoid


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

GCD domain and integral domains with normalization functions

TODO: abstract the domains to to semi domains (i.e. domains on semirings) to include ℕ and ℕ[X] etc.
-/
import algebra.associated data.int.gcd

variables {α : Type*}

set_option old_structure_cmd true

/-- Normalization domain: multiplying with `norm_unit` gives a normal form for associated elements. -/
class normalization_domain (α : Type*) extends integral_domain α :=
(norm_unit : α → units α)
(norm_unit_zero      : norm_unit 0 = 1)
(norm_unit_mul       : ∀{a b}, a ≠ 0 → b ≠ 0 → norm_unit (a * b) = norm_unit a * norm_unit b)
(norm_unit_coe_units : ∀(u : units α), norm_unit u = u⁻¹)

export normalization_domain (norm_unit norm_unit_zero norm_unit_mul norm_unit_coe_units)

attribute [simp] norm_unit_coe_units norm_unit_zero norm_unit_mul

section normalization_domain
variable [normalization_domain α]

def normalize (x : α) : α :=
x * norm_unit x

theorem associated_normalize {x : α} : associated x (normalize x) :=
⟨_, rfl⟩

theorem normalize_associated {x : α} : associated (normalize x) x :=
associated_normalize.symm

@[simp] theorem norm_unit_one : norm_unit (1:α) = 1 :=
norm_unit_coe_units 1

@[simp] lemma normalize_zero : normalize (0 : α) = 0 :=
by rw [normalize, zero_mul]

@[simp] lemma normalize_one : normalize (1 : α) = 1 :=
by rw [normalize, norm_unit_one, units.coe_one, mul_one]

lemma normalize_coe_units (u : units α) : normalize (u : α) = 1 :=
by rw [normalize, norm_unit_coe_units, ← units.coe_mul, mul_inv_self, units.coe_one]

theorem normalize_mul (x y : α) : normalize (x * y) = normalize x * normalize y :=
classical.by_cases (λ hx : x = 0, by rw [hx, zero_mul, normalize_zero, zero_mul]) $ λ hx,
classical.by_cases (λ hy : y = 0, by rw [hy, mul_zero, normalize_zero, mul_zero]) $ λ hy,
by simp only [normalize, norm_unit_mul hx hy, units.coe_mul]; simp only [mul_assoc, mul_left_comm y]

lemma normalize_eq_zero {x : α} : normalize x = 0 ↔ x = 0 :=
⟨λ hx, (associated_zero_iff_eq_zero x).1 $ hx ▸ associated_normalize, by rintro rfl; exact normalize_zero⟩

lemma normalize_eq_one {x : α} : normalize x = 1 ↔ is_unit x :=
⟨λ hx, is_unit_iff_exists_inv.2 ⟨_, hx⟩, λ ⟨u, hu⟩, hu.symm ▸ normalize_coe_units u⟩

theorem norm_unit_mul_norm_unit (a : α) : norm_unit (a * norm_unit a) = 1 :=
classical.by_cases (assume : a = 0, by simp only [this, norm_unit_zero, zero_mul]) $
  assume h, by rw [norm_unit_mul h (units.ne_zero _), norm_unit_coe_units, mul_inv_eq_one]

theorem normalize_idem (x : α) : normalize (normalize x) = normalize x :=
by rw [normalize, normalize, norm_unit_mul_norm_unit, units.coe_one, mul_one]

theorem normalize_eq_normalize {a b : α}
  (hab : a ∣ b) (hba : b ∣ a) : normalize a = normalize b :=
begin
  rcases associated_of_dvd_dvd hab hba with ⟨u, rfl⟩,
  refine classical.by_cases (by rintro rfl; simp only [zero_mul]) (assume ha : a ≠ 0, _),
  suffices : a * ↑(norm_unit a) = a * ↑u * ↑(norm_unit a) * ↑u⁻¹,
    by simpa only [normalize, mul_assoc, norm_unit_mul ha u.ne_zero, norm_unit_coe_units],
  calc a * ↑(norm_unit a) = a * ↑(norm_unit a) * ↑u * ↑u⁻¹:
      (units.mul_inv_cancel_right _ _).symm
    ... = a * ↑u * ↑(norm_unit a) * ↑u⁻¹ : by rw mul_right_comm a
end

lemma normalize_eq_normalize_iff {x y : α} : normalize x = normalize y ↔ x ∣ y ∧ y ∣ x :=
⟨λ h, ⟨dvd_mul_unit_iff.1 ⟨_, h.symm⟩, dvd_mul_unit_iff.1 ⟨_, h⟩⟩,
λ ⟨hxy, hyx⟩, normalize_eq_normalize hxy hyx⟩

theorem dvd_antisymm_of_normalize_eq {a b : α}
  (ha : normalize a = a) (hb : normalize b = b) (hab : a ∣ b) (hba : b ∣ a) :
  a = b :=
ha ▸ hb ▸ normalize_eq_normalize hab hba

@[simp] lemma dvd_normalize_iff {a b : α} : a ∣ normalize b ↔ a ∣ b :=
dvd_mul_unit_iff

@[simp] lemma normalize_dvd_iff {a b : α} : normalize a ∣ b ↔ a ∣ b :=
mul_unit_dvd_iff

end normalization_domain

namespace associates
variable [normalization_domain α]

local attribute [instance] associated.setoid

protected def out : associates α → α :=
quotient.lift (normalize : α → α) $ λ a b ⟨u, hu⟩, hu ▸
normalize_eq_normalize ⟨_, rfl⟩ (mul_unit_dvd_iff.2 $ dvd_refl a)

lemma out_mk (a : α) : (associates.mk a).out = normalize a := rfl

@[simp] lemma out_one : (1 : associates α).out = 1 :=
normalize_one

lemma out_mul (a b : associates α) : (a * b).out = a.out * b.out :=
quotient.induction_on₂ a b $ assume a b,
by simp only [associates.quotient_mk_eq_mk, out_mk, mk_mul_mk, normalize_mul]

lemma dvd_out_iff (a : α) (b : associates α) : a ∣ b.out ↔ associates.mk a ≤ b :=
quotient.induction_on b $ by simp [associates.out_mk, associates.quotient_mk_eq_mk, mk_le_mk_iff_dvd_iff]

lemma out_dvd_iff (a : α) (b : associates α) : b.out ∣ a ↔ b ≤ associates.mk a :=
quotient.induction_on b $ by simp [associates.out_mk, associates.quotient_mk_eq_mk, mk_le_mk_iff_dvd_iff]

@[simp] lemma out_top : (⊤ : associates α).out = 0 :=
normalize_zero

@[simp] lemma normalize_out (a : associates α) : normalize a.out = a.out :=
quotient.induction_on a normalize_idem

end associates

/-- GCD domain: an integral domain with normalization and `gcd` (greatest common divisor) and
`lcm` (least common multiple) operations. In this setting `gcd` and `lcm` form a bounded lattice on
the associated elements where `gcd` is the infimum, `lcm` is the supremum, `1` is bottom, and
`0` is top. The type class focuses on `gcd` and we derive the correpsonding `lcm` facts from `gcd`.
-/
class gcd_domain (α : Type*) extends normalization_domain α :=
(gcd : α → α → α)
(lcm : α → α → α)
(gcd_dvd_left   : ∀a b, gcd a b ∣ a)
(gcd_dvd_right  : ∀a b, gcd a b ∣ b)
(dvd_gcd        : ∀{a b c}, a ∣ c → a ∣ b → a ∣ gcd c b)
(normalize_gcd  : ∀a b, normalize (gcd a b) = gcd a b)
(gcd_mul_lcm    : ∀a b, gcd a b * lcm a b = normalize (a * b))
(lcm_zero_left  : ∀a, lcm 0 a = 0)
(lcm_zero_right : ∀a, lcm a 0 = 0)

export gcd_domain (gcd lcm gcd_dvd_left gcd_dvd_right dvd_gcd  lcm_zero_left lcm_zero_right)

attribute [simp] lcm_zero_left lcm_zero_right

section gcd_domain
variables [gcd_domain α]

@[simp] theorem normalize_gcd : ∀a b:α, normalize (gcd a b) = gcd a b :=
gcd_domain.normalize_gcd

@[simp] theorem gcd_mul_lcm : ∀a b:α, gcd a b * lcm a b = normalize (a * b) :=
gcd_domain.gcd_mul_lcm

section gcd

theorem dvd_gcd_iff (a b c : α) : a ∣ gcd b c ↔ (a ∣ b ∧ a ∣ c) :=
iff.intro
  (assume h, ⟨dvd_trans h (gcd_dvd_left _ _), dvd_trans h (gcd_dvd_right _ _)⟩)
  (assume ⟨hab, hac⟩, dvd_gcd hab hac)

theorem gcd_comm (a b : α) : gcd a b = gcd b a :=
dvd_antisymm_of_normalize_eq (normalize_gcd _ _) (normalize_gcd _ _)
  (dvd_gcd (gcd_dvd_right _ _) (gcd_dvd_left _ _))
  (dvd_gcd (gcd_dvd_right _ _) (gcd_dvd_left _ _))

theorem gcd_assoc (m n k : α) : gcd (gcd m n) k = gcd m (gcd n k) :=
dvd_antisymm_of_normalize_eq (normalize_gcd _ _) (normalize_gcd _ _)
  (dvd_gcd
    (dvd.trans (gcd_dvd_left (gcd m n) k) (gcd_dvd_left m n))
    (dvd_gcd (dvd.trans (gcd_dvd_left (gcd m n) k) (gcd_dvd_right m n)) (gcd_dvd_right (gcd m n) k)))
  (dvd_gcd
    (dvd_gcd (gcd_dvd_left m (gcd n k)) (dvd.trans (gcd_dvd_right m (gcd n k)) (gcd_dvd_left n k)))
    (dvd.trans (gcd_dvd_right m (gcd n k)) (gcd_dvd_right n k)))

instance : is_commutative α gcd := ⟨gcd_comm⟩
instance : is_associative α gcd := ⟨gcd_assoc⟩

theorem gcd_eq_normalize {a b c : α} (habc : gcd a b ∣ c) (hcab : c ∣ gcd a b) :
  gcd a b = normalize c :=
normalize_gcd a b ▸ normalize_eq_normalize habc hcab

@[simp] theorem gcd_zero_left (a : α) : gcd 0 a = normalize a :=
gcd_eq_normalize (gcd_dvd_right 0 a) (dvd_gcd (dvd_zero _) (dvd_refl a))

@[simp] theorem gcd_zero_right (a : α) : gcd a 0 = normalize a :=
gcd_eq_normalize (gcd_dvd_left a 0) (dvd_gcd (dvd_refl a) (dvd_zero _))

@[simp] theorem gcd_eq_zero_iff (a b : α) : gcd a b = 0 ↔ a = 0 ∧ b = 0 :=
iff.intro
  (assume h, let ⟨ca, ha⟩ := gcd_dvd_left a b, ⟨cb, hb⟩ := gcd_dvd_right a b in
    by rw [h, zero_mul] at ha hb; exact ⟨ha, hb⟩)
  (assume ⟨ha, hb⟩, by rw [ha, hb, gcd_zero_left, normalize_zero])

@[simp] theorem gcd_one_left (a : α) : gcd 1 a = 1 :=
dvd_antisymm_of_normalize_eq (normalize_gcd _ _) normalize_one (gcd_dvd_left _ _) (one_dvd _)

@[simp] theorem gcd_one_right (a : α) : gcd a 1 = 1 :=
dvd_antisymm_of_normalize_eq (normalize_gcd _ _) normalize_one (gcd_dvd_right _ _) (one_dvd _)

theorem gcd_dvd_gcd {a b c d: α} (hab : a ∣ b) (hcd : c ∣ d) : gcd a c ∣ gcd b d :=
dvd_gcd (dvd.trans (gcd_dvd_left _ _) hab) (dvd.trans (gcd_dvd_right _ _) hcd)

@[simp] theorem gcd_same (a : α) : gcd a a = normalize a :=
gcd_eq_normalize (gcd_dvd_left _ _) (dvd_gcd (dvd_refl a) (dvd_refl a))

@[simp] theorem gcd_mul_left (a b c : α) : gcd (a * b) (a * c) = normalize a * gcd b c :=
classical.by_cases (by rintro rfl; simp only [zero_mul, gcd_zero_left, normalize_zero]) $ assume ha : a ≠ 0,
suffices gcd (a * b) (a * c) = normalize (a * gcd b c),
  by simpa only [normalize_mul, normalize_gcd],
let ⟨d, eq⟩ := dvd_gcd (dvd_mul_right a b) (dvd_mul_right a c) in
gcd_eq_normalize
  (eq.symm ▸ mul_dvd_mul_left a $ show d ∣ gcd b c, from
    dvd_gcd
      ((mul_dvd_mul_iff_left ha).1 $ eq ▸ gcd_dvd_left _ _)
      ((mul_dvd_mul_iff_left ha).1 $ eq ▸ gcd_dvd_right _ _))
  (dvd_gcd
    (mul_dvd_mul_left a $ gcd_dvd_left _ _)
    (mul_dvd_mul_left a $ gcd_dvd_right _ _))

@[simp] theorem gcd_mul_right (a b c : α) : gcd (b * a) (c * a) = gcd b c * normalize a :=
by simp only [mul_comm, gcd_mul_left]

theorem gcd_eq_left_iff (a b : α) (h : normalize a = a) : gcd a b = a ↔ a ∣ b :=
iff.intro (assume eq, eq ▸ gcd_dvd_right _ _) $
  assume hab, dvd_antisymm_of_normalize_eq (normalize_gcd _ _) h (gcd_dvd_left _ _) (dvd_gcd (dvd_refl a) hab)

theorem gcd_eq_right_iff (a b : α) (h : normalize b = b) : gcd a b = b ↔ b ∣ a :=
by simpa only [gcd_comm a b] using gcd_eq_left_iff b a h

theorem gcd_dvd_gcd_mul_left (m n k : α) : gcd m n ∣ gcd (k * m) n :=
gcd_dvd_gcd (dvd_mul_left _ _) (dvd_refl _)

theorem gcd_dvd_gcd_mul_right (m n k : α) : gcd m n ∣ gcd (m * k) n :=
gcd_dvd_gcd (dvd_mul_right _ _) (dvd_refl _)

theorem gcd_dvd_gcd_mul_left_right (m n k : α) : gcd m n ∣ gcd m (k * n) :=
gcd_dvd_gcd (dvd_refl _) (dvd_mul_left _ _)

theorem gcd_dvd_gcd_mul_right_right (m n k : α) : gcd m n ∣ gcd m (n * k) :=
gcd_dvd_gcd (dvd_refl _) (dvd_mul_right _ _)

end gcd

section lcm

lemma lcm_dvd_iff {a b c : α} : lcm a b ∣ c ↔ a ∣ c ∧ b ∣ c :=
classical.by_cases
  (assume : a = 0 ∨ b = 0, by rcases this with rfl | rfl;
    simp only [iff_def, lcm_zero_left, lcm_zero_right, zero_dvd_iff, dvd_zero,
      eq_self_iff_true, and_true, imp_true_iff] {contextual:=tt})
  (assume this : ¬ (a = 0 ∨ b = 0),
    let ⟨h1, h2⟩ := not_or_distrib.1 this in
    have h : gcd a b ≠ 0, from λ H, h1 ((gcd_eq_zero_iff _ _).1 H).1,
    by rw [← mul_dvd_mul_iff_left h, gcd_mul_lcm, normalize_dvd_iff, ← dvd_normalize_iff,
        normalize_mul, normalize_gcd, ← gcd_mul_right, dvd_gcd_iff,
        mul_comm b c, mul_dvd_mul_iff_left h1, mul_dvd_mul_iff_right h2, and_comm])

lemma dvd_lcm_left (a b : α) : a ∣ lcm a b := (lcm_dvd_iff.1 (dvd_refl _)).1

lemma dvd_lcm_right (a b : α) : b ∣ lcm a b := (lcm_dvd_iff.1 (dvd_refl _)).2

lemma lcm_dvd {a b c : α} (hab : a ∣ b) (hcb : c ∣ b) : lcm a c ∣ b :=
lcm_dvd_iff.2 ⟨hab, hcb⟩

@[simp] theorem lcm_eq_zero_iff (a b : α) : lcm a b = 0 ↔ a = 0 ∨ b = 0 :=
iff.intro
  (assume h : lcm a b = 0,
    have normalize (a * b) = 0,
      by rw [← gcd_mul_lcm _ _, h, mul_zero],
    by simpa only [normalize_eq_zero, mul_eq_zero, units.ne_zero, or_false])
  (by rintro (rfl | rfl); [apply lcm_zero_left, apply lcm_zero_right])

@[simp] lemma normalize_lcm (a b : α) : normalize (lcm a b) = lcm a b :=
classical.by_cases (assume : lcm a b = 0, by rw [this, normalize_zero]) $
  assume h_lcm : lcm a b ≠ 0,
  have h1 : gcd a b ≠ 0, from mt (by rw [gcd_eq_zero_iff, lcm_eq_zero_iff];
    rintros ⟨rfl, rfl⟩; left; refl) h_lcm,
  have h2 : normalize (gcd a b * lcm a b) = gcd a b * lcm a b,
    by rw [gcd_mul_lcm, normalize_idem],
  by simpa only [normalize_mul, normalize_gcd, one_mul, domain.mul_left_inj h1] using h2

theorem lcm_comm (a b : α) : lcm a b = lcm b a :=
dvd_antisymm_of_normalize_eq (normalize_lcm _ _) (normalize_lcm _ _)
  (lcm_dvd (dvd_lcm_right _ _) (dvd_lcm_left _ _))
  (lcm_dvd (dvd_lcm_right _ _) (dvd_lcm_left _ _))

theorem lcm_assoc (m n k : α) : lcm (lcm m n) k = lcm m (lcm n k) :=
dvd_antisymm_of_normalize_eq (normalize_lcm _ _) (normalize_lcm _ _)
  (lcm_dvd
    (lcm_dvd (dvd_lcm_left _ _) (dvd.trans (dvd_lcm_left _ _) (dvd_lcm_right _ _)))
    (dvd.trans (dvd_lcm_right _ _) (dvd_lcm_right _ _)))
  (lcm_dvd
    (dvd.trans (dvd_lcm_left _ _) (dvd_lcm_left _ _))
    (lcm_dvd (dvd.trans (dvd_lcm_right _ _) (dvd_lcm_left _ _)) (dvd_lcm_right _ _)))

instance : is_commutative α lcm := ⟨lcm_comm⟩
instance : is_associative α lcm := ⟨lcm_assoc⟩

lemma lcm_eq_normalize {a b c : α} (habc : lcm a b ∣ c) (hcab : c ∣ lcm a b) :
  lcm a b = normalize c :=
normalize_lcm a b ▸ normalize_eq_normalize habc hcab

theorem lcm_dvd_lcm {a b c d : α} (hab : a ∣ b) (hcd : c ∣ d) : lcm a c ∣ lcm b d :=
lcm_dvd (dvd.trans hab (dvd_lcm_left _ _)) (dvd.trans hcd (dvd_lcm_right _ _))

@[simp] theorem lcm_units_coe_left (u : units α) (a : α) : lcm ↑u a = normalize a :=
lcm_eq_normalize (lcm_dvd (units.coe_dvd _ _) (dvd_refl _)) (dvd_lcm_right _ _)

@[simp] theorem lcm_units_coe_right (a : α) (u : units α) : lcm a ↑u = normalize a :=
(lcm_comm a u).trans $ lcm_units_coe_left _ _

@[simp] theorem lcm_one_left (a : α) : lcm 1 a = normalize a :=
lcm_units_coe_left 1 a

@[simp] theorem lcm_one_right (a : α) : lcm a 1 = normalize a :=
lcm_units_coe_right a 1

@[simp] theorem lcm_same (a : α) : lcm a a = normalize a :=
lcm_eq_normalize (lcm_dvd (dvd_refl _) (dvd_refl _)) (dvd_lcm_left _ _)

@[simp] theorem lcm_eq_one_iff (a b : α) : lcm a b = 1 ↔ a ∣ 1 ∧ b ∣ 1 :=
iff.intro
  (assume eq, eq ▸ ⟨dvd_lcm_left _ _, dvd_lcm_right _ _⟩)
  (assume ⟨⟨c, hc⟩, ⟨d, hd⟩⟩,
    show lcm (units.mk_of_mul_eq_one a c hc.symm : α) (units.mk_of_mul_eq_one b d hd.symm) = 1,
      by rw [lcm_units_coe_left, normalize_coe_units])

@[simp] theorem lcm_mul_left (a b c : α) : lcm (a * b) (a * c) = normalize a * lcm b c :=
classical.by_cases (by rintro rfl; simp only [zero_mul, lcm_zero_left, normalize_zero]) $ assume ha : a ≠ 0,
suffices lcm (a * b) (a * c) = normalize (a * lcm b c),
  by simpa only [normalize_mul, normalize_lcm],
have a ∣ lcm (a * b) (a * c), from dvd.trans (dvd_mul_right _ _) (dvd_lcm_left _ _),
let ⟨d, eq⟩ := this in
lcm_eq_normalize
  (lcm_dvd (mul_dvd_mul_left a (dvd_lcm_left _ _)) (mul_dvd_mul_left a (dvd_lcm_right _ _)))
  (eq.symm ▸ (mul_dvd_mul_left a $ lcm_dvd
    ((mul_dvd_mul_iff_left ha).1 $ eq ▸ dvd_lcm_left _ _)
    ((mul_dvd_mul_iff_left ha).1 $ eq ▸ dvd_lcm_right _ _)))

@[simp] theorem lcm_mul_right (a b c : α) : lcm (b * a) (c * a) = lcm b c * normalize a :=
by simp only [mul_comm, lcm_mul_left]

theorem lcm_eq_left_iff (a b : α) (h : normalize a = a) : lcm a b = a ↔ b ∣ a :=
iff.intro (assume eq, eq ▸ dvd_lcm_right _ _) $
  assume hab, dvd_antisymm_of_normalize_eq (normalize_lcm _ _) h (lcm_dvd (dvd_refl a) hab) (dvd_lcm_left _ _)

theorem lcm_eq_right_iff (a b : α) (h : normalize b = b) : lcm a b = b ↔ a ∣ b :=
by simpa only [lcm_comm b a] using lcm_eq_left_iff b a h

theorem lcm_dvd_lcm_mul_left (m n k : α) : lcm m n ∣ lcm (k * m) n :=
lcm_dvd_lcm (dvd_mul_left _ _) (dvd_refl _)

theorem lcm_dvd_lcm_mul_right (m n k : α) : lcm m n ∣ lcm (m * k) n :=
lcm_dvd_lcm (dvd_mul_right _ _) (dvd_refl _)

theorem lcm_dvd_lcm_mul_left_right (m n k : α) : lcm m n ∣ lcm m (k * n) :=
lcm_dvd_lcm (dvd_refl _) (dvd_mul_left _ _)

theorem lcm_dvd_lcm_mul_right_right (m n k : α) : lcm m n ∣ lcm m (n * k) :=
lcm_dvd_lcm (dvd_refl _) (dvd_mul_right _ _)

end lcm

end gcd_domain

namespace int

section normalization_domain

instance : normalization_domain ℤ :=
{ norm_unit      := λa:ℤ, if 0 ≤ a then 1 else -1,
  norm_unit_zero := if_pos (le_refl _),
  norm_unit_mul  := assume a b hna hnb,
  begin
    by_cases ha : 0 ≤ a; by_cases hb : 0 ≤ b; simp [ha, hb],
    exact if_pos (mul_nonneg ha hb),
    exact if_neg (assume h, hb $ nonneg_of_mul_nonneg_left h $ lt_of_le_of_ne ha hna.symm),
    exact if_neg (assume h, ha $ nonneg_of_mul_nonneg_right h $ lt_of_le_of_ne hb hnb.symm),
    exact if_pos (mul_nonneg_of_nonpos_of_nonpos (le_of_not_ge ha) (le_of_not_ge hb))
  end,
  norm_unit_coe_units := assume u, (units_eq_one_or u).elim
    (assume eq, eq.symm ▸ if_pos zero_le_one)
    (assume eq, eq.symm ▸ if_neg (not_le_of_gt $ show (-1:ℤ) < 0, by simp [@neg_lt ℤ _ 1 0])),
  .. (infer_instance : integral_domain ℤ) }

lemma normalize_of_nonneg {z : ℤ} (h : 0 ≤ z) : normalize z = z :=
show z * ↑(ite _ _ _) = z, by rw [if_pos h, units.coe_one, mul_one]

lemma normalize_of_neg {z : ℤ} (h : z < 0) : normalize z = -z :=
show z * ↑(ite _ _ _) = -z, by rw [if_neg (not_le_of_gt h), units.coe_neg, units.coe_one, mul_neg_one]

lemma normalize_coe_nat (n : ℕ) : normalize (n : ℤ) = n :=
normalize_of_nonneg (coe_nat_le_coe_nat_of_le $ nat.zero_le n)

theorem coe_nat_abs_eq_normalize (z : ℤ) : (z.nat_abs : ℤ) = normalize z :=
begin
  by_cases 0 ≤ z,
  { simp [nat_abs_of_nonneg h, normalize_of_nonneg h] },
  { simp [of_nat_nat_abs_of_nonpos (le_of_not_ge h), normalize_of_neg (lt_of_not_ge h)] }
end

end normalization_domain

/-- ℤ specific version of least common multiple. -/
def lcm (i j : ℤ) : ℕ := nat.lcm (nat_abs i) (nat_abs j)

theorem lcm_def (i j : ℤ) : lcm i j = nat.lcm (nat_abs i) (nat_abs j) := rfl

section gcd_domain

theorem gcd_dvd_left (i j : ℤ) : (gcd i j : ℤ) ∣ i :=
dvd_nat_abs.mp $ coe_nat_dvd.mpr $ nat.gcd_dvd_left _ _

theorem gcd_dvd_right (i j : ℤ) : (gcd i j : ℤ) ∣ j :=
dvd_nat_abs.mp $ coe_nat_dvd.mpr $ nat.gcd_dvd_right _ _

theorem dvd_gcd {i j k : ℤ} (h1 : k ∣ i) (h2 : k ∣ j) : k ∣ gcd i j :=
nat_abs_dvd.1 $ coe_nat_dvd.2 $ nat.dvd_gcd (nat_abs_dvd_abs_iff.2 h1) (nat_abs_dvd_abs_iff.2 h2)

theorem gcd_mul_lcm (i j : ℤ) : gcd i j * lcm i j = nat_abs (i * j) :=
by rw [int.gcd, int.lcm, nat.gcd_mul_lcm, nat_abs_mul]

instance : gcd_domain ℤ :=
{ gcd            := λa b, int.gcd a b,
  lcm            := λa b, int.lcm a b,
  gcd_dvd_left   := assume a b, int.gcd_dvd_left _ _,
  gcd_dvd_right  := assume a b, int.gcd_dvd_right _ _,
  dvd_gcd        := assume a b c, dvd_gcd,
  normalize_gcd  := assume a b, normalize_coe_nat _,
  gcd_mul_lcm    := by intros; rw [← int.coe_nat_mul, gcd_mul_lcm, coe_nat_abs_eq_normalize],
  lcm_zero_left  := assume a, coe_nat_eq_zero.2 $ nat.lcm_zero_left _,
  lcm_zero_right := assume a, coe_nat_eq_zero.2 $ nat.lcm_zero_right _,
  .. int.normalization_domain }

lemma coe_gcd (i j : ℤ) : ↑(int.gcd i j) = gcd_domain.gcd i j := rfl
lemma coe_lcm (i j : ℤ) : ↑(int.lcm i j) = gcd_domain.lcm i j := rfl

lemma nat_abs_gcd (i j : ℤ) : nat_abs (gcd_domain.gcd i j) = int.gcd i j := rfl
lemma nat_abs_lcm (i j : ℤ) : nat_abs (gcd_domain.lcm i j) = int.lcm i j := rfl

end gcd_domain

theorem gcd_comm (i j : ℤ) : gcd i j = gcd j i := nat.gcd_comm _ _

theorem gcd_assoc (i j k : ℤ) : gcd (gcd i j) k = gcd i (gcd j k) := nat.gcd_assoc _ _ _

@[simp] theorem gcd_self (i : ℤ) : gcd i i = nat_abs i := by simp [gcd]

@[simp] theorem gcd_zero_left (i : ℤ) : gcd 0 i = nat_abs i := by simp [gcd]

@[simp] theorem gcd_zero_right (i : ℤ) : gcd i 0 = nat_abs i := by simp [gcd]

@[simp] theorem gcd_one_left (i : ℤ) : gcd 1 i = 1 := nat.gcd_one_left _

@[simp] theorem gcd_one_right (i : ℤ) : gcd i 1 = 1 := nat.gcd_one_right _

theorem gcd_mul_left (i j k : ℤ) : gcd (i * j) (i * k) = nat_abs i * gcd j k :=
by simp [(int.coe_nat_eq_coe_nat_iff _ _).symm, coe_gcd, coe_nat_abs_eq_normalize]

theorem gcd_mul_right (i j k : ℤ) : gcd (i * j) (k * j) = gcd i k * nat_abs j :=
by simp [(int.coe_nat_eq_coe_nat_iff _ _).symm, coe_gcd, coe_nat_abs_eq_normalize]

theorem gcd_pos_of_non_zero_left {i : ℤ} (j : ℤ) (i_non_zero : i ≠ 0) : gcd i j > 0 :=
nat.gcd_pos_of_pos_left (nat_abs j) (nat_abs_pos_of_ne_zero i_non_zero)

theorem gcd_pos_of_non_zero_right (i : ℤ) {j : ℤ} (j_non_zero : j ≠ 0) : gcd i j > 0 :=
nat.gcd_pos_of_pos_right (nat_abs i) (nat_abs_pos_of_ne_zero j_non_zero)

theorem gcd_eq_zero_iff {i j : ℤ} : gcd i j = 0 ↔ i = 0 ∧ j = 0 :=
by rw [← int.coe_nat_eq_coe_nat_iff, int.coe_nat_zero, coe_gcd, gcd_eq_zero_iff]

theorem gcd_div {i j k : ℤ} (H1 : k ∣ i) (H2 : k ∣ j) :
  gcd (i / k) (j / k) = gcd i j / nat_abs k :=
by rw [gcd, nat_abs_div i k H1, nat_abs_div j k H2];
exact nat.gcd_div (nat_abs_dvd_abs_iff.mpr H1) (nat_abs_dvd_abs_iff.mpr H2)

theorem gcd_dvd_gcd_of_dvd_left {i k : ℤ} (j : ℤ) (H : i ∣ k) : gcd i j ∣ gcd k j :=
int.coe_nat_dvd.1 $ dvd_gcd (dvd.trans (gcd_dvd_left i j) H) (gcd_dvd_right i j)

theorem gcd_dvd_gcd_of_dvd_right {i k : ℤ} (j : ℤ) (H : i ∣ k) : gcd j i ∣ gcd j k :=
int.coe_nat_dvd.1 $ dvd_gcd (gcd_dvd_left j i) (dvd.trans (gcd_dvd_right j i) H)

theorem gcd_dvd_gcd_mul_left (i j k : ℤ) : gcd i j ∣ gcd (k * i) j :=
gcd_dvd_gcd_of_dvd_left _ (dvd_mul_left _ _)

theorem gcd_dvd_gcd_mul_right (i j k : ℤ) : gcd i j ∣ gcd (i * k) j :=
gcd_dvd_gcd_of_dvd_left _ (dvd_mul_right _ _)

theorem gcd_dvd_gcd_mul_left_right (i j k : ℤ) : gcd i j ∣ gcd i (k * j) :=
gcd_dvd_gcd_of_dvd_right _ (dvd_mul_left _ _)

theorem gcd_dvd_gcd_mul_right_right (i j k : ℤ) : gcd i j ∣ gcd i (j * k) :=
gcd_dvd_gcd_of_dvd_right _ (dvd_mul_right _ _)

theorem gcd_eq_left {i j : ℤ} (H : i ∣ j) : gcd i j = nat_abs i :=
nat.dvd_antisymm (by unfold gcd; exact nat.gcd_dvd_left _ _)
                 (by unfold gcd; exact nat.dvd_gcd (dvd_refl _) (nat_abs_dvd_abs_iff.mpr H))

theorem gcd_eq_right {i j : ℤ} (H : j ∣ i) : gcd i j = nat_abs j :=
by rw [gcd_comm, gcd_eq_left H]

/- lcm -/

theorem lcm_comm (i j : ℤ) : lcm i j = lcm j i :=
by simp [(int.coe_nat_eq_coe_nat_iff _ _).symm, coe_lcm, lcm_comm]

theorem lcm_assoc (i j k : ℤ) : lcm (lcm i j) k = lcm i (lcm j k) :=
by simp [(int.coe_nat_eq_coe_nat_iff _ _).symm, coe_lcm, lcm_assoc]

@[simp] theorem lcm_zero_left (i : ℤ) : lcm 0 i = 0 :=
by simp [(int.coe_nat_eq_coe_nat_iff _ _).symm, coe_lcm]

@[simp] theorem lcm_zero_right (i : ℤ) : lcm i 0 = 0 :=
by simp [(int.coe_nat_eq_coe_nat_iff _ _).symm, coe_lcm]

@[simp] theorem lcm_one_left (i : ℤ) : lcm 1 i = nat_abs i :=
by simp [(int.coe_nat_eq_coe_nat_iff _ _).symm, coe_lcm, coe_nat_abs_eq_normalize]

@[simp] theorem lcm_one_right (i : ℤ) : lcm i 1 = nat_abs i :=
by simp [(int.coe_nat_eq_coe_nat_iff _ _).symm, coe_lcm, coe_nat_abs_eq_normalize]

@[simp] theorem lcm_self (i : ℤ) : lcm i i = nat_abs i :=
by simp [(int.coe_nat_eq_coe_nat_iff _ _).symm, coe_lcm, coe_nat_abs_eq_normalize]

theorem dvd_lcm_left (i j : ℤ) : i ∣ lcm i j :=
by rw [coe_lcm]; exact dvd_lcm_left _ _

theorem dvd_lcm_right (i j : ℤ) : j ∣ lcm i j :=
by rw [coe_lcm]; exact dvd_lcm_right _ _

theorem lcm_dvd {i j k : ℤ}  : i ∣ k → j ∣ k → (lcm i j : ℤ) ∣ k :=
by rw [coe_lcm]; exact lcm_dvd

end int

theorem irreducible_iff_nat_prime : ∀(a : ℕ), irreducible a ↔ nat.prime a
| 0 := by simp [nat.not_prime_zero]
| 1 := by simp [nat.prime, one_lt_two]
| (n + 2) :=
  have h₁ : ¬n + 2 = 1, from dec_trivial,
  begin
    simp [h₁, nat.prime, irreducible, (≥), nat.le_add_left 2 n, (∣)],
    refine forall_congr (assume a, forall_congr $ assume b, forall_congr $ assume hab, _),
    by_cases a = 1; simp [h],
    split,
    { assume hb, simpa [hb] using hab.symm },
    { assume ha, subst ha,
      have : n + 2 > 0, from dec_trivial,
      refine nat.eq_of_mul_eq_mul_left this _,
      rw [← hab, mul_one] }
  end

lemma nat.prime_iff_prime {p : ℕ} : p.prime ↔ _root_.prime (p : ℕ) :=
⟨λ hp, ⟨nat.pos_iff_ne_zero.1 hp.pos, mt is_unit_iff_dvd_one.1 hp.not_dvd_one,
    λ a b, hp.dvd_mul.1⟩,
  λ hp, ⟨nat.one_lt_iff_ne_zero_and_ne_one.2 ⟨hp.1, λ h1, hp.2.1 $ h1.symm ▸ is_unit_one⟩,
    λ a h, let ⟨b, hab⟩ := h in
      (hp.2.2 a b (hab ▸ dvd_refl _)).elim
        (λ ha, or.inr (nat.dvd_antisymm h ha))
        (λ hb, or.inl (have hpb : p = b, from nat.dvd_antisymm hb
            (hab.symm ▸ dvd_mul_left _ _),
          (nat.mul_left_inj (show 0 < p, from
              nat.pos_of_ne_zero hp.1)).1 $
            by rw [hpb, mul_comm, ← hab, hpb, mul_one]))⟩⟩

lemma nat.prime_iff_prime_int {p : ℕ} : p.prime ↔ _root_.prime (p : ℤ) :=
⟨λ hp, ⟨int.coe_nat_ne_zero_iff_pos.2 hp.pos, mt is_unit_int.1 hp.ne_one,
  λ a b h, by rw [← int.dvd_nat_abs, int.coe_nat_dvd, int.nat_abs_mul, hp.dvd_mul] at h;
    rwa [← int.dvd_nat_abs, int.coe_nat_dvd, ← int.dvd_nat_abs, int.coe_nat_dvd]⟩,
  λ hp, nat.prime_iff_prime.2 ⟨int.coe_nat_ne_zero.1 hp.1,
      mt is_unit_nat.1 $ λ h, by simpa [h, not_prime_one] using hp,
    λ a b, by simpa only [int.coe_nat_dvd, (int.coe_nat_mul _ _).symm] using hp.2.2 a b⟩⟩

def associates_int_equiv_nat : (associates ℤ) ≃ ℕ :=
begin
  refine ⟨λz, z.out.nat_abs, λn, associates.mk n, _, _⟩,
  { refine (assume a, quotient.induction_on' a $ assume a,
      associates.mk_eq_mk_iff_associated.2 $ associated.symm $ ⟨norm_unit a, _⟩),
    show normalize a = int.nat_abs (normalize a),
    rw [int.coe_nat_abs_eq_normalize, normalize_idem] },
  { assume n, show int.nat_abs (normalize n) = n,
    rw [← int.coe_nat_abs_eq_normalize, int.nat_abs_of_nat, int.nat_abs_of_nat] }
end


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

/-!
# Iterations of a function

In this file we prove simple properties of `nat.iterate f n` a.k.a. `f^[n]`:

* `iterate_zero`, `iterate_succ`, `iterate_succ'`, `iterate_add`, `iterate_mul`:
  formulas for `f^[0]`, `f^[n+1]` (two versions), `f^[n+m]`, and `f^[n*m]`;

* `iterate_id` : `id^[n]=id`;

* `injective.iterate`, `surjective.iterate`, `bijective.iterate` :
  iterates of an injective/surjective/bijective function belong to the same class;

* `left_inverse.iterate`, `right_inverse.iterate`, `commute.iterate_left`, `comute.iterate_right`,
  `commute.iterate_iterate`:
  some properties of pairs of functions survive under iterations

* `iterate_fixed`, `semiconj.iterate_*`, `semiconj₂.iterate`:
  if `f` fixes a point (resp., semiconjugates unary/binary operarations), then so does `f^[n]`.

-/

universes u v

variables {α : Type u} {β : Type v}
namespace function

variable (f : α → α)

@[simp] theorem iterate_zero : f^[0] = id := rfl

theorem iterate_zero_apply (x : α) : f^[0] x = x := rfl

@[simp] theorem iterate_succ (n : ℕ) : f^[n.succ] = (f^[n]) ∘ f := rfl

theorem iterate_succ_apply (n : ℕ) (x : α) : f^[n.succ] x = (f^[n]) (f x) := rfl

@[simp] theorem iterate_id (n : ℕ) : (id : α → α)^[n] = id :=
nat.rec_on n rfl $ λ n ihn, by rw [iterate_succ, ihn, comp.left_id]

theorem iterate_add : ∀ (m n : ℕ), f^[m + n] = (f^[m]) ∘ (f^[n])
| m 0 := rfl
| m (nat.succ n) := by rw [nat.add_succ, iterate_succ, iterate_succ, iterate_add]

theorem iterate_add_apply (m n : ℕ) (x : α) : f^[m + n] x = (f^[m] (f^[n] x)) :=
by rw iterate_add

@[simp] theorem iterate_one : f^[1] = f := funext $ λ a, rfl

lemma iterate_mul (m : ℕ) : ∀ n, f^[m * n] = (f^[m]^[n])
| 0 := by simp only [nat.mul_zero, iterate_zero]
| (n + 1) := by simp only [nat.mul_succ, nat.mul_one, iterate_one, iterate_add, iterate_mul n]

variable {f}

theorem iterate_fixed {x} (h : f x = x) (n : ℕ) : f^[n] x = x :=
nat.rec_on n rfl $ λ n ihn, by rw [iterate_succ_apply, h, ihn]

theorem injective.iterate (Hinj : injective f) (n : ℕ) : injective (f^[n]) :=
nat.rec_on n injective_id $ λ n ihn, ihn.comp Hinj

theorem surjective.iterate (Hsurj : surjective f) (n : ℕ) : surjective (f^[n]) :=
nat.rec_on n surjective_id $ λ n ihn, ihn.comp Hsurj

theorem bijective.iterate (Hbij : bijective f) (n : ℕ) : bijective (f^[n]) :=
⟨Hbij.1.iterate n, Hbij.2.iterate n⟩

namespace semiconj

lemma iterate_right {f : α → β} {ga : α → α} {gb : β → β} (h : semiconj f ga gb) (n : ℕ) :
  semiconj f (ga^[n]) (gb^[n]) :=
nat.rec_on n id_right $ λ n ihn, ihn.comp_right h

lemma iterate_left {g : ℕ → α → α} (H : ∀ n, semiconj f (g n) (g $ n + 1)) (n k : ℕ) :
  semiconj (f^[n]) (g k) (g $ n + k) :=
begin
  induction n with n ihn generalizing k,
  { rw [nat.zero_add], exact id_left },
  { rw [nat.succ_eq_add_one, nat.add_right_comm, nat.add_assoc],
    exact (H k).comp_left (ihn (k + 1)) }
end

end semiconj

namespace commute

variable {g : α → α}

lemma iterate_right (h : commute f g) (n : ℕ) : commute f (g^[n]) := h.iterate_right n

lemma iterate_left (h : commute f g) (n : ℕ) : commute (f^[n]) g := (h.symm.iterate_right n).symm

lemma iterate_iterate (h : commute f g) (m n : ℕ) : commute (f^[m]) (g^[n]) :=
(h.iterate_left m).iterate_right n

lemma iterate_eq_of_map_eq (h : commute f g) (n : ℕ) {x} (hx : f x = g x) : f^[n] x = (g^[n]) x :=
nat.rec_on n rfl $ λ n ihn,
by simp only [iterate_succ_apply, hx, (h.iterate_left n).eq, ihn, ((refl g).iterate_right n).eq]

lemma comp_iterate (h : commute f g) (n : ℕ) : (f ∘ g)^[n] = (f^[n]) ∘ (g^[n]) :=
begin
  induction n with n ihn, { refl },
  funext x,
  simp only [ihn, (h.iterate_right n).eq, iterate_succ, comp_app]
end

variable (f)

lemma iterate_self (n : ℕ) : commute (f^[n]) f := (refl f).iterate_left n

lemma self_iterate (n : ℕ) : commute f (f^[n]) := (refl f).iterate_right n

lemma iterate_iterate_self (m n : ℕ) : commute (f^[m]) (f^[n]) := (refl f).iterate_iterate m n

end commute

lemma semiconj₂.iterate {f : α → α} {op : α → α → α} (hf : semiconj₂ f op op) (n : ℕ) :
  semiconj₂ (f^[n]) op op :=
nat.rec_on n (semiconj₂.id_left op) (λ n ihn, ihn.comp hf)

variable (f)

theorem iterate_succ' (n : ℕ) : f^[n.succ] = f ∘ (f^[n]) :=
by rw [iterate_succ, (commute.self_iterate f n).comp_eq]

theorem iterate_succ_apply' (n : ℕ) (x : α) : f^[n.succ] x = f (f^[n] x) :=
by rw [iterate_succ']

theorem iterate_pred_comp_of_pos {n : ℕ} (hn : 0 < n) : f^[n.pred] ∘ f = (f^[n]) :=
by rw [← iterate_succ, nat.succ_pred_eq_of_pos hn]

theorem comp_iterate_pred_of_pos {n : ℕ} (hn : 0 < n) : f ∘ (f^[n.pred]) = (f^[n]) :=
by rw [← iterate_succ', nat.succ_pred_eq_of_pos hn]

/-- A recursor for the iterate of a function. -/
def iterate.rec (p : α → Sort*) {f : α → α} (h : ∀ a, p a → p (f a)) {a : α} (ha : p a) (n : ℕ) :
  p (f^[n] a) :=
nat.rec ha (λ m, by { rw iterate_succ', exact h _ }) n

lemma iterate.rec_zero (p : α → Sort*) {f : α → α} (h : ∀ a, p a → p (f a)) {a : α} (ha : p a) :
  iterate.rec p h ha 0 = ha :=
rfl

variable {f}

theorem left_inverse.iterate {g : α → α} (hg : left_inverse g f) (n : ℕ) :
  left_inverse (g^[n]) (f^[n]) :=
nat.rec_on n (λ _, rfl) $ λ n ihn, by { rw [iterate_succ', iterate_succ], exact ihn.comp hg }

theorem right_inverse.iterate {g : α → α} (hg : right_inverse g f) (n : ℕ) :
  right_inverse (g^[n]) (f^[n]) :=
hg.iterate n

lemma iterate_comm (f : α → α) (m n : ℕ) : f^[n]^[m] = (f^[m]^[n]) :=
(iterate_mul _ _ _).symm.trans (eq.trans (by rw nat.mul_comm) (iterate_mul _ _ _))

lemma iterate_commute (m n : ℕ) : commute (λ f : α → α, f^[m]) (λ f, f^[n]) :=
λ f, iterate_comm f m n

end function


/-
Copyright (c) 2020 Alexander Bentkamp, Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alexander Bentkamp, Sébastien Gouëzel, Eric Wieser
-/
import algebra.order.smul
import data.complex.basic
import data.fin.vec_notation
import field_theory.tower

/-!
# Complex number as a vector space over `ℝ`

This file contains the following instances:
* Any `•`-structure (`has_smul`, `mul_action`, `distrib_mul_action`, `module`, `algebra`) on
  `ℝ` imbues a corresponding structure on `ℂ`. This includes the statement that `ℂ` is an `ℝ`
  algebra.
* any complex vector space is a real vector space;
* any finite dimensional complex vector space is a finite dimensional real vector space;
* the space of `ℝ`-linear maps from a real vector space to a complex vector space is a complex
  vector space.

It also defines bundled versions of four standard maps (respectively, the real part, the imaginary
part, the embedding of `ℝ` in `ℂ`, and the complex conjugate):

* `complex.re_lm` (`ℝ`-linear map);
* `complex.im_lm` (`ℝ`-linear map);
* `complex.of_real_am` (`ℝ`-algebra (homo)morphism);
* `complex.conj_ae` (`ℝ`-algebra equivalence).

It also provides a universal property of the complex numbers `complex.lift`, which constructs a
`ℂ →ₐ[ℝ] A` into any `ℝ`-algebra `A` given a square root of `-1`.

-/

namespace complex

open_locale complex_conjugate

variables {R : Type*} {S : Type*}

section

variables [has_smul R ℝ]

/- The useless `0` multiplication in `smul` is to make sure that
`restrict_scalars.module ℝ ℂ ℂ = complex.module` definitionally. -/
instance : has_smul R ℂ :=
{ smul := λ r x, ⟨r • x.re - 0 * x.im, r • x.im + 0 * x.re⟩ }

lemma smul_re (r : R) (z : ℂ) : (r • z).re = r • z.re := by simp [(•)]
lemma smul_im (r : R) (z : ℂ) : (r • z).im = r • z.im := by simp [(•)]

@[simp] lemma real_smul {x : ℝ} {z : ℂ} : x • z = x * z := rfl

end

instance [has_smul R ℝ] [has_smul S ℝ] [smul_comm_class R S ℝ] : smul_comm_class R S ℂ :=
{ smul_comm := λ r s x, by ext; simp [smul_re, smul_im, smul_comm] }

instance [has_smul R S] [has_smul R ℝ] [has_smul S ℝ] [is_scalar_tower R S ℝ] :
  is_scalar_tower R S ℂ :=
{ smul_assoc := λ r s x, by ext; simp [smul_re, smul_im, smul_assoc] }

instance [has_smul R ℝ] [has_smul Rᵐᵒᵖ ℝ] [is_central_scalar R ℝ] :
  is_central_scalar R ℂ :=
{ op_smul_eq_smul := λ r x, by ext; simp [smul_re, smul_im, op_smul_eq_smul] }

instance [monoid R] [mul_action R ℝ] : mul_action R ℂ :=
{ one_smul := λ x, by ext; simp [smul_re, smul_im, one_smul],
  mul_smul := λ r s x, by ext; simp [smul_re, smul_im, mul_smul] }

instance [semiring R] [distrib_mul_action R ℝ] : distrib_mul_action R ℂ :=
{ smul_add := λ r x y, by ext; simp [smul_re, smul_im, smul_add],
  smul_zero := λ r, by ext; simp [smul_re, smul_im, smul_zero] }

instance [semiring R] [module R ℝ] : module R ℂ :=
{ add_smul := λ r s x, by ext; simp [smul_re, smul_im, add_smul],
  zero_smul := λ r, by ext; simp [smul_re, smul_im, zero_smul] }

instance [comm_semiring R] [algebra R ℝ] : algebra R ℂ :=
{ smul := (•),
  smul_def' := λ r x, by ext; simp [smul_re, smul_im, algebra.smul_def],
  commutes' := λ r ⟨xr, xi⟩, by ext; simp [smul_re, smul_im, algebra.commutes],
  ..complex.of_real.comp (algebra_map R ℝ) }

instance : star_module ℝ ℂ :=
⟨λ r x, by simp only [star_def, star_trivial, real_smul, map_mul, conj_of_real]⟩

@[simp] lemma coe_algebra_map : (algebra_map ℝ ℂ : ℝ → ℂ) = coe := rfl

section
variables {A : Type*} [semiring A] [algebra ℝ A]

/-- We need this lemma since `complex.coe_algebra_map` diverts the simp-normal form away from
`alg_hom.commutes`. -/
@[simp] lemma _root_.alg_hom.map_coe_real_complex (f : ℂ →ₐ[ℝ] A) (x : ℝ) :
  f x = algebra_map ℝ A x :=
f.commutes x

/-- Two `ℝ`-algebra homomorphisms from ℂ are equal if they agree on `complex.I`. -/
@[ext]
lemma alg_hom_ext ⦃f g : ℂ →ₐ[ℝ] A⦄ (h : f I = g I) : f = g :=
begin
  ext ⟨x, y⟩,
  simp only [mk_eq_add_mul_I, alg_hom.map_add, alg_hom.map_coe_real_complex, alg_hom.map_mul, h]
end

end

section
open_locale complex_order

protected lemma ordered_smul : ordered_smul ℝ ℂ :=
ordered_smul.mk' $ λ a b r hab hr, ⟨by simp [hr, hab.1.le], by simp [hab.2]⟩

localized "attribute [instance] complex.ordered_smul" in complex_order

end

open submodule finite_dimensional

/-- `ℂ` has a basis over `ℝ` given by `1` and `I`. -/
noncomputable def basis_one_I : basis (fin 2) ℝ ℂ :=
basis.of_equiv_fun
{ to_fun := λ z, ![z.re, z.im],
  inv_fun := λ c, c 0 + c 1 • I,
  left_inv := λ z, by simp,
  right_inv := λ c, by { ext i, fin_cases i; simp },
  map_add' := λ z z', by simp,
  -- why does `simp` not know how to apply `smul_cons`, which is a `@[simp]` lemma, here?
  map_smul' := λ c z, by simp [matrix.smul_cons c z.re, matrix.smul_cons c z.im] }

@[simp] lemma coe_basis_one_I_repr (z : ℂ) : ⇑(basis_one_I.repr z) = ![z.re, z.im] := rfl

@[simp] lemma coe_basis_one_I : ⇑basis_one_I = ![1, I] :=
funext $ λ i, basis.apply_eq_iff.mpr $ finsupp.ext $ λ j,
by fin_cases i; fin_cases j;
    simp only [coe_basis_one_I_repr, finsupp.single_eq_same, finsupp.single_eq_of_ne,
              matrix.cons_val_zero, matrix.cons_val_one, matrix.head_cons,
              nat.one_ne_zero, fin.one_eq_zero_iff, fin.zero_eq_one_iff, ne.def, not_false_iff,
              one_re, one_im, I_re, I_im]

instance : finite_dimensional ℝ ℂ := of_fintype_basis basis_one_I

@[simp] lemma finrank_real_complex : finite_dimensional.finrank ℝ ℂ = 2 :=
by rw [finrank_eq_card_basis basis_one_I, fintype.card_fin]

@[simp] lemma dim_real_complex : module.rank ℝ ℂ = 2 :=
by simp [← finrank_eq_dim, finrank_real_complex]

lemma {u} dim_real_complex' : cardinal.lift.{u} (module.rank ℝ ℂ) = 2 :=
by simp [← finrank_eq_dim, finrank_real_complex, bit0]

/-- `fact` version of the dimension of `ℂ` over `ℝ`, locally useful in the definition of the
circle. -/
lemma finrank_real_complex_fact : fact (finrank ℝ ℂ = 2) := ⟨finrank_real_complex⟩

end complex

/- Register as an instance (with low priority) the fact that a complex vector space is also a real
vector space. -/
@[priority 900]
instance module.complex_to_real (E : Type*) [add_comm_group E] [module ℂ E] : module ℝ E :=
restrict_scalars.module ℝ ℂ E

instance module.real_complex_tower (E : Type*) [add_comm_group E] [module ℂ E] :
  is_scalar_tower ℝ ℂ E :=
restrict_scalars.is_scalar_tower ℝ ℂ E

@[simp, norm_cast] lemma complex.coe_smul {E : Type*} [add_comm_group E] [module ℂ E]
  (x : ℝ) (y : E) :
  (x : ℂ) • y = x • y :=
rfl

@[priority 100]
instance finite_dimensional.complex_to_real (E : Type*) [add_comm_group E] [module ℂ E]
  [finite_dimensional ℂ E] : finite_dimensional ℝ E :=
finite_dimensional.trans ℝ ℂ E

lemma dim_real_of_complex (E : Type*) [add_comm_group E] [module ℂ E] :
  module.rank ℝ E = 2 * module.rank ℂ E :=
cardinal.lift_inj.1 $
  by { rw [← dim_mul_dim' ℝ ℂ E, complex.dim_real_complex], simp [bit0] }

lemma finrank_real_of_complex (E : Type*) [add_comm_group E] [module ℂ E] :
  finite_dimensional.finrank ℝ E = 2 * finite_dimensional.finrank ℂ E :=
by rw [← finite_dimensional.finrank_mul_finrank ℝ ℂ E, complex.finrank_real_complex]

@[priority 900]
instance star_module.complex_to_real {E : Type*} [add_comm_group E] [has_star E] [module ℂ E]
  [star_module ℂ E] : star_module ℝ E :=
⟨λ r a, by rw [star_trivial r, restrict_scalars_smul_def, restrict_scalars_smul_def, star_smul,
  complex.coe_algebra_map, complex.star_def, complex.conj_of_real]⟩

namespace complex

open_locale complex_conjugate

/-- Linear map version of the real part function, from `ℂ` to `ℝ`. -/
def re_lm : ℂ →ₗ[ℝ] ℝ :=
{ to_fun := λx, x.re,
  map_add' := add_re,
  map_smul' := by simp, }

@[simp] lemma re_lm_coe : ⇑re_lm = re := rfl

/-- Linear map version of the imaginary part function, from `ℂ` to `ℝ`. -/
def im_lm : ℂ →ₗ[ℝ] ℝ :=
{ to_fun := λx, x.im,
  map_add' := add_im,
  map_smul' := by simp, }

@[simp] lemma im_lm_coe : ⇑im_lm = im := rfl

/-- `ℝ`-algebra morphism version of the canonical embedding of `ℝ` in `ℂ`. -/
def of_real_am : ℝ →ₐ[ℝ] ℂ := algebra.of_id ℝ ℂ

@[simp] lemma of_real_am_coe : ⇑of_real_am = coe := rfl

/-- `ℝ`-algebra isomorphism version of the complex conjugation function from `ℂ` to `ℂ` -/
def conj_ae : ℂ ≃ₐ[ℝ] ℂ :=
{ inv_fun := conj,
  left_inv := star_star,
  right_inv := star_star,
  commutes' := conj_of_real,
  .. conj }

@[simp] lemma conj_ae_coe : ⇑conj_ae = conj := rfl

/-- The matrix representation of `conj_ae`. -/
@[simp] lemma to_matrix_conj_ae :
  linear_map.to_matrix basis_one_I basis_one_I conj_ae.to_linear_map = ![![1, 0], ![0, -1]] :=
begin
  ext i j,
  simp [linear_map.to_matrix_apply],
  fin_cases i; fin_cases j; simp
end

section lift

variables {A : Type*} [ring A] [algebra ℝ A]

/-- There is an alg_hom from `ℂ` to any `ℝ`-algebra with an element that squares to `-1`.

See `complex.lift` for this as an equiv. -/
def lift_aux (I' : A) (hf : I' * I' = -1) : ℂ →ₐ[ℝ] A :=
alg_hom.of_linear_map
  ((algebra.of_id ℝ A).to_linear_map.comp re_lm + (linear_map.to_span_singleton _ _ I').comp im_lm)
  (show algebra_map ℝ A 1 + (0 : ℝ) • I' = 1,
    by rw [ring_hom.map_one, zero_smul, add_zero])
  (λ ⟨x₁, y₁⟩ ⟨x₂, y₂⟩, show algebra_map ℝ A (x₁ * x₂ - y₁ * y₂) + (x₁ * y₂ + y₁ * x₂) • I'
                          = (algebra_map ℝ A x₁ + y₁ • I') * (algebra_map ℝ A x₂ + y₂ • I'),
    begin
      rw [add_mul, mul_add, mul_add, add_comm _ (y₁ • I' * y₂ • I'), add_add_add_comm],
      congr' 1, -- equate "real" and "imaginary" parts
      { rw [smul_mul_smul, hf, smul_neg, ←algebra.algebra_map_eq_smul_one, ←sub_eq_add_neg,
          ←ring_hom.map_mul, ←ring_hom.map_sub], },
      { rw [algebra.smul_def, algebra.smul_def, algebra.smul_def, ←algebra.right_comm _ x₂,
          ←mul_assoc, ←add_mul, ←ring_hom.map_mul, ←ring_hom.map_mul, ←ring_hom.map_add] }
    end)

@[simp]
lemma lift_aux_apply (I' : A) (hI') (z : ℂ) :
 lift_aux I' hI' z = algebra_map ℝ A z.re + z.im • I' := rfl

lemma lift_aux_apply_I (I' : A) (hI') : lift_aux I' hI' I = I' := by simp

/-- A universal property of the complex numbers, providing a unique `ℂ →ₐ[ℝ] A` for every element
of `A` which squares to `-1`.

This can be used to embed the complex numbers in the `quaternion`s.

This isomorphism is named to match the very similar `zsqrtd.lift`. -/
@[simps {simp_rhs := tt}]
def lift : {I' : A // I' * I' = -1} ≃ (ℂ →ₐ[ℝ] A) :=
{ to_fun := λ I', lift_aux I' I'.prop,
  inv_fun := λ F, ⟨F I, by rw [←F.map_mul, I_mul_I, alg_hom.map_neg, alg_hom.map_one]⟩,
  left_inv := λ I', subtype.ext $ lift_aux_apply_I I' I'.prop,
  right_inv := λ F, alg_hom_ext $ lift_aux_apply_I _ _, }

/- When applied to `complex.I` itself, `lift` is the identity. -/
@[simp]
lemma lift_aux_I : lift_aux I I_mul_I = alg_hom.id ℝ ℂ :=
alg_hom_ext $ lift_aux_apply_I _ _

/- When applied to `-complex.I`, `lift` is conjugation, `conj`. -/
@[simp]
lemma lift_aux_neg_I : lift_aux (-I) ((neg_mul_neg _ _).trans I_mul_I) = conj_ae :=
alg_hom_ext $ (lift_aux_apply_I _ _).trans conj_I.symm

end lift

end complex


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

/-!
# Order for Rational Numbers

## Summary

We define the order on `ℚ`, prove that `ℚ` is a discrete, linearly ordered field, and define
functions such as `abs` and `sqrt` that depend on this order.

## Notations

- `/.` is infix notation for `rat.mk`.

## Tags

rat, rationals, field, ℚ, numerator, denominator, num, denom, order, ordering, sqrt, abs
-/

namespace rat
variables (a b c : ℚ)
open_locale rat

/-- A rational number is called nonnegative if its numerator is nonnegative. -/
protected def nonneg (r : ℚ) : Prop := 0 ≤ r.num

@[simp]

protected lemma nonneg_add {a b} : rat.nonneg a → rat.nonneg b → rat.nonneg (a + b) :=
num_denom_cases_on' a $ λ n₁ d₁ h₁,
num_denom_cases_on' b $ λ n₂ d₂ h₂,
begin
  have d₁0 : 0 < (d₁:ℤ) := int.coe_nat_pos.2 (nat.pos_of_ne_zero h₁),
  have d₂0 : 0 < (d₂:ℤ) := int.coe_nat_pos.2 (nat.pos_of_ne_zero h₂),
  simp [d₁0, d₂0, h₁, h₂, mul_pos d₁0 d₂0],
  intros n₁0 n₂0,
  apply add_nonneg; apply mul_nonneg; {assumption <|> apply int.coe_zero_le},
end

protected lemma nonneg_mul {a b} : rat.nonneg a → rat.nonneg b → rat.nonneg (a * b) :=
num_denom_cases_on' a $ λ n₁ d₁ h₁,
num_denom_cases_on' b $ λ n₂ d₂ h₂,
begin
  have d₁0 : 0 < (d₁:ℤ) := int.coe_nat_pos.2 (nat.pos_of_ne_zero h₁),
  have d₂0 : 0 < (d₂:ℤ) := int.coe_nat_pos.2 (nat.pos_of_ne_zero h₂),
  simp [d₁0, d₂0, h₁, h₂, mul_pos d₁0 d₂0, mul_nonneg] { contextual := tt }
end

protected lemma nonneg_antisymm {a} : rat.nonneg a → rat.nonneg (-a) → a = 0 :=
num_denom_cases_on' a $ λ n d h,
begin
  have d0 : 0 < (d:ℤ) := int.coe_nat_pos.2 (nat.pos_of_ne_zero h),
  simp [d0, h],
  exact λ h₁ h₂, le_antisymm h₂ h₁
end

protected lemma nonneg_total : rat.nonneg a ∨ rat.nonneg (-a) :=
by cases a with n; exact
or.imp_right neg_nonneg_of_nonpos (le_total 0 n)

instance decidable_nonneg : decidable (rat.nonneg a) :=
by cases a; unfold rat.nonneg; apply_instance

/-- Relation `a ≤ b` on `ℚ` defined as `a ≤ b ↔ rat.nonneg (b - a)`. Use `a ≤ b` instead of
`rat.le a b`. -/
protected def le (a b : ℚ) := rat.nonneg (b - a)

instance : has_le ℚ := ⟨rat.le⟩

instance decidable_le : decidable_rel ((≤) : ℚ → ℚ → Prop)
| a b := show decidable (rat.nonneg (b - a)), by apply_instance

protected theorem le_def {a b c d : ℤ} (b0 : 0 < b) (d0 : 0 < d) :
  a /. b ≤ c /. d ↔ a * d ≤ c * b :=
begin
  show rat.nonneg _ ↔ _,
  rw ← sub_nonneg,
  simp [sub_eq_add_neg, ne_of_gt b0, ne_of_gt d0, mul_pos d0 b0]
end

protected theorem le_refl : a ≤ a :=
show rat.nonneg (a - a), by rw sub_self; exact le_refl (0 : ℤ)

protected theorem le_total : a ≤ b ∨ b ≤ a :=
by have := rat.nonneg_total (b - a); rwa neg_sub at this

protected theorem le_antisymm {a b : ℚ} (hab : a ≤ b) (hba : b ≤ a) : a = b :=
by { have := eq_neg_of_add_eq_zero (rat.nonneg_antisymm hba $ by rwa [← sub_eq_add_neg, neg_sub]),
   rwa neg_neg at this }

protected theorem le_trans {a b c : ℚ} (hab : a ≤ b) (hbc : b ≤ c) : a ≤ c :=
have rat.nonneg (b - a + (c - b)), from rat.nonneg_add hab hbc,
by simpa [sub_eq_add_neg, add_comm, add_left_comm]

instance : linear_order ℚ :=
{ le              := rat.le,
  le_refl         := rat.le_refl,
  le_trans        := @rat.le_trans,
  le_antisymm     := @rat.le_antisymm,
  le_total        := rat.le_total,
  decidable_eq    := by apply_instance,
  decidable_le    := assume a b, rat.decidable_nonneg (b - a) }

/- Extra instances to short-circuit type class resolution -/
instance : has_lt ℚ          := by apply_instance
instance : distrib_lattice ℚ := by apply_instance
instance : lattice ℚ         := by apply_instance
instance : semilattice_inf ℚ := by apply_instance
instance : semilattice_sup ℚ := by apply_instance
instance : has_inf ℚ         := by apply_instance
instance : has_sup ℚ         := by apply_instance
instance : partial_order ℚ   := by apply_instance
instance : preorder ℚ        := by apply_instance

protected lemma le_def' {p q : ℚ} : p ≤ q ↔ p.num * q.denom ≤ q.num * p.denom :=
begin
  rw [←(@num_denom q), ←(@num_denom p)],
  conv_rhs { simp only [num_denom] },
  exact rat.le_def (by exact_mod_cast p.pos) (by exact_mod_cast q.pos)
end

protected lemma lt_def {p q : ℚ} : p < q ↔ p.num * q.denom < q.num * p.denom :=
begin
  rw [lt_iff_le_and_ne, rat.le_def'],
  suffices : p ≠ q ↔ p.num * q.denom ≠ q.num * p.denom, by {
    split; intro h,
    { exact lt_iff_le_and_ne.elim_right ⟨h.left, (this.elim_left h.right)⟩ },
    { have tmp := lt_iff_le_and_ne.elim_left h, exact ⟨tmp.left, this.elim_right tmp.right⟩ }},
  exact (not_iff_not.elim_right eq_iff_mul_eq_mul)
end

theorem nonneg_iff_zero_le {a} : rat.nonneg a ↔ 0 ≤ a :=
show rat.nonneg a ↔ rat.nonneg (a - 0), by simp

theorem num_nonneg_iff_zero_le : ∀ {a : ℚ}, 0 ≤ a.num ↔ 0 ≤ a
| ⟨n, d, h, c⟩ := @nonneg_iff_zero_le ⟨n, d, h, c⟩

protected theorem add_le_add_left {a b c : ℚ} : c + a ≤ c + b ↔ a ≤ b :=
by unfold has_le.le rat.le; rw add_sub_add_left_eq_sub

protected theorem mul_nonneg {a b : ℚ} (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a * b :=
by rw ← nonneg_iff_zero_le at ha hb ⊢; exact rat.nonneg_mul ha hb

instance : linear_ordered_field ℚ :=
{ zero_le_one     := dec_trivial,
  add_le_add_left := assume a b ab c, rat.add_le_add_left.2 ab,
  mul_pos         := assume a b ha hb, lt_of_le_of_ne
    (rat.mul_nonneg (le_of_lt ha) (le_of_lt hb))
    (mul_ne_zero (ne_of_lt ha).symm (ne_of_lt hb).symm).symm,
  ..rat.field,
  ..rat.linear_order,
  ..rat.semiring }

/- Extra instances to short-circuit type class resolution -/
instance : linear_ordered_comm_ring ℚ       := by apply_instance
instance : linear_ordered_ring ℚ            := by apply_instance
instance : ordered_ring ℚ                   := by apply_instance
instance : linear_ordered_semiring ℚ        := by apply_instance
instance : ordered_semiring ℚ               := by apply_instance
instance : linear_ordered_add_comm_group ℚ  := by apply_instance
instance : ordered_add_comm_group ℚ         := by apply_instance
instance : ordered_cancel_add_comm_monoid ℚ := by apply_instance
instance : ordered_add_comm_monoid ℚ        := by apply_instance

attribute [irreducible] rat.le

theorem num_pos_iff_pos {a : ℚ} : 0 < a.num ↔ 0 < a :=
lt_iff_lt_of_le_iff_le $
by simpa [(by cases a; refl : (-a).num = -a.num)]
   using @num_nonneg_iff_zero_le (-a)

lemma div_lt_div_iff_mul_lt_mul {a b c d : ℤ} (b_pos : 0 < b) (d_pos : 0 < d) :
  (a : ℚ) / b < c / d ↔ a * d < c * b :=
begin
  simp only [lt_iff_le_not_le],
  apply and_congr,
  { simp [div_num_denom, (rat.le_def b_pos d_pos)] },
  { apply not_iff_not_of_iff, simp [div_num_denom, (rat.le_def d_pos b_pos)] }
end

lemma lt_one_iff_num_lt_denom {q : ℚ} : q < 1 ↔ q.num < q.denom :=
begin
  cases decidable.em (0 < q) with q_pos q_nonpos,
  { simp [rat.lt_def] },
  { replace q_nonpos : q ≤ 0, from not_lt.elim_left q_nonpos,
    have : q.num < q.denom, by
    { have : ¬0 < q.num ↔ ¬0 < q, from not_iff_not.elim_right num_pos_iff_pos,
      simp only [not_lt] at this,
      exact lt_of_le_of_lt (this.elim_right q_nonpos) (by exact_mod_cast q.pos) },
    simp only [this, (lt_of_le_of_lt q_nonpos zero_lt_one)] }
end

theorem abs_def (q : ℚ) : abs q = q.num.nat_abs /. q.denom :=
begin
  cases le_total q 0 with hq hq,
  { rw [abs_of_nonpos hq],
    rw [←(@num_denom q), ← mk_zero_one, rat.le_def (int.coe_nat_pos.2 q.pos) zero_lt_one,
        mul_one, zero_mul] at hq,
    rw [int.of_nat_nat_abs_of_nonpos hq, ← neg_def, num_denom] },
  { rw [abs_of_nonneg hq],
    rw [←(@num_denom q), ← mk_zero_one, rat.le_def zero_lt_one (int.coe_nat_pos.2 q.pos),
        mul_one, zero_mul] at hq,
    rw [int.nat_abs_of_nonneg hq, num_denom] }
end

end rat


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

import data.list.basic

/-!
# Palindromes

This module defines *palindromes*, lists which are equal to their reverse.

The main result is the `palindrome` inductive type, and its associated `palindrome.rec_on` induction
principle. Also provided are conversions to and from other equivalent definitions.

## References

* [Pierre Castéran, *On palindromes*][casteran]

[casteran]: https://www.labri.fr/perso/casteran/CoqArt/inductive-prop-chap/palindrome.html

## Tags

palindrome, reverse, induction
-/

open list

variables {α : Type*}

/--
`palindrome l` asserts that `l` is a palindrome. This is defined inductively:

* The empty list is a palindrome;
* A list with one element is a palindrome;
* Adding the same element to both ends of a palindrome results in a bigger palindrome.
-/
inductive palindrome : list α → Prop
| nil : palindrome []
| singleton : ∀ x, palindrome [x]
| cons_concat : ∀ x {l}, palindrome l → palindrome (x :: (l ++ [x]))

namespace palindrome

lemma reverse_eq {l : list α} (p : palindrome l) : reverse l = l :=
palindrome.rec_on p rfl (λ _, rfl) (λ x l p h, by simp [h])

lemma of_reverse_eq {l : list α} : reverse l = l → palindrome l :=
begin
  refine bidirectional_rec_on l (λ _, palindrome.nil) (λ a _, palindrome.singleton a) _,
  intros x l y hp hr,
  rw [reverse_cons, reverse_append] at hr,
  rw head_eq_of_cons_eq hr,
  have : palindrome l, from hp (append_inj_left' (tail_eq_of_cons_eq hr) rfl),
  exact palindrome.cons_concat x this
end

lemma iff_reverse_eq {l : list α} : palindrome l ↔ reverse l = l :=
iff.intro reverse_eq of_reverse_eq

lemma append_reverse (l : list α) : palindrome (l ++ reverse l) :=
by { apply of_reverse_eq, rw [reverse_append, reverse_reverse] }

instance [decidable_eq α] (l : list α) : decidable (palindrome l) :=
decidable_of_iff' _ iff_reverse_eq

end palindrome