/-
Copyright (c) 2015 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Robert Y. Lewis
-/
import algebra.order.ring.abs
import algebra.order.with_zero
import algebra.group_power.ring
import data.set.intervals.basic

/-!
# Lemmas about the interaction of power operations with order

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

Note that some lemmas are in `algebra/group_power/lemmas.lean` as they import files which
depend on this file.
-/

open function

variables {β A G M R : Type*}

section monoid
variable [monoid M]

section preorder
variable [preorder M]

section left
variables [covariant_class M M (*) (≤)] {x : M}

@[to_additive nsmul_le_nsmul_of_le_right, mono]
lemma pow_le_pow_of_le_left' [covariant_class M M (swap (*)) (≤)] {a b : M} (hab : a ≤ b) :
  ∀ i : ℕ, a ^ i ≤ b ^ i
| 0     := by simp
| (k+1) := by { rw [pow_succ, pow_succ],
    exact mul_le_mul' hab (pow_le_pow_of_le_left' k) }

attribute [mono] nsmul_le_nsmul_of_le_right

@[to_additive nsmul_nonneg]
theorem one_le_pow_of_one_le' {a : M} (H : 1 ≤ a) : ∀ n : ℕ, 1 ≤ a ^ n
| 0       := by simp
| (k + 1) := by { rw pow_succ, exact one_le_mul H (one_le_pow_of_one_le' k) }

@[to_additive nsmul_nonpos]
lemma pow_le_one' {a : M} (H : a ≤ 1) (n : ℕ) : a ^ n ≤ 1 := @one_le_pow_of_one_le' Mᵒᵈ _ _ _ _ H n

@[to_additive nsmul_le_nsmul]
theorem pow_le_pow' {a : M} {n m : ℕ} (ha : 1 ≤ a) (h : n ≤ m) : a ^ n ≤ a ^ m :=
let ⟨k, hk⟩ := nat.le.dest h in
calc a ^ n ≤ a ^ n * a ^ k : le_mul_of_one_le_right' (one_le_pow_of_one_le' ha _)
       ... = a ^ m         : by rw [← hk, pow_add]

@[to_additive nsmul_le_nsmul_of_nonpos]
theorem pow_le_pow_of_le_one' {a : M} {n m : ℕ} (ha : a ≤ 1) (h : n ≤ m) : a ^ m ≤ a ^ n :=
@pow_le_pow' Mᵒᵈ _ _ _ _ _ _  ha h

@[to_additive nsmul_pos]
theorem one_lt_pow' {a : M} (ha : 1 < a) {k : ℕ} (hk : k ≠ 0) : 1 < a ^ k :=
begin
  rcases nat.exists_eq_succ_of_ne_zero hk with ⟨l, rfl⟩,
  clear hk,
  induction l with l IH,
  { simpa using ha },
  { rw pow_succ,
    exact one_lt_mul'' ha IH }
end

@[to_additive nsmul_neg]
lemma pow_lt_one' {a : M} (ha : a < 1) {k : ℕ} (hk : k ≠ 0) : a ^ k < 1 :=
@one_lt_pow' Mᵒᵈ _ _ _ _ ha k hk

@[to_additive nsmul_lt_nsmul]
theorem pow_lt_pow' [covariant_class M M (*) (<)] {a : M} {n m : ℕ} (ha : 1 < a) (h : n < m) :
  a ^ n < a ^ m :=
begin
  rcases nat.le.dest h with ⟨k, rfl⟩, clear h,
  rw [pow_add, pow_succ', mul_assoc, ← pow_succ],
  exact lt_mul_of_one_lt_right' _ (one_lt_pow' ha k.succ_ne_zero)
end

@[to_additive nsmul_strict_mono_right]
lemma pow_strict_mono_left [covariant_class M M (*) (<)] {a : M} (ha : 1 < a) :
  strict_mono ((^) a : ℕ → M) :=
λ m n, pow_lt_pow' ha

@[to_additive left.pow_nonneg]
lemma left.one_le_pow_of_le (hx : 1 ≤ x) : ∀ {n : ℕ}, 1 ≤ x^n
| 0       := (pow_zero x).ge
| (n + 1) := by { rw pow_succ, exact left.one_le_mul hx left.one_le_pow_of_le }

@[to_additive left.pow_nonpos]
lemma left.pow_le_one_of_le (hx : x ≤ 1) : ∀ {n : ℕ}, x^n ≤ 1
| 0       := (pow_zero _).le
| (n + 1) := by { rw pow_succ, exact left.mul_le_one hx left.pow_le_one_of_le }

end left

section right
variables [covariant_class M M (swap (*)) (≤)] {x : M}

@[to_additive right.pow_nonneg]
lemma right.one_le_pow_of_le (hx : 1 ≤ x) : ∀ {n : ℕ}, 1 ≤ x^n
| 0       := (pow_zero _).ge
| (n + 1) := by { rw pow_succ, exact right.one_le_mul hx right.one_le_pow_of_le }

@[to_additive right.pow_nonpos]
lemma right.pow_le_one_of_le (hx : x ≤ 1) : ∀ {n : ℕ}, x^n ≤ 1
| 0       := (pow_zero _).le
| (n + 1) := by { rw pow_succ, exact right.mul_le_one hx right.pow_le_one_of_le }

end right

section covariant_lt_swap
variables [preorder β] [covariant_class M M (*) (<)] [covariant_class M M (swap (*)) (<)]
  {f : β → M}

@[to_additive strict_mono.nsmul_left]
lemma strict_mono.pow_right' (hf : strict_mono f) : ∀ {n : ℕ}, n ≠ 0 → strict_mono (λ a, f a ^ n)
| 0 hn := (hn rfl).elim
| 1 hn := by simpa
| (nat.succ $ nat.succ n) hn :=
  by { simp_rw pow_succ _ (n + 1), exact hf.mul' (strict_mono.pow_right' n.succ_ne_zero) }

/-- See also `pow_strict_mono_right` -/
@[nolint to_additive_doc, to_additive nsmul_strict_mono_left]
lemma pow_strict_mono_right' {n : ℕ} (hn : n ≠ 0) : strict_mono (λ a : M, a ^ n) :=
strict_mono_id.pow_right' hn

end covariant_lt_swap

section covariant_le_swap
variables [preorder β] [covariant_class M M (*) (≤)] [covariant_class M M (swap (*)) (≤)]

@[to_additive monotone.nsmul_left]
lemma monotone.pow_right {f : β → M} (hf : monotone f) : ∀ n : ℕ, monotone (λ a, f a ^ n)
| 0 := by simpa using monotone_const
| (n + 1) := by { simp_rw pow_succ, exact hf.mul' (monotone.pow_right _) }

@[to_additive nsmul_mono_left]
lemma pow_mono_right (n : ℕ) : monotone (λ a : M, a ^ n) := monotone_id.pow_right _

end covariant_le_swap

@[to_additive left.pow_neg]
lemma left.pow_lt_one_of_lt [covariant_class M M (*) (<)] {n : ℕ} {x : M} (hn : 0 < n) (h : x < 1) :
  x^n < 1 :=
nat.le_induction ((pow_one _).trans_lt h) (λ n _ ih, by { rw pow_succ, exact mul_lt_one h ih }) _
  (nat.succ_le_iff.2 hn)

@[to_additive right.pow_neg]
lemma right.pow_lt_one_of_lt [covariant_class M M (swap (*)) (<)] {n : ℕ} {x : M}
  (hn : 0 < n) (h : x < 1) :
  x^n < 1 :=
nat.le_induction ((pow_one _).trans_lt h)
  (λ n _ ih, by { rw pow_succ, exact right.mul_lt_one h ih }) _ (nat.succ_le_iff.2 hn)

end preorder

section linear_order
variables [linear_order M]

section covariant_le
variables [covariant_class M M (*) (≤)]

@[to_additive nsmul_nonneg_iff]
lemma one_le_pow_iff {x : M} {n : ℕ} (hn : n ≠ 0) : 1 ≤ x ^ n ↔ 1 ≤ x :=
⟨le_imp_le_of_lt_imp_lt $ λ h, pow_lt_one' h hn, λ h, one_le_pow_of_one_le' h n⟩

@[to_additive]
lemma pow_le_one_iff {x : M} {n : ℕ} (hn : n ≠ 0) : x ^ n ≤ 1 ↔ x ≤ 1 :=
@one_le_pow_iff Mᵒᵈ _ _ _ _ _ hn

@[to_additive nsmul_pos_iff]
lemma one_lt_pow_iff {x : M} {n : ℕ} (hn : n ≠ 0) : 1 < x ^ n ↔ 1 < x :=
lt_iff_lt_of_le_iff_le (pow_le_one_iff hn)

@[to_additive]
lemma pow_lt_one_iff {x : M} {n : ℕ} (hn : n ≠ 0) : x ^ n < 1 ↔ x < 1 :=
lt_iff_lt_of_le_iff_le (one_le_pow_iff hn)

@[to_additive]
lemma pow_eq_one_iff {x : M} {n : ℕ} (hn : n ≠ 0) : x ^ n = 1 ↔ x = 1 :=
by simp only [le_antisymm_iff, pow_le_one_iff hn, one_le_pow_iff hn]

variables [covariant_class M M (*) (<)] {a : M} {m n : ℕ}

@[to_additive nsmul_le_nsmul_iff]
lemma pow_le_pow_iff' (ha : 1 < a) : a ^ m ≤ a ^ n ↔ m ≤ n := (pow_strict_mono_left ha).le_iff_le

@[to_additive nsmul_lt_nsmul_iff]
lemma pow_lt_pow_iff' (ha : 1 < a) : a ^ m < a ^ n ↔ m < n := (pow_strict_mono_left ha).lt_iff_lt

end covariant_le

section covariant_le_swap
variables [covariant_class M M (*) (≤)] [covariant_class M M (swap (*)) (≤)]

@[to_additive lt_of_nsmul_lt_nsmul]
lemma lt_of_pow_lt_pow'  {a b : M} (n : ℕ) : a ^ n < b ^ n → a < b := (pow_mono_right _).reflect_lt

@[to_additive]
lemma min_lt_max_of_mul_lt_mul {a b c d : M} (h : a * b < c * d) : min a b < max c d :=
lt_of_pow_lt_pow' 2 $ by { simp_rw pow_two, exact (mul_le_mul' inf_le_left
  inf_le_right).trans_lt (h.trans_le $ mul_le_mul' le_sup_left le_sup_right) }

@[to_additive min_lt_of_add_lt_two_nsmul]
lemma min_lt_of_mul_lt_sq {a b c : M} (h : a * b < c ^ 2) : min a b < c :=
by simpa using min_lt_max_of_mul_lt_mul (h.trans_eq $ pow_two _)

@[to_additive lt_max_of_two_nsmul_lt_add]
lemma lt_max_of_sq_lt_mul {a b c : M} (h : a ^ 2 < b * c) : a < max b c :=
by simpa using min_lt_max_of_mul_lt_mul ((pow_two _).symm.trans_lt h)

end covariant_le_swap

section covariant_lt_swap
variables [covariant_class M M (*) (<)] [covariant_class M M (swap (*)) (<)]

@[to_additive le_of_nsmul_le_nsmul]
lemma le_of_pow_le_pow' {a b : M} {n : ℕ} (hn : n ≠ 0) : a ^ n ≤ b ^ n → a ≤ b :=
(pow_strict_mono_right' hn).le_iff_le.1

@[to_additive min_le_of_add_le_two_nsmul]
lemma min_le_of_mul_le_sq {a b c : M} (h : a * b ≤ c ^ 2) : min a b ≤ c :=
by simpa using min_le_max_of_mul_le_mul (h.trans_eq $ pow_two _)

@[to_additive le_max_of_two_nsmul_le_add]
lemma le_max_of_sq_le_mul {a b c : M} (h : a ^ 2 ≤ b * c) : a ≤ max b c :=
by simpa using min_le_max_of_mul_le_mul ((pow_two _).symm.trans_le h)

end covariant_lt_swap

@[to_additive left.nsmul_neg_iff]
lemma left.pow_lt_one_iff [covariant_class M M (*) (<)] {n : ℕ} {x : M} (hn : 0 < n) :
  x^n < 1 ↔ x < 1 :=
by { haveI := has_mul.to_covariant_class_left M, exact pow_lt_one_iff hn.ne' }

@[to_additive right.nsmul_neg_iff]
lemma right.pow_lt_one_iff [covariant_class M M (swap (*)) (<)] {n : ℕ} {x : M} (hn : 0 < n) :
  x^n < 1 ↔ x < 1 :=
⟨λ H, not_le.mp $ λ k, H.not_le $ by { haveI := has_mul.to_covariant_class_right M,
    exact right.one_le_pow_of_le k }, right.pow_lt_one_of_lt hn⟩

end linear_order
end monoid

section div_inv_monoid

variables [div_inv_monoid G] [preorder G] [covariant_class G G (*) (≤)]

@[to_additive zsmul_nonneg]
theorem one_le_zpow {x : G} (H : 1 ≤ x) {n : ℤ} (hn : 0 ≤ n) :
  1 ≤ x ^ n :=
begin
  lift n to ℕ using hn,
  rw zpow_coe_nat,
  apply one_le_pow_of_one_le' H,
end

end div_inv_monoid

namespace canonically_ordered_comm_semiring

variables [canonically_ordered_comm_semiring R]

theorem pow_pos {a : R} (H : 0 < a) (n : ℕ) : 0 < a ^ n :=
pos_iff_ne_zero.2 $ pow_ne_zero _ H.ne'

end canonically_ordered_comm_semiring

section ordered_semiring
variables [ordered_semiring R] {a x y : R} {n m : ℕ}

lemma zero_pow_le_one : ∀ n : ℕ, (0 : R) ^ n ≤ 1
| 0 := (pow_zero _).le
| (n + 1) := by { rw [zero_pow n.succ_pos], exact zero_le_one }

theorem pow_add_pow_le (hx : 0 ≤ x) (hy : 0 ≤ y) (hn : n ≠ 0) : x ^ n + y ^ n ≤ (x + y) ^ n :=
begin
  rcases nat.exists_eq_succ_of_ne_zero hn with ⟨k, rfl⟩,
  induction k with k ih, { simp only [pow_one] },
  let n := k.succ,
  have h1 := add_nonneg (mul_nonneg hx (pow_nonneg hy n)) (mul_nonneg hy (pow_nonneg hx n)),
  have h2 := add_nonneg hx hy,
  calc x^n.succ + y^n.succ
    ≤ x*x^n + y*y^n + (x*y^n + y*x^n) :
      by { rw [pow_succ _ n, pow_succ _ n], exact le_add_of_nonneg_right h1 }
    ... = (x+y) * (x^n + y^n) :
      by rw [add_mul, mul_add, mul_add, add_comm (y*x^n), ← add_assoc,
        ← add_assoc, add_assoc (x*x^n) (x*y^n), add_comm (x*y^n) (y*y^n), ← add_assoc]
    ... ≤ (x+y)^n.succ :
      by { rw [pow_succ _ n], exact mul_le_mul_of_nonneg_left (ih (nat.succ_ne_zero k)) h2 }
end

lemma pow_le_one : ∀ (n : ℕ) (h₀ : 0 ≤ a) (h₁ : a ≤ 1), a ^ n ≤ 1
| 0       h₀ h₁ := (pow_zero a).le
| (n + 1) h₀ h₁ := (pow_succ' a n).le.trans (mul_le_one (pow_le_one n h₀ h₁) h₀ h₁)

lemma pow_lt_one (h₀ : 0 ≤ a) (h₁ : a < 1) : ∀ {n : ℕ} (hn : n ≠ 0), a ^ n < 1
| 0 h := (h rfl).elim
| (n + 1) h :=
  by { rw pow_succ, exact mul_lt_one_of_nonneg_of_lt_one_left h₀ h₁ (pow_le_one _ h₀ h₁.le) }

theorem one_le_pow_of_one_le (H : 1 ≤ a) : ∀ (n : ℕ), 1 ≤ a ^ n
| 0     := by rw [pow_zero]
| (n+1) := by { rw pow_succ, simpa only [mul_one] using mul_le_mul H (one_le_pow_of_one_le n)
    zero_le_one (le_trans zero_le_one H) }

lemma pow_mono (h : 1 ≤ a) : monotone (λ n : ℕ, a ^ n) :=
monotone_nat_of_le_succ $ λ n,
  by { rw pow_succ, exact le_mul_of_one_le_left (pow_nonneg (zero_le_one.trans h) _) h }

theorem pow_le_pow (ha : 1 ≤ a) (h : n ≤ m) : a ^ n ≤ a ^ m :=
pow_mono ha h

theorem le_self_pow (ha : 1 ≤ a) (h : m ≠ 0) : a ≤ a ^ m :=
(pow_one a).symm.trans_le (pow_le_pow ha $ pos_iff_ne_zero.mpr h)

@[mono] lemma pow_le_pow_of_le_left {a b : R} (ha : 0 ≤ a) (hab : a ≤ b) : ∀ i : ℕ, a^i ≤ b^i
| 0     := by simp
| (k+1) := by { rw [pow_succ, pow_succ],
    exact mul_le_mul hab (pow_le_pow_of_le_left _) (pow_nonneg ha _) (le_trans ha hab) }

lemma one_lt_pow (ha : 1 < a) : ∀ {n : ℕ} (hn : n ≠ 0), 1 < a ^ n
| 0 h := (h rfl).elim
| (n + 1) h :=
  by { rw pow_succ, exact one_lt_mul_of_lt_of_le ha (one_le_pow_of_one_le ha.le _) }

end ordered_semiring

section strict_ordered_semiring
variables [strict_ordered_semiring R] {a x y : R} {n m : ℕ}

lemma pow_lt_pow_of_lt_left (h : x < y) (hx : 0 ≤ x) : ∀ {n : ℕ}, 0 < n → x ^ n < y ^ n
| 0 hn := hn.false.elim
| (n + 1) _ := by simpa only [pow_succ'] using
    mul_lt_mul_of_le_of_le' (pow_le_pow_of_le_left hx h.le _) h (pow_pos (hx.trans_lt h) _) hx

lemma strict_mono_on_pow (hn : 0 < n) : strict_mono_on (λ x : R, x ^ n) (set.Ici 0) :=
λ x hx y hy h, pow_lt_pow_of_lt_left h hx hn

lemma pow_strict_mono_right (h : 1 < a) : strict_mono (λ n : ℕ, a ^ n) :=
have 0 < a := zero_le_one.trans_lt h,
strict_mono_nat_of_lt_succ $ λ n, by simpa only [one_mul, pow_succ]
  using mul_lt_mul h (le_refl (a ^ n)) (pow_pos this _) this.le

lemma pow_lt_pow (h : 1 < a) (h2 : n < m) : a ^ n < a ^ m :=
pow_strict_mono_right h h2

lemma pow_lt_pow_iff (h : 1 < a) : a ^ n < a ^ m ↔ n < m :=
(pow_strict_mono_right h).lt_iff_lt

lemma pow_le_pow_iff (h : 1 < a) : a ^ n ≤ a ^ m ↔ n ≤ m :=
(pow_strict_mono_right h).le_iff_le

lemma strict_anti_pow (h₀ : 0 < a) (h₁ : a < 1) : strict_anti (λ n : ℕ, a ^ n) :=
strict_anti_nat_of_succ_lt $ λ n,
  by simpa only [pow_succ, one_mul] using mul_lt_mul h₁ le_rfl (pow_pos h₀ n) zero_le_one

lemma pow_lt_pow_iff_of_lt_one (h₀ : 0 < a) (h₁ : a < 1) : a ^ m < a ^ n ↔ n < m :=
(strict_anti_pow h₀ h₁).lt_iff_lt

lemma pow_lt_pow_of_lt_one (h : 0 < a) (ha : a < 1) {i j : ℕ} (hij : i < j) : a ^ j < a ^ i :=
(pow_lt_pow_iff_of_lt_one h ha).2 hij

lemma pow_lt_self_of_lt_one (h₀ : 0 < a) (h₁ : a < 1) (hn : 1 < n) : a ^ n < a :=
calc a ^ n < a ^ 1 : pow_lt_pow_of_lt_one h₀ h₁ hn
... = a : pow_one _

lemma sq_pos_of_pos (ha : 0 < a) : 0 < a ^ 2 := by { rw sq, exact mul_pos ha ha }

end strict_ordered_semiring

section strict_ordered_ring
variables [strict_ordered_ring R] {a : R}

lemma pow_bit0_pos_of_neg (ha : a < 0) (n : ℕ) : 0 < a ^ bit0 n :=
begin
  rw pow_bit0',
  exact pow_pos (mul_pos_of_neg_of_neg ha ha) _,
end

lemma pow_bit1_neg (ha : a < 0) (n : ℕ) : a ^ bit1 n < 0 :=
begin
  rw [bit1, pow_succ],
  exact mul_neg_of_neg_of_pos ha (pow_bit0_pos_of_neg ha n),
end

lemma sq_pos_of_neg (ha : a < 0) : 0 < a ^ 2 := pow_bit0_pos_of_neg ha _

end strict_ordered_ring

section linear_ordered_semiring
variables [linear_ordered_semiring R] {a b : R}

lemma pow_le_one_iff_of_nonneg {a : R} (ha : 0 ≤ a) {n : ℕ} (hn : n ≠ 0) : a ^ n ≤ 1 ↔ a ≤ 1 :=
begin
  refine ⟨_, pow_le_one n ha⟩,
  rw [←not_lt, ←not_lt],
  exact mt (λ h, one_lt_pow h hn),
end

lemma one_le_pow_iff_of_nonneg {a : R} (ha : 0 ≤ a) {n : ℕ} (hn : n ≠ 0) : 1 ≤ a ^ n ↔ 1 ≤ a :=
begin
  refine ⟨_, λ h, one_le_pow_of_one_le h n⟩,
  rw [←not_lt, ←not_lt],
  exact mt (λ h, pow_lt_one ha h hn),
end

lemma one_lt_pow_iff_of_nonneg {a : R} (ha : 0 ≤ a) {n : ℕ} (hn : n ≠ 0) : 1 < a ^ n ↔ 1 < a :=
lt_iff_lt_of_le_iff_le (pow_le_one_iff_of_nonneg ha hn)

lemma pow_lt_one_iff_of_nonneg {a : R} (ha : 0 ≤ a) {n : ℕ} (hn : n ≠ 0) : a ^ n < 1 ↔ a < 1 :=
lt_iff_lt_of_le_iff_le (one_le_pow_iff_of_nonneg ha hn)

lemma sq_le_one_iff {a : R} (ha : 0 ≤ a) : a^2 ≤ 1 ↔ a ≤ 1 :=
pow_le_one_iff_of_nonneg ha (nat.succ_ne_zero _)

lemma sq_lt_one_iff {a : R} (ha : 0 ≤ a) : a^2 < 1 ↔ a < 1 :=
pow_lt_one_iff_of_nonneg ha (nat.succ_ne_zero _)

lemma one_le_sq_iff {a : R} (ha : 0 ≤ a) : 1 ≤ a^2 ↔ 1 ≤ a :=
one_le_pow_iff_of_nonneg ha (nat.succ_ne_zero _)

lemma one_lt_sq_iff {a : R} (ha : 0 ≤ a) : 1 < a^2 ↔ 1 < a :=
one_lt_pow_iff_of_nonneg ha (nat.succ_ne_zero _)

@[simp] theorem pow_left_inj {x y : R} {n : ℕ} (Hxpos : 0 ≤ x) (Hypos : 0 ≤ y) (Hnpos : 0 < n) :
  x ^ n = y ^ n ↔ x = y :=
(@strict_mono_on_pow R _ _ Hnpos).eq_iff_eq Hxpos Hypos

lemma lt_of_pow_lt_pow {a b : R} (n : ℕ) (hb : 0 ≤ b) (h : a ^ n < b ^ n) : a < b :=
lt_of_not_ge $ λ hn, not_lt_of_ge (pow_le_pow_of_le_left hb hn _) h

lemma le_of_pow_le_pow {a b : R} (n : ℕ) (hb : 0 ≤ b) (hn : 0 < n) (h : a ^ n ≤ b ^ n) : a ≤ b :=
le_of_not_lt $ λ h1, not_le_of_lt (pow_lt_pow_of_lt_left h1 hb hn) h

@[simp] lemma sq_eq_sq {a b : R} (ha : 0 ≤ a) (hb : 0 ≤ b) : a ^ 2 = b ^ 2 ↔ a = b :=
pow_left_inj ha hb dec_trivial

lemma lt_of_mul_self_lt_mul_self (hb : 0 ≤ b) : a * a < b * b → a < b :=
by { simp_rw ←sq, exact lt_of_pow_lt_pow _ hb }

end linear_ordered_semiring

section linear_ordered_ring

variable [linear_ordered_ring R]

lemma pow_abs (a : R) (n : ℕ) : |a| ^ n = |a ^ n| :=
((abs_hom.to_monoid_hom : R →* R).map_pow a n).symm

lemma abs_neg_one_pow (n : ℕ) : |(-1 : R) ^ n| = 1 :=
by rw [←pow_abs, abs_neg, abs_one, one_pow]

theorem pow_bit0_nonneg (a : R) (n : ℕ) : 0 ≤ a ^ bit0 n :=
by { rw pow_bit0, exact mul_self_nonneg _ }

theorem sq_nonneg (a : R) : 0 ≤ a ^ 2 :=
pow_bit0_nonneg a 1

alias sq_nonneg ← pow_two_nonneg

theorem pow_bit0_pos {a : R} (h : a ≠ 0) (n : ℕ) : 0 < a ^ bit0 n :=
(pow_bit0_nonneg a n).lt_of_ne (pow_ne_zero _ h).symm

theorem sq_pos_of_ne_zero (a : R) (h : a ≠ 0) : 0 < a ^ 2 :=
pow_bit0_pos h 1

alias sq_pos_of_ne_zero ← pow_two_pos_of_ne_zero

theorem pow_bit0_pos_iff (a : R) {n : ℕ} (hn : n ≠ 0) : 0 < a ^ bit0 n ↔ a ≠ 0 :=
begin
  refine ⟨λ h, _, λ h, pow_bit0_pos h n⟩,
  rintro rfl,
  rw zero_pow (nat.zero_lt_bit0 hn) at h,
  exact lt_irrefl _ h,
end

theorem sq_pos_iff (a : R) : 0 < a ^ 2 ↔ a ≠ 0 :=
pow_bit0_pos_iff a one_ne_zero

variables {x y : R}

theorem sq_abs (x : R) : |x| ^ 2 = x ^ 2 :=
by simpa only [sq] using abs_mul_abs_self x

theorem abs_sq (x : R) : |x ^ 2| = x ^ 2 :=
by simpa only [sq] using abs_mul_self x

theorem sq_lt_sq : x ^ 2 < y ^ 2 ↔ |x| < |y| :=
by simpa only [sq_abs]
  using (@strict_mono_on_pow R _ _ two_pos).lt_iff_lt (abs_nonneg x) (abs_nonneg y)

theorem sq_lt_sq' (h1 : -y < x) (h2 : x < y) : x ^ 2 < y ^ 2 :=
sq_lt_sq.2 (lt_of_lt_of_le (abs_lt.2 ⟨h1, h2⟩) (le_abs_self _))

theorem sq_le_sq : x ^ 2 ≤ y ^ 2 ↔ |x| ≤ |y| :=
by simpa only [sq_abs]
  using (@strict_mono_on_pow R _ _ two_pos).le_iff_le (abs_nonneg x) (abs_nonneg y)

theorem sq_le_sq' (h1 : -y ≤ x) (h2 : x ≤ y) : x ^ 2 ≤ y ^ 2 :=
sq_le_sq.2 (le_trans (abs_le.mpr ⟨h1, h2⟩) (le_abs_self _))

theorem abs_lt_of_sq_lt_sq (h : x^2 < y^2) (hy : 0 ≤ y) : |x| < y :=
by rwa [← abs_of_nonneg hy, ← sq_lt_sq]

theorem abs_lt_of_sq_lt_sq' (h : x^2 < y^2) (hy : 0 ≤ y) : -y < x ∧ x < y :=
abs_lt.mp $ abs_lt_of_sq_lt_sq h hy

theorem abs_le_of_sq_le_sq (h : x^2 ≤ y^2) (hy : 0 ≤ y) : |x| ≤ y :=
by rwa [← abs_of_nonneg hy, ← sq_le_sq]

theorem abs_le_of_sq_le_sq' (h : x^2 ≤ y^2) (hy : 0 ≤ y) : -y ≤ x ∧ x ≤ y :=
abs_le.mp $ abs_le_of_sq_le_sq h hy

lemma sq_eq_sq_iff_abs_eq_abs (x y : R) : x^2 = y^2 ↔ |x| = |y| :=
by simp only [le_antisymm_iff, sq_le_sq]

@[simp] lemma sq_le_one_iff_abs_le_one (x : R) : x^2 ≤ 1 ↔ |x| ≤ 1 :=
by simpa only [one_pow, abs_one] using @sq_le_sq _ _ x 1

@[simp] lemma sq_lt_one_iff_abs_lt_one (x : R) : x^2 < 1 ↔ |x| < 1 :=
by simpa only [one_pow, abs_one] using @sq_lt_sq _ _ x 1

@[simp] lemma one_le_sq_iff_one_le_abs (x : R) : 1 ≤ x^2 ↔ 1 ≤ |x| :=
by simpa only [one_pow, abs_one] using @sq_le_sq _ _ 1 x

@[simp] lemma one_lt_sq_iff_one_lt_abs (x : R) : 1 < x^2 ↔ 1 < |x| :=
by simpa only [one_pow, abs_one] using @sq_lt_sq _ _ 1 x

lemma pow_four_le_pow_two_of_pow_two_le {x y : R} (h : x^2 ≤ y) : x^4 ≤ y^2 :=
(pow_mul x 2 2).symm ▸ pow_le_pow_of_le_left (sq_nonneg x) h 2

end linear_ordered_ring

section linear_ordered_comm_ring
variables [linear_ordered_comm_ring R]

/-- Arithmetic mean-geometric mean (AM-GM) inequality for linearly ordered commutative rings. -/
lemma two_mul_le_add_sq (a b : R) : 2 * a * b ≤ a ^ 2 + b ^ 2 :=
sub_nonneg.mp ((sub_add_eq_add_sub _ _ _).subst ((sub_sq a b).subst (sq_nonneg _)))

alias two_mul_le_add_sq ← two_mul_le_add_pow_two

end linear_ordered_comm_ring

section linear_ordered_comm_monoid_with_zero
variables [linear_ordered_comm_monoid_with_zero M] [no_zero_divisors M] {a : M} {n : ℕ}

lemma pow_pos_iff (hn : 0 < n) : 0 < a ^ n ↔ 0 < a := by simp_rw [zero_lt_iff, pow_ne_zero_iff hn]

end linear_ordered_comm_monoid_with_zero

section linear_ordered_comm_group_with_zero
variables [linear_ordered_comm_group_with_zero M] {a : M} {m n : ℕ}

lemma pow_lt_pow_succ (ha : 1 < a) : a ^ n < a ^ n.succ :=
by { rw [←one_mul (a ^ n), pow_succ],
  exact mul_lt_right₀ _ ha (pow_ne_zero _ (zero_lt_one.trans ha).ne') }

lemma pow_lt_pow₀ (ha : 1 < a) (hmn : m < n) : a ^ m < a ^ n :=
by { induction hmn with n hmn ih, exacts [pow_lt_pow_succ ha, lt_trans ih (pow_lt_pow_succ ha)] }

end linear_ordered_comm_group_with_zero

namespace monoid_hom
variables [ring R] [monoid M] [linear_order M] [covariant_class M M (*) (≤)] (f : R →* M)

lemma map_neg_one : f (-1) = 1 :=
(pow_eq_one_iff (nat.succ_ne_zero 1)).1 $ by rw [←map_pow, neg_one_sq, map_one]

@[simp] lemma map_neg (x : R) : f (-x) = f x :=
by rw [←neg_one_mul, map_mul, map_neg_one, one_mul]

lemma map_sub_swap (x y : R) : f (x - y) = f (y - x) := by rw [←map_neg, neg_sub]

end monoid_hom


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

! This file was ported from Lean 3 source module topology.algebra.filter_basis
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Order.Filter.Bases
import Mathbin.Topology.Algebra.Module.Basic

/-!
# Group and ring filter bases

A `group_filter_basis` is a `filter_basis` on a group with some properties relating
the basis to the group structure. The main theorem is that a `group_filter_basis`
on a group gives a topology on the group which makes it into a topological group
with neighborhoods of the neutral element generated by the given basis.

## Main definitions and results

Given a group `G` and a ring `R`:

* `group_filter_basis G`: the type of filter bases that will become neighborhood of `1`
  for a topology on `G` compatible with the group structure
* `group_filter_basis.topology`: the associated topology
* `group_filter_basis.is_topological_group`: the compatibility between the above topology
  and the group structure
* `ring_filter_basis R`: the type of filter bases that will become neighborhood of `0`
  for a topology on `R` compatible with the ring structure
* `ring_filter_basis.topology`: the associated topology
* `ring_filter_basis.is_topological_ring`: the compatibility between the above topology
  and the ring structure

## References

* [N. Bourbaki, *General Topology*][bourbaki1966]
-/

open Filter Set TopologicalSpace Function

open Topology Filter Pointwise

universe u

/-- A `group_filter_basis` on a group is a `filter_basis` satisfying some additional axioms.
  Example : if `G` is a topological group then the neighbourhoods of the identity are a
  `group_filter_basis`. Conversely given a `group_filter_basis` one can define a topology
  compatible with the group structure on `G`.  -/
class GroupFilterBasis (G : Type u) [Group G] extends FilterBasis G where
  one' : ∀ {U}, U ∈ sets → (1 : G) ∈ U
  mul' : ∀ {U}, U ∈ sets → ∃ V ∈ sets, V * V ⊆ U
  inv' : ∀ {U}, U ∈ sets → ∃ V ∈ sets, V ⊆ (fun x => x⁻¹) ⁻¹' U
  conj' : ∀ x₀, ∀ {U}, U ∈ sets → ∃ V ∈ sets, V ⊆ (fun x => x₀ * x * x₀⁻¹) ⁻¹' U
#align group_filter_basis GroupFilterBasis

/-- A `add_group_filter_basis` on an additive group is a `filter_basis` satisfying some additional
  axioms. Example : if `G` is a topological group then the neighbourhoods of the identity are a
  `add_group_filter_basis`. Conversely given a `add_group_filter_basis` one can define a topology
  compatible with the group structure on `G`. -/
class AddGroupFilterBasis (A : Type u) [AddGroup A] extends FilterBasis A where
  zero' : ∀ {U}, U ∈ sets → (0 : A) ∈ U
  add' : ∀ {U}, U ∈ sets → ∃ V ∈ sets, V + V ⊆ U
  neg' : ∀ {U}, U ∈ sets → ∃ V ∈ sets, V ⊆ (fun x => -x) ⁻¹' U
  conj' : ∀ x₀, ∀ {U}, U ∈ sets → ∃ V ∈ sets, V ⊆ (fun x => x₀ + x + -x₀) ⁻¹' U
#align add_group_filter_basis AddGroupFilterBasis

attribute [to_additive] GroupFilterBasis

attribute [to_additive] GroupFilterBasis.one'

attribute [to_additive] GroupFilterBasis.mul'

attribute [to_additive] GroupFilterBasis.inv'

attribute [to_additive] GroupFilterBasis.conj'

attribute [to_additive] GroupFilterBasis.toFilterBasis

/-- `group_filter_basis` constructor in the commutative group case. -/
@[to_additive "`add_group_filter_basis` constructor in the additive commutative group case."]
def groupFilterBasisOfComm {G : Type _} [CommGroup G] (sets : Set (Set G))
    (nonempty : sets.Nonempty) (inter_sets : ∀ x y, x ∈ sets → y ∈ sets → ∃ z ∈ sets, z ⊆ x ∩ y)
    (one : ∀ U ∈ sets, (1 : G) ∈ U) (mul : ∀ U ∈ sets, ∃ V ∈ sets, V * V ⊆ U)
    (inv : ∀ U ∈ sets, ∃ V ∈ sets, V ⊆ (fun x => x⁻¹) ⁻¹' U) : GroupFilterBasis G :=
  { sets
    Nonempty
    inter_sets
    one' := one
    mul' := mul
    inv' := inv
    conj' := fun x U U_in => ⟨U, U_in, by simp⟩ }
#align group_filter_basis_of_comm groupFilterBasisOfComm
#align add_group_filter_basis_of_comm addGroupFilterBasisOfComm

namespace GroupFilterBasis

variable {G : Type u} [Group G] {B : GroupFilterBasis G}

@[to_additive]
instance : Membership (Set G) (GroupFilterBasis G) :=
  ⟨fun s f => s ∈ f.sets⟩

@[to_additive]
theorem one {U : Set G} : U ∈ B → (1 : G) ∈ U :=
  GroupFilterBasis.one'
#align group_filter_basis.one GroupFilterBasis.one
#align add_group_filter_basis.zero AddGroupFilterBasis.zero

@[to_additive]
theorem mul {U : Set G} : U ∈ B → ∃ V ∈ B, V * V ⊆ U :=
  GroupFilterBasis.mul'
#align group_filter_basis.mul GroupFilterBasis.mul
#align add_group_filter_basis.add AddGroupFilterBasis.add

@[to_additive]
theorem inv {U : Set G} : U ∈ B → ∃ V ∈ B, V ⊆ (fun x => x⁻¹) ⁻¹' U :=
  GroupFilterBasis.inv'
#align group_filter_basis.inv GroupFilterBasis.inv
#align add_group_filter_basis.neg AddGroupFilterBasis.neg

@[to_additive]
theorem conj : ∀ x₀, ∀ {U}, U ∈ B → ∃ V ∈ B, V ⊆ (fun x => x₀ * x * x₀⁻¹) ⁻¹' U :=
  GroupFilterBasis.conj'
#align group_filter_basis.conj GroupFilterBasis.conj
#align add_group_filter_basis.conj AddGroupFilterBasis.conj

/-- The trivial group filter basis consists of `{1}` only. The associated topology
is discrete. -/
@[to_additive
      "The trivial additive group filter basis consists of `{0}` only. The associated\ntopology is discrete."]
instance : Inhabited (GroupFilterBasis G) :=
  ⟨by
    refine'
      { sets := {{1}}
        Nonempty := singleton_nonempty _.. }
    all_goals simp only [exists_prop, mem_singleton_iff]
    · rintro - - rfl rfl
      use {1}
      simp
    · simp
    · rintro - rfl
      use {1}
      simp
    · rintro - rfl
      use {1}
      simp
    · rintro x₀ - rfl
      use {1}
      simp⟩

@[to_additive]
theorem prod_subset_self (B : GroupFilterBasis G) {U : Set G} (h : U ∈ B) : U ⊆ U * U :=
  fun x x_in => ⟨1, x, one h, x_in, one_mul x⟩
#align group_filter_basis.prod_subset_self GroupFilterBasis.prod_subset_self
#align add_group_filter_basis.sum_subset_self AddGroupFilterBasis.sum_subset_self

/-- The neighborhood function of a `group_filter_basis` -/
@[to_additive "The neighborhood function of a `add_group_filter_basis`"]
def n (B : GroupFilterBasis G) : G → Filter G := fun x =>
  map (fun y => x * y) B.toFilterBasis.filterₓ
#align group_filter_basis.N GroupFilterBasis.n
#align add_group_filter_basis.N AddGroupFilterBasis.n

@[simp, to_additive]
theorem n_one (B : GroupFilterBasis G) : B.n 1 = B.toFilterBasis.filterₓ := by
  simp only [N, one_mul, map_id']
#align group_filter_basis.N_one GroupFilterBasis.n_one
#align add_group_filter_basis.N_zero AddGroupFilterBasis.n_zero

@[to_additive]
protected theorem hasBasis (B : GroupFilterBasis G) (x : G) :
    HasBasis (B.n x) (fun V : Set G => V ∈ B) fun V => (fun y => x * y) '' V :=
  HasBasis.map (fun y => x * y) toFilterBasis.HasBasis
#align group_filter_basis.has_basis GroupFilterBasis.hasBasis
#align add_group_filter_basis.has_basis AddGroupFilterBasis.hasBasis

/-- The topological space structure coming from a group filter basis. -/
@[to_additive "The topological space structure coming from an additive group filter basis."]
def topology (B : GroupFilterBasis G) : TopologicalSpace G :=
  TopologicalSpace.mkOfNhds B.n
#align group_filter_basis.topology GroupFilterBasis.topology
#align add_group_filter_basis.topology AddGroupFilterBasis.topology

@[to_additive]
theorem nhds_eq (B : GroupFilterBasis G) {x₀ : G} : @nhds G B.topology x₀ = B.n x₀ :=
  by
  rw [TopologicalSpace.nhds_mkOfNhds]
  · intro x U U_in
    rw [(B.has_basis x).mem_iff] at U_in
    rcases U_in with ⟨V, V_in, H⟩
    simpa [mem_pure] using H (mem_image_of_mem _ (GroupFilterBasis.one V_in))
  · intro x U U_in
    rw [(B.has_basis x).mem_iff] at U_in
    rcases U_in with ⟨V, V_in, H⟩
    rcases GroupFilterBasis.mul V_in with ⟨W, W_in, hW⟩
    use (fun y => x * y) '' W, image_mem_map (FilterBasis.mem_filter_of_mem _ W_in)
    constructor
    · rw [image_subset_iff] at H⊢
      exact ((B.prod_subset_self W_in).trans hW).trans H
    · rintro y ⟨t, tW, rfl⟩
      rw [(B.has_basis _).mem_iff]
      use W, W_in
      apply subset.trans _ H
      clear H
      rintro z ⟨w, wW, rfl⟩
      exact ⟨t * w, hW (mul_mem_mul tW wW), by simp [mul_assoc]⟩
#align group_filter_basis.nhds_eq GroupFilterBasis.nhds_eq
#align add_group_filter_basis.nhds_eq AddGroupFilterBasis.nhds_eq

@[to_additive]
theorem nhds_one_eq (B : GroupFilterBasis G) :
    @nhds G B.topology (1 : G) = B.toFilterBasis.filterₓ :=
  by
  rw [B.nhds_eq]
  simp only [N, one_mul]
  exact map_id
#align group_filter_basis.nhds_one_eq GroupFilterBasis.nhds_one_eq
#align add_group_filter_basis.nhds_zero_eq AddGroupFilterBasis.nhds_zero_eq

@[to_additive]
theorem nhds_hasBasis (B : GroupFilterBasis G) (x₀ : G) :
    HasBasis (@nhds G B.topology x₀) (fun V : Set G => V ∈ B) fun V => (fun y => x₀ * y) '' V :=
  by
  rw [B.nhds_eq]
  apply B.has_basis
#align group_filter_basis.nhds_has_basis GroupFilterBasis.nhds_hasBasis
#align add_group_filter_basis.nhds_has_basis AddGroupFilterBasis.nhds_hasBasis

@[to_additive]
theorem nhds_one_hasBasis (B : GroupFilterBasis G) :
    HasBasis (@nhds G B.topology 1) (fun V : Set G => V ∈ B) id :=
  by
  rw [B.nhds_one_eq]
  exact B.to_filter_basis.has_basis
#align group_filter_basis.nhds_one_has_basis GroupFilterBasis.nhds_one_hasBasis
#align add_group_filter_basis.nhds_zero_has_basis AddGroupFilterBasis.nhds_zero_hasBasis

@[to_additive]
theorem mem_nhds_one (B : GroupFilterBasis G) {U : Set G} (hU : U ∈ B) : U ∈ @nhds G B.topology 1 :=
  by
  rw [B.nhds_one_has_basis.mem_iff]
  exact ⟨U, hU, rfl.subset⟩
#align group_filter_basis.mem_nhds_one GroupFilterBasis.mem_nhds_one
#align add_group_filter_basis.mem_nhds_zero AddGroupFilterBasis.mem_nhds_zero

-- See note [lower instance priority]
/-- If a group is endowed with a topological structure coming from a group filter basis then it's a
topological group. -/
@[to_additive
      "If a group is endowed with a topological structure coming from a group filter basis\nthen it's a topological group."]
instance (priority := 100) is_topologicalGroup (B : GroupFilterBasis G) :
    @TopologicalGroup G B.topology _ := by
  letI := B.topology
  have basis := B.nhds_one_has_basis
  have basis' := Basis.prod Basis
  refine' TopologicalGroup.of_nhds_one _ _ _ _
  · rw [basis'.tendsto_iff Basis]
    suffices ∀ U ∈ B, ∃ V W, (V ∈ B ∧ W ∈ B) ∧ ∀ a b, a ∈ V → b ∈ W → a * b ∈ U by simpa
    intro U U_in
    rcases mul U_in with ⟨V, V_in, hV⟩
    use V, V, V_in, V_in
    intro a b a_in b_in
    exact hV ⟨a, b, a_in, b_in, rfl⟩
  · rw [basis.tendsto_iff Basis]
    intro U U_in
    simpa using inv U_in
  · intro x₀
    rw [nhds_eq, nhds_one_eq]
    rfl
  · intro x₀
    rw [basis.tendsto_iff Basis]
    intro U U_in
    exact conj x₀ U_in
#align group_filter_basis.is_topological_group GroupFilterBasis.is_topologicalGroup
#align add_group_filter_basis.is_topological_add_group AddGroupFilterBasis.is_topological_add_group

end GroupFilterBasis

/-- A `ring_filter_basis` on a ring is a `filter_basis` satisfying some additional axioms.
  Example : if `R` is a topological ring then the neighbourhoods of the identity are a
  `ring_filter_basis`. Conversely given a `ring_filter_basis` on a ring `R`, one can define a
  topology on `R` which is compatible with the ring structure.  -/
class RingFilterBasis (R : Type u) [Ring R] extends AddGroupFilterBasis R where
  mul' : ∀ {U}, U ∈ sets → ∃ V ∈ sets, V * V ⊆ U
  mul_left' : ∀ (x₀ : R) {U}, U ∈ sets → ∃ V ∈ sets, V ⊆ (fun x => x₀ * x) ⁻¹' U
  mul_right' : ∀ (x₀ : R) {U}, U ∈ sets → ∃ V ∈ sets, V ⊆ (fun x => x * x₀) ⁻¹' U
#align ring_filter_basis RingFilterBasis

namespace RingFilterBasis

variable {R : Type u} [Ring R] (B : RingFilterBasis R)

instance : Membership (Set R) (RingFilterBasis R) :=
  ⟨fun s B => s ∈ B.sets⟩

theorem mul {U : Set R} (hU : U ∈ B) : ∃ V ∈ B, V * V ⊆ U :=
  mul' hU
#align ring_filter_basis.mul RingFilterBasis.mul

theorem mul_left (x₀ : R) {U : Set R} (hU : U ∈ B) : ∃ V ∈ B, V ⊆ (fun x => x₀ * x) ⁻¹' U :=
  mul_left' x₀ hU
#align ring_filter_basis.mul_left RingFilterBasis.mul_left

theorem mul_right (x₀ : R) {U : Set R} (hU : U ∈ B) : ∃ V ∈ B, V ⊆ (fun x => x * x₀) ⁻¹' U :=
  mul_right' x₀ hU
#align ring_filter_basis.mul_right RingFilterBasis.mul_right

/-- The topology associated to a ring filter basis.
It has the given basis as a basis of neighborhoods of zero. -/
def topology : TopologicalSpace R :=
  B.toAddGroupFilterBasis.topology
#align ring_filter_basis.topology RingFilterBasis.topology

/-- If a ring is endowed with a topological structure coming from
a ring filter basis then it's a topological ring. -/
instance (priority := 100) is_topologicalRing {R : Type u} [Ring R] (B : RingFilterBasis R) :
    @TopologicalRing R B.topology _ :=
  by
  let B' := B.to_add_group_filter_basis
  letI := B'.topology
  have basis := B'.nhds_zero_has_basis
  have basis' := Basis.prod Basis
  haveI := B'.is_topological_add_group
  apply TopologicalRing.of_addGroup_of_nhds_zero
  · rw [basis'.tendsto_iff Basis]
    suffices ∀ U ∈ B', ∃ V W, (V ∈ B' ∧ W ∈ B') ∧ ∀ a b, a ∈ V → b ∈ W → a * b ∈ U by simpa
    intro U U_in
    rcases B.mul U_in with ⟨V, V_in, hV⟩
    use V, V, V_in, V_in
    intro a b a_in b_in
    exact hV ⟨a, b, a_in, b_in, rfl⟩
  · intro x₀
    rw [basis.tendsto_iff Basis]
    intro U
    simpa using B.mul_left x₀
  · intro x₀
    rw [basis.tendsto_iff Basis]
    intro U
    simpa using B.mul_right x₀
#align ring_filter_basis.is_topological_ring RingFilterBasis.is_topologicalRing

end RingFilterBasis

/-- A `module_filter_basis` on a module is a `filter_basis` satisfying some additional axioms.
  Example : if `M` is a topological module then the neighbourhoods of zero are a
  `module_filter_basis`. Conversely given a `module_filter_basis` one can define a topology
  compatible with the module structure on `M`.  -/
structure ModuleFilterBasis (R M : Type _) [CommRing R] [TopologicalSpace R] [AddCommGroup M]
  [Module R M] extends AddGroupFilterBasis M where
  smul' : ∀ {U}, U ∈ sets → ∃ V ∈ 𝓝 (0 : R), ∃ W ∈ sets, V • W ⊆ U
  smul_left' : ∀ (x₀ : R) {U}, U ∈ sets → ∃ V ∈ sets, V ⊆ (fun x => x₀ • x) ⁻¹' U
  smul_right' : ∀ (m₀ : M) {U}, U ∈ sets → ∀ᶠ x in 𝓝 (0 : R), x • m₀ ∈ U
#align module_filter_basis ModuleFilterBasis

namespace ModuleFilterBasis

variable {R M : Type _} [CommRing R] [TopologicalSpace R] [AddCommGroup M] [Module R M]
  (B : ModuleFilterBasis R M)

instance GroupFilterBasis.hasMem : Membership (Set M) (ModuleFilterBasis R M) :=
  ⟨fun s B => s ∈ B.sets⟩
#align module_filter_basis.group_filter_basis.has_mem ModuleFilterBasis.GroupFilterBasis.hasMem

theorem smul {U : Set M} (hU : U ∈ B) : ∃ V ∈ 𝓝 (0 : R), ∃ W ∈ B, V • W ⊆ U :=
  B.smul' hU
#align module_filter_basis.smul ModuleFilterBasis.smul

theorem smul_left (x₀ : R) {U : Set M} (hU : U ∈ B) : ∃ V ∈ B, V ⊆ (fun x => x₀ • x) ⁻¹' U :=
  B.smul_left' x₀ hU
#align module_filter_basis.smul_left ModuleFilterBasis.smul_left

theorem smul_right (m₀ : M) {U : Set M} (hU : U ∈ B) : ∀ᶠ x in 𝓝 (0 : R), x • m₀ ∈ U :=
  B.smul_right' m₀ hU
#align module_filter_basis.smul_right ModuleFilterBasis.smul_right

/-- If `R` is discrete then the trivial additive group filter basis on any `R`-module is a
module filter basis. -/
instance [DiscreteTopology R] : Inhabited (ModuleFilterBasis R M) :=
  ⟨{
      show AddGroupFilterBasis M from
        default with
      smul' := by
        rintro U (h : U ∈ {{(0 : M)}})
        rw [mem_singleton_iff] at h
        use univ, univ_mem, {0}, rfl
        rintro a ⟨x, m, -, hm, rfl⟩
        simp [mem_singleton_iff.1 hm, h]
      smul_left' := by
        rintro x₀ U (h : U ∈ {{(0 : M)}})
        rw [mem_singleton_iff] at h
        use {0}, rfl
        simp [h]
      smul_right' := by
        rintro m₀ U (h : U ∈ (0 : Set (Set M)))
        rw [Set.mem_zero] at h
        simp [h, nhds_discrete] }⟩

/-- The topology associated to a module filter basis on a module over a topological ring.
It has the given basis as a basis of neighborhoods of zero. -/
def topology : TopologicalSpace M :=
  B.toAddGroupFilterBasis.topology
#align module_filter_basis.topology ModuleFilterBasis.topology

/-- The topology associated to a module filter basis on a module over a topological ring.
It has the given basis as a basis of neighborhoods of zero. This version gets the ring
topology by unification instead of type class inference. -/
def topology' {R M : Type _} [CommRing R] {tR : TopologicalSpace R} [AddCommGroup M] [Module R M]
    (B : ModuleFilterBasis R M) : TopologicalSpace M :=
  B.toAddGroupFilterBasis.topology
#align module_filter_basis.topology' ModuleFilterBasis.topology'

/-- A topological add group whith a basis of `𝓝 0` satisfying the axioms of `module_filter_basis`
is a topological module.

This lemma is mathematically useless because one could obtain such a result by applying
`module_filter_basis.has_continuous_smul` and use the fact that group topologies are characterized
by their neighborhoods of 0 to obtain the `has_continuous_smul` on the pre-existing topology.

But it turns out it's just easier to get it as a biproduct of the proof, so this is just a free
quality-of-life improvement. -/
theorem ContinuousSMul.of_basis_zero {ι : Type _} [TopologicalRing R] [TopologicalSpace M]
    [TopologicalAddGroup M] {p : ι → Prop} {b : ι → Set M} (h : HasBasis (𝓝 0) p b)
    (hsmul : ∀ {i}, p i → ∃ V ∈ 𝓝 (0 : R), ∃ (j : _)(hj : p j), V • b j ⊆ b i)
    (hsmul_left : ∀ (x₀ : R) {i}, p i → ∃ (j : _)(hj : p j), b j ⊆ (fun x => x₀ • x) ⁻¹' b i)
    (hsmul_right : ∀ (m₀ : M) {i}, p i → ∀ᶠ x in 𝓝 (0 : R), x • m₀ ∈ b i) : ContinuousSMul R M :=
  by
  apply ContinuousSMul.of_nhds_zero
  · rw [h.tendsto_right_iff]
    intro i hi
    rcases hsmul hi with ⟨V, V_in, j, hj, hVj⟩
    apply mem_of_superset (prod_mem_prod V_in <| h.mem_of_mem hj)
    rintro ⟨v, w⟩ ⟨v_in : v ∈ V, w_in : w ∈ b j⟩
    exact hVj (Set.smul_mem_smul v_in w_in)
  · intro m₀
    rw [h.tendsto_right_iff]
    intro i hi
    exact hsmul_right m₀ hi
  · intro x₀
    rw [h.tendsto_right_iff]
    intro i hi
    rcases hsmul_left x₀ hi with ⟨j, hj, hji⟩
    exact mem_of_superset (h.mem_of_mem hj) hji
#align has_continuous_smul.of_basis_zero ContinuousSMul.of_basis_zero

/-- If a module is endowed with a topological structure coming from
a module filter basis then it's a topological module. -/
instance (priority := 100) continuousSMul [TopologicalRing R] :
    @ContinuousSMul R M _ _ B.topology :=
  by
  let B' := B.to_add_group_filter_basis
  letI := B'.topology
  haveI := B'.is_topological_add_group
  exact
    ContinuousSMul.of_basis_zero B'.nhds_zero_has_basis (fun _ => B.smul) B.smul_left B.smul_right
#align module_filter_basis.has_continuous_smul ModuleFilterBasis.continuousSMul

/-- Build a module filter basis from compatible ring and additive group filter bases. -/
def ofBases {R M : Type _} [CommRing R] [AddCommGroup M] [Module R M] (BR : RingFilterBasis R)
    (BM : AddGroupFilterBasis M) (smul : ∀ {U}, U ∈ BM → ∃ V ∈ BR, ∃ W ∈ BM, V • W ⊆ U)
    (smul_left : ∀ (x₀ : R) {U}, U ∈ BM → ∃ V ∈ BM, V ⊆ (fun x => x₀ • x) ⁻¹' U)
    (smul_right : ∀ (m₀ : M) {U}, U ∈ BM → ∃ V ∈ BR, V ⊆ (fun x => x • m₀) ⁻¹' U) :
    @ModuleFilterBasis R M _ BR.topology _ _ :=
  {
    BM with
    smul' := by
      intro U U_in
      rcases smul U_in with ⟨V, V_in, W, W_in, H⟩
      exact ⟨V, BR.to_add_group_filter_basis.mem_nhds_zero V_in, W, W_in, H⟩
    smul_left' := smul_left
    smul_right' := by
      intro m₀ U U_in
      rcases smul_right m₀ U_in with ⟨V, V_in, H⟩
      exact mem_of_superset (BR.to_add_group_filter_basis.mem_nhds_zero V_in) H }
#align module_filter_basis.of_bases ModuleFilterBasis.ofBases

end ModuleFilterBasis


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

! This file was ported from Lean 3 source module data.fintype.pi
! leanprover-community/mathlib commit e04043d6bf7264a3c84bc69711dc354958ca4516
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Fintype.Basic
import Mathbin.Data.Finset.Pi

/-!
# fintype instances for pi types

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

variable {α : Type _}

open Finset

namespace Fintype

variable [DecidableEq α] [Fintype α] {δ : α → Type _}

#print Fintype.piFinset /-
/-- Given for all `a : α` a finset `t a` of `δ a`, then one can define the
finset `fintype.pi_finset t` of all functions taking values in `t a` for all `a`. This is the
analogue of `finset.pi` where the base finset is `univ` (but formally they are not the same, as
there is an additional condition `i ∈ finset.univ` in the `finset.pi` definition). -/
def piFinset (t : ∀ a, Finset (δ a)) : Finset (∀ a, δ a) :=
  (Finset.univ.pi t).map ⟨fun f a => f a (mem_univ a), fun _ _ => by simp [Function.funext_iff]⟩
#align fintype.pi_finset Fintype.piFinset
-/

#print Fintype.mem_piFinset /-
@[simp]
theorem mem_piFinset {t : ∀ a, Finset (δ a)} {f : ∀ a, δ a} : f ∈ piFinset t ↔ ∀ a, f a ∈ t a :=
  by
  constructor
  · simp only [pi_finset, mem_map, and_imp, forall_prop_of_true, exists_prop, mem_univ, exists_imp,
      mem_pi]
    rintro g hg hgf a
    rw [← hgf]
    exact hg a
  · simp only [pi_finset, mem_map, forall_prop_of_true, exists_prop, mem_univ, mem_pi]
    exact fun hf => ⟨fun a ha => f a, hf, rfl⟩
#align fintype.mem_pi_finset Fintype.mem_piFinset
-/

#print Fintype.coe_piFinset /-
@[simp]
theorem coe_piFinset (t : ∀ a, Finset (δ a)) :
    (piFinset t : Set (∀ a, δ a)) = Set.pi Set.univ fun a => t a :=
  Set.ext fun x => by
    rw [Set.mem_univ_pi]
    exact Fintype.mem_piFinset
#align fintype.coe_pi_finset Fintype.coe_piFinset
-/

#print Fintype.piFinset_subset /-
theorem piFinset_subset (t₁ t₂ : ∀ a, Finset (δ a)) (h : ∀ a, t₁ a ⊆ t₂ a) :
    piFinset t₁ ⊆ piFinset t₂ := fun g hg => mem_piFinset.2 fun a => h a <| mem_piFinset.1 hg a
#align fintype.pi_finset_subset Fintype.piFinset_subset
-/

/- warning: fintype.pi_finset_empty -> Fintype.piFinset_empty is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : Fintype.{u1} α] {δ : α -> Type.{u2}} [_inst_3 : Nonempty.{succ u1} α], Eq.{succ (max u1 u2)} (Finset.{max u1 u2} (forall (a : α), δ a)) (Fintype.piFinset.{u1, u2} α (fun (a : α) (b : α) => _inst_1 a b) _inst_2 (fun (_x : α) => δ _x) (fun (_x : α) => EmptyCollection.emptyCollection.{u2} (Finset.{u2} (δ _x)) (Finset.hasEmptyc.{u2} (δ _x)))) (EmptyCollection.emptyCollection.{max u1 u2} (Finset.{max u1 u2} (forall (a : α), δ a)) (Finset.hasEmptyc.{max u1 u2} (forall (a : α), δ a)))
but is expected to have type
  forall {α : Type.{u2}} [_inst_1 : DecidableEq.{succ u2} α] [_inst_2 : Fintype.{u2} α] {δ : α -> Type.{u1}} [_inst_3 : Nonempty.{succ u2} α], Eq.{max (succ u2) (succ u1)} (Finset.{max u2 u1} (forall (a : α), δ a)) (Fintype.piFinset.{u2, u1} α (fun (a : α) (b : α) => _inst_1 a b) _inst_2 (fun (_x : α) => δ _x) (fun (_x : α) => EmptyCollection.emptyCollection.{u1} (Finset.{u1} (δ _x)) (Finset.instEmptyCollectionFinset.{u1} (δ _x)))) (EmptyCollection.emptyCollection.{max u2 u1} (Finset.{max u2 u1} (forall (a : α), δ a)) (Finset.instEmptyCollectionFinset.{max u2 u1} (forall (a : α), δ a)))
Case conversion may be inaccurate. Consider using '#align fintype.pi_finset_empty Fintype.piFinset_emptyₓ'. -/
@[simp]
theorem piFinset_empty [Nonempty α] : piFinset (fun _ => ∅ : ∀ i, Finset (δ i)) = ∅ :=
  eq_empty_of_forall_not_mem fun _ => by simp
#align fintype.pi_finset_empty Fintype.piFinset_empty

/- warning: fintype.pi_finset_singleton -> Fintype.piFinset_singleton is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : Fintype.{u1} α] {δ : α -> Type.{u2}} (f : forall (i : α), δ i), Eq.{succ (max u1 u2)} (Finset.{max u1 u2} (forall (a : α), δ a)) (Fintype.piFinset.{u1, u2} α (fun (a : α) (b : α) => _inst_1 a b) _inst_2 (fun (i : α) => δ i) (fun (i : α) => Singleton.singleton.{u2, u2} (δ i) (Finset.{u2} (δ i)) (Finset.hasSingleton.{u2} (δ i)) (f i))) (Singleton.singleton.{max u1 u2, max u1 u2} (forall (a : α), δ a) (Finset.{max u1 u2} (forall (a : α), δ a)) (Finset.hasSingleton.{max u1 u2} (forall (a : α), δ a)) f)
but is expected to have type
  forall {α : Type.{u2}} [_inst_1 : DecidableEq.{succ u2} α] [_inst_2 : Fintype.{u2} α] {δ : α -> Type.{u1}} (f : forall (i : α), δ i), Eq.{max (succ u2) (succ u1)} (Finset.{max u2 u1} (forall (a : α), δ a)) (Fintype.piFinset.{u2, u1} α (fun (a : α) (b : α) => _inst_1 a b) _inst_2 (fun (i : α) => δ i) (fun (i : α) => Singleton.singleton.{u1, u1} (δ i) (Finset.{u1} (δ i)) (Finset.instSingletonFinset.{u1} (δ i)) (f i))) (Singleton.singleton.{max u2 u1, max u2 u1} (forall (a : α), δ a) (Finset.{max u2 u1} (forall (a : α), δ a)) (Finset.instSingletonFinset.{max u2 u1} (forall (a : α), δ a)) f)
Case conversion may be inaccurate. Consider using '#align fintype.pi_finset_singleton Fintype.piFinset_singletonₓ'. -/
@[simp]
theorem piFinset_singleton (f : ∀ i, δ i) : piFinset (fun i => {f i} : ∀ i, Finset (δ i)) = {f} :=
  ext fun _ => by simp only [Function.funext_iff, Fintype.mem_piFinset, mem_singleton]
#align fintype.pi_finset_singleton Fintype.piFinset_singleton

#print Fintype.piFinset_subsingleton /-
theorem piFinset_subsingleton {f : ∀ i, Finset (δ i)} (hf : ∀ i, (f i : Set (δ i)).Subsingleton) :
    (Fintype.piFinset f : Set (∀ i, δ i)).Subsingleton := fun a ha b hb =>
  funext fun i => hf _ (mem_piFinset.1 ha _) (mem_piFinset.1 hb _)
#align fintype.pi_finset_subsingleton Fintype.piFinset_subsingleton
-/

/- warning: fintype.pi_finset_disjoint_of_disjoint -> Fintype.piFinset_disjoint_of_disjoint is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : Fintype.{u1} α] {δ : α -> Type.{u2}} (t₁ : forall (a : α), Finset.{u2} (δ a)) (t₂ : forall (a : α), Finset.{u2} (δ a)) {a : α}, (Disjoint.{u2} (Finset.{u2} (δ a)) (Finset.partialOrder.{u2} (δ a)) (Finset.orderBot.{u2} (δ a)) (t₁ a) (t₂ a)) -> (Disjoint.{max u1 u2} (Finset.{max u1 u2} (forall (a : α), δ a)) (Finset.partialOrder.{max u1 u2} (forall (a : α), δ a)) (Finset.orderBot.{max u1 u2} (forall (a : α), δ a)) (Fintype.piFinset.{u1, u2} α (fun (a : α) (b : α) => _inst_1 a b) _inst_2 (fun (a : α) => δ a) t₁) (Fintype.piFinset.{u1, u2} α (fun (a : α) (b : α) => _inst_1 a b) _inst_2 (fun (a : α) => δ a) t₂))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : Fintype.{u1} α] {δ : α -> Type.{u2}} (t₁ : forall (a : α), Finset.{u2} (δ a)) (t₂ : forall (a : α), Finset.{u2} (δ a)) {a : α}, (Disjoint.{u2} (Finset.{u2} (δ a)) (Finset.partialOrder.{u2} (δ a)) (Finset.instOrderBotFinsetToLEToPreorderPartialOrder.{u2} (δ a)) (t₁ a) (t₂ a)) -> (Disjoint.{max u2 u1} (Finset.{max u1 u2} (forall (a : α), δ a)) (Finset.partialOrder.{max u1 u2} (forall (a : α), δ a)) (Finset.instOrderBotFinsetToLEToPreorderPartialOrder.{max u1 u2} (forall (a : α), δ a)) (Fintype.piFinset.{u1, u2} α (fun (a : α) (b : α) => _inst_1 a b) _inst_2 (fun (a : α) => δ a) t₁) (Fintype.piFinset.{u1, u2} α (fun (a : α) (b : α) => _inst_1 a b) _inst_2 (fun (a : α) => δ a) t₂))
Case conversion may be inaccurate. Consider using '#align fintype.pi_finset_disjoint_of_disjoint Fintype.piFinset_disjoint_of_disjointₓ'. -/
theorem piFinset_disjoint_of_disjoint (t₁ t₂ : ∀ a, Finset (δ a)) {a : α}
    (h : Disjoint (t₁ a) (t₂ a)) : Disjoint (piFinset t₁) (piFinset t₂) :=
  disjoint_iff_ne.2 fun f₁ hf₁ f₂ hf₂ eq₁₂ =>
    disjoint_iff_ne.1 h (f₁ a) (mem_piFinset.1 hf₁ a) (f₂ a) (mem_piFinset.1 hf₂ a)
      (congr_fun eq₁₂ a)
#align fintype.pi_finset_disjoint_of_disjoint Fintype.piFinset_disjoint_of_disjoint

end Fintype

/-! ### pi -/

#print Pi.fintype /-
/-- A dependent product of fintypes, indexed by a fintype, is a fintype. -/
instance Pi.fintype {α : Type _} {β : α → Type _} [DecidableEq α] [Fintype α] [∀ a, Fintype (β a)] :
    Fintype (∀ a, β a) :=
  ⟨Fintype.piFinset fun _ => univ, by simp⟩
#align pi.fintype Pi.fintype
-/

/- warning: fintype.pi_finset_univ -> Fintype.piFinset_univ is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : Fintype.{u1} α] [_inst_3 : forall (a : α), Fintype.{u2} (β a)], Eq.{succ (max u1 u2)} (Finset.{max u1 u2} (forall (a : α), β a)) (Fintype.piFinset.{u1, u2} α (fun (a : α) (b : α) => _inst_1 a b) _inst_2 (fun (a : α) => β a) (fun (a : α) => Finset.univ.{u2} (β a) (_inst_3 a))) (Finset.univ.{max u1 u2} (forall (a : α), β a) (Pi.fintype.{u1, u2} α (fun (a : α) => β a) (fun (a : α) (b : α) => _inst_1 a b) _inst_2 (fun (a : α) => _inst_3 a)))
but is expected to have type
  forall {α : Type.{u2}} {β : α -> Type.{u1}} [_inst_1 : DecidableEq.{succ u2} α] [_inst_2 : Fintype.{u2} α] [_inst_3 : forall (a : α), Fintype.{u1} (β a)], Eq.{max (succ u2) (succ u1)} (Finset.{max u2 u1} (forall (a : α), β a)) (Fintype.piFinset.{u2, u1} α (fun (a : α) (b : α) => _inst_1 a b) _inst_2 (fun (a : α) => β a) (fun (a : α) => Finset.univ.{u1} (β a) (_inst_3 a))) (Finset.univ.{max u2 u1} (forall (a : α), β a) (Pi.fintype.{u2, u1} α (fun (a : α) => β a) (fun (a : α) (b : α) => _inst_1 a b) _inst_2 (fun (a : α) => _inst_3 a)))
Case conversion may be inaccurate. Consider using '#align fintype.pi_finset_univ Fintype.piFinset_univₓ'. -/
@[simp]
theorem Fintype.piFinset_univ {α : Type _} {β : α → Type _} [DecidableEq α] [Fintype α]
    [∀ a, Fintype (β a)] :
    (Fintype.piFinset fun a : α => (Finset.univ : Finset (β a))) =
      (Finset.univ : Finset (∀ a, β a)) :=
  rfl
#align fintype.pi_finset_univ Fintype.piFinset_univ

/- warning: function.embedding.fintype -> Function.Embedding.fintype is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Fintype.{u1} α] [_inst_2 : Fintype.{u2} β] [_inst_3 : DecidableEq.{succ u1} α] [_inst_4 : DecidableEq.{succ u2} β], Fintype.{max u1 u2} (Function.Embedding.{succ u1, succ u2} α β)
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Fintype.{u1} α] [_inst_2 : Fintype.{u2} β], Fintype.{max u1 u2} (Function.Embedding.{succ u1, succ u2} α β)
Case conversion may be inaccurate. Consider using '#align function.embedding.fintype Function.Embedding.fintypeₓ'. -/
instance Function.Embedding.fintype {α β} [Fintype α] [Fintype β] [DecidableEq α] [DecidableEq β] :
    Fintype (α ↪ β) :=
  Fintype.ofEquiv _ (Equiv.subtypeInjectiveEquivEmbedding α β)
#align function.embedding.fintype Function.Embedding.fintype

/- warning: finset.univ_pi_univ -> Finset.univ_pi_univ is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : α -> Type.{u2}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : Fintype.{u1} α] [_inst_3 : forall (a : α), Fintype.{u2} (β a)], Eq.{succ (max u1 u2)} (Finset.{max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a (Finset.univ.{u1} α _inst_2)) -> (β a))) (Finset.pi.{u1, u2} α (fun (a : α) => β a) (fun (a : α) (b : α) => _inst_1 a b) (Finset.univ.{u1} α _inst_2) (fun (a : α) => Finset.univ.{u2} (β a) (_inst_3 a))) (Finset.univ.{max u1 u2} (forall (a : α), (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a (Finset.univ.{u1} α _inst_2)) -> (β a)) (Pi.fintype.{u1, u2} α (fun (a : α) => (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a (Finset.univ.{u1} α _inst_2)) -> (β a)) (fun (a : α) (b : α) => _inst_1 a b) _inst_2 (fun (a : α) => pfunFintype.{u2} (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a (Finset.univ.{u1} α _inst_2)) (Finset.decidableMem.{u1} α (fun (a : α) (b : α) => _inst_1 a b) a (Finset.univ.{u1} α _inst_2)) (fun (H : Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a (Finset.univ.{u1} α _inst_2)) => β a) (fun (hp : Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a (Finset.univ.{u1} α _inst_2)) => _inst_3 a))))
but is expected to have type
  forall {α : Type.{u2}} {β : α -> Type.{u1}} [_inst_1 : DecidableEq.{succ u2} α] [_inst_2 : Fintype.{u2} α] [_inst_3 : forall (a : α), Fintype.{u1} (β a)], Eq.{max (succ u2) (succ u1)} (Finset.{max u1 u2} (forall (a : α), (Membership.mem.{u2, u2} α (Finset.{u2} α) (Finset.instMembershipFinset.{u2} α) a (Finset.univ.{u2} α _inst_2)) -> (β a))) (Finset.pi.{u1, u2} α (fun (a : α) => β a) (fun (a : α) (b : α) => _inst_1 a b) (Finset.univ.{u2} α _inst_2) (fun (a : α) => Finset.univ.{u1} (β a) (_inst_3 a))) (Finset.univ.{max u2 u1} (forall (a : α), (Membership.mem.{u2, u2} α (Finset.{u2} α) (Finset.instMembershipFinset.{u2} α) a (Finset.univ.{u2} α _inst_2)) -> (β a)) (Pi.fintype.{u2, u1} α (fun (a : α) => (Membership.mem.{u2, u2} α (Finset.{u2} α) (Finset.instMembershipFinset.{u2} α) a (Finset.univ.{u2} α _inst_2)) -> (β a)) (fun (a : α) (b : α) => _inst_1 a b) _inst_2 (fun (a : α) => pfunFintype.{u1} (Membership.mem.{u2, u2} α (Finset.{u2} α) (Finset.instMembershipFinset.{u2} α) a (Finset.univ.{u2} α _inst_2)) (Finset.decidableMem.{u2} α (fun (a : α) (b : α) => _inst_1 a b) a (Finset.univ.{u2} α _inst_2)) (fun (H : Membership.mem.{u2, u2} α (Finset.{u2} α) (Finset.instMembershipFinset.{u2} α) a (Finset.univ.{u2} α _inst_2)) => β a) (fun (hp : Membership.mem.{u2, u2} α (Finset.{u2} α) (Finset.instMembershipFinset.{u2} α) a (Finset.univ.{u2} α _inst_2)) => (fun (a : α) => _inst_3 a) a))))
Case conversion may be inaccurate. Consider using '#align finset.univ_pi_univ Finset.univ_pi_univₓ'. -/
@[simp]
theorem Finset.univ_pi_univ {α : Type _} {β : α → Type _} [DecidableEq α] [Fintype α]
    [∀ a, Fintype (β a)] :
    (Finset.univ.pi fun a : α => (Finset.univ : Finset (β a))) = Finset.univ :=
  by
  ext
  simp
#align finset.univ_pi_univ Finset.univ_pi_univ


/-
Copyright (c) 2021 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Yury Kudryashov
-/
import topology.algebra.order.intermediate_value
import topology.local_extr

/-!
# Compactness of a closed interval

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

In this file we prove that a closed interval in a conditionally complete linear ordered type with
order topology (or a product of such types) is compact.

We prove the extreme value theorem (`is_compact.exists_forall_le`, `is_compact.exists_forall_ge`):
a continuous function on a compact set takes its minimum and maximum values. We provide many
variations of this theorem.

We also prove that the image of a closed interval under a continuous map is a closed interval, see
`continuous_on.image_Icc`.

## Tags

compact, extreme value theorem
-/

open filter order_dual topological_space function set
open_locale filter topology

/-!
### Compactness of a closed interval

In this section we define a typeclass `compact_Icc_space α` saying that all closed intervals in `α`
are compact. Then we provide an instance for a `conditionally_complete_linear_order` and prove that
the product (both `α × β` and an indexed product) of spaces with this property inherits the
property.

We also prove some simple lemmas about spaces with this property.
-/

/-- This typeclass says that all closed intervals in `α` are compact. This is true for all
conditionally complete linear orders with order topology and products (finite or infinite)
of such spaces. -/
class compact_Icc_space (α : Type*) [topological_space α] [preorder α] : Prop :=
(is_compact_Icc : ∀ {a b : α}, is_compact (Icc a b))

export compact_Icc_space (is_compact_Icc)

/-- A closed interval in a conditionally complete linear order is compact. -/
@[priority 100]
instance conditionally_complete_linear_order.to_compact_Icc_space
  (α : Type*) [conditionally_complete_linear_order α] [topological_space α] [order_topology α] :
  compact_Icc_space α :=
begin
  refine ⟨λ a b, _⟩,
  cases le_or_lt a b with hab hab, swap, { simp [hab] },
  refine is_compact_iff_ultrafilter_le_nhds.2 (λ f hf, _),
  contrapose! hf,
  rw [le_principal_iff],
  have hpt : ∀ x ∈ Icc a b, {x} ∉ f,
    from λ x hx hxf, hf x hx ((le_pure_iff.2 hxf).trans (pure_le_nhds x)),
  set s := {x ∈ Icc a b | Icc a x ∉ f},
  have hsb : b ∈ upper_bounds s, from λ x hx, hx.1.2,
  have sbd : bdd_above s, from ⟨b, hsb⟩,
  have ha : a ∈ s, by simp [hpt, hab],
  rcases hab.eq_or_lt with rfl|hlt, { exact ha.2 },
  set c := Sup s,
  have hsc : is_lub s c, from is_lub_cSup ⟨a, ha⟩ sbd,
  have hc : c ∈ Icc a b, from ⟨hsc.1 ha, hsc.2 hsb⟩,
  specialize hf c hc,
  have hcs : c ∈ s,
  { cases hc.1.eq_or_lt with heq hlt, { rwa ← heq },
    refine ⟨hc, λ hcf, hf (λ U hU, _)⟩,
    rcases (mem_nhds_within_Iic_iff_exists_Ioc_subset' hlt).1 (mem_nhds_within_of_mem_nhds hU)
      with ⟨x, hxc, hxU⟩,
    rcases ((hsc.frequently_mem ⟨a, ha⟩).and_eventually
      (Ioc_mem_nhds_within_Iic ⟨hxc, le_rfl⟩)).exists
      with ⟨y, ⟨hyab, hyf⟩, hy⟩,
    refine mem_of_superset(f.diff_mem_iff.2 ⟨hcf, hyf⟩) (subset.trans _ hxU),
    rw diff_subset_iff,
    exact subset.trans Icc_subset_Icc_union_Ioc
      (union_subset_union subset.rfl $ Ioc_subset_Ioc_left hy.1.le) },
  cases hc.2.eq_or_lt with heq hlt, { rw ← heq, exact hcs.2 },
  contrapose! hf,
  intros U hU,
  rcases (mem_nhds_within_Ici_iff_exists_mem_Ioc_Ico_subset hlt).1 (mem_nhds_within_of_mem_nhds hU)
    with ⟨y, hxy, hyU⟩,
  refine mem_of_superset _ hyU, clear_dependent U,
  have hy : y ∈ Icc a b, from ⟨hc.1.trans hxy.1.le, hxy.2⟩,
  by_cases hay : Icc a y ∈ f,
  { refine mem_of_superset (f.diff_mem_iff.2 ⟨f.diff_mem_iff.2 ⟨hay, hcs.2⟩, hpt y hy⟩) _,
    rw [diff_subset_iff, union_comm, Ico_union_right hxy.1.le, diff_subset_iff],
    exact Icc_subset_Icc_union_Icc },
  { exact ((hsc.1 ⟨hy, hay⟩).not_lt hxy.1).elim },
end

instance {ι : Type*} {α : ι → Type*} [Π i, preorder (α i)] [Π i, topological_space (α i)]
  [Π i, compact_Icc_space (α i)] : compact_Icc_space (Π i, α i) :=
⟨λ a b, pi_univ_Icc a b ▸ is_compact_univ_pi $ λ i, is_compact_Icc⟩

instance pi.compact_Icc_space' {α β : Type*} [preorder β] [topological_space β]
  [compact_Icc_space β] : compact_Icc_space (α → β) :=
pi.compact_Icc_space

instance {α β : Type*} [preorder α] [topological_space α] [compact_Icc_space α]
  [preorder β] [topological_space β] [compact_Icc_space β] :
  compact_Icc_space (α × β) :=
⟨λ a b, (Icc_prod_eq a b).symm ▸ is_compact_Icc.prod is_compact_Icc⟩

/-- An unordered closed interval is compact. -/
lemma is_compact_uIcc {α : Type*} [linear_order α] [topological_space α] [compact_Icc_space α]
  {a b : α} : is_compact (uIcc a b) :=
is_compact_Icc

/-- A complete linear order is a compact space.

We do not register an instance for a `[compact_Icc_space α]` because this would only add instances
for products (indexed or not) of complete linear orders, and we have instances with higher priority
that cover these cases. -/
@[priority 100] -- See note [lower instance priority]
instance compact_space_of_complete_linear_order {α : Type*} [complete_linear_order α]
  [topological_space α] [order_topology α] :
  compact_space α :=
⟨by simp only [← Icc_bot_top, is_compact_Icc]⟩

section

variables {α : Type*} [preorder α] [topological_space α] [compact_Icc_space α]

instance compact_space_Icc (a b : α) : compact_space (Icc a b) :=
is_compact_iff_compact_space.mp is_compact_Icc

end

/-!
### Min and max elements of a compact set
-/

variables {α β γ : Type*} [conditionally_complete_linear_order α] [topological_space α]
  [order_topology α] [topological_space β] [topological_space γ]

lemma is_compact.Inf_mem {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
  Inf s ∈ s :=
hs.is_closed.cInf_mem ne_s hs.bdd_below

lemma is_compact.Sup_mem {s : set α} (hs : is_compact s) (ne_s : s.nonempty) : Sup s ∈ s :=
@is_compact.Inf_mem αᵒᵈ _ _ _ _ hs ne_s

lemma is_compact.is_glb_Inf {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
  is_glb s (Inf s) :=
is_glb_cInf ne_s hs.bdd_below

lemma is_compact.is_lub_Sup {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
  is_lub s (Sup s) :=
@is_compact.is_glb_Inf αᵒᵈ _ _ _ _ hs ne_s

lemma is_compact.is_least_Inf {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
  is_least s (Inf s) :=
⟨hs.Inf_mem ne_s, (hs.is_glb_Inf ne_s).1⟩

lemma is_compact.is_greatest_Sup {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
  is_greatest s (Sup s) :=
@is_compact.is_least_Inf αᵒᵈ _ _ _ _ hs ne_s

lemma is_compact.exists_is_least {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
  ∃ x, is_least s x :=
⟨_, hs.is_least_Inf ne_s⟩

lemma is_compact.exists_is_greatest {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
  ∃ x, is_greatest s x :=
⟨_, hs.is_greatest_Sup ne_s⟩

lemma is_compact.exists_is_glb {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
  ∃ x ∈ s, is_glb s x :=
⟨_, hs.Inf_mem ne_s, hs.is_glb_Inf ne_s⟩

lemma is_compact.exists_is_lub {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
  ∃ x ∈ s, is_lub s x :=
⟨_, hs.Sup_mem ne_s, hs.is_lub_Sup ne_s⟩

lemma is_compact.exists_Inf_image_eq_and_le {s : set β} (hs : is_compact s) (ne_s : s.nonempty)
  {f : β → α} (hf : continuous_on f s) :
  ∃ x ∈ s, Inf (f '' s) = f x ∧ ∀ y ∈ s, f x ≤ f y :=
let ⟨x, hxs, hx⟩ := (hs.image_of_continuous_on hf).Inf_mem (ne_s.image f)
in ⟨x, hxs, hx.symm, λ y hy,
  hx.trans_le $ cInf_le (hs.image_of_continuous_on hf).bdd_below $ mem_image_of_mem f hy⟩

lemma is_compact.exists_Sup_image_eq_and_ge {s : set β} (hs : is_compact s) (ne_s : s.nonempty)
  {f : β → α} (hf : continuous_on f s) :
  ∃ x ∈ s, Sup (f '' s) = f x ∧ ∀ y ∈ s, f y ≤ f x :=
@is_compact.exists_Inf_image_eq_and_le αᵒᵈ _ _ _ _ _ _ hs ne_s _ hf

lemma is_compact.exists_Inf_image_eq {s : set β} (hs : is_compact s) (ne_s : s.nonempty)
  {f : β → α} (hf : continuous_on f s) :
  ∃ x ∈ s,  Inf (f '' s) = f x :=
let ⟨x, hxs, hx, _⟩ := hs.exists_Inf_image_eq_and_le ne_s hf in ⟨x, hxs, hx⟩

lemma is_compact.exists_Sup_image_eq :
  ∀ {s : set β}, is_compact s → s.nonempty → ∀ {f : β → α}, continuous_on f s →
  ∃ x ∈ s, Sup (f '' s) = f x :=
@is_compact.exists_Inf_image_eq αᵒᵈ _ _ _ _ _

lemma eq_Icc_of_connected_compact {s : set α} (h₁ : is_connected s) (h₂ : is_compact s) :
  s = Icc (Inf s) (Sup s) :=
eq_Icc_cInf_cSup_of_connected_bdd_closed h₁ h₂.bdd_below h₂.bdd_above h₂.is_closed

/-!
### Extreme value theorem
-/

/-- The **extreme value theorem**: a continuous function realizes its minimum on a compact set. -/
lemma is_compact.exists_forall_le {s : set β} (hs : is_compact s) (ne_s : s.nonempty)
  {f : β → α} (hf : continuous_on f s) :
  ∃x∈s, ∀y∈s, f x ≤ f y :=
begin
  rcases (hs.image_of_continuous_on hf).exists_is_least (ne_s.image f)
    with ⟨_, ⟨x, hxs, rfl⟩, hx⟩,
  exact ⟨x, hxs, ball_image_iff.1 hx⟩
end

/-- The **extreme value theorem**: a continuous function realizes its maximum on a compact set. -/
lemma is_compact.exists_forall_ge :
  ∀ {s : set β}, is_compact s → s.nonempty → ∀ {f : β → α}, continuous_on f s →
  ∃x∈s, ∀y∈s, f y ≤ f x :=
@is_compact.exists_forall_le αᵒᵈ _ _ _ _ _

/-- The **extreme value theorem**: if a function `f` is continuous on a closed set `s` and it is
larger than a value in its image away from compact sets, then it has a minimum on this set. -/
lemma continuous_on.exists_forall_le' {s : set β} {f : β → α} (hf : continuous_on f s)
  (hsc : is_closed s) {x₀ : β} (h₀ : x₀ ∈ s) (hc : ∀ᶠ x in cocompact β ⊓ 𝓟 s, f x₀ ≤ f x) :
  ∃ x ∈ s, ∀ y ∈ s, f x ≤ f y :=
begin
  rcases (has_basis_cocompact.inf_principal _).eventually_iff.1 hc with ⟨K, hK, hKf⟩,
  have hsub : insert x₀ (K ∩ s) ⊆ s, from insert_subset.2 ⟨h₀, inter_subset_right _ _⟩,
  obtain ⟨x, hx, hxf⟩ : ∃ x ∈ insert x₀ (K ∩ s), ∀ y ∈ insert x₀ (K ∩ s), f x ≤ f y :=
    ((hK.inter_right hsc).insert x₀).exists_forall_le (insert_nonempty _ _) (hf.mono hsub),
  refine ⟨x, hsub hx, λ y hy, _⟩,
  by_cases hyK : y ∈ K,
  exacts [hxf _ (or.inr ⟨hyK, hy⟩), (hxf _ (or.inl rfl)).trans (hKf ⟨hyK, hy⟩)]
end

/-- The **extreme value theorem**: if a function `f` is continuous on a closed set `s` and it is
smaller than a value in its image away from compact sets, then it has a maximum on this set. -/
lemma continuous_on.exists_forall_ge' {s : set β} {f : β → α} (hf : continuous_on f s)
  (hsc : is_closed s) {x₀ : β} (h₀ : x₀ ∈ s) (hc : ∀ᶠ x in cocompact β ⊓ 𝓟 s, f x ≤ f x₀) :
  ∃ x ∈ s, ∀ y ∈ s, f y ≤ f x :=
@continuous_on.exists_forall_le' αᵒᵈ _ _ _ _ _ _ _ hf hsc _ h₀ hc

/-- The **extreme value theorem**: if a continuous function `f` is larger than a value in its range
away from compact sets, then it has a global minimum. -/
lemma _root_.continuous.exists_forall_le' {f : β → α} (hf : continuous f) (x₀ : β)
  (h : ∀ᶠ x in cocompact β, f x₀ ≤ f x) : ∃ (x : β), ∀ (y : β), f x ≤ f y :=
let ⟨x, _, hx⟩ := hf.continuous_on.exists_forall_le' is_closed_univ (mem_univ x₀)
  (by rwa [principal_univ, inf_top_eq])
in ⟨x, λ y, hx y (mem_univ y)⟩

/-- The **extreme value theorem**: if a continuous function `f` is smaller than a value in its range
away from compact sets, then it has a global maximum. -/
lemma _root_.continuous.exists_forall_ge' {f : β → α} (hf : continuous f) (x₀ : β)
  (h : ∀ᶠ x in cocompact β, f x ≤ f x₀) : ∃ (x : β), ∀ (y : β), f y ≤ f x :=
@continuous.exists_forall_le' αᵒᵈ _ _ _ _ _ _ hf x₀ h

/-- The **extreme value theorem**: if a continuous function `f` tends to infinity away from compact
sets, then it has a global minimum. -/
lemma _root_.continuous.exists_forall_le [nonempty β] {f : β → α}
  (hf : continuous f) (hlim : tendsto f (cocompact β) at_top) :
  ∃ x, ∀ y, f x ≤ f y :=
by { inhabit β, exact hf.exists_forall_le' default (hlim.eventually $ eventually_ge_at_top _) }

/-- The **extreme value theorem**: if a continuous function `f` tends to negative infinity away from
compact sets, then it has a global maximum. -/
lemma continuous.exists_forall_ge [nonempty β] {f : β → α}
  (hf : continuous f) (hlim : tendsto f (cocompact β) at_bot) :
  ∃ x, ∀ y, f y ≤ f x :=
@continuous.exists_forall_le αᵒᵈ _ _ _ _ _ _ _ hf hlim

lemma is_compact.Sup_lt_iff_of_continuous {f : β → α}
  {K : set β} (hK : is_compact K) (h0K : K.nonempty) (hf : continuous_on f K) (y : α) :
  Sup (f '' K) < y ↔ ∀ x ∈ K, f x < y :=
begin
  refine ⟨λ h x hx, (le_cSup (hK.bdd_above_image hf) $ mem_image_of_mem f hx).trans_lt h, λ h, _⟩,
  obtain ⟨x, hx, h2x⟩ := hK.exists_forall_ge h0K hf,
  refine (cSup_le (h0K.image f) _).trans_lt (h x hx),
  rintro _ ⟨x', hx', rfl⟩, exact h2x x' hx'
end

lemma is_compact.lt_Inf_iff_of_continuous {α β : Type*}
  [conditionally_complete_linear_order α] [topological_space α]
  [order_topology α] [topological_space β] {f : β → α}
  {K : set β} (hK : is_compact K) (h0K : K.nonempty) (hf : continuous_on f K) (y : α) :
  y < Inf (f '' K) ↔ ∀ x ∈ K, y < f x :=
@is_compact.Sup_lt_iff_of_continuous αᵒᵈ β _ _ _ _ _ _ hK h0K hf y

/-- A continuous function with compact support has a global minimum. -/
@[to_additive "A continuous function with compact support has a global minimum."]
lemma continuous.exists_forall_le_of_has_compact_mul_support [nonempty β] [has_one α]
  {f : β → α} (hf : continuous f) (h : has_compact_mul_support f) :
  ∃ (x : β), ∀ (y : β), f x ≤ f y :=
begin
  obtain ⟨_, ⟨x, rfl⟩, hx⟩ := (h.is_compact_range hf).exists_is_least (range_nonempty _),
  rw [mem_lower_bounds, forall_range_iff] at hx,
  exact ⟨x, hx⟩,
end

/-- A continuous function with compact support has a global maximum. -/
@[to_additive "A continuous function with compact support has a global maximum."]
lemma continuous.exists_forall_ge_of_has_compact_mul_support [nonempty β] [has_one α]
  {f : β → α} (hf : continuous f) (h : has_compact_mul_support f) :
  ∃ (x : β), ∀ (y : β), f y ≤ f x :=
@continuous.exists_forall_le_of_has_compact_mul_support αᵒᵈ _ _ _ _ _ _ _ _ hf h

lemma is_compact.continuous_Sup {f : γ → β → α}
  {K : set β} (hK : is_compact K) (hf : continuous ↿f) :
    continuous (λ x, Sup (f x '' K)) :=
begin
  rcases eq_empty_or_nonempty K with rfl|h0K,
  { simp_rw [image_empty], exact continuous_const },
  rw [continuous_iff_continuous_at],
  intro x,
  obtain ⟨y, hyK, h2y, hy⟩ :=
    hK.exists_Sup_image_eq_and_ge h0K
      (show continuous (λ y, f x y), from hf.comp $ continuous.prod.mk x).continuous_on,
  rw [continuous_at, h2y, tendsto_order],
  have := tendsto_order.mp ((show continuous (λ x, f x y), from
    hf.comp $ continuous_id.prod_mk continuous_const).tendsto x),
  refine ⟨λ z hz, _, λ z hz, _⟩,
  { refine (this.1 z hz).mono (λ x' hx', hx'.trans_le $ le_cSup _ $ mem_image_of_mem (f x') hyK),
    exact hK.bdd_above_image (hf.comp $ continuous.prod.mk x').continuous_on },
  { have h : ({x} : set γ) ×ˢ K ⊆ ↿f ⁻¹' (Iio z),
    { rintro ⟨x', y'⟩ ⟨hx', hy'⟩, cases hx', exact (hy y' hy').trans_lt hz },
    obtain ⟨u, v, hu, hv, hxu, hKv, huv⟩ :=
      generalized_tube_lemma is_compact_singleton hK (is_open_Iio.preimage hf) h,
    refine eventually_of_mem (hu.mem_nhds (singleton_subset_iff.mp hxu)) (λ x' hx', _),
    rw [hK.Sup_lt_iff_of_continuous h0K
      (show continuous (f x'), from (hf.comp $ continuous.prod.mk x')).continuous_on],
    exact λ y' hy', huv (mk_mem_prod hx' (hKv hy')) }
end

lemma is_compact.continuous_Inf {f : γ → β → α}
  {K : set β} (hK : is_compact K) (hf : continuous ↿f) :
    continuous (λ x, Inf (f x '' K)) :=
@is_compact.continuous_Sup αᵒᵈ β γ _ _ _ _ _ _ _ hK hf

namespace continuous_on
/-!
### Image of a closed interval
-/

variables [densely_ordered α] [conditionally_complete_linear_order β] [order_topology β]
  {f : α → β} {a b c : α}

open_locale interval

lemma image_Icc (hab : a ≤ b) (h : continuous_on f $ Icc a b) :
  f '' Icc a b = Icc (Inf $ f '' Icc a b) (Sup $ f '' Icc a b) :=
eq_Icc_of_connected_compact ⟨(nonempty_Icc.2 hab).image f, is_preconnected_Icc.image f h⟩
  (is_compact_Icc.image_of_continuous_on h)

lemma image_uIcc_eq_Icc (h : continuous_on f $ [a, b]) :
  f '' [a, b] = Icc (Inf (f '' [a, b])) (Sup (f '' [a, b])) :=
begin
  cases le_total a b with h2 h2,
  { simp_rw [uIcc_of_le h2] at h ⊢, exact h.image_Icc h2 },
  { simp_rw [uIcc_of_ge h2] at h ⊢, exact h.image_Icc h2 },
end

lemma image_uIcc (h : continuous_on f $ [a, b]) :
  f '' [a, b] = [Inf (f '' [a, b]), Sup (f '' [a, b])] :=
begin
  refine h.image_uIcc_eq_Icc.trans (uIcc_of_le _).symm,
  refine cInf_le_cSup _ _ (nonempty_uIcc.image _); rw h.image_uIcc_eq_Icc,
  exacts [bdd_below_Icc, bdd_above_Icc]
end

lemma Inf_image_Icc_le (h : continuous_on f $ Icc a b) (hc : c ∈ Icc a b) :
  Inf (f '' (Icc a b)) ≤ f c :=
begin
  rw h.image_Icc (nonempty_Icc.mp (set.nonempty_of_mem hc)),
  exact cInf_le bdd_below_Icc (mem_Icc.mpr ⟨cInf_le (is_compact_Icc.bdd_below_image h) ⟨c, hc, rfl⟩,
     le_cSup (is_compact_Icc.bdd_above_image h) ⟨c, hc, rfl⟩⟩),
end

lemma le_Sup_image_Icc (h : continuous_on f $ Icc a b) (hc : c ∈ Icc a b) :
  f c ≤ Sup (f '' (Icc a b)) :=
begin
  rw h.image_Icc (nonempty_Icc.mp (set.nonempty_of_mem hc)),
  exact le_cSup bdd_above_Icc (mem_Icc.mpr ⟨cInf_le (is_compact_Icc.bdd_below_image h) ⟨c, hc, rfl⟩,
     le_cSup (is_compact_Icc.bdd_above_image h) ⟨c, hc, rfl⟩⟩),
end

end continuous_on

lemma is_compact.exists_local_min_on_mem_subset {f : β → α} {s t : set β} {z : β}
  (ht : is_compact t) (hf : continuous_on f t) (hz : z ∈ t) (hfz : ∀ z' ∈ t \ s, f z < f z') :
  ∃ x ∈ s, is_local_min_on f t x :=
begin
  obtain ⟨x, hx, hfx⟩ : ∃ x ∈ t, ∀ y ∈ t, f x ≤ f y := ht.exists_forall_le ⟨z, hz⟩ hf,
  have key : ∀ ⦃y⦄, y ∈ t → (∀ z' ∈ t \ s, f y < f z') → y ∈ s := λ y hy hfy,
    by { by_contra; simpa using ((hfy y ((mem_diff y).mpr ⟨hy,h⟩))) },
  have h1 : ∀ z' ∈ t \ s, f x < f z' := λ z' hz', (hfx z hz).trans_lt (hfz z' hz'),
  have h2 : x ∈ s := key hx h1,
  refine ⟨x, h2, eventually_nhds_within_of_forall hfx⟩
end

lemma is_compact.exists_local_min_mem_open {f : β → α} {s t : set β} {z : β} (ht : is_compact t)
  (hst : s ⊆ t) (hf : continuous_on f t) (hz : z ∈ t) (hfz : ∀ z' ∈ t \ s, f z < f z')
  (hs : is_open s) :
  ∃ x ∈ s, is_local_min f x :=
begin
  obtain ⟨x, hx, hfx⟩ := ht.exists_local_min_on_mem_subset hf hz hfz,
  exact ⟨x, hx, hfx.is_local_min (filter.mem_of_superset (hs.mem_nhds hx) hst)⟩
end


/-
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, Aaron Anderson
-/
import ring_theory.coprime.basic
import ring_theory.principal_ideal_domain

/-!
# Divisibility over ℕ and ℤ

This file collects results for the integers and natural numbers that use abstract algebra in
their proofs or cases of ℕ and ℤ being examples of structures in abstract algebra.

## Main statements

* `nat.prime_iff`: `nat.prime` coincides with the general definition of `prime`
* `nat.irreducible_iff_prime`: a non-unit natural number is only divisible by `1` iff it is prime
* `nat.factors_eq`: the multiset of elements of `nat.factors` is equal to the factors
   given by the `unique_factorization_monoid` instance
* ℤ is a `normalization_monoid`
* ℤ is a `gcd_monoid`

## Tags

prime, irreducible, natural numbers, integers, normalization monoid, gcd monoid,
greatest common divisor, prime factorization, prime factors, unique factorization,
unique factors
-/

theorem nat.prime_iff {p : ℕ} : p.prime ↔ prime p :=
begin
  split; intro h,
  { refine ⟨h.ne_zero, ⟨_, λ a b, _⟩⟩,
    { rw nat.is_unit_iff, apply h.ne_one },
    { apply h.dvd_mul.1 } },
  { refine ⟨_, λ m hm, _⟩,
    { cases p, { exfalso, apply h.ne_zero rfl },
      cases p, { exfalso, apply h.ne_one rfl },
      exact (add_le_add_right (zero_le p) 2 : _ ) },
    { cases hm with n hn,
      cases h.2.2 m n (hn ▸ dvd_rfl) with hpm hpn,
      { right, apply nat.dvd_antisymm (dvd.intro _ hn.symm) hpm },
      { left,
        cases n, { exfalso, rw [hn, mul_zero] at h, apply h.ne_zero rfl },
        apply nat.eq_of_mul_eq_mul_right (nat.succ_pos _),
        rw [← hn, one_mul],
        apply nat.dvd_antisymm hpn (dvd.intro m _),
        rw [mul_comm, hn], }, } }
end

theorem nat.irreducible_iff_prime {p : ℕ} : irreducible p ↔ prime p :=
begin
  refine ⟨λ h, _, prime.irreducible⟩,
  rw ← nat.prime_iff,
  refine ⟨_, λ m hm, _⟩,
  { cases p, { exfalso, apply h.ne_zero rfl },
    cases p, { exfalso, apply h.not_unit is_unit_one, },
    exact (add_le_add_right (zero_le p) 2 : _ ) },
  { cases hm with n hn,
    cases h.is_unit_or_is_unit hn with um un,
    { left, rw nat.is_unit_iff.1 um, },
    { right, rw [hn, nat.is_unit_iff.1 un, mul_one], } }
end

namespace nat

instance : wf_dvd_monoid ℕ :=
⟨begin
  apply rel_hom.well_founded _ (with_top.well_founded_lt nat.lt_wf),
  refine ⟨λ x, if x = 0 then ⊤ else x, _⟩,
  intros a b h,
  cases a,
  { exfalso, revert h, simp [dvd_not_unit] },
  cases b,
  {simp [succ_ne_zero, with_top.coe_lt_top]},
  cases dvd_and_not_dvd_iff.2 h with h1 h2,
  simp only [succ_ne_zero, with_top.coe_lt_coe, if_false],
  apply lt_of_le_of_ne (nat.le_of_dvd (nat.succ_pos _) h1) (λ con, h2 _),
  rw con,
end⟩

instance : unique_factorization_monoid ℕ :=
⟨λ _, nat.irreducible_iff_prime⟩

end nat

/-- `ℕ` is a gcd_monoid. -/
instance : gcd_monoid ℕ :=
{ gcd := nat.gcd,
  lcm := nat.lcm,
  gcd_dvd_left := nat.gcd_dvd_left ,
  gcd_dvd_right := nat.gcd_dvd_right,
  dvd_gcd := λ a b c, nat.dvd_gcd,
  gcd_mul_lcm := λ a b, by rw [nat.gcd_mul_lcm],
  lcm_zero_left := nat.lcm_zero_left,
  lcm_zero_right := nat.lcm_zero_right }

instance : normalized_gcd_monoid ℕ :=
{ normalize_gcd := λ a b, normalize_eq _,
  normalize_lcm := λ a b, normalize_eq _,
  .. (infer_instance : gcd_monoid ℕ),
  .. (infer_instance : normalization_monoid ℕ) }

lemma gcd_eq_nat_gcd (m n : ℕ) : gcd m n = nat.gcd m n := rfl

lemma lcm_eq_nat_lcm (m n : ℕ) : lcm m n = nat.lcm m n := rfl

namespace int

section normalization_monoid

instance : normalization_monoid ℤ :=
{ 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
    cases hna.lt_or_lt with ha ha; cases hnb.lt_or_lt with hb hb;
      simp [mul_nonneg_iff, ha.le, ha.not_le, hb.le, hb.not_le]
  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 dec_trivial)), }

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

lemma nonneg_of_normalize_eq_self {z : ℤ} (hz : normalize z = z) : 0 ≤ z :=
calc 0 ≤ (z.nat_abs : ℤ) : coe_zero_le _
... = normalize z : coe_nat_abs_eq_normalize _
... = z : hz

lemma nonneg_iff_normalize_eq_self (z : ℤ) : normalize z = z ↔ 0 ≤ z :=
⟨nonneg_of_normalize_eq_self, normalize_of_nonneg⟩

lemma eq_of_associated_of_nonneg {a b : ℤ} (h : associated a b) (ha : 0 ≤ a) (hb : 0 ≤ b) : a = b :=
dvd_antisymm_of_normalize_eq (normalize_of_nonneg ha) (normalize_of_nonneg hb) h.dvd h.symm.dvd

end normalization_monoid

section gcd_monoid

instance : gcd_monoid ℤ :=
{ 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,
  gcd_mul_lcm    := λ a b, by
  { rw [← int.coe_nat_mul, gcd_mul_lcm, coe_nat_abs_eq_normalize],
    exact normalize_associated (a * b) },
  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 _}

instance : normalized_gcd_monoid ℤ :=
{ normalize_gcd  := λ a b, normalize_coe_nat _,
  normalize_lcm  := λ a b, normalize_coe_nat _,
  .. int.normalization_monoid,
  .. (infer_instance : gcd_monoid ℤ) }

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

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

end gcd_monoid

lemma exists_unit_of_abs (a : ℤ) : ∃ (u : ℤ) (h : is_unit u), (int.nat_abs a : ℤ) = u * a :=
begin
  cases (nat_abs_eq a) with h,
  { use [1, is_unit_one], rw [← h, one_mul], },
  { use [-1, is_unit_one.neg], rw [ ← neg_eq_iff_neg_eq.mp (eq.symm h)],
    simp only [neg_mul_eq_neg_mul_symm, one_mul] }
end

lemma gcd_eq_nat_abs {a b : ℤ} : int.gcd a b = nat.gcd a.nat_abs b.nat_abs := rfl

lemma gcd_eq_one_iff_coprime {a b : ℤ} : int.gcd a b = 1 ↔ is_coprime a b :=
begin
  split,
  { intro hg,
    obtain ⟨ua, hua, ha⟩ := exists_unit_of_abs a,
    obtain ⟨ub, hub, hb⟩ := exists_unit_of_abs b,
    use [(nat.gcd_a (int.nat_abs a) (int.nat_abs b)) * ua,
        (nat.gcd_b (int.nat_abs a) (int.nat_abs b)) * ub],
    rw [mul_assoc, ← ha, mul_assoc, ← hb, mul_comm, mul_comm _ (int.nat_abs b : ℤ),
      ← nat.gcd_eq_gcd_ab, ←gcd_eq_nat_abs, hg, int.coe_nat_one] },
  { rintro ⟨r, s, h⟩,
    by_contradiction hg,
    obtain ⟨p, ⟨hp, ha, hb⟩⟩ := nat.prime.not_coprime_iff_dvd.mp hg,
    apply nat.prime.not_dvd_one hp,
    rw [←coe_nat_dvd, int.coe_nat_one, ← h],
    exact dvd_add ((coe_nat_dvd_left.mpr ha).mul_left _)
      ((coe_nat_dvd_left.mpr hb).mul_left _) }
end

lemma coprime_iff_nat_coprime {a b : ℤ} : is_coprime a b ↔ nat.coprime a.nat_abs b.nat_abs :=
by rw [←gcd_eq_one_iff_coprime, nat.coprime_iff_gcd_eq_one, gcd_eq_nat_abs]

lemma sq_of_gcd_eq_one {a b c : ℤ} (h : int.gcd a b = 1) (heq : a * b = c ^ 2) :
  ∃ (a0 : ℤ), a = a0 ^ 2 ∨ a = - (a0 ^ 2) :=
begin
  have h' : is_unit (gcd_monoid.gcd a b), { rw [← coe_gcd, h, int.coe_nat_one], exact is_unit_one },
  obtain ⟨d, ⟨u, hu⟩⟩ := exists_associated_pow_of_mul_eq_pow h' heq,
  use d,
  rw ← hu,
  cases int.units_eq_one_or u with hu' hu'; { rw hu', simp }
end

lemma sq_of_coprime {a b c : ℤ} (h : is_coprime a b) (heq : a * b = c ^ 2) :
  ∃ (a0 : ℤ), a = a0 ^ 2 ∨ a = - (a0 ^ 2) := sq_of_gcd_eq_one (gcd_eq_one_iff_coprime.mpr h) heq

lemma nat_abs_euclidean_domain_gcd (a b : ℤ) :
  int.nat_abs (euclidean_domain.gcd a b) = int.gcd a b :=
begin
  apply nat.dvd_antisymm; rw ← int.coe_nat_dvd,
  { rw int.nat_abs_dvd,
    exact int.dvd_gcd (euclidean_domain.gcd_dvd_left _ _) (euclidean_domain.gcd_dvd_right _ _) },
  { rw int.dvd_nat_abs,
    exact euclidean_domain.dvd_gcd (int.gcd_dvd_left _ _) (int.gcd_dvd_right _ _) }
end

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_iff, (≥), 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_int {p : ℕ} : p.prime ↔ _root_.prime (p : ℤ) :=
⟨λ hp, ⟨int.coe_nat_ne_zero_iff_pos.2 hp.pos, mt int.is_unit_iff_nat_abs_eq.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.2 ⟨int.coe_nat_ne_zero.1 hp.1,
      mt nat.is_unit_iff.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⟩⟩

/-- Maps an associate class of integers consisting of `-n, n` to `n : ℕ` -/
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] },
  { intro n, dsimp, rw [associates.out_mk ↑n,
    ← int.coe_nat_abs_eq_normalize, int.nat_abs_of_nat, int.nat_abs_of_nat] }
end

lemma int.prime.dvd_mul {m n : ℤ} {p : ℕ}
  (hp : nat.prime p) (h : (p : ℤ) ∣ m * n) : p ∣ m.nat_abs ∨ p ∣ n.nat_abs :=
begin
  apply (nat.prime.dvd_mul hp).mp,
  rw ← int.nat_abs_mul,
  exact int.coe_nat_dvd_left.mp h
end

lemma int.prime.dvd_mul' {m n : ℤ} {p : ℕ}
  (hp : nat.prime p) (h : (p : ℤ) ∣ m * n) : (p : ℤ) ∣ m ∨ (p : ℤ) ∣ n :=
begin
  rw [int.coe_nat_dvd_left, int.coe_nat_dvd_left],
  exact int.prime.dvd_mul hp h
end

lemma int.prime.dvd_pow {n : ℤ} {k p : ℕ}
  (hp : nat.prime p) (h : (p : ℤ) ∣ n ^ k) : p  ∣ n.nat_abs :=
begin
  apply @nat.prime.dvd_of_dvd_pow _ _ k hp,
  rw ← int.nat_abs_pow,
  exact int.coe_nat_dvd_left.mp h
end

lemma int.prime.dvd_pow' {n : ℤ} {k p : ℕ}
  (hp : nat.prime p) (h : (p : ℤ) ∣ n ^ k) : (p : ℤ)  ∣ n :=
begin
  rw int.coe_nat_dvd_left,
  exact int.prime.dvd_pow hp h
end

lemma prime_two_or_dvd_of_dvd_two_mul_pow_self_two {m : ℤ} {p : ℕ}
  (hp : nat.prime p) (h : (p : ℤ) ∣ 2 * m ^ 2) : p = 2 ∨ p ∣ int.nat_abs m :=
begin
  cases int.prime.dvd_mul hp h with hp2 hpp,
  { apply or.intro_left,
    exact le_antisymm (nat.le_of_dvd zero_lt_two hp2) (nat.prime.two_le hp) },
  { apply or.intro_right,
    rw [sq, int.nat_abs_mul] at hpp,
    exact (or_self _).mp ((nat.prime.dvd_mul hp).mp hpp)}
end

open unique_factorization_monoid

theorem nat.factors_eq {n : ℕ} : normalized_factors n = n.factors :=
begin
  cases n, { simp },
  rw [← multiset.rel_eq, ← associated_eq_eq],
  apply factors_unique (irreducible_of_normalized_factor) _,
  { rw [multiset.coe_prod, nat.prod_factors (nat.succ_pos _)],
    apply normalized_factors_prod (nat.succ_ne_zero _) },
  { apply_instance },
  { intros x hx,
    rw [nat.irreducible_iff_prime, ← nat.prime_iff],
    exact nat.prime_of_mem_factors hx }
end

lemma nat.factors_multiset_prod_of_irreducible
  {s : multiset ℕ} (h : ∀ (x : ℕ), x ∈ s → irreducible x) :
  normalized_factors (s.prod) = s :=
begin
  rw [← multiset.rel_eq, ← associated_eq_eq],
  apply unique_factorization_monoid.factors_unique irreducible_of_normalized_factor h
    (normalized_factors_prod _),
  rw [ne.def, multiset.prod_eq_zero_iff],
  intro con,
  exact not_irreducible_zero (h 0 con),
end

namespace multiplicity

lemma finite_int_iff_nat_abs_finite {a b : ℤ} : finite a b ↔ finite a.nat_abs b.nat_abs :=
by simp only [finite_def, ← int.nat_abs_dvd_iff_dvd, int.nat_abs_pow]

lemma finite_int_iff {a b : ℤ} : finite a b ↔ (a.nat_abs ≠ 1 ∧ b ≠ 0) :=
by rw [finite_int_iff_nat_abs_finite, finite_nat_iff, pos_iff_ne_zero, int.nat_abs_ne_zero]

instance decidable_nat : decidable_rel (λ a b : ℕ, (multiplicity a b).dom) :=
λ a b, decidable_of_iff _ finite_nat_iff.symm

instance decidable_int : decidable_rel (λ a b : ℤ, (multiplicity a b).dom) :=
λ a b, decidable_of_iff _ finite_int_iff.symm

end multiplicity

lemma induction_on_primes {P : ℕ → Prop} (h₀ : P 0) (h₁ : P 1)
  (h : ∀ p a : ℕ, p.prime → P a → P (p * a)) (n : ℕ) : P n :=
begin
  apply unique_factorization_monoid.induction_on_prime,
  exact h₀,
  { intros n h,
    rw nat.is_unit_iff.1 h,
    exact h₁, },
  { intros a p _ hp ha,
    exact h p a (nat.prime_iff.2 hp) ha, },
end

lemma int.associated_nat_abs (k : ℤ) : associated k k.nat_abs :=
associated_of_dvd_dvd (int.coe_nat_dvd_right.mpr dvd_rfl) (int.nat_abs_dvd.mpr dvd_rfl)

lemma int.prime_iff_nat_abs_prime {k : ℤ} : prime k ↔ nat.prime k.nat_abs :=
(int.associated_nat_abs k).prime_iff.trans nat.prime_iff_prime_int.symm

theorem int.associated_iff_nat_abs {a b : ℤ} : associated a b ↔ a.nat_abs = b.nat_abs :=
begin
  rw [←dvd_dvd_iff_associated, ←int.nat_abs_dvd_iff_dvd,
      ←int.nat_abs_dvd_iff_dvd, dvd_dvd_iff_associated],
  exact associated_iff_eq,
end

lemma int.associated_iff {a b : ℤ} : associated a b ↔ (a = b ∨ a = -b) :=
begin
  rw int.associated_iff_nat_abs,
  exact int.nat_abs_eq_nat_abs_iff,
end

namespace int

lemma zmultiples_nat_abs (a : ℤ) :
  add_subgroup.zmultiples (a.nat_abs : ℤ) = add_subgroup.zmultiples a :=
le_antisymm
  (add_subgroup.zmultiples_subset (mem_zmultiples_iff.mpr (dvd_nat_abs.mpr (dvd_refl a))))
  (add_subgroup.zmultiples_subset (mem_zmultiples_iff.mpr (nat_abs_dvd.mpr (dvd_refl a))))

lemma span_nat_abs (a : ℤ) : ideal.span ({a.nat_abs} : set ℤ) = ideal.span {a} :=
by { rw ideal.span_singleton_eq_span_singleton, exact (associated_nat_abs _).symm }

theorem eq_pow_of_mul_eq_pow_bit1_left {a b c : ℤ}
  (hab : is_coprime a b) {k : ℕ} (h : a * b = c ^ (bit1 k)) : ∃ d, a = d ^ (bit1 k) :=
begin
  obtain ⟨d, hd⟩ := exists_associated_pow_of_mul_eq_pow' hab h,
  replace hd := hd.symm,
  rw [associated_iff_nat_abs, nat_abs_eq_nat_abs_iff, ←neg_pow_bit1] at hd,
  obtain rfl|rfl := hd; exact ⟨_, rfl⟩,
end

theorem eq_pow_of_mul_eq_pow_bit1_right {a b c : ℤ}
  (hab : is_coprime a b) {k : ℕ} (h : a * b = c ^ (bit1 k)) : ∃ d, b = d ^ (bit1 k) :=
eq_pow_of_mul_eq_pow_bit1_left hab.symm (by rwa mul_comm at h)

theorem eq_pow_of_mul_eq_pow_bit1 {a b c : ℤ}
  (hab : is_coprime a b) {k : ℕ} (h : a * b = c ^ (bit1 k)) :
  (∃ d, a = d ^ (bit1 k)) ∧ (∃ e, b = e ^ (bit1 k)) :=
⟨eq_pow_of_mul_eq_pow_bit1_left hab h, eq_pow_of_mul_eq_pow_bit1_right hab h⟩

end int


/-
Copyright (c) 2020 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton
-/
import data.set.finite

/-!
# Infinitude of intervals

Bounded intervals in dense orders are infinite, as are unbounded intervals
in orders that are unbounded on the appropriate side.
-/

namespace set

variables {α : Type*} [preorder α]

section bounded

variables [densely_ordered α]

lemma Ioo.infinite {a b : α} (h : a < b) : infinite (Ioo a b) :=
begin
  rintro (f : finite (Ioo a b)),
  obtain ⟨m, hm₁, hm₂⟩ : ∃ m ∈ Ioo a b, ∀ x ∈ Ioo a b, ¬x < m,
  { simpa [h] using finset.exists_minimal f.to_finset },
  obtain ⟨z, hz₁, hz₂⟩ : ∃ z, a < z ∧ z < m := exists_between hm₁.1,
  exact hm₂ z ⟨hz₁, lt_trans hz₂ hm₁.2⟩ hz₂,
end

lemma Ioc.infinite {a b : α} (h : a < b) : infinite (Ioc a b) :=
(Ioo.infinite h).mono Ioo_subset_Ioc_self

lemma Icc.infinite {a b : α} (h : a < b) : infinite (Icc a b) :=
(Ioo.infinite h).mono Ioo_subset_Icc_self

end bounded

section unbounded_below

variables [no_min_order α]

lemma Iio.infinite {b : α} : infinite (Iio b) :=
begin
  rintro (f : finite (Iio b)),
  obtain ⟨m, hm₁, hm₂⟩ : ∃ m < b, ∀ x < b, ¬x < m,
  { simpa using finset.exists_minimal f.to_finset },
  obtain ⟨z, hz⟩ : ∃ z, z < m := exists_lt _,
  exact hm₂ z (lt_trans hz hm₁) hz
end

lemma Iic.infinite {b : α} : infinite (Iic b) :=
Iio.infinite.mono Iio_subset_Iic_self

end unbounded_below

section unbounded_above

variables [no_max_order α]

lemma Ioi.infinite {a : α} : infinite (Ioi a) :=
by apply @Iio.infinite (order_dual α)

lemma Ici.infinite {a : α} : infinite (Ici a) :=
Ioi.infinite.mono Ioi_subset_Ici_self

end unbounded_above

end set


/-
Copyright (c) 2021 Frédéric Dupuis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Frédéric Dupuis, Heather Macbeth
-/
import data.equiv.module
import data.real.basic

/-!
# Test file for conjugate linear maps

The implementation of conjugate-linear maps in mathlib is designed to have a few convenient
properties:

1. A conjugate-linear map with respect to the ring `ℝ` (or any other ring given the "trivial"
  `star_ring` instance) is *definitionally* a plain linear map; that is, the type is the same.

2. The composition of two conjugate-linear maps is *definitionally* a plain linear map.

3. The composition of a plain linear map and a conjugate-linear map is conjugate-linear.

4. The inverse of a conjugate-linear equivalence is *definitionally* a conjugate-linear
  equivalence.

This file contains tests to make sure that future refactors do not lose these definitional
properties.

## Tags

Conjugate linear maps, semilinear maps

-/

section real
variables {M : Type*} [add_comm_monoid M] [module ℝ M]
variables {M₂ : Type*} [add_comm_monoid M₂] [module ℝ M₂]

example (f : M →ₗ⋆[ℝ] M₂) : M →ₗ[ℝ] M₂ := f

example (f : M →ₗ[ℝ] M₂) : M →ₗ⋆[ℝ] M₂ := f

end real

section star_ring
variables {R : Type*} [comm_semiring R] [star_ring R]
variables {M : Type*} [add_comm_monoid M] [module R M]
variables {M₂ : Type*} [add_comm_monoid M₂] [module R M₂]
variables {M₃ : Type*} [add_comm_monoid M₃] [module R M₃]

example (f : M →ₗ⋆[R] M₂) (g : M₂ →ₗ⋆[R] M₃) : M →ₗ[R] M₃ := g.comp f

example (f : M →ₗ[R] M₂) (g : M₂ →ₗ⋆[R] M₃) : M →ₗ⋆[R] M₃ := g.comp f
example (f : M →ₗ⋆[R] M₂) (g : M₂ →ₗ[R] M₃) : M →ₗ⋆[R] M₃ := g.comp f

example (f : M ≃ₗ⋆[R] M₂) : M₂ ≃ₗ⋆[R] M := f.symm

end star_ring