/-
Copyright (c) 2018 Guy Leroy. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sangwoo Jo (aka Jason), Guy Leroy, Johannes Hölzl, Mario Carneiro
-/
import data.nat.gcd.basic
import tactic.norm_num

/-!
# Extended GCD and divisibility over ℤ

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

## Main definitions

* Given `x y : ℕ`, `xgcd x y` computes the pair of integers `(a, b)` such that
  `gcd x y = x * a + y * b`. `gcd_a x y` and `gcd_b x y` are defined to be `a` and `b`,
  respectively.

## Main statements

* `gcd_eq_gcd_ab`: Bézout's lemma, given `x y : ℕ`, `gcd x y = x * gcd_a x y + y * gcd_b x y`.

## Tags

Bézout's lemma, Bezout's lemma
-/

/-! ### Extended Euclidean algorithm -/
namespace nat

/-- Helper function for the extended GCD algorithm (`nat.xgcd`). -/
def xgcd_aux : ℕ → ℤ → ℤ → ℕ → ℤ → ℤ → ℕ × ℤ × ℤ
| 0          s t r' s' t' := (r', s', t')
| r@(succ _) s t r' s' t' :=
  have r' % r < r, from mod_lt _ $ succ_pos _,
  let q := r' / r in xgcd_aux (r' % r) (s' - q * s) (t' - q * t) r s t

@[simp] theorem xgcd_zero_left {s t r' s' t'} : xgcd_aux 0 s t r' s' t' = (r', s', t') :=
by simp [xgcd_aux]

theorem xgcd_aux_rec {r s t r' s' t'} (h : 0 < r) :
  xgcd_aux r s t r' s' t' = xgcd_aux (r' % r) (s' - (r' / r) * s) (t' - (r' / r) * t) r s t :=
by cases r; [exact absurd h (lt_irrefl _), {simp only [xgcd_aux], refl}]

/-- Use the extended GCD algorithm to generate the `a` and `b` values
  satisfying `gcd x y = x * a + y * b`. -/
def xgcd (x y : ℕ) : ℤ × ℤ := (xgcd_aux x 1 0 y 0 1).2

/-- The extended GCD `a` value in the equation `gcd x y = x * a + y * b`. -/
def gcd_a (x y : ℕ) : ℤ := (xgcd x y).1

/-- The extended GCD `b` value in the equation `gcd x y = x * a + y * b`. -/
def gcd_b (x y : ℕ) : ℤ := (xgcd x y).2

@[simp] theorem gcd_a_zero_left {s : ℕ} : gcd_a 0 s = 0 :=
by { unfold gcd_a, rw [xgcd, xgcd_zero_left] }

@[simp] theorem gcd_b_zero_left {s : ℕ} : gcd_b 0 s = 1 :=
by { unfold gcd_b, rw [xgcd, xgcd_zero_left] }

@[simp] theorem gcd_a_zero_right {s : ℕ} (h : s ≠ 0) : gcd_a s 0 = 1 :=
begin
  unfold gcd_a xgcd,
  induction s,
  { exact absurd rfl h, },
  { simp [xgcd_aux], }
end

@[simp] theorem gcd_b_zero_right {s : ℕ} (h : s ≠ 0) : gcd_b s 0 = 0 :=
begin
  unfold gcd_b xgcd,
  induction s,
  { exact absurd rfl h, },
  { simp [xgcd_aux], }
end

@[simp] theorem xgcd_aux_fst (x y) : ∀ s t s' t',
  (xgcd_aux x s t y s' t').1 = gcd x y :=
gcd.induction x y (by simp) (λ x y h IH s t s' t', by simp [xgcd_aux_rec, h, IH]; rw ← gcd_rec)

theorem xgcd_aux_val (x y) : xgcd_aux x 1 0 y 0 1 = (gcd x y, xgcd x y) :=
by rw [xgcd, ← xgcd_aux_fst x y 1 0 0 1]; cases xgcd_aux x 1 0 y 0 1; refl

theorem xgcd_val (x y) : xgcd x y = (gcd_a x y, gcd_b x y) :=
by unfold gcd_a gcd_b; cases xgcd x y; refl

section
parameters (x y : ℕ)

private def P : ℕ × ℤ × ℤ → Prop
| (r, s, t) := (r : ℤ) = x * s + y * t

theorem xgcd_aux_P {r r'} : ∀ {s t s' t'}, P (r, s, t) → P (r', s', t') →
  P (xgcd_aux r s t r' s' t') :=
gcd.induction r r' (by simp) $ λ a b h IH s t s' t' p p', begin
  rw [xgcd_aux_rec h], refine IH _ p, dsimp [P] at *,
  rw [int.mod_def], generalize : (b / a : ℤ) = k,
  rw [p, p'],
  simp [mul_add, mul_comm, mul_left_comm, add_comm, add_left_comm, sub_eq_neg_add, mul_assoc]
end

/-- **Bézout's lemma**: given `x y : ℕ`, `gcd x y = x * a + y * b`, where `a = gcd_a x y` and
`b = gcd_b x y` are computed by the extended Euclidean algorithm.
-/
theorem gcd_eq_gcd_ab : (gcd x y : ℤ) = x * gcd_a x y + y * gcd_b x y :=
by have := @xgcd_aux_P x y x y 1 0 0 1 (by simp [P]) (by simp [P]);
   rwa [xgcd_aux_val, xgcd_val] at this
end

lemma exists_mul_mod_eq_gcd {k n : ℕ} (hk : gcd n k < k) :
  ∃ m, n * m % k = gcd n k :=
begin
  have hk' := int.coe_nat_ne_zero.mpr (ne_of_gt (lt_of_le_of_lt (zero_le (gcd n k)) hk)),
  have key := congr_arg (λ m, int.nat_mod m k) (gcd_eq_gcd_ab n k),
  simp_rw int.nat_mod at key,
  rw [int.add_mul_mod_self_left, ←int.coe_nat_mod, int.to_nat_coe_nat, mod_eq_of_lt hk] at key,
  refine ⟨(n.gcd_a k % k).to_nat, eq.trans (int.coe_nat_inj _) key.symm⟩,
  rw [int.coe_nat_mod, int.coe_nat_mul, int.to_nat_of_nonneg (int.mod_nonneg _ hk'),
      int.to_nat_of_nonneg (int.mod_nonneg _ hk'), int.mul_mod, int.mod_mod, ←int.mul_mod],
end

lemma exists_mul_mod_eq_one_of_coprime {k n : ℕ} (hkn : coprime n k) (hk : 1 < k) :
  ∃ m, n * m % k = 1 :=
Exists.cases_on (exists_mul_mod_eq_gcd (lt_of_le_of_lt (le_of_eq hkn) hk))
  (λ m hm, ⟨m, hm.trans hkn⟩)

end nat

/-! ### Divisibility over ℤ -/
namespace int

protected lemma coe_nat_gcd (m n : ℕ) : int.gcd ↑m ↑n = nat.gcd m n := rfl

/-- The extended GCD `a` value in the equation `gcd x y = x * a + y * b`. -/
def gcd_a : ℤ → ℤ → ℤ
| (of_nat m) n := m.gcd_a n.nat_abs
| -[1+ m]    n := -m.succ.gcd_a n.nat_abs

/-- The extended GCD `b` value in the equation `gcd x y = x * a + y * b`. -/
def gcd_b : ℤ → ℤ → ℤ
| m (of_nat n) := m.nat_abs.gcd_b n
| m -[1+ n]    := -m.nat_abs.gcd_b n.succ

/-- **Bézout's lemma** -/
theorem gcd_eq_gcd_ab : ∀ x y : ℤ, (gcd x y : ℤ) = x * gcd_a x y + y * gcd_b x y
| (m : ℕ) (n : ℕ) := nat.gcd_eq_gcd_ab _ _
| (m : ℕ) -[1+ n] := show (_ : ℤ) = _ + -(n+1) * -_, by rw neg_mul_neg; apply nat.gcd_eq_gcd_ab
| -[1+ m] (n : ℕ) := show (_ : ℤ) = -(m+1) * -_ + _ , by rw neg_mul_neg; apply nat.gcd_eq_gcd_ab
| -[1+ m] -[1+ n] := show (_ : ℤ) = -(m+1) * -_ + -(n+1) * -_,
  by { rw [neg_mul_neg, neg_mul_neg], apply nat.gcd_eq_gcd_ab }

theorem nat_abs_div (a b : ℤ) (H : b ∣ a) : nat_abs (a / b) = (nat_abs a) / (nat_abs b) :=
begin
  cases (nat.eq_zero_or_pos (nat_abs b)),
  {rw eq_zero_of_nat_abs_eq_zero h, simp [int.div_zero]},
  calc
  nat_abs (a / b) = nat_abs (a / b) * 1 : by rw mul_one
    ... = nat_abs (a / b) * (nat_abs b / nat_abs b) : by rw nat.div_self h
    ... = nat_abs (a / b) * nat_abs b / nat_abs b : by rw (nat.mul_div_assoc _ dvd_rfl)
    ... = nat_abs (a / b * b) / nat_abs b : by rw (nat_abs_mul (a / b) b)
    ... = nat_abs a / nat_abs b : by rw int.div_mul_cancel H,
end

theorem dvd_of_mul_dvd_mul_left {i j k : ℤ} (k_non_zero : k ≠ 0) (H : k * i ∣ k * j) : i ∣ j :=
dvd.elim H (λl H1, by rw mul_assoc at H1; exact ⟨_, mul_left_cancel₀ k_non_zero H1⟩)

theorem dvd_of_mul_dvd_mul_right {i j k : ℤ} (k_non_zero : k ≠ 0) (H : i * k ∣ j * k) : i ∣ j :=
by rw [mul_comm i k, mul_comm j k] at H; exact dvd_of_mul_dvd_mul_left k_non_zero H

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

protected lemma coe_nat_lcm (m n : ℕ) : int.lcm ↑m ↑n = nat.lcm m n := rfl

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_iff_dvd.2 h1) (nat_abs_dvd_iff_dvd.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]

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 _

@[simp] lemma gcd_neg_right {x y : ℤ} : gcd x (-y) = gcd x y :=
by rw [int.gcd, int.gcd, nat_abs_neg]

@[simp] lemma gcd_neg_left {x y : ℤ} : gcd (-x) y = gcd x y :=
by rw [int.gcd, int.gcd, nat_abs_neg]

theorem gcd_mul_left (i j k : ℤ) : gcd (i * j) (i * k) = nat_abs i * gcd j k :=
by { rw [int.gcd, int.gcd, nat_abs_mul, nat_abs_mul], apply nat.gcd_mul_left }

theorem gcd_mul_right (i j k : ℤ) : gcd (i * j) (k * j) = gcd i k * nat_abs j :=
by { rw [int.gcd, int.gcd, nat_abs_mul, nat_abs_mul], apply nat.gcd_mul_right }

theorem gcd_pos_of_non_zero_left {i : ℤ} (j : ℤ) (i_non_zero : i ≠ 0) : 0 < gcd i j :=
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) : 0 < gcd i j :=
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 :=
begin
  rw int.gcd,
  split,
  { intro h,
    exact ⟨nat_abs_eq_zero.mp (nat.eq_zero_of_gcd_eq_zero_left h),
      nat_abs_eq_zero.mp (nat.eq_zero_of_gcd_eq_zero_right h)⟩ },
  { intro h, rw [nat_abs_eq_zero.mpr h.left, nat_abs_eq_zero.mpr h.right],
    apply nat.gcd_zero_left }
end

theorem gcd_pos_iff {i j : ℤ} : 0 < gcd i j ↔ i ≠ 0 ∨ j ≠ 0 :=
pos_iff_ne_zero.trans $ gcd_eq_zero_iff.not.trans not_and_distrib

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_iff_dvd.mpr H1) (nat_abs_dvd_iff_dvd.mpr H2)

theorem gcd_div_gcd_div_gcd {i j : ℤ} (H : 0 < gcd i j) :
  gcd (i / gcd i j) (j / gcd i j) = 1 :=
begin
  rw [gcd_div (gcd_dvd_left i j) (gcd_dvd_right i j)],
  rw [nat_abs_of_nat, nat.div_self H]
end

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 ((gcd_dvd_left i j).trans 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) ((gcd_dvd_right j i).trans 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_rfl (nat_abs_dvd_iff_dvd.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]

theorem ne_zero_of_gcd {x y : ℤ}
  (hc : gcd x y ≠ 0) : x ≠ 0 ∨ y ≠ 0 :=
begin
  contrapose! hc,
  rw [hc.left, hc.right, gcd_zero_right, nat_abs_zero]
end

theorem exists_gcd_one {m n : ℤ} (H : 0 < gcd m n) :
  ∃ (m' n' : ℤ), gcd m' n' = 1 ∧ m = m' * gcd m n ∧ n = n' * gcd m n :=
⟨_, _, gcd_div_gcd_div_gcd H,
  (int.div_mul_cancel (gcd_dvd_left m n)).symm,
  (int.div_mul_cancel (gcd_dvd_right m n)).symm⟩

theorem exists_gcd_one' {m n : ℤ} (H : 0 < gcd m n) :
  ∃ (g : ℕ) (m' n' : ℤ), 0 < g ∧ gcd m' n' = 1 ∧ m = m' * g ∧ n = n' * g :=
let ⟨m', n', h⟩ := exists_gcd_one H in ⟨_, m', n', H, h⟩

theorem pow_dvd_pow_iff {m n : ℤ} {k : ℕ} (k0 : 0 < k) : m ^ k ∣ n ^ k ↔ m ∣ n :=
begin
  refine ⟨λ h, _, λ h, pow_dvd_pow_of_dvd h _⟩,
  apply int.nat_abs_dvd_iff_dvd.mp,
  apply (nat.pow_dvd_pow_iff k0).mp,
  rw [← int.nat_abs_pow, ← int.nat_abs_pow],
  exact int.nat_abs_dvd_iff_dvd.mpr h
end

lemma gcd_dvd_iff {a b : ℤ} {n : ℕ} : gcd a b ∣ n ↔ ∃ x y : ℤ, ↑n = a * x + b * y :=
begin
  split,
  { intro h,
    rw [← nat.mul_div_cancel' h, int.coe_nat_mul, gcd_eq_gcd_ab, add_mul, mul_assoc, mul_assoc],
    refine ⟨_, _, rfl⟩, },
  { rintro ⟨x, y, h⟩,
    rw [←int.coe_nat_dvd, h],
    exact dvd_add (dvd_mul_of_dvd_left (gcd_dvd_left a b) _)
      (dvd_mul_of_dvd_left (gcd_dvd_right a b) y) }
end

lemma gcd_greatest {a b d : ℤ} (hd_pos : 0 ≤ d) (hda : d ∣ a) (hdb : d ∣ b)
  (hd : ∀ e : ℤ, e ∣ a → e ∣ b → e ∣ d) : d = gcd a b :=
dvd_antisymm hd_pos
  (coe_zero_le (gcd a b)) (dvd_gcd hda hdb) (hd _ (gcd_dvd_left a b) (gcd_dvd_right a b))

/-- Euclid's lemma: if `a ∣ b * c` and `gcd a c = 1` then `a ∣ b`.
Compare with `is_coprime.dvd_of_dvd_mul_left` and
`unique_factorization_monoid.dvd_of_dvd_mul_left_of_no_prime_factors` -/
lemma dvd_of_dvd_mul_left_of_gcd_one {a b c : ℤ} (habc : a ∣ b * c) (hab : gcd a c = 1) : a ∣ b :=
begin
  have := gcd_eq_gcd_ab a c,
  simp only [hab, int.coe_nat_zero, int.coe_nat_succ, zero_add] at this,
  have : b * a * gcd_a a c + b * c * gcd_b a c = b, { simp [mul_assoc, ←mul_add, ←this] },
  rw ←this,
  exact dvd_add (dvd_mul_of_dvd_left (dvd_mul_left a b) _) (dvd_mul_of_dvd_left habc _),
end

/-- Euclid's lemma: if `a ∣ b * c` and `gcd a b = 1` then `a ∣ c`.
Compare with `is_coprime.dvd_of_dvd_mul_right` and
`unique_factorization_monoid.dvd_of_dvd_mul_right_of_no_prime_factors` -/
lemma dvd_of_dvd_mul_right_of_gcd_one {a b c : ℤ} (habc : a ∣ b * c) (hab : gcd a b = 1) : a ∣ c :=
by { rw mul_comm at habc, exact dvd_of_dvd_mul_left_of_gcd_one habc hab }

/-- For nonzero integers `a` and `b`, `gcd a b` is the smallest positive natural number that can be
written in the form `a * x + b * y` for some pair of integers `x` and `y` -/
theorem gcd_least_linear {a b : ℤ} (ha : a ≠ 0) :
  is_least { n : ℕ | 0 < n ∧ ∃ x y : ℤ, ↑n = a * x + b * y } (a.gcd b) :=
begin
  simp_rw ←gcd_dvd_iff,
  split,
  { simpa [and_true, dvd_refl, set.mem_set_of_eq] using gcd_pos_of_non_zero_left b ha },
  { simp only [lower_bounds, and_imp, set.mem_set_of_eq],
    exact λ n hn_pos hn, nat.le_of_dvd hn_pos hn },
end

/-! ### lcm -/

theorem lcm_comm (i j : ℤ) : lcm i j = lcm j i :=
by { rw [int.lcm, int.lcm], exact nat.lcm_comm _ _ }

theorem lcm_assoc (i j k : ℤ) : lcm (lcm i j) k = lcm i (lcm j k) :=
by { rw [int.lcm, int.lcm, int.lcm, int.lcm, nat_abs_of_nat, nat_abs_of_nat], apply nat.lcm_assoc }

@[simp] theorem lcm_zero_left (i : ℤ) : lcm 0 i = 0 :=
by { rw [int.lcm], apply nat.lcm_zero_left }

@[simp] theorem lcm_zero_right (i : ℤ) : lcm i 0 = 0 :=
by { rw [int.lcm], apply nat.lcm_zero_right }

@[simp] theorem lcm_one_left (i : ℤ) : lcm 1 i = nat_abs i :=
by { rw int.lcm, apply nat.lcm_one_left }

@[simp] theorem lcm_one_right (i : ℤ) : lcm i 1 = nat_abs i :=
by { rw int.lcm, apply nat.lcm_one_right }

@[simp] theorem lcm_self (i : ℤ) : lcm i i = nat_abs i :=
by { rw int.lcm, apply nat.lcm_self }

theorem dvd_lcm_left (i j : ℤ) : i ∣ lcm i j :=
by { rw int.lcm, apply coe_nat_dvd_right.mpr, apply nat.dvd_lcm_left }

theorem dvd_lcm_right (i j : ℤ) : j ∣ lcm i j :=
by { rw int.lcm, apply coe_nat_dvd_right.mpr, apply nat.dvd_lcm_right }

theorem lcm_dvd {i j k : ℤ}  : i ∣ k → j ∣ k → (lcm i j : ℤ) ∣ k :=
begin
  rw int.lcm,
  intros hi hj,
  exact coe_nat_dvd_left.mpr
    (nat.lcm_dvd (nat_abs_dvd_iff_dvd.mpr hi) (nat_abs_dvd_iff_dvd.mpr hj))
end

end int

lemma pow_gcd_eq_one {M : Type*} [monoid M] (x : M) {m n : ℕ} (hm : x ^ m = 1) (hn : x ^ n = 1) :
  x ^ m.gcd n = 1 :=
begin
  cases m, { simp only [hn, nat.gcd_zero_left] },
  lift x to Mˣ using is_unit_of_pow_eq_one hm m.succ_ne_zero,
  simp only [← units.coe_pow] at *,
  rw [← units.coe_one, ← zpow_coe_nat, ← units.ext_iff] at *,
  simp only [nat.gcd_eq_gcd_ab, zpow_add, zpow_mul, hm, hn, one_zpow, one_mul]
end

lemma gcd_nsmul_eq_zero {M : Type*} [add_monoid M] (x : M) {m n : ℕ} (hm : m • x = 0)
  (hn : n • x = 0) : (m.gcd n) • x = 0 :=
begin
  apply multiplicative.of_add.injective,
  rw [of_add_nsmul, of_add_zero, pow_gcd_eq_one];
  rwa [←of_add_nsmul, ←of_add_zero, equiv.apply_eq_iff_eq]
end

attribute [to_additive gcd_nsmul_eq_zero] pow_gcd_eq_one

/-! ### GCD prover -/
open norm_num

namespace tactic
namespace norm_num

lemma int_gcd_helper' {d : ℕ} {x y a b : ℤ} (h₁ : (d:ℤ) ∣ x) (h₂ : (d:ℤ) ∣ y)
  (h₃ : x * a + y * b = d) : int.gcd x y = d :=
begin
  refine nat.dvd_antisymm _ (int.coe_nat_dvd.1 (int.dvd_gcd h₁ h₂)),
  rw [← int.coe_nat_dvd, ← h₃],
  apply dvd_add,
  { exact (int.gcd_dvd_left _ _).mul_right _ },
  { exact (int.gcd_dvd_right _ _).mul_right _ }
end

lemma nat_gcd_helper_dvd_left (x y a : ℕ) (h : x * a = y) : nat.gcd x y = x :=
nat.gcd_eq_left ⟨a, h.symm⟩

lemma nat_gcd_helper_dvd_right (x y a : ℕ) (h : y * a = x) : nat.gcd x y = y :=
nat.gcd_eq_right ⟨a, h.symm⟩

lemma nat_gcd_helper_2 (d x y a b u v tx ty : ℕ) (hu : d * u = x) (hv : d * v = y)
  (hx : x * a = tx) (hy : y * b = ty) (h : ty + d = tx) : nat.gcd x y = d :=
begin
  rw ← int.coe_nat_gcd, apply @int_gcd_helper' _ _ _ a (-b)
    (int.coe_nat_dvd.2 ⟨_, hu.symm⟩) (int.coe_nat_dvd.2 ⟨_, hv.symm⟩),
  rw [mul_neg, ← sub_eq_add_neg, sub_eq_iff_eq_add'],
  norm_cast, rw [hx, hy, h]
end

lemma nat_gcd_helper_1 (d x y a b u v tx ty : ℕ) (hu : d * u = x) (hv : d * v = y)
  (hx : x * a = tx) (hy : y * b = ty) (h : tx + d = ty) : nat.gcd x y = d :=
(nat.gcd_comm _ _).trans $ nat_gcd_helper_2 _ _ _ _ _ _ _ _ _ hv hu hy hx h

lemma nat_lcm_helper (x y d m n : ℕ) (hd : nat.gcd x y = d) (d0 : 0 < d)
  (xy : x * y = n) (dm : d * m = n) : nat.lcm x y = m :=
mul_right_injective₀ d0.ne' $ by rw [dm, ← xy, ← hd, nat.gcd_mul_lcm]

lemma nat_coprime_helper_zero_left (x : ℕ) (h : 1 < x) : ¬ nat.coprime 0 x :=
mt (nat.coprime_zero_left _).1 $ ne_of_gt h

lemma nat_coprime_helper_zero_right (x : ℕ) (h : 1 < x) : ¬ nat.coprime x 0 :=
mt (nat.coprime_zero_right _).1 $ ne_of_gt h

lemma nat_coprime_helper_2 (x y a b tx ty : ℕ)
  (hx : x * a = tx) (hy : y * b = ty) (h : ty + 1 = tx) : nat.coprime x y :=
nat_gcd_helper_2 _ _ _ _ _ _ _ _ _ (one_mul _) (one_mul _) hx hy h

lemma nat_not_coprime_helper (d x y u v : ℕ) (hu : d * u = x) (hv : d * v = y)
  (h : 1 < d) : ¬ nat.coprime x y :=
nat.not_coprime_of_dvd_of_dvd h ⟨_, hu.symm⟩ ⟨_, hv.symm⟩

lemma int_gcd_helper (x y : ℤ) (nx ny d : ℕ) (hx : (nx:ℤ) = x) (hy : (ny:ℤ) = y)
  (h : nat.gcd nx ny = d) : int.gcd x y = d :=
by rwa [← hx, ← hy, int.coe_nat_gcd]

lemma int_gcd_helper_neg_left (x y : ℤ) (d : ℕ) (h : int.gcd x y = d) : int.gcd (-x) y = d :=
by rw int.gcd at h ⊢; rwa int.nat_abs_neg

lemma int_gcd_helper_neg_right (x y : ℤ) (d : ℕ) (h : int.gcd x y = d) : int.gcd x (-y) = d :=
by rw int.gcd at h ⊢; rwa int.nat_abs_neg

lemma int_lcm_helper (x y : ℤ) (nx ny d : ℕ) (hx : (nx:ℤ) = x) (hy : (ny:ℤ) = y)
  (h : nat.lcm nx ny = d) : int.lcm x y = d :=
by rwa [← hx, ← hy, int.coe_nat_lcm]

lemma int_lcm_helper_neg_left (x y : ℤ) (d : ℕ) (h : int.lcm x y = d) : int.lcm (-x) y = d :=
by rw int.lcm at h ⊢; rwa int.nat_abs_neg

lemma int_lcm_helper_neg_right (x y : ℤ) (d : ℕ) (h : int.lcm x y = d) : int.lcm x (-y) = d :=
by rw int.lcm at h ⊢; rwa int.nat_abs_neg

/-- Evaluates the `nat.gcd` function. -/
meta def prove_gcd_nat (c : instance_cache) (ex ey : expr) :
  tactic (instance_cache × expr × expr) := do
  x ← ex.to_nat,
  y ← ey.to_nat,
  match x, y with
  | 0, _ := pure (c, ey, `(nat.gcd_zero_left).mk_app [ey])
  | _, 0 := pure (c, ex, `(nat.gcd_zero_right).mk_app [ex])
  | 1, _ := pure (c, `(1:ℕ), `(nat.gcd_one_left).mk_app [ey])
  | _, 1 := pure (c, `(1:ℕ), `(nat.gcd_one_right).mk_app [ex])
  | _, _ := do
    let (d, a, b) := nat.xgcd_aux x 1 0 y 0 1,
    if d = x then do
      (c, ea) ← c.of_nat (y / x),
      (c, _, p) ← prove_mul_nat c ex ea,
      pure (c, ex, `(nat_gcd_helper_dvd_left).mk_app [ex, ey, ea, p])
    else if d = y then do
      (c, ea) ← c.of_nat (x / y),
      (c, _, p) ← prove_mul_nat c ey ea,
      pure (c, ey, `(nat_gcd_helper_dvd_right).mk_app [ex, ey, ea, p])
    else do
      (c, ed) ← c.of_nat d,
      (c, ea) ← c.of_nat a.nat_abs,
      (c, eb) ← c.of_nat b.nat_abs,
      (c, eu) ← c.of_nat (x / d),
      (c, ev) ← c.of_nat (y / d),
      (c, _, pu) ← prove_mul_nat c ed eu,
      (c, _, pv) ← prove_mul_nat c ed ev,
      (c, etx, px) ← prove_mul_nat c ex ea,
      (c, ety, py) ← prove_mul_nat c ey eb,
      (c, p) ← if a ≥ 0 then prove_add_nat c ety ed etx else prove_add_nat c etx ed ety,
      let pf : expr := if a ≥ 0 then `(nat_gcd_helper_2) else `(nat_gcd_helper_1),
      pure (c, ed, pf.mk_app [ed, ex, ey, ea, eb, eu, ev, etx, ety, pu, pv, px, py, p])
  end

/-- Evaluates the `nat.lcm` function. -/
meta def prove_lcm_nat (c : instance_cache) (ex ey : expr) :
  tactic (instance_cache × expr × expr) := do
  x ← ex.to_nat,
  y ← ey.to_nat,
  match x, y with
  | 0, _ := pure (c, `(0:ℕ), `(nat.lcm_zero_left).mk_app [ey])
  | _, 0 := pure (c, `(0:ℕ), `(nat.lcm_zero_right).mk_app [ex])
  | 1, _ := pure (c, ey, `(nat.lcm_one_left).mk_app [ey])
  | _, 1 := pure (c, ex, `(nat.lcm_one_right).mk_app [ex])
  | _, _ := do
    (c, ed, pd) ← prove_gcd_nat c ex ey,
    (c, p0) ← prove_pos c ed,
    (c, en, xy) ← prove_mul_nat c ex ey,
    d ← ed.to_nat,
    (c, em) ← c.of_nat ((x * y) / d),
    (c, _, dm) ← prove_mul_nat c ed em,
    pure (c, em, `(nat_lcm_helper).mk_app [ex, ey, ed, em, en, pd, p0, xy, dm])
  end

/-- Evaluates the `int.gcd` function. -/
meta def prove_gcd_int (zc nc : instance_cache) : expr → expr →
  tactic (instance_cache × instance_cache × expr × expr)
| x y := match match_neg x with
  | some x := do
    (zc, nc, d, p) ← prove_gcd_int x y,
    pure (zc, nc, d, `(int_gcd_helper_neg_left).mk_app [x, y, d, p])
  | none := match match_neg y with
    | some y := do
      (zc, nc, d, p) ← prove_gcd_int x y,
      pure (zc, nc, d, `(int_gcd_helper_neg_right).mk_app [x, y, d, p])
    | none := do
      (zc, nc, nx, px) ← prove_nat_uncast zc nc x,
      (zc, nc, ny, py) ← prove_nat_uncast zc nc y,
      (nc, d, p) ← prove_gcd_nat nc nx ny,
      pure (zc, nc, d, `(int_gcd_helper).mk_app [x, y, nx, ny, d, px, py, p])
    end
  end

/-- Evaluates the `int.lcm` function. -/
meta def prove_lcm_int (zc nc : instance_cache) : expr → expr →
  tactic (instance_cache × instance_cache × expr × expr)
| x y := match match_neg x with
  | some x := do
    (zc, nc, d, p) ← prove_lcm_int x y,
    pure (zc, nc, d, `(int_lcm_helper_neg_left).mk_app [x, y, d, p])
  | none := match match_neg y with
    | some y := do
      (zc, nc, d, p) ← prove_lcm_int x y,
      pure (zc, nc, d, `(int_lcm_helper_neg_right).mk_app [x, y, d, p])
    | none := do
      (zc, nc, nx, px) ← prove_nat_uncast zc nc x,
      (zc, nc, ny, py) ← prove_nat_uncast zc nc y,
      (nc, d, p) ← prove_lcm_nat nc nx ny,
      pure (zc, nc, d, `(int_lcm_helper).mk_app [x, y, nx, ny, d, px, py, p])
    end
  end

/-- Evaluates the `nat.coprime` function. -/
meta def prove_coprime_nat (c : instance_cache) (ex ey : expr) :
  tactic (instance_cache × (expr ⊕ expr)) := do
  x ← ex.to_nat,
  y ← ey.to_nat,
  match x, y with
  | 1, _ := pure (c, sum.inl $ `(nat.coprime_one_left).mk_app [ey])
  | _, 1 := pure (c, sum.inl $ `(nat.coprime_one_right).mk_app [ex])
  | 0, 0 := pure (c, sum.inr `(nat.not_coprime_zero_zero))
  | 0, _ := do
    c ← mk_instance_cache `(ℕ),
    (c, p) ← prove_lt_nat c `(1) ey,
    pure (c, sum.inr $ `(nat_coprime_helper_zero_left).mk_app [ey, p])
  | _, 0 := do
    c ← mk_instance_cache `(ℕ),
    (c, p) ← prove_lt_nat c `(1) ex,
    pure (c, sum.inr $ `(nat_coprime_helper_zero_right).mk_app [ex, p])
  | _, _ := do
    c ← mk_instance_cache `(ℕ),
    let (d, a, b) := nat.xgcd_aux x 1 0 y 0 1,
    if d = 1 then do
      (c, ea) ← c.of_nat a.nat_abs,
      (c, eb) ← c.of_nat b.nat_abs,
      (c, etx, px) ← prove_mul_nat c ex ea,
      (c, ety, py) ← prove_mul_nat c ey eb,
      (c, p) ← if a ≥ 0 then prove_add_nat c ety `(1) etx else prove_add_nat c etx `(1) ety,
      let pf : expr := if a ≥ 0 then `(nat_coprime_helper_2) else `(nat_coprime_helper_1),
      pure (c, sum.inl $ pf.mk_app [ex, ey, ea, eb, etx, ety, px, py, p])
    else do
      (c, ed) ← c.of_nat d,
      (c, eu) ← c.of_nat (x / d),
      (c, ev) ← c.of_nat (y / d),
      (c, _, pu) ← prove_mul_nat c ed eu,
      (c, _, pv) ← prove_mul_nat c ed ev,
      (c, p) ← prove_lt_nat c `(1) ed,
      pure (c, sum.inr $ `(nat_not_coprime_helper).mk_app [ed, ex, ey, eu, ev, pu, pv, p])
  end

/-- Evaluates the `gcd`, `lcm`, and `coprime` functions. -/
@[norm_num] meta def eval_gcd : expr → tactic (expr × expr)
| `(nat.gcd %%ex %%ey) := do
    c ← mk_instance_cache `(ℕ),
    prod.snd <$> prove_gcd_nat c ex ey
| `(nat.lcm %%ex %%ey) := do
    c ← mk_instance_cache `(ℕ),
    prod.snd <$> prove_lcm_nat c ex ey
| `(nat.coprime %%ex %%ey) := do
    c ← mk_instance_cache `(ℕ),
    prove_coprime_nat c ex ey >>= sum.elim true_intro false_intro ∘ prod.snd
| `(int.gcd %%ex %%ey) := do
    zc ← mk_instance_cache `(ℤ),
    nc ← mk_instance_cache `(ℕ),
    (prod.snd ∘ prod.snd) <$> prove_gcd_int zc nc ex ey
| `(int.lcm %%ex %%ey) := do
    zc ← mk_instance_cache `(ℤ),
    nc ← mk_instance_cache `(ℕ),
    (prod.snd ∘ prod.snd) <$> prove_lcm_int zc nc ex ey
| _ := failed

end norm_num
end tactic


import data.real.basic

variables a b c d : ℝ

#check add_mul
#check add_mul c a b
#check add_sub
#check add_sub c b a
#check sub_zero
#check sub_self
#check sub_add
#check sub_sub
#check mul_comm d c
#check mul_sub a b c
#check pow_two d

-- BEGIN
example (a b : ℝ) : (a + b) * (a - b) = a^2 - b^2 :=
begin
  rw [add_mul, mul_sub, mul_sub],
  rw [add_sub, mul_comm b a, sub_add, sub_self, sub_zero],
  rw [← pow_two a, ← pow_two b],
end
-- END


/-
if R is a ring and S is a multiplicative subset of R then S−1R is the zero ring if and only if S contains 0,

[proof omitted]
-/

import ring_theory.localization group_theory.submonoid

universe u

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

theorem localization.subsingleton_iff_zero_mem : subsingleton (localization.loc α S) ↔ (0:α) ∈ S :=
⟨λ ⟨h⟩, let ⟨w, H, hw⟩ := quotient.exact (h 0 1) in by simp at hw; rwa hw at H,
 λ h, ⟨λ x y, quotient.induction_on₂ x y $ λ ⟨m₁, m₂, hm⟩ ⟨n₁, n₂, hn⟩, quotient.sound $ ⟨0, h, by simp⟩⟩⟩


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

import linear_algebra.free_module.basic
import linear_algebra.matrix.to_lin
import ring_theory.finiteness

/-!
# Finite and free modules

We provide some instances for finite and free modules.

## Main results

* `module.free.choose_basis_index.fintype` : If a free module is finite, then any basis is
  finite.
* `module.free.linear_map.free ` : if `M` and `N` are finite and free, then `M →ₗ[R] N` is free.
* `module.finite.of_basis` : A free module with a basis indexed by a `fintype` is finite.
* `module.free.linear_map.module.finite` : if `M` and `N` are finite and free, then `M →ₗ[R] N`
  is finite.
-/

universes u v w

variables (R : Type u) (M : Type v) (N : Type w)

namespace module.free

section ring

variables [ring R] [add_comm_group M] [module R M] [module.free R M]

/-- If a free module is finite, then any basis is finite. -/
noncomputable
instance [nontrivial R] [module.finite R M] :
  fintype (module.free.choose_basis_index R M) :=
begin
  obtain ⟨h⟩ := id ‹module.finite R M›,
  choose s hs using h,
  exact basis_fintype_of_finite_spans ↑s hs (choose_basis _ _),
end

end ring

section comm_ring

variables [comm_ring R] [add_comm_group M] [module R M] [module.free R M]
variables [add_comm_group N] [module R N] [module.free R N]

instance [nontrivial R] [module.finite R M] [module.finite R N] : module.free R (M →ₗ[R] N) :=
begin
  classical,
  exact of_equiv
    (linear_map.to_matrix (module.free.choose_basis R M) (module.free.choose_basis R N)).symm,
end

variables {R M}

/-- A free module with a basis indexed by a `fintype` is finite. -/
lemma _root_.module.finite.of_basis {R : Type*} {M : Type*} {ι : Type*} [comm_ring R]
  [add_comm_group M] [module R M] [fintype ι] (b : basis ι R M) : module.finite R M :=
begin
  classical,
  refine ⟨⟨finset.univ.image b, _⟩⟩,
  simp only [set.image_univ, finset.coe_univ, finset.coe_image, basis.span_eq],
end

instance _root_.module.finite.matrix {ι₁ : Type*} [fintype ι₁] {ι₂ : Type*} [fintype ι₂] :
  module.finite R (matrix ι₁ ι₂ R) :=
module.finite.of_basis $ pi.basis $ λ i, pi.basis_fun R _

instance [nontrivial R] [module.finite R M] [module.finite R N] :
  module.finite R (M →ₗ[R] N) :=
begin
  classical,
  have f := (linear_map.to_matrix (choose_basis R M) (choose_basis R N)).symm,
  exact module.finite.of_surjective f.to_linear_map (linear_equiv.surjective f),
end

end comm_ring

section integer

variables [add_comm_group M] [module.finite ℤ M] [module.free ℤ M]
variables [add_comm_group N] [module.finite ℤ N] [module.free ℤ N]

instance : module.finite ℤ (M →+ N) :=
module.finite.equiv (add_monoid_hom_lequiv_int ℤ).symm

instance : module.free ℤ (M →+ N) :=
module.free.of_equiv (add_monoid_hom_lequiv_int ℤ).symm

end integer

end module.free


/-
An exhaustive description of all possible moves in the game.

Moves of the form `move__nil` are to towers that are empty, while moves of the form
`move__cons` are to towers having at least one disc. The condition of the larger discs being below the
smaller ones is enforced in the latter case.
-/
inductive TowersOfHanoi (n : Nat) : List Nat → List Nat → List Nat → Type _

  | move₁₂nil {a : Nat} {as cs : List Nat} :
    TowersOfHanoi n (a :: as) [] cs → TowersOfHanoi n as [a] cs

  | move₁₂cons {a b : Nat} {as bs cs : List Nat} :
    (a < b) → TowersOfHanoi n (a :: as) (b :: bs) cs → TowersOfHanoi n as (a :: b :: bs) cs

  | move₁₃nil {a : Nat} {as bs : List Nat} :
    TowersOfHanoi n (a :: as) bs [] → TowersOfHanoi n as bs [a]

  | move₁₃cons {a b : Nat} {as bs cs : List Nat} :
    (a < c) → TowersOfHanoi n (a :: as) bs (c :: cs) → TowersOfHanoi n as bs (a :: c :: cs)

  | move₂₃nil {b : Nat} {as bs : List Nat} :
    TowersOfHanoi n as (b :: bs) [] → TowersOfHanoi n as bs [b]

  | move₂₃cons {b c : Nat} {as bs cs : List Nat} :
    (b < c) → TowersOfHanoi n as (b :: bs) cs → TowersOfHanoi n as bs (b :: c :: cs)

  | move₃₂nil {c : Nat} {as cs : List Nat} :
    TowersOfHanoi n as [] (c :: cs) → TowersOfHanoi n as [c] cs

  | move₃₂cons {b c : Nat} {as bs cs : List Nat} :
    (c < b) → TowersOfHanoi n as (b :: bs) (c :: cs) → TowersOfHanoi n as (c :: b :: bs) cs

  | move₂₁nil {b : Nat} {bs cs : List Nat} :
    TowersOfHanoi n [] (b :: bs) cs → TowersOfHanoi n [b] bs cs

  | move₂₁cons {a b : Nat} {as bs cs : List Nat} :
    (b < a) → TowersOfHanoi n (a :: as) (b :: bs) cs → TowersOfHanoi n (b :: a :: as) bs cs

  | move₃₁nil {c : Nat} {bs cs : List Nat} :
    TowersOfHanoi n [] bs (c :: cs) → TowersOfHanoi n [c] bs cs

  | move₃₁cons {a c : Nat} {as bs cs : List Nat} :
    (c < a) → TowersOfHanoi n (a :: as) bs  (c :: cs) → TowersOfHanoi n (c :: a :: as) bs cs

open TowersOfHanoi

/-
Custom tactics for playing the game.

The `moveXY` tactic invokes the built-in `apply` tactic
which uses a function `f : α → β` to convert a goal `⊢ β` to `⊢ α`.

This is the reason the constructors of the form `moveYX`` are applied.
-/

section movetactics

macro "moveAB" : tactic => `(first
                               | apply move₂₁cons ; simp
                               | apply move₂₁nil)

macro "moveAC" : tactic => `(first
                               | apply move₃₁cons ; simp
                               | apply move₃₁nil)

macro "moveBA" : tactic => `(first
                               | apply move₁₂cons ; simp
                               | apply move₁₂nil)

macro "moveBC" : tactic => `(first
                               | apply move₃₂cons ; simp
                               | apply move₃₂nil)

macro "moveCA" : tactic => `(first
                               | apply move₁₃cons ; simp
                               | apply move₁₃nil)

macro "moveCB" : tactic => `(first
                               | apply move₂₃cons ; simp
                               | apply move₂₃nil)

macro "done" : tactic => `(assumption)

end movetactics

-- an example of the game in action
example (goal : TowersOfHanoi 2 [] [] [0, 1]) : TowersOfHanoi 2 [0, 1] [] [] := by
  moveAC
  moveAB
  moveCA
  moveBC
  moveAC
  done

theorem moveStack {n : Nat} {as bs cs as' bs' cs' : List Nat} (αs βs γs : List Nat)
  (init : TowersOfHanoi n as bs cs) (final : TowersOfHanoi n as' bs' cs') :
  (TowersOfHanoi n (as ++ αs) (bs ++ βs) (cs ++ γs)) → (TowersOfHanoi n (as' ++ αs) (bs' ++ βs) (cs' ++ γs)) := by
  intro moves
  sorry


import probability_density

noncomputable theory
open_locale classical measure_theory nnreal ennreal

namespace measure_theory

open measure_theory measure_theory.measure topological_space real

variables {α β : Type*} [measurable_space α] [measurable_space β]
variables {E : Type*} [inner_product_space ℝ E] [measurable_space E]
  [second_countable_topology E] [complete_space E] [borel_space E]

local notation `⟪`x`, `y`⟫` := @inner ℝ E _ x y

/-- The Laplace transform of a measure on some set. -/
def laplace_transform (μ : measure E) (support : set E) : E → ℝ :=
λ s, ∫ x in support, exp (-⟪s, x⟫) ∂μ

-- make it localized
notation `𝓛 ` μ:75 := laplace_transform μ set.univ
notation `𝓛 ` μ ` on ` support:75 := laplace_transform μ support

@[measurability]
lemma measurable_inner_right (x : E) : measurable (λ y, ⟪x, y⟫) :=
(inner_right x).continuous.measurable

/-- If `S` is a region of the domain such that for all `s ∈ S`, `x ∈ support` we have
`⟪s, x⟫ ≥0`, then the Laplace transformation exists in `S`. This is mostly useful for
proving properties of the Laplace transform with the support being [0, ∞). -/
lemma integrable_on_exp_neg_inner {μ : measure E} {support S : set E}
  (hsupport : μ support < ∞) (hS : ∀ ⦃s x⦄, s ∈ S → x ∈ support → 0 ≤ ⟪s, x⟫)
  {s : E} (hs : s ∈ S) : integrable_on (λ x, exp (-⟪s, x⟫)) support μ :=
begin
  refine ⟨by measurability, _⟩,
  refine lt_of_le_of_lt (set_lintegral_mono_on _ (@measurable_const _ _ _ _ 1) _) _,
  { measurability },
  { intros x hx,
    specialize hS hs hx,
    rw [ennreal.coe_le_one_iff, nnnorm_of_nonneg (le_of_lt (exp_pos _))],
    change _ ≤ (⟨1, zero_le_one⟩ : ℝ≥0),
    simp [hS] },
  { rwa [set_lintegral_const, one_mul] }
end

section

variables {μ ν : measure E} {support : set E}

lemma laplace_transform_add {s : E}
  (hμs : integrable_on (λ x, exp (-⟪s, x⟫)) support μ)
  (hνs : integrable_on (λ x, exp (-⟪s, x⟫)) support ν) :
  (𝓛 (μ + ν) on support) s = (𝓛 μ on support) s + (𝓛 ν on support) s :=
begin
  simp only [laplace_transform, restrict_add, pi.add_apply],
  rw [integral_add_measure hμs hνs]
end

lemma laplace_transform_smul {s : E} {c : ℝ≥0} :
  (𝓛 (c • μ) on support) s = c • (𝓛 μ on support) s :=
begin
  simp only [laplace_transform],
  erw [restrict_smul, integral_smul_measure],
  refl
end

/-- The Laplace transform of `μ.with_density f` on the set `S` equals
`∫ x in S, exp (-⟪s, x⟫) * f x ∂μ`.

The latter integral is the more commonly seen definition for the Laplace transformation
of a function. With this lemma, if `X` is a random variable and `ℙ` is a probability measure,
`𝓛 (map X ℙ) s = ∫ exp(-sx) * pdf X ∂λ = 𝔼[exp(-s X)]` where `λ` is the Lebesgue measure. -/
lemma laplace_transform_with_density (hsupp : measurable_set support)
  {f : E → ℝ≥0∞} (hf : measurable f) (hf' : ∀ᵐ x ∂μ, x ∈ support → f x < ∞) {s : E} :
  (𝓛 (μ.with_density f) on support) s = ∫ x in support, exp (-⟪s, x⟫) * (f x).to_real ∂μ :=
begin
  simp only [laplace_transform],
  rw [integral_eq_lintegral_of_nonneg_ae, integral_eq_lintegral_of_nonneg_ae],
  { rw [set_lintegral_with_density_eq_set_lintegral_mul _ hf
        (measurable_const.inner measurable_id').neg.exp.ennreal_of_real hsupp],
    congr' 1,
    refine set_lintegral_congr_fun hsupp
      (filter.eventually.mp hf' (ae_of_all _ (λ x hx hmem, _))),
    rw [ennreal.of_real_mul (le_of_lt (exp_pos _)),
        ennreal.of_real_to_real (hx hmem).ne, mul_comm],
    refl },
  all_goals { try { measurability } },
  { exact ae_of_all _ (λ x, mul_nonneg (le_of_lt (exp_pos _)) ennreal.to_real_nonneg) },
  { refine ae_of_all _ (λ x, le_of_lt (exp_pos _)) },
end

lemma laplace_transform_map (hsupp : measurable_set support)
  {f : E → E} (hf : measurable f) {s : E} :
  (𝓛 (map f μ) on support) s = ∫ x in f ⁻¹' support, exp (-⟪s, f x⟫) ∂μ :=
begin
  simp only [laplace_transform],
  rw set_integral_map hsupp _ hf,
  measurability,
end

/-- Given a measure `μ`, the Laplace transform of `μ.with_density (x ↦ exp(-⟪t, x⟫))` at `s`
equals the Laplace transform of `μ` at `s + t`. -/
lemma laplace_transform_with_density_add (hsupp : measurable_set support) {s t : E} :
  (𝓛 (μ.with_density (λ x, ennreal.of_real (exp (-⟪t, x⟫)))) on support) s =
  (𝓛 μ on support) (s + t) :=
begin
  rw laplace_transform_with_density hsupp,
  { have : ∀ x, (ennreal.of_real (exp (-⟪t, x⟫))).to_real = exp (-⟪t, x⟫),
    { intro x, rw ennreal.to_real_of_real (le_of_lt (exp_pos _)) },
    simp_rw [this, ← exp_add, ← neg_add, ← inner_add_left],
    refl },
  { measurability },
  { exact (ae_of_all _ (λ x hx, ennreal.of_real_lt_top)) },
end

lemma laplace_transform_with_density_smul
  (hsupp : measurable_set support) {s : E} {c : ℝ} :
  (𝓛 (map (λ x, c • x) μ) on support) s = (𝓛 μ on ((λ x, c • x) ⁻¹' support)) (c • s) :=
begin
  rw laplace_transform_map hsupp (measurable_id'.const_smul' c),
  simp only [laplace_transform, inner_smul_left, inner_smul_right, is_R_or_C.conj_to_real]
end

end

end measure_theory


-- Complementario de un conjunto: Pruebas de A \ B ⊆ Bᶜ
-- ====================================================

-- ----------------------------------------------------
-- Ej. 1. Demostrar
--    A \ B ⊆ Bᶜ
-- ----------------------------------------------------

import data.set

variable  {U : Type}
variables A B : set U
variable  x : U

open set

-- #reduce x ∈ Bᶜ
-- #reduce Bᶜ

-- 1ª demostración
example : A \ B ⊆ Bᶜ :=
begin
  intros x h,
  simp at *,
  exact h.right,
end

-- 2ª demostración
example : A \ B ⊆ Bᶜ :=
begin
  intros x h,
  exact h.right,
end

-- 3ª demostración
example : A \ B ⊆ Bᶜ :=
assume x,
assume h1 : x ∈ A \ B,
have h2 : x ∉ B, from and.right h1,
show x ∈ Bᶜ,     from h2

-- 4ª demostración
example : A \ B ⊆ Bᶜ :=
assume x,
assume h1 : x ∈ A \ B,
show x ∈ Bᶜ, from and.right h1

-- 5ª demostración
example : A \ B ⊆ Bᶜ :=
assume x,
λ h1, and.right h1

-- 6ª demostración
example : A \ B ⊆ Bᶜ :=
assume x,
and.right

-- 7ª demostración
example : A \ B ⊆ Bᶜ :=
λ _, and.right

-- 8ª demostración
example : A \ B ⊆ Bᶜ :=
λ _, not_mem_of_mem_diff


/-
Copyright (c) 2022 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa

! This file was ported from Lean 3 source module data.polynomial.laurent
! leanprover-community/mathlib commit 831c494092374cfe9f50591ed0ac81a25efc5b86
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Polynomial.AlgebraMap
import Mathbin.RingTheory.Localization.Basic

/-!  # Laurent polynomials

We introduce Laurent polynomials over a semiring `R`.  Mathematically, they are expressions of the
form
$$
\sum_{i \in \mathbb{Z}} a_i T ^ i
$$
where the sum extends over a finite subset of `ℤ`.  Thus, negative exponents are allowed.  The
coefficients come from the semiring `R` and the variable `T` commutes with everything.

Since we are going to convert back and forth between polynomials and Laurent polynomials, we
decided to maintain some distinction by using the symbol `T`, rather than `X`, as the variable for
Laurent polynomials

## Notation
The symbol `R[T;T⁻¹]` stands for `laurent_polynomial R`.  We also define

* `C : R →+* R[T;T⁻¹]` the inclusion of constant polynomials, analogous to the one for `R[X]`;
* `T : ℤ → R[T;T⁻¹]` the sequence of powers of the variable `T`.

## Implementation notes

We define Laurent polynomials as `add_monoid_algebra R ℤ`.
Thus, they are essentially `finsupp`s `ℤ →₀ R`.
This choice differs from the current irreducible design of `polynomial`, that instead shields away
the implementation via `finsupp`s.  It is closer to the original definition of polynomials.

As a consequence, `laurent_polynomial` plays well with polynomials, but there is a little roughness
in establishing the API, since the `finsupp` implementation of `R[X]` is well-shielded.

Unlike the case of polynomials, I felt that the exponent notation was not too easy to use, as only
natural exponents would be allowed.  Moreover, in the end, it seems likely that we should aim to
perform computations on exponents in `ℤ` anyway and separating this via the symbol `T` seems
convenient.

I made a *heavy* use of `simp` lemmas, aiming to bring Laurent polynomials to the form `C a * T n`.
Any comments or suggestions for improvements is greatly appreciated!

##  Future work
Lots is missing!
-- (Riccardo) add inclusion into Laurent series.
-- (Riccardo) giving a morphism (as `R`-alg, so in the commutative case)
  from `R[T,T⁻¹]` to `S` is the same as choosing a unit of `S`.
-- A "better" definition of `trunc` would be as an `R`-linear map.  This works:
--  ```
--  def trunc : R[T;T⁻¹] →[R] R[X] :=
--  begin
--    refine (_ : add_monoid_algebra R ℕ →[R] R[X]).comp _,
--    { exact ⟨(to_finsupp_iso R).symm, by simp⟩ },
--    { refine ⟨λ r, comap_domain _ r (set.inj_on_of_injective (λ a b ab, int.of_nat.inj ab) _), _⟩,
--      exact λ r f, comap_domain_smul _ _ _ }
--  end
--  ```
--  but it would make sense to bundle the maps better, for a smoother user experience.
--  I (DT) did not have the strength to embark on this (possibly short!) journey, after getting to
--  this stage of the Laurent process!
--  This would likely involve adding a `comap_domain` analogue of
--  `add_monoid_algebra.map_domain_alg_hom` and an `R`-linear version of
--  `polynomial.to_finsupp_iso`.
-- Add `degree, int_degree, int_trailing_degree, leading_coeff, trailing_coeff,...`.
-/

open Polynomial BigOperators

open Polynomial AddMonoidAlgebra Finsupp

noncomputable section

variable {R : Type _}

/-- The semiring of Laurent polynomials with coefficients in the semiring `R`.
We denote it by `R[T;T⁻¹]`.
The ring homomorphism `C : R →+* R[T;T⁻¹]` includes `R` as the constant polynomials. -/
abbrev LaurentPolynomial (R : Type _) [Semiring R] :=
  AddMonoidAlgebra R ℤ
#align laurent_polynomial LaurentPolynomial

-- mathport name: «expr [T;T⁻¹]»
local notation:9000 R "[T;T⁻¹]" => LaurentPolynomial R

/-- The ring homomorphism, taking a polynomial with coefficients in `R` to a Laurent polynomial
with coefficients in `R`. -/
def Polynomial.toLaurent [Semiring R] : R[X] →+* R[T;T⁻¹] :=
  (mapDomainRingHom R Int.ofNatHom).comp (toFinsuppIso R)
#align polynomial.to_laurent Polynomial.toLaurent

/-- This is not a simp lemma, as it is usually preferable to use the lemmas about `C` and `X`
instead. -/
theorem Polynomial.toLaurent_apply [Semiring R] (p : R[X]) :
    p.toLaurent = p.toFinsupp.mapDomain coe :=
  rfl
#align polynomial.to_laurent_apply Polynomial.toLaurent_apply

/-- The `R`-algebra map, taking a polynomial with coefficients in `R` to a Laurent polynomial
with coefficients in `R`. -/
def Polynomial.toLaurentAlg [CommSemiring R] : R[X] →ₐ[R] R[T;T⁻¹] :=
  by
  refine' AlgHom.comp _ (to_finsupp_iso_alg R).toAlgHom
  exact map_domain_alg_hom R R Int.ofNatHom
#align polynomial.to_laurent_alg Polynomial.toLaurentAlg

@[simp]
theorem Polynomial.toLaurentAlg_apply [CommSemiring R] (f : R[X]) : f.toLaurentAlg = f.toLaurent :=
  rfl
#align polynomial.to_laurent_alg_apply Polynomial.toLaurentAlg_apply

namespace LaurentPolynomial

section Semiring

variable [Semiring R]

theorem single_zero_one_eq_one : (single 0 1 : R[T;T⁻¹]) = (1 : R[T;T⁻¹]) :=
  rfl
#align laurent_polynomial.single_zero_one_eq_one LaurentPolynomial.single_zero_one_eq_one

/-!  ### The functions `C` and `T`. -/

/-- The ring homomorphism `C`, including `R` into the ring of Laurent polynomials over `R` as
the constant Laurent polynomials. -/
def c : R →+* R[T;T⁻¹] :=
  singleZeroRingHom
#align laurent_polynomial.C LaurentPolynomial.c

theorem algebraMap_apply {R A : Type _} [CommSemiring R] [Semiring A] [Algebra R A] (r : R) :
    algebraMap R (LaurentPolynomial A) r = c (algebraMap R A r) :=
  rfl
#align laurent_polynomial.algebra_map_apply LaurentPolynomial.algebraMap_apply

/-- When we have `[comm_semiring R]`, the function `C` is the same as `algebra_map R R[T;T⁻¹]`.
(But note that `C` is defined when `R` is not necessarily commutative, in which case
`algebra_map` is not available.)
-/
theorem c_eq_algebraMap {R : Type _} [CommSemiring R] (r : R) : c r = algebraMap R R[T;T⁻¹] r :=
  rfl
#align laurent_polynomial.C_eq_algebra_map LaurentPolynomial.c_eq_algebraMap

theorem single_eq_c (r : R) : single 0 r = c r :=
  rfl
#align laurent_polynomial.single_eq_C LaurentPolynomial.single_eq_c

/-- The function `n ↦ T ^ n`, implemented as a sequence `ℤ → R[T;T⁻¹]`.

Using directly `T ^ n` does not work, since we want the exponents to be of Type `ℤ` and there
is no `ℤ`-power defined on `R[T;T⁻¹]`.  Using that `T` is a unit introduces extra coercions.
For these reasons, the definition of `T` is as a sequence. -/
def t (n : ℤ) : R[T;T⁻¹] :=
  single n 1
#align laurent_polynomial.T LaurentPolynomial.t

@[simp]
theorem t_zero : (t 0 : R[T;T⁻¹]) = 1 :=
  rfl
#align laurent_polynomial.T_zero LaurentPolynomial.t_zero

theorem t_add (m n : ℤ) : (t (m + n) : R[T;T⁻¹]) = t m * t n :=
  by
  convert single_mul_single.symm
  simp [T]
#align laurent_polynomial.T_add LaurentPolynomial.t_add

theorem t_sub (m n : ℤ) : (t (m - n) : R[T;T⁻¹]) = t m * t (-n) := by rw [← T_add, sub_eq_add_neg]
#align laurent_polynomial.T_sub LaurentPolynomial.t_sub

@[simp]
theorem t_pow (m : ℤ) (n : ℕ) : (t m ^ n : R[T;T⁻¹]) = t (n * m) := by
  rw [T, T, single_pow n, one_pow, nsmul_eq_mul]
#align laurent_polynomial.T_pow LaurentPolynomial.t_pow

/-- The `simp` version of `mul_assoc`, in the presence of `T`'s. -/
@[simp]
theorem mul_t_assoc (f : R[T;T⁻¹]) (m n : ℤ) : f * t m * t n = f * t (m + n) := by
  simp [← T_add, mul_assoc]
#align laurent_polynomial.mul_T_assoc LaurentPolynomial.mul_t_assoc

@[simp]
theorem single_eq_c_mul_t (r : R) (n : ℤ) : (single n r : R[T;T⁻¹]) = (c r * t n : R[T;T⁻¹]) := by
  convert single_mul_single.symm <;> simp
#align laurent_polynomial.single_eq_C_mul_T LaurentPolynomial.single_eq_c_mul_t

-- This lemma locks in the right changes and is what Lean proved directly.
-- The actual `simp`-normal form of a Laurent monomial is `C a * T n`, whenever it can be reached.
@[simp]
theorem Polynomial.toLaurent_c_mul_t (n : ℕ) (r : R) :
    ((Polynomial.monomial n r).toLaurent : R[T;T⁻¹]) = c r * t n :=
  show mapDomain coe (monomial n r).toFinsupp = (c r * t n : R[T;T⁻¹]) by
    rw [to_finsupp_monomial, map_domain_single, single_eq_C_mul_T]
#align polynomial.to_laurent_C_mul_T Polynomial.toLaurent_c_mul_t

@[simp]
theorem Polynomial.toLaurent_c (r : R) : (Polynomial.C r).toLaurent = c r :=
  by
  convert Polynomial.toLaurent_c_mul_t 0 r
  simp only [Int.ofNat_zero, T_zero, mul_one]
#align polynomial.to_laurent_C Polynomial.toLaurent_c

@[simp]
theorem Polynomial.toLaurent_x : (Polynomial.X.toLaurent : R[T;T⁻¹]) = t 1 :=
  by
  have : (Polynomial.X : R[X]) = monomial 1 1 := by simp [← C_mul_X_pow_eq_monomial]
  simp [this, Polynomial.toLaurent_c_mul_t]
#align polynomial.to_laurent_X Polynomial.toLaurent_x

@[simp]
theorem Polynomial.toLaurent_one : (Polynomial.toLaurent : R[X] → R[T;T⁻¹]) 1 = 1 :=
  map_one Polynomial.toLaurent
#align polynomial.to_laurent_one Polynomial.toLaurent_one

@[simp]
theorem Polynomial.toLaurent_c_mul_eq (r : R) (f : R[X]) :
    (Polynomial.C r * f).toLaurent = c r * f.toLaurent := by
  simp only [_root_.map_mul, Polynomial.toLaurent_c]
#align polynomial.to_laurent_C_mul_eq Polynomial.toLaurent_c_mul_eq

@[simp]
theorem Polynomial.toLaurent_x_pow (n : ℕ) : (X ^ n : R[X]).toLaurent = t n := by
  simp only [map_pow, Polynomial.toLaurent_x, T_pow, mul_one]
#align polynomial.to_laurent_X_pow Polynomial.toLaurent_x_pow

@[simp]
theorem Polynomial.toLaurent_c_mul_x_pow (n : ℕ) (r : R) :
    (Polynomial.C r * X ^ n).toLaurent = c r * t n := by
  simp only [_root_.map_mul, Polynomial.toLaurent_c, Polynomial.toLaurent_x_pow]
#align polynomial.to_laurent_C_mul_X_pow Polynomial.toLaurent_c_mul_x_pow

instance invertibleT (n : ℤ) : Invertible (t n : R[T;T⁻¹])
    where
  invOf := t (-n)
  invOf_mul_self := by rw [← T_add, add_left_neg, T_zero]
  mul_invOf_self := by rw [← T_add, add_right_neg, T_zero]
#align laurent_polynomial.invertible_T LaurentPolynomial.invertibleT

@[simp]
theorem invOf_t (n : ℤ) : ⅟ (t n : R[T;T⁻¹]) = t (-n) :=
  rfl
#align laurent_polynomial.inv_of_T LaurentPolynomial.invOf_t

theorem isUnit_t (n : ℤ) : IsUnit (t n : R[T;T⁻¹]) :=
  isUnit_of_invertible _
#align laurent_polynomial.is_unit_T LaurentPolynomial.isUnit_t

@[elab_as_elim]
protected theorem induction_on {M : R[T;T⁻¹] → Prop} (p : R[T;T⁻¹]) (h_C : ∀ a, M (c a))
    (h_add : ∀ {p q}, M p → M q → M (p + q))
    (h_C_mul_T : ∀ (n : ℕ) (a : R), M (c a * t n) → M (c a * t (n + 1)))
    (h_C_mul_T_Z : ∀ (n : ℕ) (a : R), M (c a * t (-n)) → M (c a * t (-n - 1))) : M p :=
  by
  have A : ∀ {n : ℤ} {a : R}, M (C a * T n) :=
    by
    intro n a
    apply n.induction_on
    · simpa only [T_zero, mul_one] using h_C a
    · exact fun m => h_C_mul_T m a
    · exact fun m => h_C_mul_T_Z m a
  have B : ∀ s : Finset ℤ, M (s.Sum fun n : ℤ => C (p.to_fun n) * T n) :=
    by
    apply Finset.induction
    · convert h_C 0
      simp only [Finset.sum_empty, _root_.map_zero]
    · intro n s ns ih
      rw [Finset.sum_insert ns]
      exact h_add A ih
  convert B p.support
  ext a
  simp_rw [← single_eq_C_mul_T, Finset.sum_apply', single_apply, Finset.sum_ite_eq']
  split_ifs with h h
  · rfl
  · exact finsupp.not_mem_support_iff.mp h
#align laurent_polynomial.induction_on LaurentPolynomial.induction_on

/-- To prove something about Laurent polynomials, it suffices to show that
* the condition is closed under taking sums, and
* it holds for monomials.
-/
@[elab_as_elim]
protected theorem induction_on' {M : R[T;T⁻¹] → Prop} (p : R[T;T⁻¹])
    (h_add : ∀ p q, M p → M q → M (p + q)) (h_C_mul_T : ∀ (n : ℤ) (a : R), M (c a * t n)) : M p :=
  by
  refine' p.induction_on (fun a => _) h_add _ _ <;> try exact fun n f _ => h_C_mul_T _ f
  convert h_C_mul_T 0 a
  exact (mul_one _).symm
#align laurent_polynomial.induction_on' LaurentPolynomial.induction_on'

theorem commute_t (n : ℤ) (f : R[T;T⁻¹]) : Commute (t n) f :=
  f.inductionOn' (fun p q Tp Tq => Commute.add_right Tp Tq) fun m a =>
    show t n * _ = _
      by
      rw [T, T, ← single_eq_C, single_mul_single, single_mul_single, single_mul_single]
      simp [add_comm]
#align laurent_polynomial.commute_T LaurentPolynomial.commute_t

@[simp]
theorem t_mul (n : ℤ) (f : R[T;T⁻¹]) : t n * f = f * t n :=
  (commute_t n f).Eq
#align laurent_polynomial.T_mul LaurentPolynomial.t_mul

/-- `trunc : R[T;T⁻¹] →+ R[X]` maps a Laurent polynomial `f` to the polynomial whose terms of
nonnegative degree coincide with the ones of `f`.  The terms of negative degree of `f` "vanish".
`trunc` is a left-inverse to `polynomial.to_laurent`. -/
def trunc : R[T;T⁻¹] →+ R[X] :=
  (toFinsuppIso R).symm.toAddMonoidHom.comp <| comapDomain.addMonoidHom fun a b => Int.ofNat.inj
#align laurent_polynomial.trunc LaurentPolynomial.trunc

@[simp]
theorem trunc_c_mul_t (n : ℤ) (r : R) : trunc (c r * t n) = ite (0 ≤ n) (monomial n.toNat r) 0 :=
  by
  apply (to_finsupp_iso R).Injective
  rw [← single_eq_C_mul_T, Trunc, AddMonoidHom.coe_comp, Function.comp_apply,
    comap_domain.add_monoid_hom_apply, to_finsupp_iso_apply]
  by_cases n0 : 0 ≤ n
  · lift n to ℕ using n0
    erw [comap_domain_single, to_finsupp_iso_symm_apply]
    simp only [Int.coe_nat_nonneg, Int.toNat_coe_nat, if_true, to_finsupp_iso_apply,
      to_finsupp_monomial]
  · lift -n to ℕ using (neg_pos.mpr (not_le.mp n0)).le with m
    rw [to_finsupp_iso_apply, to_finsupp_inj, if_neg n0]
    erw [to_finsupp_iso_symm_apply]
    ext a
    have := ((not_le.mp n0).trans_le (Int.ofNat_zero_le a)).ne'
    simp only [coeff, comap_domain_apply, Int.ofNat_eq_coe, coeff_zero, single_apply_eq_zero, this,
      IsEmpty.forall_iff]
#align laurent_polynomial.trunc_C_mul_T LaurentPolynomial.trunc_c_mul_t

@[simp]
theorem leftInverse_trunc_toLaurent :
    Function.LeftInverse (trunc : R[T;T⁻¹] → R[X]) Polynomial.toLaurent :=
  by
  refine' fun f => f.inductionOn' _ _
  · exact fun f g hf hg => by simp only [hf, hg, _root_.map_add]
  ·
    exact fun n r => by
      simp only [Polynomial.toLaurent_c_mul_t, trunc_C_mul_T, Int.coe_nat_nonneg, Int.toNat_coe_nat,
        if_true]
#align laurent_polynomial.left_inverse_trunc_to_laurent LaurentPolynomial.leftInverse_trunc_toLaurent

@[simp]
theorem Polynomial.trunc_toLaurent (f : R[X]) : trunc f.toLaurent = f :=
  leftInverse_trunc_toLaurent _
#align polynomial.trunc_to_laurent Polynomial.trunc_toLaurent

theorem Polynomial.toLaurent_injective :
    Function.Injective (Polynomial.toLaurent : R[X] → R[T;T⁻¹]) :=
  leftInverse_trunc_toLaurent.Injective
#align polynomial.to_laurent_injective Polynomial.toLaurent_injective

@[simp]
theorem Polynomial.toLaurent_inj (f g : R[X]) : f.toLaurent = g.toLaurent ↔ f = g :=
  ⟨fun h => Polynomial.toLaurent_injective h, congr_arg _⟩
#align polynomial.to_laurent_inj Polynomial.toLaurent_inj

theorem Polynomial.toLaurent_ne_zero {f : R[X]} : f ≠ 0 ↔ f.toLaurent ≠ 0 :=
  (map_ne_zero_iff _ Polynomial.toLaurent_injective).symm
#align polynomial.to_laurent_ne_zero Polynomial.toLaurent_ne_zero

theorem exists_t_pow (f : R[T;T⁻¹]) : ∃ (n : ℕ)(f' : R[X]), f'.toLaurent = f * t n :=
  by
  apply f.induction_on' _ fun n a => _ <;> clear f
  · rintro f g ⟨m, fn, hf⟩ ⟨n, gn, hg⟩
    refine' ⟨m + n, fn * X ^ n + gn * X ^ m, _⟩
    simp only [hf, hg, add_mul, add_comm (n : ℤ), map_add, map_mul, Polynomial.toLaurent_x_pow,
      mul_T_assoc, Int.ofNat_add]
  · cases' n with n n
    · exact ⟨0, Polynomial.C a * X ^ n, by simp⟩
    · refine' ⟨n + 1, Polynomial.C a, _⟩
      simp only [Int.negSucc_eq, Polynomial.toLaurent_c, Int.ofNat_succ, mul_T_assoc, add_left_neg,
        T_zero, mul_one]
#align laurent_polynomial.exists_T_pow LaurentPolynomial.exists_t_pow

/-- This is a version of `exists_T_pow` stated as an induction principle. -/
@[elab_as_elim]
theorem induction_on_mul_t {Q : R[T;T⁻¹] → Prop} (f : R[T;T⁻¹])
    (Qf : ∀ {f : R[X]} {n : ℕ}, Q (f.toLaurent * t (-n))) : Q f :=
  by
  rcases f.exists_T_pow with ⟨n, f', hf⟩
  rw [← mul_one f, ← T_zero, ← Nat.cast_zero, ← Nat.sub_self n, Nat.cast_sub rfl.le, T_sub, ←
    mul_assoc, ← hf]
  exact Qf
#align laurent_polynomial.induction_on_mul_T LaurentPolynomial.induction_on_mul_t

/-- Suppose that `Q` is a statement about Laurent polynomials such that
* `Q` is true on *ordinary* polynomials;
* `Q (f * T)` implies `Q f`;
it follow that `Q` is true on all Laurent polynomials. -/
theorem reduce_to_polynomial_of_mul_t (f : R[T;T⁻¹]) {Q : R[T;T⁻¹] → Prop}
    (Qf : ∀ f : R[X], Q f.toLaurent) (QT : ∀ f, Q (f * t 1) → Q f) : Q f :=
  by
  induction' f using LaurentPolynomial.induction_on_mul_t with f n
  induction' n with n hn
  · simpa only [Int.ofNat_zero, neg_zero, T_zero, mul_one] using Qf _
  · convert QT _ _
    simpa using hn
#align laurent_polynomial.reduce_to_polynomial_of_mul_T LaurentPolynomial.reduce_to_polynomial_of_mul_t

section Support

theorem support_c_mul_t (a : R) (n : ℤ) : (c a * t n).support ⊆ {n} := by
  simpa only [← single_eq_C_mul_T] using support_single_subset
#align laurent_polynomial.support_C_mul_T LaurentPolynomial.support_c_mul_t

theorem support_c_mul_t_of_ne_zero {a : R} (a0 : a ≠ 0) (n : ℤ) : (c a * t n).support = {n} :=
  by
  rw [← single_eq_C_mul_T]
  exact support_single_ne_zero _ a0
#align laurent_polynomial.support_C_mul_T_of_ne_zero LaurentPolynomial.support_c_mul_t_of_ne_zero

/-- The support of a polynomial `f` is a finset in `ℕ`.  The lemma `to_laurent_support f`
shows that the support of `f.to_laurent` is the same finset, but viewed in `ℤ` under the natural
inclusion `ℕ ↪ ℤ`. -/
theorem toLaurent_support (f : R[X]) : f.toLaurent.support = f.support.map Nat.castEmbedding :=
  by
  generalize hd : f.support = s
  revert f
  refine' Finset.induction_on s _ _ <;> clear s
  ·
    simp (config := { contextual := true }) only [Polynomial.support_eq_empty, map_zero,
      Finsupp.support_zero, eq_self_iff_true, imp_true_iff, Finset.map_empty]
  · intro a s as hf f fs
    have : (erase a f).toLaurent.support = s.map Nat.castEmbedding :=
      hf (f.erase a)
        (by
          simp only [fs, Finset.erase_eq_of_not_mem as, Polynomial.support_erase,
            Finset.erase_insert_eq_erase])
    rw [← monomial_add_erase f a, Finset.map_insert, ← this, map_add, Polynomial.toLaurent_c_mul_t,
      support_add_eq, Finset.insert_eq]
    · congr
      exact support_C_mul_T_of_ne_zero (polynomial.mem_support_iff.mp (by simp [fs])) _
    · rw [this]
      exact Disjoint.mono_left (support_C_mul_T _ _) (by simpa)
#align laurent_polynomial.to_laurent_support LaurentPolynomial.toLaurent_support

end Support

section Degrees

/-- The degree of a Laurent polynomial takes values in `with_bot ℤ`.
If `f : R[T;T⁻¹]` is a Laurent polynomial, then `f.degree` is the maximum of its support of `f`,
or `⊥`, if `f = 0`. -/
def degree (f : R[T;T⁻¹]) : WithBot ℤ :=
  f.support.max
#align laurent_polynomial.degree LaurentPolynomial.degree

@[simp]
theorem degree_zero : degree (0 : R[T;T⁻¹]) = ⊥ :=
  rfl
#align laurent_polynomial.degree_zero LaurentPolynomial.degree_zero

@[simp]
theorem degree_eq_bot_iff {f : R[T;T⁻¹]} : f.degree = ⊥ ↔ f = 0 :=
  by
  refine' ⟨fun h => _, fun h => by rw [h, degree_zero]⟩
  rw [degree, Finset.max_eq_sup_withBot] at h
  ext n
  refine' not_not.mp fun f0 => _
  simp_rw [Finset.sup_eq_bot_iff, Finsupp.mem_support_iff, Ne.def, WithBot.coe_ne_bot] at h
  exact h n f0
#align laurent_polynomial.degree_eq_bot_iff LaurentPolynomial.degree_eq_bot_iff

section ExactDegrees

open Classical

@[simp]
theorem degree_c_mul_t (n : ℤ) (a : R) (a0 : a ≠ 0) : (c a * t n).degree = n :=
  by
  rw [degree]
  convert Finset.max_singleton
  refine' support_eq_singleton.mpr _
  simp only [← single_eq_C_mul_T, single_eq_same, a0, Ne.def, not_false_iff, eq_self_iff_true,
    and_self_iff]
#align laurent_polynomial.degree_C_mul_T LaurentPolynomial.degree_c_mul_t

theorem degree_c_mul_t_ite (n : ℤ) (a : R) : (c a * t n).degree = ite (a = 0) ⊥ n := by
  split_ifs with h h <;>
    simp only [h, map_zero, MulZeroClass.zero_mul, degree_zero, degree_C_mul_T, Ne.def,
      not_false_iff]
#align laurent_polynomial.degree_C_mul_T_ite LaurentPolynomial.degree_c_mul_t_ite

@[simp]
theorem degree_t [Nontrivial R] (n : ℤ) : (t n : R[T;T⁻¹]).degree = n :=
  by
  rw [← one_mul (T n), ← map_one C]
  exact degree_C_mul_T n 1 (one_ne_zero : (1 : R) ≠ 0)
#align laurent_polynomial.degree_T LaurentPolynomial.degree_t

theorem degree_c {a : R} (a0 : a ≠ 0) : (c a).degree = 0 :=
  by
  rw [← mul_one (C a), ← T_zero]
  exact degree_C_mul_T 0 a a0
#align laurent_polynomial.degree_C LaurentPolynomial.degree_c

theorem degree_c_ite (a : R) : (c a).degree = ite (a = 0) ⊥ 0 := by
  split_ifs with h h <;> simp only [h, map_zero, degree_zero, degree_C, Ne.def, not_false_iff]
#align laurent_polynomial.degree_C_ite LaurentPolynomial.degree_c_ite

end ExactDegrees

section DegreeBounds

theorem degree_c_mul_t_le (n : ℤ) (a : R) : (c a * t n).degree ≤ n :=
  by
  by_cases a0 : a = 0
  · simp only [a0, map_zero, MulZeroClass.zero_mul, degree_zero, bot_le]
  · exact (degree_C_mul_T n a a0).le
#align laurent_polynomial.degree_C_mul_T_le LaurentPolynomial.degree_c_mul_t_le

theorem degree_t_le (n : ℤ) : (t n : R[T;T⁻¹]).degree ≤ n :=
  (le_of_eq (by rw [map_one, one_mul])).trans (degree_c_mul_t_le n (1 : R))
#align laurent_polynomial.degree_T_le LaurentPolynomial.degree_t_le

theorem degree_c_le (a : R) : (c a).degree ≤ 0 :=
  (le_of_eq (by rw [T_zero, mul_one])).trans (degree_c_mul_t_le 0 a)
#align laurent_polynomial.degree_C_le LaurentPolynomial.degree_c_le

end DegreeBounds

end Degrees

instance : Module R[X] R[T;T⁻¹] :=
  Module.compHom _ Polynomial.toLaurent

instance (R : Type _) [Semiring R] : IsScalarTower R[X] R[X] R[T;T⁻¹]
    where smul_assoc x y z := by simp only [SMul.smul, SMul.comp.smul, map_mul, mul_assoc]

end Semiring

section CommSemiring

variable [CommSemiring R]

instance algebraPolynomial (R : Type _) [CommSemiring R] : Algebra R[X] R[T;T⁻¹] :=
  { Polynomial.toLaurent with
    commutes' := fun f l => by simp [mul_comm]
    smul_def' := fun f l => rfl }
#align laurent_polynomial.algebra_polynomial LaurentPolynomial.algebraPolynomial

theorem algebraMap_x_pow (n : ℕ) : algebraMap R[X] R[T;T⁻¹] (X ^ n) = t n :=
  Polynomial.toLaurent_x_pow n
#align laurent_polynomial.algebra_map_X_pow LaurentPolynomial.algebraMap_x_pow

@[simp]
theorem algebraMap_eq_toLaurent (f : R[X]) : algebraMap R[X] R[T;T⁻¹] f = f.toLaurent :=
  rfl
#align laurent_polynomial.algebra_map_eq_to_laurent LaurentPolynomial.algebraMap_eq_toLaurent

theorem isLocalization : IsLocalization (Submonoid.closure ({X} : Set R[X])) R[T;T⁻¹] :=
  { map_units := fun t => by
      cases' t with t ht
      rcases submonoid.mem_closure_singleton.mp ht with ⟨n, rfl⟩
      simp only [is_unit_T n, [anonymous], algebra_map_eq_to_laurent, Polynomial.toLaurent_x_pow]
    surj := fun f =>
      by
      induction' f using LaurentPolynomial.induction_on_mul_t with f n
      have := (Submonoid.closure ({X} : Set R[X])).pow_mem Submonoid.mem_closure_singleton_self n
      refine' ⟨(f, ⟨_, this⟩), _⟩
      simp only [[anonymous], algebra_map_eq_to_laurent, Polynomial.toLaurent_x_pow, mul_T_assoc,
        add_left_neg, T_zero, mul_one]
    eq_iff_exists := fun f g =>
      by
      rw [algebra_map_eq_to_laurent, algebra_map_eq_to_laurent, Polynomial.toLaurent_inj]
      refine' ⟨_, _⟩
      · rintro rfl
        exact ⟨1, rfl⟩
      · rintro ⟨⟨h, hX⟩, h⟩
        rcases submonoid.mem_closure_singleton.mp hX with ⟨n, rfl⟩
        exact mul_X_pow_injective n h }
#align laurent_polynomial.is_localization LaurentPolynomial.isLocalization

end CommSemiring

end LaurentPolynomial


import tactic

namespace vilnius

/- ### implication -/

example (P Q : Prop) : P → Q → P :=
begin
  intro hP,
  intro h,
  exact hP,
end

/- ### not -/

example (P Q : Prop) : (P → ¬ Q) → (Q → ¬ P) :=
begin
  intros h1 h2 h3,
  apply h1,
  exact h3,
  exact h2,
end

/- ### and -/

example (P Q : Prop) : P ∧ Q → Q :=
begin
  intro h,
  cases h,
  exact h_right,
end

example (P Q : Prop) : P → Q → P ∧ Q :=
begin
  intros h1 h2,
  split,
  exact h1,
  exact h2,
end

example (P Q : Prop) : P ∧ Q → Q ∧ P :=
begin
  intro h,
  split,
  cases h,
  exact h_right,
  cases h,
  exact h_left,
end

example (P : Prop) : P ∧ ¬ P → false :=
begin
  intro h,
  cases h,
  apply h_right,
  exact h_left,
end

/- ## Or -/

example (P Q : Prop) : ¬ P ∨ Q → P → Q :=
begin
  intros h1 h2,
  cases h1,
  by_contradiction,
  apply h1,
  exact h2,
  exact h1,
end

example (P Q R : Prop) : P ∨ (Q ∧ R) → ¬ P → ¬ Q → false :=
begin
  intros h1 h2 h3,
  cases h1,
  apply h2,
  exact h1,
  cases h1,
  apply h3,
  exact h1_left,
end

end vilnius


import Math.Data.Function
import Math.Order.Basic

open Order

namespace SetTheory

/-- The type of sets of terms of type `α`. -/
def Set (α : Type u) := α → Prop

class Inter (α : Type u) where
  inter : α → α → α

infixr:80 " ∩ " => Inter.inter

class Union (α : Type u) where
  union : α → α → α

infixr:60 " ∪ " => Union.union

class Subset (α : Type u) where
  subset : α → α → Prop

infixl:51 " ⊆ " => Subset.subset

instance (α : Type u) : Membership α (Set α) where
  mem x A := A x

namespace Set

/-- The empty set. -/
def empty (α : Type u) : Set α := λ _ => False

/-- The set containing all  -/
def univ (α : Type u) : Set α := λ _ => True

/-- The set containing only `x`. -/
def singleton (x : α) := λ y => y = x

/-- The complement of `A`. -/
def compl (A : Set α) : Set α := λ x => ¬ A x

/-- The intersection of `A` and `B`. -/
def inter (A B : Set α) : Set α := λ x => A x ∧ B x

/-- The union of `A` and `B`. -/
def union (A B : Set α) : Set α := λ x => A x ∨ B x

/-- The difference of `A` and `B`. -/
def diff (A B : Set α) : Set α := λ x => A x ∨ ¬ B x

/-- The proposition `A ⊆ B`. -/
def subset (A B : Set α) := ∀ {x}, A x → B x

/-- The powerset of `A`. -/
def powerset (A : Set α) : Set (Set α) := λ B => A.subset B

/-- The union of a set of sets. -/
def set_union (A : Set (Set α)) : Set α := λ x => ∃ B, B ∈ A ∧ x ∈ B

instance : Inter (Set α) where inter := inter
instance : Union (Set α) where union := union
instance : Compl (Set α) where compl := compl
instance (α : Type u) : EmptyCollection (Set α) where emptyCollection := empty α
instance : Subset (Set α) where subset := subset

theorem ext {A B : Set α} (h : ∀ x, x ∈ A ↔ x ∈ B) : A = B :=
  funext (λ x => propext (h x))

@[simp]
theorem compl_union (A B : Set α) : (A ∪ B)ᶜ = Aᶜ ∩ Bᶜ := by {
  apply ext;
  intro x;
  constructor;
  exact λ hx => ⟨λ ha => hx (Or.inl ha), λ hb => hx (Or.inr hb)⟩;
  intro hx hab;
  cases hab with
  | inl hab => apply hx.1 hab;
  | inr hab => apply hx.2 hab;
}

@[simp]
theorem compl_inter (A B : Set α) : (A ∩ B)ᶜ = Aᶜ ∪ Bᶜ := by {
  apply ext;
  intro x;
  constructor;
  intro hx;
  by_cases A x;
  exact Or.inr $ λ bx => hx ⟨by assumption, bx⟩;
  exact Or.inl $ by assumption;
  intro hx hab;
  cases hx with
  | inl hx => exact hx hab.1;
  | inr hx => exact hx hab.2;
}

@[simp]
theorem compl_univ : (univ α)ᶜ = ∅ := by {
  apply ext;
  intro x;
  constructor;
  intro h;
  apply h;
  trivial;
  intro h;
  intro _;
  exact h;
}

@[simp]
theorem compl_empty : ∅ᶜ = univ α := by {
  apply Set.ext;
  intro x;
  constructor;
  intro _;
  trivial;
  intro _;
  exact id;
}

theorem cantor (f : α → Set α) : ¬ Function.surjective f := by {
  intro hf;
  let S : Set α := λ x => x ∉ f x;
  cases hf S with
  | intro x hx => {
    by_cases h : x ∈ f x;
    -- Case x ∈ f x
    have q := h;
    rw [hx] at q;
    exact q h;
    -- Case x ∉ f x
    have q := h;
    rw [hx] at h;
    exact h q;
  }
}

def subset_self (A : Set α) : A ⊆ A := id

def subset_asymm {A B : Set α} : A ⊆ B → B ⊆ A → A = B := λ h₁ h₂ => ext (λ _ => ⟨h₁, h₂⟩)

def subset_trans {A B C : Set α} : A ⊆ B → B ⊆ C → A ⊆ C := λ h₁ h₂ => λ hx => h₂ (h₁ hx)

def subset_union_left (A B : Set α) : A ⊆ A ∪ B := Or.inl

def subset_union_right (A B : Set α) : B ⊆ A ∪ B := Or.inr

def union_subset {A B C : Set α} : A ⊆ C → B ⊆ C → A ∪ B ⊆ C := λ h₁ h₂ x hx => by {
  cases hx;
  apply h₁; assumption;
  apply h₂; assumption;
}

def inter_subset_left (A B : Set α) : A ∩ B ⊆ A := And.left

def inter_subset_right (A B : Set α) : A ∩ B ⊆ B := And.right

def subset_inter {A B C : Set α} : A ⊆ B → A ⊆ C → A ⊆ B ∩ C := λ h₁ h₂ _ hx => ⟨h₁ hx, h₂ hx⟩

end Set

end SetTheory