/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad
-/
import data.int.basic
import data.int.cast.basic
import algebra.ring.divisibility
import algebra.order.group.abs
import algebra.order.ring.char_zero
import tactic.assert_exists

/-!
# Order instances on the integers

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

This file contains:
* instances on `ℤ`. The stronger one is `int.linear_ordered_comm_ring`.
* basic lemmas about integers that involve order properties.

## Recursors

* `int.rec`: Sign disjunction. Something is true/defined on `ℤ` if it's true/defined for nonnegative
  and for negative values. (Defined in core Lean 3)
* `int.induction_on`: Simple growing induction on positive numbers, plus simple decreasing induction
  on negative numbers. Note that this recursor is currently only `Prop`-valued.
* `int.induction_on'`: Simple growing induction for numbers greater than `b`, plus simple decreasing
  induction on numbers less than `b`.
-/

open nat

namespace int

instance : linear_ordered_comm_ring ℤ :=
{ add_le_add_left := @int.add_le_add_left,
  mul_pos         := @int.mul_pos,
  zero_le_one     := le_of_lt int.zero_lt_one,
  .. int.comm_ring, .. int.linear_order, .. int.nontrivial }

/-! ### Extra instances to short-circuit type class resolution
-/
instance : ordered_comm_ring ℤ  := strict_ordered_comm_ring.to_ordered_comm_ring'
instance : ordered_ring ℤ       := strict_ordered_ring.to_ordered_ring'
instance : linear_ordered_add_comm_group ℤ := by apply_instance

end int

namespace int

theorem abs_eq_nat_abs : ∀ a : ℤ, |a| = nat_abs a
| (n : ℕ) := abs_of_nonneg $ coe_zero_le _
| -[1+ n] := abs_of_nonpos $ le_of_lt $ neg_succ_lt_zero _

@[simp, norm_cast] lemma coe_nat_abs (n : ℤ) : (n.nat_abs : ℤ) = |n| := n.abs_eq_nat_abs.symm

lemma _root_.nat.cast_nat_abs {α : Type*} [add_group_with_one α] (n : ℤ) : (n.nat_abs : α) = ↑|n| :=
by rw [←int.coe_nat_abs, int.cast_coe_nat]

theorem nat_abs_abs (a : ℤ) : nat_abs (|a|) = nat_abs a :=
by rw [abs_eq_nat_abs]; refl

theorem sign_mul_abs (a : ℤ) : sign a * |a| = a :=
by rw [abs_eq_nat_abs, sign_mul_nat_abs]

theorem coe_nat_eq_zero {n : ℕ} : (n : ℤ) = 0 ↔ n = 0 := nat.cast_eq_zero

theorem coe_nat_ne_zero {n : ℕ} : (n : ℤ) ≠ 0 ↔ n ≠ 0 := by simp

lemma coe_nat_ne_zero_iff_pos {n : ℕ} : (n : ℤ) ≠ 0 ↔ 0 < n :=
⟨λ h, nat.pos_of_ne_zero (coe_nat_ne_zero.1 h),
λ h, (ne_of_lt (coe_nat_lt.2 h)).symm⟩

@[norm_cast] lemma abs_coe_nat (n : ℕ) : |(n : ℤ)| = n := abs_of_nonneg (coe_nat_nonneg n)

theorem sign_add_eq_of_sign_eq : ∀ {m n : ℤ}, m.sign = n.sign → (m + n).sign = n.sign :=
begin
  have : (1 : ℤ) ≠ -1 := dec_trivial,
  rintro ((_ | m) | m) ((_ | n) | n);
  simp [this, this.symm],
  rw int.sign_eq_one_iff_pos,
  apply int.add_pos;
  { exact zero_lt_one.trans_le (le_add_of_nonneg_left $ coe_zero_le _) }
end

/-! ### succ and pred -/

theorem lt_succ_self (a : ℤ) : a < succ a :=
lt_add_of_pos_right _ zero_lt_one

theorem pred_self_lt (a : ℤ) : pred a < a :=
sub_lt_self _ zero_lt_one

theorem lt_add_one_iff {a b : ℤ} : a < b + 1 ↔ a ≤ b :=
add_le_add_iff_right _

lemma le_add_one {a b : ℤ} (h : a ≤ b) : a ≤ b + 1 :=
le_of_lt (int.lt_add_one_iff.mpr h)

theorem sub_one_lt_iff {a b : ℤ} : a - 1 < b ↔ a ≤ b :=
sub_lt_iff_lt_add.trans lt_add_one_iff

theorem le_sub_one_iff {a b : ℤ} : a ≤ b - 1 ↔ a < b :=
le_sub_iff_add_le

@[simp] lemma abs_lt_one_iff {a : ℤ} : |a| < 1 ↔ a = 0 :=
⟨λ a0, let ⟨hn, hp⟩ := abs_lt.mp a0 in (le_of_lt_add_one (by exact hp)).antisymm hn,
  λ a0, (abs_eq_zero.mpr a0).le.trans_lt zero_lt_one⟩

lemma one_le_abs {z : ℤ} (h₀: z ≠ 0) : 1 ≤ |z| :=
add_one_le_iff.mpr (abs_pos.mpr h₀)

/-- Inductively define a function on `ℤ` by defining it at `b`, for the `succ` of a number greater
than `b`, and the `pred` of a number less than `b`. -/
@[elab_as_eliminator]
protected def induction_on' {C : ℤ → Sort*} (z : ℤ) (b : ℤ)
  (H0 : C b) (Hs : ∀ k, b ≤ k → C k → C (k + 1)) (Hp : ∀ k ≤ b, C k → C (k - 1)) : C z :=
begin
  -- Note that we use `convert` here where possible as we are constructing data, and this reduces
  -- the number of times `eq.mpr` appears in the term.
  rw ←sub_add_cancel z b,
  induction (z - b) with n n,
  { induction n with n ih,
    { convert H0 using 1,
      rw [of_nat_zero, zero_add] },
    convert Hs _ (le_add_of_nonneg_left (of_nat_nonneg _)) ih using 1,
    rw [of_nat_succ, add_assoc, add_comm 1 b, ←add_assoc] },
  { induction n with n ih,
    { convert Hp _ le_rfl H0 using 1,
      rw [neg_succ_of_nat_eq, ←of_nat_eq_coe, of_nat_zero, zero_add, neg_add_eq_sub] },
    { convert Hp _ (le_of_lt (add_lt_of_neg_of_le (neg_succ_lt_zero _) le_rfl)) ih using 1,
      rw [neg_succ_of_nat_coe', nat.succ_eq_add_one, ←neg_succ_of_nat_coe, sub_add_eq_add_sub] } }
end

/-- See `int.induction_on'` for an induction in both directions. -/
protected lemma le_induction {P : ℤ → Prop} {m : ℤ} (h0 : P m)
  (h1 : ∀ (n : ℤ), m ≤ n → P n → P (n + 1)) (n : ℤ) :
  m ≤ n → P n :=
begin
  apply int.induction_on' n m,
  { intro _, exact h0, },
  { intros k hle hi _, exact h1 k hle (hi hle), },
  { intros _ hle _ hle',
    exfalso,
    exact lt_irrefl k (le_sub_one_iff.mp (hle.trans hle')), },
end

/-- See `int.induction_on'` for an induction in both directions. -/
protected lemma le_induction_down {P : ℤ → Prop} {m : ℤ} (h0 : P m)
  (h1 : ∀ (n : ℤ), n ≤ m → P n → P (n - 1)) (n : ℤ) :
  n ≤ m → P n :=
begin
  apply int.induction_on' n m,
  { intro _, exact h0, },
  { intros _ hle _ hle',
    exfalso,
    exact lt_irrefl k (add_one_le_iff.mp (hle'.trans hle)), },
  { intros k hle hi _,
    exact h1 k hle (hi hle), },
end

/-! ### nat abs -/

variables {a b : ℤ} {n : ℕ}

attribute [simp] nat_abs nat_abs_of_nat nat_abs_zero nat_abs_one

@[simp] lemma nat_abs_dvd_iff_dvd {a b : ℤ} : a.nat_abs ∣ b.nat_abs ↔ a ∣ b :=
begin
  refine ⟨_, λ ⟨k, hk⟩, ⟨k.nat_abs, hk.symm ▸ nat_abs_mul a k⟩⟩,
  rintro ⟨k, hk⟩,
  rw [←nat_abs_of_nat k, ←nat_abs_mul, nat_abs_eq_nat_abs_iff, neg_mul_eq_mul_neg] at hk,
  cases hk; exact ⟨_, hk⟩
end

/-! ### `/`  -/

protected theorem div_nonpos {a b : ℤ} (Ha : 0 ≤ a) (Hb : b ≤ 0) : a / b ≤ 0 :=
nonpos_of_neg_nonneg $ by rw [← int.div_neg]; exact int.div_nonneg Ha (neg_nonneg_of_nonpos Hb)

theorem div_eq_zero_of_lt_abs {a b : ℤ} (H1 : 0 ≤ a) (H2 : a < |b|) : a / b = 0 :=
match b, |b|, abs_eq_nat_abs b, H2 with
| (n : ℕ), ._, rfl, H2 := div_eq_zero_of_lt H1 H2
| -[1+ n], ._, rfl, H2 := neg_injective $ by rw [← int.div_neg]; exact div_eq_zero_of_lt H1 H2
end

protected theorem add_mul_div_right (a b : ℤ) {c : ℤ} (H : c ≠ 0) :
  (a + b * c) / c = a / c + b :=
have ∀ {k n : ℕ} {a : ℤ}, (a + n * k.succ) / k.succ = a / k.succ + n, from
λ k n a, match a with
| (m : ℕ) := congr_arg of_nat $ nat.add_mul_div_right _ _ k.succ_pos
| -[1+ m] := show ((n * k.succ:ℕ) - m.succ : ℤ) / k.succ =
                  n - (m / k.succ + 1 : ℕ), begin
  cases lt_or_ge m (n*k.succ) with h h,
  { rw [← int.coe_nat_sub h,
        ← int.coe_nat_sub ((nat.div_lt_iff_lt_mul k.succ_pos).2 h)],
    apply congr_arg of_nat,
    rw [mul_comm, nat.mul_sub_div], rwa mul_comm },
  { change (↑(n * nat.succ k) - (m + 1) : ℤ) / ↑(nat.succ k) =
           ↑n - ((m / nat.succ k : ℕ) + 1),
    rw [← sub_sub, ← sub_sub, ← neg_sub (m:ℤ), ← neg_sub _ (n:ℤ),
        ← int.coe_nat_sub h,
        ← int.coe_nat_sub ((nat.le_div_iff_mul_le k.succ_pos).2 h),
        ← neg_succ_of_nat_coe', ← neg_succ_of_nat_coe'],
    { apply congr_arg neg_succ_of_nat,
      rw [mul_comm, nat.sub_mul_div], rwa mul_comm } }
  end
end,
have ∀ {a b c : ℤ}, 0 < c → (a + b * c) / c = a / c + b, from
λ a b c H, match c, eq_succ_of_zero_lt H, b with
| ._, ⟨k, rfl⟩, (n : ℕ) := this
| ._, ⟨k, rfl⟩, -[1+ n] :=
  show (a - n.succ * k.succ) / k.succ = (a / k.succ) - n.succ, from
  eq_sub_of_add_eq $ by rw [← this, sub_add_cancel]
end,
match lt_trichotomy c 0 with
| or.inl hlt          := neg_inj.1 $ by rw [← int.div_neg, neg_add, ← int.div_neg, ← neg_mul_neg];
                         apply this (neg_pos_of_neg hlt)
| or.inr (or.inl heq) := absurd heq H
| or.inr (or.inr hgt) := this hgt
end

protected theorem add_mul_div_left (a : ℤ) {b : ℤ} (c : ℤ) (H : b ≠ 0) :
    (a + b * c) / b = a / b + c :=
by rw [mul_comm, int.add_mul_div_right _ _ H]

@[simp] protected theorem mul_div_cancel (a : ℤ) {b : ℤ} (H : b ≠ 0) : a * b / b = a :=
by have := int.add_mul_div_right 0 a H;
   rwa [zero_add, int.zero_div, zero_add] at this

@[simp] protected theorem mul_div_cancel_left {a : ℤ} (b : ℤ) (H : a ≠ 0) : a * b / a = b :=
by rw [mul_comm, int.mul_div_cancel _ H]

@[simp] protected theorem div_self {a : ℤ} (H : a ≠ 0) : a / a = 1 :=
by have := int.mul_div_cancel 1 H; rwa one_mul at this

local attribute [simp] int.zero_div int.div_zero

protected theorem add_div_of_dvd_right {a b c : ℤ} (H : c ∣ b) :
  (a + b) / c = a / c + b / c :=
begin
  by_cases h1 : c = 0,
  { simp [h1] },
  cases H with k hk,
  rw hk,
  change c ≠ 0 at h1,
  rw [mul_comm c k, int.add_mul_div_right _ _ h1, ←zero_add (k * c), int.add_mul_div_right _ _ h1,
      int.zero_div, zero_add]
end

protected theorem add_div_of_dvd_left {a b c : ℤ} (H : c ∣ a) :
  (a + b) / c = a / c + b / c :=
by rw [add_comm, int.add_div_of_dvd_right H, add_comm]

/-! ### mod -/

@[simp] theorem mod_abs (a b : ℤ) : a % (|b|) = a % b :=
abs_by_cases (λ i, a % i = a % b) rfl (mod_neg _ _)

theorem mod_nonneg : ∀ (a : ℤ) {b : ℤ}, b ≠ 0 → 0 ≤ a % b
| (m : ℕ) n H := coe_zero_le _
| -[1+ m] n H :=
  sub_nonneg_of_le $ coe_nat_le_coe_nat_of_le $ nat.mod_lt _ (nat_abs_pos_of_ne_zero H)

theorem mod_lt_of_pos (a : ℤ) {b : ℤ} (H : 0 < b) : a % b < b :=
match a, b, eq_succ_of_zero_lt H with
| (m : ℕ), ._, ⟨n, rfl⟩ := coe_nat_lt_coe_nat_of_lt (nat.mod_lt _ (nat.succ_pos _))
| -[1+ m], ._, ⟨n, rfl⟩ := sub_lt_self _ (coe_nat_lt_coe_nat_of_lt $ nat.succ_pos _)
end

theorem mod_lt (a : ℤ) {b : ℤ} (H : b ≠ 0) : a % b < |b| :=
by rw [← mod_abs]; exact mod_lt_of_pos _ (abs_pos.2 H)

@[simp] theorem add_mul_mod_self {a b c : ℤ} : (a + b * c) % c = a % c :=
if cz : c = 0 then by rw [cz, mul_zero, add_zero] else
by rw [mod_def, mod_def, int.add_mul_div_right _ _ cz,
       mul_add, mul_comm, add_sub_add_right_eq_sub]

@[simp] theorem add_mul_mod_self_left (a b c : ℤ) : (a + b * c) % b = a % b :=
by rw [mul_comm, add_mul_mod_self]

@[simp] theorem add_mod_self {a b : ℤ} : (a + b) % b = a % b :=
by have := add_mul_mod_self_left a b 1; rwa mul_one at this

@[simp] theorem add_mod_self_left {a b : ℤ} : (a + b) % a = b % a :=
by rw [add_comm, add_mod_self]

@[simp] theorem mod_add_mod (m n k : ℤ) : (m % n + k) % n = (m + k) % n :=
by have := (add_mul_mod_self_left (m % n + k) n (m / n)).symm;
   rwa [add_right_comm, mod_add_div] at this

@[simp] theorem add_mod_mod (m n k : ℤ) : (m + n % k) % k = (m + n) % k :=
by rw [add_comm, mod_add_mod, add_comm]

lemma add_mod (a b n : ℤ) : (a + b) % n = ((a % n) + (b % n)) % n :=
by rw [add_mod_mod, mod_add_mod]

theorem add_mod_eq_add_mod_right {m n k : ℤ} (i : ℤ) (H : m % n = k % n) :
  (m + i) % n = (k + i) % n :=
by rw [← mod_add_mod, ← mod_add_mod k, H]

theorem add_mod_eq_add_mod_left {m n k : ℤ} (i : ℤ) (H : m % n = k % n) :
  (i + m) % n = (i + k) % n :=
by rw [add_comm, add_mod_eq_add_mod_right _ H, add_comm]

theorem mod_add_cancel_right {m n k : ℤ} (i) : (m + i) % n = (k + i) % n ↔
  m % n = k % n :=
⟨λ H, by have := add_mod_eq_add_mod_right (-i) H;
      rwa [add_neg_cancel_right, add_neg_cancel_right] at this,
 add_mod_eq_add_mod_right _⟩

theorem mod_add_cancel_left {m n k i : ℤ} :
  (i + m) % n = (i + k) % n ↔ m % n = k % n :=
by rw [add_comm, add_comm i, mod_add_cancel_right]

theorem mod_sub_cancel_right {m n k : ℤ} (i) : (m - i) % n = (k - i) % n ↔
  m % n = k % n :=
mod_add_cancel_right _

@[simp] theorem mul_mod_left (a b : ℤ) : (a * b) % b = 0 :=
by rw [← zero_add (a * b), add_mul_mod_self, zero_mod]

@[simp] theorem mul_mod_right (a b : ℤ) : (a * b) % a = 0 :=
by rw [mul_comm, mul_mod_left]

lemma mul_mod (a b n : ℤ) : (a * b) % n = ((a % n) * (b % n)) % n :=
begin
  conv_lhs
  { rw [←mod_add_div a n, ←mod_add_div' b n, right_distrib, left_distrib, left_distrib,
        mul_assoc, mul_assoc, ←left_distrib n _ _, add_mul_mod_self_left, ← mul_assoc,
        add_mul_mod_self] }
end

local attribute [simp] -- Will be generalized to Euclidean domains.
theorem mod_self {a : ℤ} : a % a = 0 :=
by have := mul_mod_left 1 a; rwa one_mul at this

@[simp] theorem mod_mod_of_dvd (n : ℤ) {m k : ℤ} (h : m ∣ k) : n % k % m = n % m :=
begin
  conv { to_rhs, rw ←mod_add_div n k },
  rcases h with ⟨t, rfl⟩, rw [mul_assoc, add_mul_mod_self_left]
end

@[simp] theorem mod_mod (a b : ℤ) : a % b % b = a % b :=
by conv {to_rhs, rw [← mod_add_div a b, add_mul_mod_self_left]}

lemma sub_mod (a b n : ℤ) : (a - b) % n = ((a % n) - (b % n)) % n :=
begin
  apply (mod_add_cancel_right b).mp,
  rw [sub_add_cancel, ← add_mod_mod, sub_add_cancel, mod_mod]
end

/-- See also `int.div_mod_equiv` for a similar statement as an `equiv`. -/
protected theorem div_mod_unique {a b r q : ℤ} (h : 0 < b) :
  a / b = q ∧ a % b = r ↔ r + b * q = a ∧ 0 ≤ r ∧ r < b :=
begin
  split,
  { rintro ⟨rfl, rfl⟩,
    exact ⟨mod_add_div a b, mod_nonneg _ h.ne.symm, mod_lt_of_pos _ h⟩, },
  { rintro ⟨rfl, hz, hb⟩,
    split,
    { rw [int.add_mul_div_left r q (ne_of_gt h), div_eq_zero_of_lt hz hb],
      simp, },
    { rw [add_mul_mod_self_left, mod_eq_of_lt hz hb] } },
end

local attribute [simp] int.zero_mod

theorem mod_eq_mod_iff_mod_sub_eq_zero {m n k : ℤ} : m % n = k % n ↔ (m - k) % n = 0 :=
(mod_sub_cancel_right k).symm.trans $ by simp

@[simp] lemma neg_mod_two (i : ℤ) : (-i) % 2 = i % 2 :=
begin
  apply int.mod_eq_mod_iff_mod_sub_eq_zero.mpr,
  convert int.mul_mod_right 2 (-i),
  simp only [two_mul, sub_eq_add_neg]
end

/-! ### properties of `/` and `%` -/

theorem lt_div_add_one_mul_self (a : ℤ) {b : ℤ} (H : 0 < b) : a < (a / b + 1) * b :=
by { rw [add_mul, one_mul, mul_comm, ← sub_lt_iff_lt_add', ← mod_def],
  exact mod_lt_of_pos _ H }

theorem abs_div_le_abs : ∀ (a b : ℤ), |a / b| ≤ |a| :=
suffices ∀ (a : ℤ) (n : ℕ), |a / n| ≤ |a|, from
λ a b, match b, eq_coe_or_neg b with
| ._, ⟨n, or.inl rfl⟩ := this _ _
| ._, ⟨n, or.inr rfl⟩ := by rw [int.div_neg, abs_neg]; apply this
end,
λ a n, by rw [abs_eq_nat_abs, abs_eq_nat_abs]; exact
coe_nat_le_coe_nat_of_le (match a, n with
| (m : ℕ), n := nat.div_le_self _ _
| -[1+ m], 0 := nat.zero_le _
| -[1+ m], n+1 := nat.succ_le_succ (nat.div_le_self _ _)
end)

theorem div_le_self {a : ℤ} (b : ℤ) (Ha : 0 ≤ a) : a / b ≤ a :=
by have := le_trans (le_abs_self _) (abs_div_le_abs a b);
   rwa [abs_of_nonneg Ha] at this

lemma mod_two_eq_zero_or_one (n : ℤ) : n % 2 = 0 ∨ n % 2 = 1 :=
have h : n % 2 < 2 := abs_of_nonneg (show 0 ≤ (2 : ℤ), from dec_trivial) ▸ int.mod_lt _ dec_trivial,
have h₁ : 0 ≤ n % 2 := int.mod_nonneg _ dec_trivial,
match (n % 2), h, h₁ with
| (0 : ℕ) := λ _ _, or.inl rfl
| (1 : ℕ) := λ _ _, or.inr rfl
| (k + 2 : ℕ) := λ h _, absurd h dec_trivial
| -[1+ a] := λ _ h₁, absurd h₁ dec_trivial
end

/-! ### dvd -/

theorem dvd_of_mod_eq_zero {a b : ℤ} (H : b % a = 0) : a ∣ b :=
⟨b / a, (mul_div_cancel_of_mod_eq_zero H).symm⟩

theorem mod_eq_zero_of_dvd : ∀ {a b : ℤ}, a ∣ b → b % a = 0
| a ._ ⟨c, rfl⟩ := mul_mod_right _ _

theorem dvd_iff_mod_eq_zero (a b : ℤ) : a ∣ b ↔ b % a = 0 :=
⟨mod_eq_zero_of_dvd, dvd_of_mod_eq_zero⟩

/-- If `a % b = c` then `b` divides `a - c`. -/
lemma dvd_sub_of_mod_eq {a b c : ℤ} (h : a % b = c) : b ∣ a - c :=
begin
  have hx : a % b % b = c % b, { rw h },
  rw [mod_mod, ←mod_sub_cancel_right c, sub_self, zero_mod] at hx,
  exact dvd_of_mod_eq_zero hx
end

theorem nat_abs_dvd {a b : ℤ} : (a.nat_abs : ℤ) ∣ b ↔ a ∣ b :=
(nat_abs_eq a).elim (λ e, by rw ← e) (λ e, by rw [← neg_dvd, ← e])

theorem dvd_nat_abs {a b : ℤ} : a ∣ b.nat_abs ↔ a ∣ b :=
(nat_abs_eq b).elim (λ e, by rw ← e) (λ e, by rw [← dvd_neg, ← e])

instance decidable_dvd : @decidable_rel ℤ (∣) :=
assume a n, decidable_of_decidable_of_iff (by apply_instance) (dvd_iff_mod_eq_zero _ _).symm

protected theorem div_mul_cancel {a b : ℤ} (H : b ∣ a) : a / b * b = a :=
div_mul_cancel_of_mod_eq_zero (mod_eq_zero_of_dvd H)

protected theorem mul_div_cancel' {a b : ℤ} (H : a ∣ b) : a * (b / a) = b :=
by rw [mul_comm, int.div_mul_cancel H]

theorem div_dvd_div : ∀ {a b c : ℤ} (H1 : a ∣ b) (H2 : b ∣ c), b / a ∣ c / a
| a ._ ._ ⟨b, rfl⟩ ⟨c, rfl⟩ := if az : a = 0 then by simp [az] else
  by rw [int.mul_div_cancel_left _ az, mul_assoc, int.mul_div_cancel_left _ az];
     apply dvd_mul_right

protected theorem eq_mul_of_div_eq_right {a b c : ℤ} (H1 : b ∣ a) (H2 : a / b = c) :
  a = b * c :=
by rw [← H2, int.mul_div_cancel' H1]

protected theorem div_eq_of_eq_mul_right {a b c : ℤ} (H1 : b ≠ 0) (H2 : a = b * c) :
  a / b = c :=
by rw [H2, int.mul_div_cancel_left _ H1]

protected theorem eq_div_of_mul_eq_right {a b c : ℤ} (H1 : a ≠ 0) (H2 : a * b = c) :
  b = c / a :=
eq.symm $ int.div_eq_of_eq_mul_right H1 H2.symm

protected theorem div_eq_iff_eq_mul_right {a b c : ℤ} (H : b ≠ 0) (H' : b ∣ a) :
  a / b = c ↔ a = b * c :=
⟨int.eq_mul_of_div_eq_right H', int.div_eq_of_eq_mul_right H⟩

protected theorem div_eq_iff_eq_mul_left {a b c : ℤ} (H : b ≠ 0) (H' : b ∣ a) :
  a / b = c ↔ a = c * b :=
by rw mul_comm; exact int.div_eq_iff_eq_mul_right H H'

protected theorem eq_mul_of_div_eq_left {a b c : ℤ} (H1 : b ∣ a) (H2 : a / b = c) :
  a = c * b :=
by rw [mul_comm, int.eq_mul_of_div_eq_right H1 H2]

protected theorem div_eq_of_eq_mul_left {a b c : ℤ} (H1 : b ≠ 0) (H2 : a = c * b) :
  a / b = c :=
int.div_eq_of_eq_mul_right H1 (by rw [mul_comm, H2])

protected lemma eq_zero_of_div_eq_zero {d n : ℤ} (h : d ∣ n) (H : n / d = 0) : n = 0 :=
by rw [← int.mul_div_cancel' h, H, mul_zero]

@[simp]
protected lemma div_left_inj {a b d : ℤ} (hda : d ∣ a) (hdb : d ∣ b) : a / d = b / d ↔ a = b :=
begin
  refine ⟨λ h, _, congr_arg _⟩,
  rw [←int.mul_div_cancel' hda, ←int.mul_div_cancel' hdb, h],
end

lemma abs_sign_of_nonzero {z : ℤ} (hz : z ≠ 0) : |z.sign| = 1 :=
by rw [abs_eq_nat_abs, nat_abs_sign_of_nonzero hz, int.coe_nat_one]

/-- If `n > 0` then `m` is not divisible by `n` iff it is between `n * k` and `n * (k + 1)`
  for some `k`. -/
lemma exists_lt_and_lt_iff_not_dvd (m : ℤ) {n : ℤ} (hn : 0 < n) :
  (∃ k, n * k < m ∧ m < n * (k + 1)) ↔ ¬ n ∣ m :=
begin
  split,
  { rintro ⟨k, h1k, h2k⟩ ⟨l, rfl⟩, rw [mul_lt_mul_left hn] at h1k h2k,
    rw [lt_add_one_iff, ← not_lt] at h2k, exact h2k h1k },
  { intro h, rw [dvd_iff_mod_eq_zero, ← ne.def] at h,
    have := (mod_nonneg m hn.ne.symm).lt_of_ne h.symm,
    simp only [← mod_add_div m n] {single_pass := tt},
    refine ⟨m / n, lt_add_of_pos_left _ this, _⟩,
    rw [add_comm _ (1 : ℤ), left_distrib, mul_one], exact add_lt_add_right (mod_lt_of_pos _ hn) _ }
end

local attribute [simp] int.div_zero

protected theorem mul_div_assoc (a : ℤ) : ∀ {b c : ℤ}, c ∣ b → (a * b) / c = a * (b / c)
| ._ c ⟨d, rfl⟩ := if cz : c = 0 then by simp [cz] else
  by rw [mul_left_comm, int.mul_div_cancel_left _ cz, int.mul_div_cancel_left _ cz]

protected theorem mul_div_assoc' (b : ℤ) {a c : ℤ} (h : c ∣ a) : a * b / c = a / c * b :=
by rw [mul_comm, int.mul_div_assoc _ h, mul_comm]

theorem neg_div_of_dvd : ∀ {a b : ℤ} (H : b ∣ a), -a / b = -(a / b)
| ._ b ⟨c, rfl⟩ := if bz : b = 0 then by simp [bz] else
  by rw [neg_mul_eq_mul_neg, int.mul_div_cancel_left _ bz, int.mul_div_cancel_left _ bz]

lemma sub_div_of_dvd (a : ℤ) {b c : ℤ} (hcb : c ∣ b) : (a - b) / c = a / c - b / c :=
begin
  rw [sub_eq_add_neg, sub_eq_add_neg, int.add_div_of_dvd_right ((dvd_neg c b).mpr hcb)],
  congr,
  exact neg_div_of_dvd hcb,
end

lemma sub_div_of_dvd_sub {a b c : ℤ} (hcab : c ∣ (a - b)) : (a - b) / c = a / c - b / c :=
by rw [eq_sub_iff_add_eq, ← int.add_div_of_dvd_left hcab, sub_add_cancel]

protected theorem sign_eq_div_abs (a : ℤ) : sign a = a / |a| :=
if az : a = 0 then by simp [az] else
(int.div_eq_of_eq_mul_left (mt abs_eq_zero.1 az)
  (sign_mul_abs _).symm).symm

/-! ### `/` and ordering -/

protected theorem div_mul_le (a : ℤ) {b : ℤ} (H : b ≠ 0) : a / b * b ≤ a :=
le_of_sub_nonneg $ by rw [mul_comm, ← mod_def]; apply mod_nonneg _ H

protected theorem div_le_of_le_mul {a b c : ℤ} (H : 0 < c) (H' : a ≤ b * c) : a / c ≤ b :=
le_of_mul_le_mul_right (le_trans (int.div_mul_le _ (ne_of_gt H)) H') H

protected theorem mul_lt_of_lt_div {a b c : ℤ} (H : 0 < c) (H3 : a < b / c) : a * c < b :=
lt_of_not_ge $ mt (int.div_le_of_le_mul H) (not_le_of_gt H3)

protected theorem mul_le_of_le_div {a b c : ℤ} (H1 : 0 < c) (H2 : a ≤ b / c) : a * c ≤ b :=
le_trans (mul_le_mul_of_nonneg_right H2 (le_of_lt H1)) (int.div_mul_le _ (ne_of_gt H1))

protected theorem le_div_of_mul_le {a b c : ℤ} (H1 : 0 < c) (H2 : a * c ≤ b) : a ≤ b / c :=
le_of_lt_add_one $ lt_of_mul_lt_mul_right
  (lt_of_le_of_lt H2 (lt_div_add_one_mul_self _ H1)) (le_of_lt H1)

protected theorem le_div_iff_mul_le {a b c : ℤ} (H : 0 < c) : a ≤ b / c ↔ a * c ≤ b :=
⟨int.mul_le_of_le_div H, int.le_div_of_mul_le H⟩

protected theorem div_le_div {a b c : ℤ} (H : 0 < c) (H' : a ≤ b) : a / c ≤ b / c :=
int.le_div_of_mul_le H (le_trans (int.div_mul_le _ (ne_of_gt H)) H')

protected theorem div_lt_of_lt_mul {a b c : ℤ} (H : 0 < c) (H' : a < b * c) : a / c < b :=
lt_of_not_ge $ mt (int.mul_le_of_le_div H) (not_le_of_gt H')

protected theorem lt_mul_of_div_lt {a b c : ℤ} (H1 : 0 < c) (H2 : a / c < b) : a < b * c :=
lt_of_not_ge $ mt (int.le_div_of_mul_le H1) (not_le_of_gt H2)

protected theorem div_lt_iff_lt_mul {a b c : ℤ} (H : 0 < c) : a / c < b ↔ a < b * c :=
⟨int.lt_mul_of_div_lt H, int.div_lt_of_lt_mul H⟩

protected theorem le_mul_of_div_le {a b c : ℤ} (H1 : 0 ≤ b) (H2 : b ∣ a) (H3 : a / b ≤ c) :
  a ≤ c * b :=
by rw [← int.div_mul_cancel H2]; exact mul_le_mul_of_nonneg_right H3 H1

protected theorem lt_div_of_mul_lt {a b c : ℤ} (H1 : 0 ≤ b) (H2 : b ∣ c) (H3 : a * b < c) :
  a < c / b :=
lt_of_not_ge $ mt (int.le_mul_of_div_le H1 H2) (not_le_of_gt H3)

protected theorem lt_div_iff_mul_lt {a b : ℤ} (c : ℤ) (H : 0 < c) (H' : c ∣ b) :
  a < b / c ↔ a * c < b :=
⟨int.mul_lt_of_lt_div H, int.lt_div_of_mul_lt (le_of_lt H) H'⟩

theorem div_pos_of_pos_of_dvd {a b : ℤ} (H1 : 0 < a) (H2 : 0 ≤ b) (H3 : b ∣ a) : 0 < a / b :=
int.lt_div_of_mul_lt H2 H3 (by rwa zero_mul)

lemma nat_abs_eq_of_dvd_dvd {s t : ℤ} (hst : s ∣ t) (hts : t ∣ s) : nat_abs s = nat_abs t :=
nat.dvd_antisymm (nat_abs_dvd_iff_dvd.mpr hst) (nat_abs_dvd_iff_dvd.mpr hts)

theorem div_eq_div_of_mul_eq_mul {a b c d : ℤ} (H2 : d ∣ c) (H3 : b ≠ 0)
    (H4 : d ≠ 0) (H5 : a * d = b * c) :
  a / b = c / d :=
int.div_eq_of_eq_mul_right H3 $
by rw [← int.mul_div_assoc _ H2]; exact
(int.div_eq_of_eq_mul_left H4 H5.symm).symm

lemma div_dvd_of_dvd {s t : ℤ} (hst : s ∣ t) : (t / s) ∣ t :=
begin
  rcases eq_or_ne s 0 with rfl | hs,
  { simpa using hst },
  rcases hst with ⟨c, hc⟩,
  simp [hc, int.mul_div_cancel_left _ hs],
end

/-! ### to_nat -/

@[simp] theorem to_nat_le {a : ℤ} {n : ℕ} : to_nat a ≤ n ↔ a ≤ n :=
by rw [(coe_nat_le_coe_nat_iff _ _).symm, to_nat_eq_max, max_le_iff];
   exact and_iff_left (coe_zero_le _)

@[simp] theorem lt_to_nat {n : ℕ} {a : ℤ} : n < to_nat a ↔ (n : ℤ) < a :=
le_iff_le_iff_lt_iff_lt.1 to_nat_le

@[simp]
lemma coe_nat_nonpos_iff {n : ℕ} : (n : ℤ) ≤ 0 ↔ n = 0 :=
⟨ λ h, le_antisymm (int.coe_nat_le.mp (h.trans int.coe_nat_zero.le)) n.zero_le,
  λ h, (coe_nat_eq_zero.mpr h).le⟩

theorem to_nat_le_to_nat {a b : ℤ} (h : a ≤ b) : to_nat a ≤ to_nat b :=
by rw to_nat_le; exact le_trans h (le_to_nat b)

theorem to_nat_lt_to_nat {a b : ℤ} (hb : 0 < b) : to_nat a < to_nat b ↔ a < b :=
⟨λ h, begin cases a, exact lt_to_nat.1 h, exact lt_trans (neg_succ_of_nat_lt_zero a) hb, end,
 λ h, begin rw lt_to_nat, cases a, exact h, exact hb end⟩

theorem lt_of_to_nat_lt {a b : ℤ} (h : to_nat a < to_nat b) : a < b :=
(to_nat_lt_to_nat $ lt_to_nat.1 $ lt_of_le_of_lt (nat.zero_le _) h).1 h

@[simp]
lemma to_nat_pred_coe_of_pos {i : ℤ} (h : 0 < i) : ((i.to_nat - 1 : ℕ) : ℤ) = i - 1 :=
by simp [h, le_of_lt h] with push_cast

@[simp]
lemma to_nat_eq_zero : ∀ {n : ℤ}, n.to_nat = 0 ↔ n ≤ 0
| (n : ℕ) := calc _ ↔ (n = 0) : ⟨(to_nat_coe_nat n).symm.trans, (to_nat_coe_nat n).trans⟩
                ... ↔ _       : coe_nat_nonpos_iff.symm
| -[1+ n] := show ((-((n : ℤ) + 1)).to_nat = 0) ↔ (-(n + 1) : ℤ) ≤ 0, from
calc _ ↔ true : ⟨λ _, trivial, λ h, to_nat_neg_nat _⟩
   ... ↔ _    : ⟨λ h, neg_nonpos_of_nonneg (coe_zero_le _), λ _, trivial⟩

@[simp] lemma to_nat_sub_of_le {a b : ℤ} (h : b ≤ a) : (to_nat (a - b) : ℤ) = a - b :=
int.to_nat_of_nonneg (sub_nonneg_of_le h)

end int

-- We should need only a minimal development of sets in order to get here.
assert_not_exists set.range


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

import algebra.big_operators.basic

/-!
# Results about big operators with values in an ordered algebraic structure.

Mostly monotonicity results for the `∏` and `∑` operations.

-/

open_locale big_operators

variables {ι α β M N G k R : Type*}

namespace finset

section

variables [comm_monoid M] [ordered_comm_monoid N]

/-- Let `{x | p x}` be a subsemigroup of a commutative monoid `M`. Let `f : M → N` be a map
submultiplicative on `{x | p x}`, i.e., `p x → p y → f (x * y) ≤ f x * f y`. Let `g i`, `i ∈ s`, be
a nonempty finite family of elements of `M` such that `∀ i ∈ s, p (g i)`. Then
`f (∏ x in s, g x) ≤ ∏ x in s, f (g x)`. -/
@[to_additive le_sum_nonempty_of_subadditive_on_pred]
lemma le_prod_nonempty_of_submultiplicative_on_pred
  (f : M → N) (p : M → Prop) (h_mul : ∀ x y, p x → p y → f (x * y) ≤ f x * f y)
  (hp_mul : ∀ x y, p x → p y → p (x * y)) (g : ι → M) (s : finset ι) (hs_nonempty : s.nonempty)
  (hs : ∀ i ∈ s, p (g i)) :
  f (∏ i in s, g i) ≤ ∏ i in s, f (g i) :=
begin
  refine le_trans (multiset.le_prod_nonempty_of_submultiplicative_on_pred f p h_mul hp_mul _ _ _) _,
  { simp [hs_nonempty.ne_empty], },
  { exact multiset.forall_mem_map_iff.mpr hs, },
  rw multiset.map_map,
  refl,
end

/-- Let `{x | p x}` be an additive subsemigroup of an additive commutative monoid `M`. Let `f : M →
N` be a map subadditive on `{x | p x}`, i.e., `p x → p y → f (x + y) ≤ f x + f y`. Let `g i`, `i ∈
s`, be a nonempty finite family of elements of `M` such that `∀ i ∈ s, p (g i)`. Then
`f (∑ i in s, g i) ≤ ∏ i in s, f (g i)`. -/
add_decl_doc le_sum_nonempty_of_subadditive_on_pred

/-- If `f : M → N` is a submultiplicative function, `f (x * y) ≤ f x * f y` and `g i`, `i ∈ s`, is a
nonempty finite family of elements of `M`, then `f (∏ i in s, g i) ≤ ∏ i in s, f (g i)`. -/
@[to_additive le_sum_nonempty_of_subadditive]
lemma le_prod_nonempty_of_submultiplicative
  (f : M → N) (h_mul : ∀ x y, f (x * y) ≤ f x * f y) {s : finset ι} (hs : s.nonempty) (g : ι → M) :
  f (∏ i in s, g i) ≤ ∏ i in s, f (g i) :=
le_prod_nonempty_of_submultiplicative_on_pred f (λ i, true) (λ x y _ _, h_mul x y)
  (λ _ _ _ _, trivial) g s hs (λ _ _, trivial)

/-- If `f : M → N` is a subadditive function, `f (x + y) ≤ f x + f y` and `g i`, `i ∈ s`, is a
nonempty finite family of elements of `M`, then `f (∑ i in s, g i) ≤ ∑ i in s, f (g i)`. -/
add_decl_doc le_sum_nonempty_of_subadditive

/-- Let `{x | p x}` be a subsemigroup of a commutative monoid `M`. Let `f : M → N` be a map
such that `f 1 = 1` and `f` is submultiplicative on `{x | p x}`, i.e.,
`p x → p y → f (x * y) ≤ f x * f y`. Let `g i`, `i ∈ s`, be a finite family of elements of `M` such
that `∀ i ∈ s, p (g i)`. Then `f (∏ i in s, g i) ≤ ∏ i in s, f (g i)`. -/
@[to_additive le_sum_of_subadditive_on_pred]
lemma le_prod_of_submultiplicative_on_pred (f : M → N) (p : M → Prop) (h_one : f 1 = 1)
  (h_mul : ∀ x y, p x → p y → f (x * y) ≤ f x * f y)
  (hp_mul : ∀ x y, p x → p y → p (x * y)) (g : ι → M) {s : finset ι} (hs : ∀ i ∈ s, p (g i)) :
  f (∏ i in s, g i) ≤ ∏ i in s, f (g i) :=
begin
  rcases eq_empty_or_nonempty s with rfl|hs_nonempty,
  { simp [h_one] },
  { exact le_prod_nonempty_of_submultiplicative_on_pred f p h_mul hp_mul g s hs_nonempty hs, },
end

/-- Let `{x | p x}` be a subsemigroup of a commutative monoid `M`. Let `f : M → N` be a map
such that `f 1 = 1` and `f` is submultiplicative on `{x | p x}`, i.e.,
`p x → p y → f (x * y) ≤ f x * f y`. Let `g i`, `i ∈ s`, be a finite family of elements of `M` such
that `∀ i ∈ s, p (g i)`. Then `f (∏ x in s, g x) ≤ ∏ x in s, f (g x)`. -/
add_decl_doc le_sum_of_subadditive_on_pred

/-- If `f : M → N` is a submultiplicative function, `f (x * y) ≤ f x * f y`, `f 1 = 1`, and `g i`,
`i ∈ s`, is a finite family of elements of `M`, then `f (∏ i in s, g i) ≤ ∏ i in s, f (g i)`. -/
@[to_additive le_sum_of_subadditive]
lemma le_prod_of_submultiplicative (f : M → N) (h_one : f 1 = 1)
  (h_mul : ∀ x y, f (x * y) ≤ f x * f y) (s : finset ι) (g : ι → M) :
  f (∏ i in s, g i) ≤ ∏ i in s, f (g i) :=
begin
  refine le_trans (multiset.le_prod_of_submultiplicative f h_one h_mul _) _,
  rw multiset.map_map,
  refl,
end

/-- If `f : M → N` is a submultiplicative function, `f (x * y) ≤ f x * f y`, `f 1 = 1`, and `g i`,
`i ∈ s`, is a finite family of elements of `M`, then `f (∏ i in s, g i) ≤ ∏ i in s, f (g i)`. -/
add_decl_doc le_sum_of_subadditive

variables {f g : ι → N} {s t : finset ι}

/-- In an ordered commutative monoid, if each factor `f i` of one finite product is less than or
equal to the corresponding factor `g i` of another finite product, then
`∏ i in s, f i ≤ ∏ i in s, g i`. -/
@[to_additive sum_le_sum]
lemma prod_le_prod'' (h : ∀ i ∈ s, f i ≤ g i) : ∏ i in s, f i ≤ ∏ i in s, g i :=
begin
  classical,
  induction s using finset.induction_on with i s hi ihs h,
  { refl },
  { simp only [prod_insert hi],
    exact mul_le_mul' (h _ (mem_insert_self _ _)) (ihs $ λ j hj, h j (mem_insert_of_mem hj)) }
end

/-- In an ordered additive commutative monoid, if each summand `f i` of one finite sum is less than
or equal to the corresponding summand `g i` of another finite sum, then
`∑ i in s, f i ≤ ∑ i in s, g i`. -/
add_decl_doc sum_le_sum

@[to_additive sum_nonneg]  lemma one_le_prod' (h : ∀i ∈ s, 1 ≤ f i) : 1 ≤ (∏ i in s, f i) :=
le_trans (by rw prod_const_one) (prod_le_prod'' h)

@[to_additive sum_nonpos] lemma prod_le_one' (h : ∀i ∈ s, f i ≤ 1) : (∏ i in s, f i) ≤ 1 :=
(prod_le_prod'' h).trans_eq (by rw prod_const_one)

@[to_additive sum_le_sum_of_subset_of_nonneg]
lemma prod_le_prod_of_subset_of_one_le' (h : s ⊆ t) (hf : ∀ i ∈ t, i ∉ s → 1 ≤ f i) :
  ∏ i in s, f i ≤ ∏ i in t, f i :=
by classical;
calc (∏ i in s, f i) ≤ (∏ i in t \ s, f i) * (∏ i in s, f i) :
    le_mul_of_one_le_left' $ one_le_prod' $ by simpa only [mem_sdiff, and_imp]
  ... = ∏ i in t \ s ∪ s, f i : (prod_union sdiff_disjoint).symm
  ... = ∏ i in t, f i         : by rw [sdiff_union_of_subset h]

@[to_additive sum_mono_set_of_nonneg]
lemma prod_mono_set_of_one_le' (hf : ∀ x, 1 ≤ f x) : monotone (λ s, ∏ x in s, f x) :=
λ s t hst, prod_le_prod_of_subset_of_one_le' hst $ λ x _ _, hf x

@[to_additive sum_le_univ_sum_of_nonneg]
lemma prod_le_univ_prod_of_one_le' [fintype ι] {s : finset ι} (w : ∀ x, 1 ≤ f x) :
  ∏ x in s, f x ≤ ∏ x, f x :=
prod_le_prod_of_subset_of_one_le' (subset_univ s) (λ a _ _, w a)

@[to_additive sum_eq_zero_iff_of_nonneg]
lemma prod_eq_one_iff_of_one_le' : (∀ i ∈ s, 1 ≤ f i) → (∏ i in s, f i = 1 ↔ ∀ i ∈ s, f i = 1) :=
begin
  classical,
  apply finset.induction_on s,
  exact λ _, ⟨λ _ _, false.elim, λ _, rfl⟩,
  assume a s ha ih H,
  have : ∀ i ∈ s, 1 ≤ f i, from λ _, H _ ∘ mem_insert_of_mem,
  rw [prod_insert ha, mul_eq_one_iff' (H _ $ mem_insert_self _ _) (one_le_prod' this),
    forall_mem_insert, ih this]
end

@[to_additive sum_eq_zero_iff_of_nonneg]
lemma prod_eq_one_iff_of_le_one' : (∀ i ∈ s, f i ≤ 1) → (∏ i in s, f i = 1 ↔ ∀ i ∈ s, f i = 1) :=
@prod_eq_one_iff_of_one_le' _ (order_dual N) _ _ _

@[to_additive single_le_sum]
lemma single_le_prod' (hf : ∀ i ∈ s, 1 ≤ f i) {a} (h : a ∈ s) : f a ≤ (∏ x in s, f x) :=
calc f a = ∏ i in {a}, f i : prod_singleton.symm
     ... ≤ ∏ i in s, f i   :
  prod_le_prod_of_subset_of_one_le' (singleton_subset_iff.2 h) $ λ i hi _, hf i hi

variables {ι' : Type*} [decidable_eq ι']

@[to_additive sum_fiberwise_le_sum_of_sum_fiber_nonneg]
lemma prod_fiberwise_le_prod_of_one_le_prod_fiber' {t : finset ι'}
  {g : ι → ι'} {f : ι → N} (h : ∀ y ∉ t, (1 : N) ≤ ∏ x in s.filter (λ x, g x = y), f x) :
  ∏ y in t, ∏ x in s.filter (λ x, g x = y), f x ≤ ∏ x in s, f x :=
calc (∏ y in t, ∏ x in s.filter (λ x, g x = y), f x) ≤
  (∏ y in t ∪ s.image g, ∏ x in s.filter (λ x, g x = y), f x) :
  prod_le_prod_of_subset_of_one_le' (subset_union_left _ _) $ λ y hyts, h y
... = ∏ x in s, f x :
  prod_fiberwise_of_maps_to (λ x hx, mem_union.2 $ or.inr $ mem_image_of_mem _ hx) _

@[to_additive sum_le_sum_fiberwise_of_sum_fiber_nonpos]
lemma prod_le_prod_fiberwise_of_prod_fiber_le_one' {t : finset ι'}
  {g : ι → ι'} {f : ι → N} (h : ∀ y ∉ t, (∏ x in s.filter (λ x, g x = y), f x) ≤ 1) :
  (∏ x in s, f x) ≤ ∏ y in t, ∏ x in s.filter (λ x, g x = y), f x :=
@prod_fiberwise_le_prod_of_one_le_prod_fiber' _ (order_dual N) _ _ _ _ _ _ _ h

end

lemma abs_sum_le_sum_abs {G : Type*} [linear_ordered_add_comm_group G] (f : ι → G) (s : finset ι) :
  abs (∑ i in s, f i) ≤ ∑ i in s, abs (f i) :=
le_sum_of_subadditive _ abs_zero abs_add s f

lemma abs_prod {R : Type*} [linear_ordered_comm_ring R] {f : ι → R} {s : finset ι} :
  abs (∏ x in s, f x) = ∏ x in s, abs (f x) :=
(abs_hom.to_monoid_hom : R →* R).map_prod _ _

section pigeonhole

variable [decidable_eq β]

theorem card_le_mul_card_image_of_maps_to {f : α → β} {s : finset α} {t : finset β}
  (Hf : ∀ a ∈ s, f a ∈ t) (n : ℕ) (hn : ∀ a ∈ t, (s.filter (λ x, f x = a)).card ≤ n) :
  s.card ≤ n * t.card :=
calc s.card = (∑ a in t, (s.filter (λ x, f x = a)).card) : card_eq_sum_card_fiberwise Hf
        ... ≤ (∑ _ in t, n)                              : sum_le_sum hn
        ... = _                                          : by simp [mul_comm]

theorem card_le_mul_card_image {f : α → β} (s : finset α)
  (n : ℕ) (hn : ∀ a ∈ s.image f, (s.filter (λ x, f x = a)).card ≤ n) :
  s.card ≤ n * (s.image f).card :=
card_le_mul_card_image_of_maps_to (λ x, mem_image_of_mem _) n hn

theorem mul_card_image_le_card_of_maps_to {f : α → β} {s : finset α} {t : finset β}
  (Hf : ∀ a ∈ s, f a ∈ t) (n : ℕ) (hn : ∀ a ∈ t, n ≤ (s.filter (λ x, f x = a)).card) :
  n * t.card ≤ s.card :=
calc n * t.card = (∑ _ in t, n) : by simp [mul_comm]
            ... ≤ (∑ a in t, (s.filter (λ x, f x = a)).card) : sum_le_sum hn
            ... = s.card : by rw ← card_eq_sum_card_fiberwise Hf

theorem mul_card_image_le_card {f : α → β} (s : finset α)
  (n : ℕ) (hn : ∀ a ∈ s.image f, n ≤ (s.filter (λ x, f x = a)).card) :
  n * (s.image f).card ≤ s.card :=
mul_card_image_le_card_of_maps_to (λ x, mem_image_of_mem _) n hn

end pigeonhole

section canonically_ordered_monoid

variables [canonically_ordered_monoid M] {f : ι → M} {s t : finset ι}

@[simp, to_additive sum_eq_zero_iff]
lemma prod_eq_one_iff' : ∏ x in s, f x = 1 ↔ ∀ x ∈ s, f x = 1 :=
prod_eq_one_iff_of_one_le' $ λ x hx, one_le (f x)

@[to_additive sum_le_sum_of_subset]
lemma prod_le_prod_of_subset' (h : s ⊆ t) : ∏ x in s, f x ≤ ∏ x in t, f x :=
prod_le_prod_of_subset_of_one_le' h $ assume x h₁ h₂, one_le _

@[to_additive sum_mono_set]
lemma prod_mono_set' (f : ι → M) : monotone (λ s, ∏ x in s, f x) :=
λ s₁ s₂ hs, prod_le_prod_of_subset' hs

@[to_additive sum_le_sum_of_ne_zero]
lemma prod_le_prod_of_ne_one' (h : ∀ x ∈ s, f x ≠ 1 → x ∈ t) :
  ∏ x in s, f x ≤ ∏ x in t, f x :=
by classical;
calc ∏ x in s, f x = (∏ x in s.filter (λ x, f x = 1), f x) * ∏ x in s.filter (λ x, f x ≠ 1), f x :
    by rw [← prod_union, filter_union_filter_neg_eq];
       exact disjoint_filter.2 (assume _ _ h n_h, n_h h)
  ... ≤ (∏ x in t, f x) : mul_le_of_le_one_of_le'
      (prod_le_one' $ by simp only [mem_filter, and_imp]; exact λ _ _, le_of_eq)
      (prod_le_prod_of_subset' $ by simpa only [subset_iff, mem_filter, and_imp])

end canonically_ordered_monoid

section ordered_cancel_comm_monoid

variables [ordered_cancel_comm_monoid M] {f g : ι → M} {s t : finset ι}

@[to_additive sum_lt_sum]
theorem prod_lt_prod' (Hle : ∀ i ∈ s, f i ≤ g i) (Hlt : ∃ i ∈ s, f i < g i) :
  ∏ i in s, f i < ∏ i in s, g i :=
begin
  classical,
  rcases Hlt with ⟨i, hi, hlt⟩,
  rw [← insert_erase hi, prod_insert (not_mem_erase _ _), prod_insert (not_mem_erase _ _)],
  exact mul_lt_mul_of_lt_of_le hlt (prod_le_prod'' $ λ j hj, Hle j  $ mem_of_mem_erase hj)
end

@[to_additive sum_lt_sum_of_nonempty]
lemma prod_lt_prod_of_nonempty' (hs : s.nonempty) (Hlt : ∀ i ∈ s, f i < g i) :
  ∏ i in s, f i < ∏ i in s, g i :=
begin
  apply prod_lt_prod',
  { intros i hi, apply le_of_lt (Hlt i hi) },
  cases hs with i hi,
  exact ⟨i, hi, Hlt i hi⟩,
end

@[to_additive sum_lt_sum_of_subset]
lemma prod_lt_prod_of_subset' (h : s ⊆ t) {i : ι} (ht : i ∈ t) (hs : i ∉ s) (hlt : 1 < f i)
  (hle : ∀ j ∈ t, j ∉ s → 1 ≤ f j) :
  ∏ j in s, f j < ∏ j in t, f j :=
by classical;
calc ∏ j in s, f j < ∏ j in insert i s, f j :
begin
  rw prod_insert hs,
  exact lt_mul_of_one_lt_left' (∏ j in s, f j) hlt,
end
... ≤ ∏ j in t, f j :
begin
  apply prod_le_prod_of_subset_of_one_le',
  { simp [finset.insert_subset, h, ht] },
  { assume x hx h'x,
    simp only [mem_insert, not_or_distrib] at h'x,
    exact hle x hx h'x.2 }
end

@[to_additive single_lt_sum]
lemma single_lt_prod' {i j : ι} (hij : j ≠ i) (hi : i ∈ s) (hj : j ∈ s) (hlt : 1 < f j)
  (hle : ∀ k ∈ s, k ≠ i → 1 ≤ f k) :
  f i < ∏ k in s, f k :=
calc f i = ∏ k in {i}, f k : prod_singleton.symm
     ... < ∏ k in s, f k   :
  prod_lt_prod_of_subset' (singleton_subset_iff.2 hi) hj (mt mem_singleton.1 hij) hlt $
    λ k hks hki, hle k hks (mt mem_singleton.2 hki)

end ordered_cancel_comm_monoid

section linear_ordered_cancel_comm_monoid

variables [linear_ordered_cancel_comm_monoid M] {f g : ι → M} {s t : finset ι}

@[to_additive exists_lt_of_sum_lt]
theorem exists_lt_of_prod_lt' (Hlt : ∏ i in s, f i < ∏ i in s, g i) :
  ∃ i ∈ s, f i < g i :=
begin
  contrapose! Hlt with Hle,
  exact prod_le_prod'' Hle
end

@[to_additive exists_le_of_sum_le]
theorem exists_le_of_prod_le' (hs : s.nonempty) (Hle : ∏ i in s, f i ≤ ∏ i in s, g i) :
  ∃ i ∈ s, f i ≤ g i :=
begin
  contrapose! Hle with Hlt,
  exact prod_lt_prod_of_nonempty' hs Hlt
end

@[to_additive exists_pos_of_sum_zero_of_exists_nonzero]
lemma exists_one_lt_of_prod_one_of_exists_ne_one' (f : ι → M)
  (h₁ : ∏ i in s, f i = 1) (h₂ : ∃ i ∈ s, f i ≠ 1) :
  ∃ i ∈ s, 1 < f i :=
begin
  contrapose! h₁,
  obtain ⟨i, m, i_ne⟩ : ∃ i ∈ s, f i ≠ 1 := h₂,
  apply ne_of_lt,
  calc ∏ j in s, f j < ∏ j in s, 1 : prod_lt_prod' h₁ ⟨i, m, (h₁ i m).lt_of_ne i_ne⟩
                 ... = 1           : prod_const_one
end

end linear_ordered_cancel_comm_monoid

section ordered_comm_semiring

variables [ordered_comm_semiring R] {f g : ι → R} {s t : finset ι}
open_locale classical

/- this is also true for a ordered commutative multiplicative monoid -/
lemma prod_nonneg (h0 : ∀ i ∈ s, 0 ≤ f i) : 0 ≤ ∏ i in s, f i :=
prod_induction f (λ i, 0 ≤ i) (λ _ _ ha hb, mul_nonneg ha hb) zero_le_one h0

/- this is also true for a ordered commutative multiplicative monoid -/
lemma prod_pos [nontrivial R] (h0 : ∀ i ∈ s, 0 < f i) :
  0 < ∏ i in s, f i :=
prod_induction f (λ x, 0 < x) (λ _ _ ha hb, mul_pos ha hb) zero_lt_one h0

/-- If all `f i`, `i ∈ s`, are nonnegative and each `f i` is less than or equal to `g i`, then the
product of `f i` is less than or equal to the product of `g i`. See also `finset.prod_le_prod''` for
the case of an ordered commutative multiplicative monoid. -/
lemma prod_le_prod (h0 : ∀ i ∈ s, 0 ≤ f i) (h1 : ∀ i ∈ s, f i ≤ g i) :
  ∏ i in s, f i ≤ ∏ i in s, g i :=
begin
  induction s using finset.induction with a s has ih h,
  { simp },
  { simp only [prod_insert has], apply mul_le_mul,
    { exact h1 a (mem_insert_self a s) },
    { apply ih (λ x H, h0 _ _) (λ x H, h1 _ _); exact (mem_insert_of_mem H) },
    { apply prod_nonneg (λ x H, h0 x (mem_insert_of_mem H)) },
    { apply le_trans (h0 a (mem_insert_self a s)) (h1 a (mem_insert_self a s)) } }
end

/-- If each `f i`, `i ∈ s` belongs to `[0, 1]`, then their product is less than or equal to one.
See also `finset.prod_le_one'` for the case of an ordered commutative multiplicative monoid. -/
lemma prod_le_one (h0 : ∀ i ∈ s, 0 ≤ f i) (h1 : ∀ i ∈ s, f i ≤ 1) :
  ∏ i in s, f i ≤ 1 :=
begin
  convert ← prod_le_prod h0 h1,
  exact finset.prod_const_one
end

/-- If `g, h ≤ f` and `g i + h i ≤ f i`, then the product of `f` over `s` is at least the
  sum of the products of `g` and `h`. This is the version for `ordered_comm_semiring`. -/
lemma prod_add_prod_le {i : ι} {f g h : ι → R}
  (hi : i ∈ s) (h2i : g i + h i ≤ f i) (hgf : ∀ j ∈ s, j ≠ i → g j ≤ f j)
  (hhf : ∀ j ∈ s, j ≠ i → h j ≤ f j) (hg : ∀ i ∈ s, 0 ≤ g i) (hh : ∀ i ∈ s, 0 ≤ h i) :
  ∏ i in s, g i + ∏ i in s, h i ≤ ∏ i in s, f i :=
begin
  simp_rw [prod_eq_mul_prod_diff_singleton hi],
  refine le_trans _ (mul_le_mul_of_nonneg_right h2i _),
  { rw [right_distrib],
    apply add_le_add; apply mul_le_mul_of_nonneg_left; try { apply_assumption; assumption };
      apply prod_le_prod; simp * { contextual := tt } },
  { apply prod_nonneg, simp only [and_imp, mem_sdiff, mem_singleton],
    intros j h1j h2j, exact le_trans (hg j h1j) (hgf j h1j h2j) }
end

end ordered_comm_semiring

section canonically_ordered_comm_semiring

variables [canonically_ordered_comm_semiring R] {f g h : ι → R} {s : finset ι} {i : ι}

lemma prod_le_prod' (h : ∀ i ∈ s, f i ≤ g i) :
  ∏ i in s, f i ≤ ∏ i in s, g i :=
begin
  classical,
  induction s using finset.induction with a s has ih h,
  { simp },
  { rw [finset.prod_insert has, finset.prod_insert has],
    apply canonically_ordered_semiring.mul_le_mul,
    { exact h _ (finset.mem_insert_self a s) },
    { exact ih (λ i hi, h _ (finset.mem_insert_of_mem hi)) } }
end

/-- If `g, h ≤ f` and `g i + h i ≤ f i`, then the product of `f` over `s` is at least the
  sum of the products of `g` and `h`. This is the version for `canonically_ordered_comm_semiring`.
-/
lemma prod_add_prod_le' (hi : i ∈ s) (h2i : g i + h i ≤ f i)
  (hgf : ∀ j ∈ s, j ≠ i → g j ≤ f j) (hhf : ∀ j ∈ s, j ≠ i → h j ≤ f j) :
  ∏ i in s, g i + ∏ i in s, h i ≤ ∏ i in s, f i :=
begin
  classical, simp_rw [prod_eq_mul_prod_diff_singleton hi],
  refine le_trans _ (canonically_ordered_semiring.mul_le_mul_right' h2i _),
  rw [right_distrib],
  apply add_le_add; apply canonically_ordered_semiring.mul_le_mul_left'; apply prod_le_prod';
  simp only [and_imp, mem_sdiff, mem_singleton]; intros; apply_assumption; assumption
end

end canonically_ordered_comm_semiring

end finset

namespace fintype

variables [fintype ι]

@[mono, to_additive sum_mono]
lemma prod_mono' [ordered_comm_monoid M] : monotone (λ f : ι → M, ∏ i, f i) :=
λ f g hfg, finset.prod_le_prod'' $ λ x _, hfg x

@[to_additive sum_strict_mono]
lemma prod_strict_mono' [ordered_cancel_comm_monoid M] : strict_mono (λ f : ι → M, ∏ x, f x) :=
λ f g hfg, let ⟨hle, i, hlt⟩ := pi.lt_def.mp hfg in
  finset.prod_lt_prod' (λ i _, hle i) ⟨i, finset.mem_univ i, hlt⟩

end fintype

namespace with_top
open finset

/-- A product of finite numbers is still finite -/
lemma prod_lt_top [canonically_ordered_comm_semiring R] [nontrivial R] [decidable_eq R]
  {s : finset ι} {f : ι → with_top R} (h : ∀ i ∈ s, f i < ⊤) :
  ∏ i in s, f i < ⊤ :=
prod_induction f (λ a, a < ⊤) (λ a b, mul_lt_top) (coe_lt_top 1) h

/-- A sum of finite numbers is still finite -/
lemma sum_lt_top [ordered_add_comm_monoid M] {s : finset ι} {f : ι → with_top M} :
  (∀ i ∈ s, f i < ⊤) → (∑ i in s, f i) < ⊤ :=
sum_induction f (λ a, a < ⊤) (by { simp_rw add_lt_top, tauto }) zero_lt_top

/-- A sum of numbers is infinite iff one of them is infinite -/
lemma sum_eq_top_iff [ordered_add_comm_monoid M] {s : finset ι} {f : ι → with_top M} :
  ∑ i in s, f i = ⊤ ↔ ∃ i ∈ s, f i = ⊤ :=
begin
  classical,
  split,
  { contrapose!,
    exact λ h, (sum_lt_top $ λ i hi, lt_top_iff_ne_top.2 (h i hi)).ne },
  { rintro ⟨i, his, hi⟩,
    rw [sum_eq_add_sum_diff_singleton his, hi, top_add] }
end

/-- A sum of finite numbers is still finite -/
lemma sum_lt_top_iff [ordered_add_comm_monoid M] {s : finset ι} {f : ι → with_top M} :
  ∑ i in s, f i < ⊤ ↔ ∀ i ∈ s, f i < ⊤ :=
by simp only [lt_top_iff_ne_top, ne.def, sum_eq_top_iff, not_exists]

end with_top


import mynat.definition -- Imports the natural numbers.
import mynat.add -- imports addition.
import world02.level01 -- hide
import world02.level03 -- hide

namespace mynat -- hide

lemma add_comm (a b : mynat) : a + b = b + a :=
begin [nat_num_game]
  induction b with d hd,
  rw add_zero,
  rw zero_add,
  refl,
  rw add_succ,
  rw succ_add,
  rw hd,
  refl,
end

end mynat -- hide


import data.real.basic tactic

variables a b : ℝ

#check pow_two_nonneg
#check pow_two_nonneg b
#check ring

-- BEGIN
example : 2*a*b ≤ a^2 + b^2 :=
begin
  have h : 0 ≤ a^2 - 2*a*b + b^2,
  calc
    a^2 - 2*a*b + b^2 = (a - b)^2 : by ring
    ... ≥ 0                       : by apply pow_two_nonneg,
  linarith,
end
-- END


import ring_theory.localization
import ring_theory.subring

import for_mathlib.nonarchimedean.basic
import for_mathlib.topological_rings

import sheaves.presheaf_of_topological_rings
import Spa.rational_open_data

/-!
# The structure presheaf on the adic spectrum of a Huber pair

The purpose of this file is to endow the adic spectrum `spa A` of a Huber pair
with a presheaf of topological rings: the structure presheaf.
Sections of this presheaf will be thought of as functions on the adic spectrum.

## Implementation details

Because the library for categorical limits was not yet very stable at the time of writing,
we implement the sections of the presheaf by manually taking a limit:

  -- The underlying type of 𝒪_X(U), the structure presheaf on X = Spa(A)
  def presheaf_value (U : opens (spa A)) :=
  {f : Π (rd : rational_open_data_subsets U), rat_open_data_completion rd.1 //
     ∀ (rd1 rd2 : rational_open_data_subsets U) (h : rd1.1 ≤ rd2.1),
       rat_open_data_completion.restriction h (f rd1) = (f rd2)} -- agrees on overlaps

-/

universes u₁ u₂ u₃

open_locale classical

open set function Spv valuation

local postfix `⁺` : 66 := λ A : Huber_pair, A.plus

namespace spa

variable {A : Huber_pair}

section
open topological_space

/-- The set of all rational open subsets contained in the open set U. -/
def rational_open_data_subsets (U : opens (spa A)) :=
{ r : rational_open_data A // r.open_set ⊆ U}

/-- The natural inclusion map of rational open subsets contained in the open set U
into those contained in some larger open set V (that contains U).-/
def rational_open_data_subsets.map {U V : opens (spa A)} (hUV : U ≤ V)
  (rd : rational_open_data_subsets U) :
  rational_open_data_subsets V :=
⟨rd.val, set.subset.trans rd.property hUV⟩

/--The intersection of two rational open subsets contained in some open set U
is a rational open subset contained in U.-/
noncomputable def rational_open_data_subsets_inter {U :  opens (spa A)}
  (r1 r2 : rational_open_data_subsets U) :
rational_open_data_subsets U :=
⟨rational_open_data.inter r1.1 r2.1, begin
  rw rational_open_data.inter_open_set,
  refine set.subset.trans (inter_subset_left r1.1.open_set r2.1.open_set) _,
  exact r1.2
end⟩

lemma rational_open_data_subsets_symm {U :  opens (spa A)}
  (r1 r2 : rational_open_data_subsets U) :
rational_open_data_subsets_inter r1 r2 = rational_open_data_subsets_inter r2 r1 :=
begin
  rw subtype.ext,
  exact rational_open_data.inter_symm r1.1 r2.1
end

end -- section

open uniform_space

-- rat_open_data is short for "rational open data". KB needs to think more clearly
-- about namespaces etc.

/-- A<T/s>, the functions on D(T,s). A topological ring -/
def rat_open_data_completion (r : rational_open_data A) :=
completion (rational_open_data.localization r)

namespace rat_open_data_completion
open topological_space

/-- The ring structure on A<T/s>. -/
noncomputable instance (r : rational_open_data A) : comm_ring (rat_open_data_completion r) :=
by dunfold rat_open_data_completion; apply_instance

/-- The uniform structure on A<T/s>. -/
instance uniform_space (r : rational_open_data A) : uniform_space (rat_open_data_completion r) :=
by dunfold rat_open_data_completion; apply_instance

/-- A<T/s> is a topological ring. -/
instance (r : rational_open_data A) : topological_ring (rat_open_data_completion r) :=
by dunfold rat_open_data_completion; apply_instance

/-- The natural map A<T₁/s₁> → A<T₂/s₂> for two rational open subsets r1 and r2 with r1 ≤ r2.-/
noncomputable def restriction {r1 r2 : rational_open_data A} (h : r1 ≤ r2) :
rat_open_data_completion r1 → rat_open_data_completion r2 :=
completion.map (rational_open_data.localization_map h)

/-- The natural map A<T₁/s₁> → A<T₂/s₂> is a ring homomorphism.-/
instance restriction_is_ring_hom {r1 r2 : rational_open_data A} (h : r1 ≤ r2) :
  is_ring_hom (restriction h) :=
completion.is_ring_hom_map (rational_open_data.localization_map_is_cts h)

lemma restriction_is_uniform_continuous {r1 r2 : rational_open_data A} (h : r1 ≤ r2) :
uniform_continuous (rat_open_data_completion.restriction h) :=
completion.uniform_continuous_map

end rat_open_data_completion -- namespace

open topological_space

/-- The underlying type of 𝒪_X(U), the structure presheaf on X = Spa(A) -/
def presheaf_value (U : opens (spa A)) :=
{f : Π (rd : rational_open_data_subsets U), rat_open_data_completion rd.1 //
   ∀ (rd1 rd2 : rational_open_data_subsets U) (h : rd1.1 ≤ rd2.1),
     rat_open_data_completion.restriction h (f rd1) = (f rd2)} -- agrees on overlaps

/-- An auxilliary definition:
  The underlying type of 𝒪_X(U), the structure presheaf on X = Spa(A),
  but given as a subset, rather than a subtype.
  This definition is used for the definition of the ring structure on 𝒪_X(U) -/
def presheaf_value_set (U : opens (spa A)) :=
{f : Π (rd : rational_open_data_subsets U), rat_open_data_completion rd.1 |
   ∀ (rd1 rd2 : rational_open_data_subsets U) (h : rd1.1 ≤ rd2.1),
     rat_open_data_completion.restriction h (f rd1) = (f rd2)}

-- We need to check it's a ring

/-- The value of the structure presheaf on an open set U
is a subring of the big Pi-type in its definiton.-/
lemma presheaf_subring (U : opens (spa A)) : is_subring (presheaf_value_set U) :=
{ zero_mem := λ _ _ _, is_ring_hom.map_zero _,
  one_mem := λ _ _ _, is_ring_hom.map_one _,
  add_mem := λ a b ha hb rd₁ rd₂ h,
  begin
    change rat_open_data_completion.restriction h (a rd₁ + b rd₁) = a rd₂ + b rd₂,
    rw is_ring_hom.map_add (rat_open_data_completion.restriction h),
    rw [ha _ _ h, hb _ _ h],
  end,
  neg_mem := λ a ha rd₁ rd₂ h,
  begin
    change rat_open_data_completion.restriction h (-(a rd₁)) = -(a rd₂),
    rw is_ring_hom.map_neg (rat_open_data_completion.restriction h),
    rw ha _ _ h,
  end,
  mul_mem := λ a b ha hb rd₁ rd₂ h,
  begin
    change rat_open_data_completion.restriction h (a rd₁ * b rd₁) = a rd₂ * b rd₂,
    rw is_ring_hom.map_mul (rat_open_data_completion.restriction h),
    rw [ha _ _ h, hb _ _ h]
  end }

/-- The ring structure on the value of the structure presheaf on an open set U.-/
noncomputable instance presheaf_comm_ring (U : opens (spa A)) : comm_ring (presheaf_value U) :=
@subset.comm_ring _ pi.comm_ring _ (spa.presheaf_subring U)

/-- The topology on the value of the structure presheaf on an open set U.-/
instance presheaf_top_space (U : opens (spa A)) : topological_space (presheaf_value U) :=
by unfold presheaf_value; apply_instance

/-- The value of the structure presheaf on an open set U is a topological ring.-/
instance presheaf_top_ring (U : opens (spa A)) : topological_ring (presheaf_value U) :=
begin
  haveI := spa.presheaf_subring U,
  letI : topological_ring (Π (rd : rational_open_data_subsets U), rat_open_data_completion (rd.1)) :=
    by apply_instance,
  apply topological_subring (presheaf_value_set U),
end

/-- The restriction map for the structure presheaf on the adic spectrum of a Huber pair. -/
def presheaf_map {U V : opens (spa A)} (hUV : U ≤ V) :
  presheaf_value V → presheaf_value U :=
λ f, ⟨_, λ rd1 rd2 h,
  (f.2 (rational_open_data_subsets.map hUV rd1)
    (rational_open_data_subsets.map hUV rd2) h : _)⟩

-- Note the (X : _) trick at the end of the preceding definition,
-- which tells Lean "don't try and elaborate X assuming it has the type you know it has,
-- elaborate it independently, figure out the type, and then unify".
-- Thanks to Mario Carneiro for this trick which
-- hugely speeds up elaboration time of this definition.

@[simp] lemma presheaf_map_id (U : opens (spa A)) :
  presheaf_map (le_refl U) = id :=
by { delta presheaf_map, tidy }

lemma presheaf_map_comp {U V W : opens (spa A)} (hUV : U ≤ V) (hVW : V ≤ W) :
  presheaf_map hUV ∘ presheaf_map hVW = presheaf_map (le_trans hUV hVW) :=
by { delta presheaf_map, tidy }

/-- The restriction maps of the structure presheaf are ring homomorphisms. -/
instance presheaf_map_is_ring_hom {U V : opens (spa A)} (hUV : U ≤ V) :
is_ring_hom (presheaf_map hUV) :=
{ map_one := rfl,
  map_mul := λ _ _, rfl,
  map_add := λ _ _, rfl }

lemma presheaf_map_cts {U V : opens (spa A)} (hUV : U ≤ V) :
  continuous (presheaf_map hUV) :=
continuous_subtype_mk _ (continuous_pi (λ i, ((continuous_apply _).comp continuous_subtype_val)))

variable (A)

/-- The structure presheaf on the adic spectrum of a Huber pair. -/
noncomputable def presheaf_of_topological_rings : presheaf_of_topological_rings (spa A) :=
{ F := presheaf_value,
  res := λ U V, presheaf_map,
  Hid := presheaf_map_id,
  Hcomp := λ U V W, presheaf_map_comp,
  Fring := spa.presheaf_comm_ring,
  res_is_ring_hom := λ U V, spa.presheaf_map_is_ring_hom,
  Ftop := spa.presheaf_top_space,
  Ftop_ring := spa.presheaf_top_ring,
  res_continuous := λ U V, presheaf_map_cts }

end spa -- namespace

-- notes

-- KB idle comment: I guess we never make A<T/s> a Huber pair if A is a Huber pair?
-- We would need integral closure for this and I don't think we have it in mathlib.

-- We see mid way through p75 that the definition of the presheaf
-- on V is proj lim of O_X(U) as U runs through rationals opens in V. This gets
-- the projective limit topology and then we have a presheaf (hopefully this is
-- straightforward) of complete topological rings (need proj lim of complete is complete)


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

! This file was ported from Lean 3 source module combinatorics.set_family.harris_kleitman
! leanprover-community/mathlib commit 0a0ec35061ed9960bf0e7ffb0335f44447b58977
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Combinatorics.SetFamily.Compression.Down
import Mathbin.Order.UpperLower.Basic
import Mathbin.Data.Fintype.BigOperators

/-!
# Harris-Kleitman inequality

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

This file proves the Harris-Kleitman inequality. This relates `𝒜.card * ℬ.card` and
`2 ^ card α * (𝒜 ∩ ℬ).card` where `𝒜` and `ℬ` are upward- or downcard-closed finite families of
finsets. This can be interpreted as saying that any two lower sets (resp. any two upper sets)
correlate in the uniform measure.

## Main declarations

* `is_lower_set.le_card_inter_finset`: One form of the Harris-Kleitman inequality.

## References

* [D. J. Kleitman, *Families of non-disjoint subsets*][kleitman1966]
-/

open Finset

open BigOperators

variable {α : Type _} [DecidableEq α] {𝒜 ℬ : Finset (Finset α)} {s : Finset α} {a : α}

#print IsLowerSet.nonMemberSubfamily /-
theorem IsLowerSet.nonMemberSubfamily (h : IsLowerSet (𝒜 : Set (Finset α))) :
    IsLowerSet (𝒜.nonMemberSubfamily a : Set (Finset α)) := fun s t hts =>
  by
  simp_rw [mem_coe, mem_non_member_subfamily]
  exact And.imp (h hts) (mt <| @hts _)
#align is_lower_set.non_member_subfamily IsLowerSet.nonMemberSubfamily
-/

#print IsLowerSet.memberSubfamily /-
theorem IsLowerSet.memberSubfamily (h : IsLowerSet (𝒜 : Set (Finset α))) :
    IsLowerSet (𝒜.memberSubfamily a : Set (Finset α)) :=
  by
  rintro s t hts
  simp_rw [mem_coe, mem_member_subfamily]
  exact And.imp (h <| insert_subset_insert _ hts) (mt <| @hts _)
#align is_lower_set.member_subfamily IsLowerSet.memberSubfamily
-/

#print IsLowerSet.memberSubfamily_subset_nonMemberSubfamily /-
theorem IsLowerSet.memberSubfamily_subset_nonMemberSubfamily (h : IsLowerSet (𝒜 : Set (Finset α))) :
    𝒜.memberSubfamily a ⊆ 𝒜.nonMemberSubfamily a := fun s =>
  by
  rw [mem_member_subfamily, mem_non_member_subfamily]
  exact And.imp_left (h <| subset_insert _ _)
#align is_lower_set.member_subfamily_subset_non_member_subfamily IsLowerSet.memberSubfamily_subset_nonMemberSubfamily
-/

#print IsLowerSet.le_card_inter_finset' /-
/-- **Harris-Kleitman inequality**: Any two lower sets of finsets correlate. -/
theorem IsLowerSet.le_card_inter_finset' (h𝒜 : IsLowerSet (𝒜 : Set (Finset α)))
    (hℬ : IsLowerSet (ℬ : Set (Finset α))) (h𝒜s : ∀ t ∈ 𝒜, t ⊆ s) (hℬs : ∀ t ∈ ℬ, t ⊆ s) :
    𝒜.card * ℬ.card ≤ 2 ^ s.card * (𝒜 ∩ ℬ).card :=
  by
  induction' s using Finset.induction with a s hs ih generalizing 𝒜 ℬ
  · simp_rw [subset_empty, ← subset_singleton_iff', subset_singleton_iff] at h𝒜s hℬs
    obtain rfl | rfl := h𝒜s
    · simp only [card_empty, empty_inter, MulZeroClass.mul_zero, MulZeroClass.zero_mul]
    obtain rfl | rfl := hℬs
    · simp only [card_empty, inter_empty, MulZeroClass.mul_zero, MulZeroClass.zero_mul]
    · simp only [card_empty, pow_zero, inter_singleton_of_mem, mem_singleton, card_singleton]
  rw [card_insert_of_not_mem hs, ← card_member_subfamily_add_card_non_member_subfamily a 𝒜, ←
    card_member_subfamily_add_card_non_member_subfamily a ℬ, add_mul, mul_add, mul_add,
    add_comm (_ * _), add_add_add_comm]
  refine'
    (add_le_add_right
          (mul_add_mul_le_mul_add_mul
              (card_le_of_subset h𝒜.member_subfamily_subset_non_member_subfamily) <|
            card_le_of_subset hℬ.member_subfamily_subset_non_member_subfamily)
          _).trans
      _
  rw [← two_mul, pow_succ, mul_assoc]
  have h₀ :
    ∀ 𝒞 : Finset (Finset α), (∀ t ∈ 𝒞, t ⊆ insert a s) → ∀ t ∈ 𝒞.nonMemberSubfamily a, t ⊆ s :=
    by
    rintro 𝒞 h𝒞 t ht
    rw [mem_non_member_subfamily] at ht
    exact (subset_insert_iff_of_not_mem ht.2).1 (h𝒞 _ ht.1)
  have h₁ : ∀ 𝒞 : Finset (Finset α), (∀ t ∈ 𝒞, t ⊆ insert a s) → ∀ t ∈ 𝒞.memberSubfamily a, t ⊆ s :=
    by
    rintro 𝒞 h𝒞 t ht
    rw [mem_member_subfamily] at ht
    exact (subset_insert_iff_of_not_mem ht.2).1 ((subset_insert _ _).trans <| h𝒞 _ ht.1)
  refine' mul_le_mul_left' _ _
  refine'
    (add_le_add (ih h𝒜.member_subfamily hℬ.member_subfamily (h₁ _ h𝒜s) <| h₁ _ hℬs) <|
          ih h𝒜.non_member_subfamily hℬ.non_member_subfamily (h₀ _ h𝒜s) <| h₀ _ hℬs).trans_eq
      _
  rw [← mul_add, ← member_subfamily_inter, ← non_member_subfamily_inter,
    card_member_subfamily_add_card_non_member_subfamily]
#align is_lower_set.le_card_inter_finset' IsLowerSet.le_card_inter_finset'
-/

variable [Fintype α]

#print IsLowerSet.le_card_inter_finset /-
/-- **Harris-Kleitman inequality**: Any two lower sets of finsets correlate. -/
theorem IsLowerSet.le_card_inter_finset (h𝒜 : IsLowerSet (𝒜 : Set (Finset α)))
    (hℬ : IsLowerSet (ℬ : Set (Finset α))) : 𝒜.card * ℬ.card ≤ 2 ^ Fintype.card α * (𝒜 ∩ ℬ).card :=
  h𝒜.le_card_inter_finset' hℬ (fun _ _ => subset_univ _) fun _ _ => subset_univ _
#align is_lower_set.le_card_inter_finset IsLowerSet.le_card_inter_finset
-/

#print IsUpperSet.card_inter_le_finset /-
/-- **Harris-Kleitman inequality**: Upper sets and lower sets of finsets anticorrelate. -/
theorem IsUpperSet.card_inter_le_finset (h𝒜 : IsUpperSet (𝒜 : Set (Finset α)))
    (hℬ : IsLowerSet (ℬ : Set (Finset α))) : 2 ^ Fintype.card α * (𝒜 ∩ ℬ).card ≤ 𝒜.card * ℬ.card :=
  by
  rw [← isLowerSet_compl, ← coe_compl] at h𝒜
  have := h𝒜.le_card_inter_finset hℬ
  rwa [card_compl, Fintype.card_finset, tsub_mul, tsub_le_iff_tsub_le, ← mul_tsub, ←
    card_sdiff (inter_subset_right _ _), sdiff_inter_self_right, sdiff_compl, _root_.inf_comm] at
    this
#align is_upper_set.card_inter_le_finset IsUpperSet.card_inter_le_finset
-/

#print IsLowerSet.card_inter_le_finset /-
/-- **Harris-Kleitman inequality**: Lower sets and upper sets of finsets anticorrelate. -/
theorem IsLowerSet.card_inter_le_finset (h𝒜 : IsLowerSet (𝒜 : Set (Finset α)))
    (hℬ : IsUpperSet (ℬ : Set (Finset α))) : 2 ^ Fintype.card α * (𝒜 ∩ ℬ).card ≤ 𝒜.card * ℬ.card :=
  by
  rw [inter_comm, mul_comm 𝒜.card]
  exact hℬ.card_inter_le_finset h𝒜
#align is_lower_set.card_inter_le_finset IsLowerSet.card_inter_le_finset
-/

#print IsUpperSet.le_card_inter_finset /-
/-- **Harris-Kleitman inequality**: Any two upper sets of finsets correlate. -/
theorem IsUpperSet.le_card_inter_finset (h𝒜 : IsUpperSet (𝒜 : Set (Finset α)))
    (hℬ : IsUpperSet (ℬ : Set (Finset α))) : 𝒜.card * ℬ.card ≤ 2 ^ Fintype.card α * (𝒜 ∩ ℬ).card :=
  by
  rw [← isLowerSet_compl, ← coe_compl] at h𝒜
  have := h𝒜.card_inter_le_finset hℬ
  rwa [card_compl, Fintype.card_finset, tsub_mul, le_tsub_iff_le_tsub, ← mul_tsub, ←
    card_sdiff (inter_subset_right _ _), sdiff_inter_self_right, sdiff_compl, _root_.inf_comm] at
    this
  · exact mul_le_mul_left' (card_le_of_subset <| inter_subset_right _ _) _
  · rw [← Fintype.card_finset]
    exact mul_le_mul_right' (card_le_univ _) _
#align is_upper_set.le_card_inter_finset IsUpperSet.le_card_inter_finset
-/