/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Jeremy Avigad

Definitions and properties of div and mod, following the SSReflect library.

Following SSReflect and the SMTlib standard, we define a % b so that 0 ≤ a % b < |b| when b ≠ 0.
-/
import data.int.order data.nat.div
open [coercion] [reducible] nat
open [declaration] [class] nat (succ)
open eq.ops

namespace int

/- definitions -/

protected definition div (a b : ℤ) : ℤ :=
sign b *
  (match a with
    | of_nat m := of_nat (m / (nat_abs b))
    | -[1+m]   := -[1+ ((m:nat) / (nat_abs b))]
  end)

definition int_has_div [instance] [priority int.prio] : has_div int :=
has_div.mk int.div

lemma of_nat_div_eq (m : nat) (b : ℤ) : (of_nat m) / b = sign b * of_nat (m / (nat_abs b)) :=
rfl

lemma neg_succ_div_eq (m: nat) (b : ℤ) : -[1+m] / b = sign b * -[1+ (m / (nat_abs b))] :=
rfl

lemma div_def (a b : ℤ) : a / b =
  sign b *
    (match a with
      | of_nat m := of_nat (m / (nat_abs b))
      | -[1+m]   := -[1+ ((m:nat) / (nat_abs b))]
    end) :=
rfl

protected definition mod (a b : ℤ) : ℤ := a - a / b * b

definition int_has_mod [instance] [priority int.prio] : has_mod int :=
has_mod.mk int.mod

lemma mod_def (a b : ℤ) : a % b = a - a / b * b :=
rfl

notation [priority int.prio] a ≡ b `[mod `:0 c:0 `]` := a % c = b % c

/- /  -/

theorem of_nat_div (m n : nat) : of_nat (m / n) = (of_nat m) / (of_nat n) :=
nat.cases_on n
  (begin rewrite [of_nat_div_eq, of_nat_zero, sign_zero, zero_mul, nat.div_zero] end)
  (take (n : nat), by rewrite [of_nat_div_eq, sign_of_succ, one_mul])

theorem neg_succ_of_nat_div (m : nat) {b : ℤ} (H : b > 0) :
  -[1+m] / b = -(m / b + 1) :=
calc
  -[1+m] / b = sign b * _         : rfl
     ... = -[1+(m / (nat_abs b))] : by rewrite [sign_of_pos H, one_mul]
     ... = -(m / b + 1)           : by rewrite [of_nat_div_eq, sign_of_pos H, one_mul]

protected theorem div_neg (a b : ℤ) : a / -b = -(a / b) :=
begin
  induction a,
    rewrite [*of_nat_div_eq, sign_neg, neg_mul_eq_neg_mul, nat_abs_neg],
    rewrite [*neg_succ_div_eq, sign_neg, neg_mul_eq_neg_mul, nat_abs_neg],
end

theorem div_of_neg_of_pos {a b : ℤ} (Ha : a < 0) (Hb : b > 0) : a / b = -((-a - 1) / b + 1) :=
obtain (m : nat) (H1 : a = -[1+m]), from exists_eq_neg_succ_of_nat Ha,
calc
  a / b = -(m / b + 1)         : by rewrite [H1, neg_succ_of_nat_div _ Hb]
      ... = -((-a -1) / b + 1) : by rewrite [H1, neg_succ_of_nat_eq', neg_sub, sub_neg_eq_add,
                                               add.comm 1, add_sub_cancel]

protected theorem div_nonneg {a b : ℤ} (Ha : a ≥ 0) (Hb : b ≥ 0) : a / b ≥ 0 :=
obtain (m : ℕ) (Hm : a = m), from exists_eq_of_nat Ha,
obtain (n : ℕ) (Hn : b = n), from exists_eq_of_nat Hb,
calc
  a / b = m / n : by rewrite [Hm, Hn]
      ... ≥ 0       : by rewrite -of_nat_div; apply trivial

protected theorem div_nonpos {a b : ℤ} (Ha : a ≥ 0) (Hb : b ≤ 0) : a / b ≤ 0 :=
calc
  a / b = -(a / -b) : by rewrite [int.div_neg, neg_neg]
      ... ≤ 0       : neg_nonpos_of_nonneg (int.div_nonneg Ha (neg_nonneg_of_nonpos Hb))

theorem div_neg' {a b : ℤ} (Ha : a < 0) (Hb : b > 0) : a / b < 0 :=
have -a - 1 ≥ 0, from le_sub_one_of_lt (neg_pos_of_neg Ha),
have (-a - 1) / b + 1 > 0, from lt_add_one_of_le (int.div_nonneg this (le_of_lt Hb)),
calc
  a / b = -((-a - 1) / b + 1) : div_of_neg_of_pos Ha Hb
      ... < 0                 : neg_neg_of_pos this

protected theorem zero_div (b : ℤ) : 0 / b = 0 :=
by krewrite [of_nat_div_eq, nat.zero_div, of_nat_zero, mul_zero]

protected theorem div_zero (a : ℤ) : a / 0 = 0 :=
by rewrite [div_def, sign_zero, zero_mul]

protected theorem div_one (a : ℤ) : a / 1 = a :=
have (1 : int) > 0, from dec_trivial,
int.cases_on a
  (take m : nat, by rewrite [-of_nat_one, -of_nat_div, nat.div_one])
  (take m : nat, by rewrite [!neg_succ_of_nat_div this, -of_nat_one, -of_nat_div, nat.div_one])

theorem eq_div_mul_add_mod (a b : ℤ) : a = a / b * b + a % b :=
!add.comm ▸ eq_add_of_sub_eq rfl

theorem div_eq_zero_of_lt {a b : ℤ} : 0 ≤ a → a < b → a / b = 0 :=
int.cases_on a
  (take (m : nat), assume H,
    int.cases_on b
      (take (n : nat),
        assume H : m < n,
        show m / n = 0,
          by rewrite [-of_nat_div, nat.div_eq_zero_of_lt (lt_of_of_nat_lt_of_nat H)])
      (take (n : nat),
        assume H : m < -[1+n],
        have H1 : ¬(m < -[1+n]), from dec_trivial,
        absurd H H1))
  (take (m : nat),
    assume H : 0 ≤ -[1+m],
    have ¬ (0 ≤ -[1+m]), from dec_trivial,
    absurd H this)

theorem div_eq_zero_of_lt_abs {a b : ℤ} (H1 : 0 ≤ a) (H2 : a < abs b) : a / b = 0 :=
lt.by_cases
  (suppose b < 0,
    have a < -b, from abs_of_neg this ▸ H2,
    calc
      a / b = - (a / -b) : by rewrite [int.div_neg, neg_neg]
          ... = 0         : by rewrite [div_eq_zero_of_lt H1 this, neg_zero])
  (suppose b = 0, this⁻¹ ▸ !int.div_zero)
  (suppose b > 0,
    have a < b, from abs_of_pos this ▸ H2,
    div_eq_zero_of_lt H1 this)

private theorem add_mul_div_self_aux1 {a : ℤ} {k : ℕ} (n : ℕ) (H1 : a ≥ 0) (H2 : k > 0) :
  (a + n * k) / k = a / k + n :=
obtain (m : nat) (Hm : a = of_nat m), from exists_eq_of_nat H1,
begin
  subst Hm,
  rewrite [-of_nat_mul, -of_nat_add, -*of_nat_div, -of_nat_add, !nat.add_mul_div_self H2]
end

private theorem add_mul_div_self_aux2 {a : ℤ} {k : ℕ} (n : ℕ) (H1 : a < 0) (H2 : k > 0) :
  (a + n * k) / k = a / k + n :=
obtain m (Hm : a = -[1+m]), from exists_eq_neg_succ_of_nat H1,
or.elim (nat.lt_or_ge m (n * k))
  (assume m_lt_nk : m < n * k,
    have H3 : m + 1 ≤ n * k, from nat.succ_le_of_lt m_lt_nk,
    have H4 : m / k + 1 ≤ n,
      from nat.succ_le_of_lt (nat.div_lt_of_lt_mul m_lt_nk),
    have (-[1+m] + n * k) / k = -[1+m] / k + n, from calc
      (-[1+m] + n * k) / k
            = of_nat ((k * n - (m + 1)) / k) :
                by rewrite [add.comm, neg_succ_of_nat_eq, of_nat_div, mul.comm k n,
                            of_nat_sub H3]
        ... = of_nat (n - m / k - 1)         :
                nat.mul_sub_div_of_lt (!nat.mul_comm ▸ m_lt_nk)
        ... = -[1+m] / k + n                 :
                by rewrite [nat.sub_sub, of_nat_sub H4, int.add_comm, sub_eq_add_neg,
                            !neg_succ_of_nat_div (of_nat_lt_of_nat_of_lt H2),
                            of_nat_add, of_nat_div],
    Hm⁻¹ ▸ this)
  (assume nk_le_m :  n * k ≤ m,
    have -[1+m] / k + n = (-[1+m] + n * k) / k, from calc
      -[1+m] / k + n
            = -(of_nat ((m - n * k + n * k) / k) + 1) + n :
                by rewrite [neg_succ_of_nat_div m (of_nat_lt_of_nat_of_lt H2),
                            nat.sub_add_cancel nk_le_m, of_nat_div]
        ... = -(of_nat ((m - n * k) / k + n) + 1) + n     : nat.add_mul_div_self H2
        ... = -(of_nat (m - n * k) / k + 1)               :
                   by rewrite [of_nat_add, *neg_add, add.right_comm, neg_add_cancel_right,
                               of_nat_div]
        ... = -[1+(m - n * k)] / k                        :
                   neg_succ_of_nat_div _ (of_nat_lt_of_nat_of_lt H2)
        ... = -(of_nat(m - n * k) + 1) / k                : rfl
        ... = -(of_nat m - of_nat(n * k) + 1) / k         : of_nat_sub nk_le_m
        ... = (-(of_nat m + 1) + n * k) / k               :
                   by rewrite [sub_eq_add_neg, -*add.assoc, *neg_add, neg_neg, add.right_comm]
        ... = (-[1+m] + n * k) / k                        : rfl,
    Hm⁻¹ ▸ this⁻¹)

private theorem add_mul_div_self_aux3 (a : ℤ) {b c : ℤ} (H1 : b ≥ 0) (H2 : c > 0) :
    (a + b * c) / c = a / c + b :=
obtain (n : nat) (Hn : b = of_nat n), from exists_eq_of_nat H1,
obtain (k : nat) (Hk : c = of_nat k), from exists_eq_of_nat (le_of_lt H2),
have knz : k ≠ 0, from assume kz, !lt.irrefl (kz ▸ Hk ▸ H2),
have kgt0 : (#nat k > 0), from nat.pos_of_ne_zero knz,
have H3 : (a + n * k) / k = a / k + n, from
  or.elim (lt_or_ge a 0)
    (assume Ha : a < 0, add_mul_div_self_aux2 _ Ha kgt0)
    (assume Ha : a ≥ 0, add_mul_div_self_aux1 _ Ha kgt0),
Hn⁻¹ ▸ Hk⁻¹ ▸ H3

private theorem add_mul_div_self_aux4 (a b : ℤ) {c : ℤ} (H : c > 0) :
    (a + b * c) / c = a / c + b :=
or.elim (le.total 0 b)
  (assume H1 : 0 ≤ b, add_mul_div_self_aux3 _ H1 H)
  (assume H1 : 0 ≥ b,
    eq.symm (calc
      a / c + b = (a + b * c + -b * c) / c + b :
                        by rewrite [-neg_mul_eq_neg_mul, add_neg_cancel_right]
              ... = (a + b * c) / c + - b + b  :
                        add_mul_div_self_aux3 _ (neg_nonneg_of_nonpos H1) H
              ... = (a + b * c) / c            : neg_add_cancel_right))

protected theorem add_mul_div_self (a b : ℤ) {c : ℤ} (H : c ≠ 0) :
  (a + b * c) / c = a / c + b :=
lt.by_cases
  (assume H1 : 0 < c, !add_mul_div_self_aux4 H1)
  (assume H1 : 0 = c, absurd H1⁻¹ H)
  (assume H1 : 0 > c,
    have H2 : -c > 0, from neg_pos_of_neg H1,
    calc
      (a + b * c) / c = - ((a + -b * -c) / -c) : by rewrite [int.div_neg, neg_mul_neg, neg_neg]
                    ... = -(a / -c + -b)       : !add_mul_div_self_aux4 H2
                    ... = a / c + b            : by rewrite [int.div_neg, neg_add, *neg_neg])

protected theorem add_mul_div_self_left (a : ℤ) {b : ℤ} (c : ℤ) (H : b ≠ 0) :
    (a + b * c) / b = a / b + c :=
!mul.comm ▸ !int.add_mul_div_self H

protected theorem mul_div_cancel (a : ℤ) {b : ℤ} (H : b ≠ 0) : a * b / b = a :=
calc
  a * b / b = (0 + a * b) / b : zero_add
          ... = 0 / b + a     : !int.add_mul_div_self H
          ... = a             : by rewrite [int.zero_div, zero_add]

protected theorem mul_div_cancel_left {a : ℤ} (b : ℤ) (H : a ≠ 0) : a * b / a = b :=
!mul.comm ▸ int.mul_div_cancel b H

protected theorem div_self {a : ℤ} (H : a ≠ 0) : a / a = 1 :=
!mul_one ▸ !int.mul_div_cancel_left H

/- mod -/

theorem of_nat_mod (m n : nat) : m % n = of_nat (m % n) :=
have H : m = of_nat (m % n) + m / n * n, from calc
  m = of_nat (m / n * n + m % n)              : nat.eq_div_mul_add_mod
    ... = of_nat (m / n) * n + of_nat (m % n) : rfl
    ... = m / n * n + of_nat (m % n)          : of_nat_div
    ... = of_nat (m % n) + m / n * n          : add.comm,
calc
  m % n = m - m / n * n : rfl
      ... = of_nat (m % n)  : sub_eq_of_eq_add H

theorem neg_succ_of_nat_mod (m : ℕ) {b : ℤ} (bpos : b > 0) :
  -[1+m] % b = b - 1 - m % b :=
calc
  -[1+m] % b = -(m + 1) - -[1+m] / b * b : rfl
    ... = -(m + 1) - -(m / b + 1) * b    : neg_succ_of_nat_div _ bpos
    ... = -m + -1 + (b + m / b * b)      :
              by rewrite [neg_add, -neg_mul_eq_neg_mul, sub_neg_eq_add, right_distrib,
                                 one_mul, (add.comm b)]
    ... = b + -1 + (-m + m / b * b)      :
              by rewrite [-*add.assoc, add.comm (-m), add.right_comm (-1), (add.comm b)]
    ... = b - 1 - m % b                  :
              by rewrite [(mod_def), *sub_eq_add_neg, neg_add, neg_neg]
                -- it seems the parser has difficulty here, because "mod" is a token?

theorem mod_neg (a b : ℤ) : a % -b = a % b :=
calc
  a % -b = a - (a / -b) * -b   : rfl
       ... = a - -(a / b) * -b : int.div_neg
       ... = a - a / b * b     : neg_mul_neg
       ... = a % b             : rfl

theorem mod_abs (a b : ℤ) : a % (abs b) = a % b :=
abs.by_cases rfl !mod_neg

theorem zero_mod (b : ℤ) : 0 % b = 0 :=
by rewrite [(mod_def), int.zero_div, zero_mul, sub_zero]

theorem mod_zero (a : ℤ) : a % 0 = a :=
by rewrite [(mod_def), mul_zero, sub_zero]

theorem mod_one (a : ℤ) : a % 1 = 0 :=
calc
  a % 1 = a - a / 1 * 1 : rfl
      ... = 0 : by rewrite [mul_one, int.div_one, sub_self]

private lemma of_nat_mod_abs (m : ℕ) (b : ℤ) : m % (abs b) = of_nat (m % (nat_abs b)) :=
calc
  m % (abs b) = m % (nat_abs b)            : of_nat_nat_abs
            ... = of_nat (m % (nat_abs b)) : of_nat_mod

private lemma of_nat_mod_abs_lt (m : ℕ) {b : ℤ} (H : b ≠ 0) : m % (abs b) < (abs b) :=
have H1 : abs b > 0, from abs_pos_of_ne_zero H,
have H2 : (#nat nat_abs b > 0), from lt_of_of_nat_lt_of_nat (!of_nat_nat_abs⁻¹ ▸ H1),
calc
  m % (abs b) = of_nat (m % (nat_abs b)) : of_nat_mod_abs m b
        ... < nat_abs b : of_nat_lt_of_nat_of_lt (!nat.mod_lt H2)
        ... = abs b       : of_nat_nat_abs _

theorem mod_eq_of_lt {a b : ℤ} (H1 : 0 ≤ a) (H2 : a < b) : a % b = a :=
obtain (m : nat) (Hm : a = of_nat m), from exists_eq_of_nat H1,
obtain (n : nat) (Hn : b = of_nat n), from exists_eq_of_nat (le_of_lt (lt_of_le_of_lt H1 H2)),
begin
  revert H2,
  rewrite [Hm, Hn, of_nat_mod, of_nat_lt_of_nat_iff, of_nat_eq_of_nat_iff],
  apply nat.mod_eq_of_lt
end

theorem mod_nonneg (a : ℤ) {b : ℤ} (H : b ≠ 0) : a % b ≥ 0 :=
have H1 : abs b > 0, from abs_pos_of_ne_zero H,
have H2 : a % (abs b) ≥ 0, from
  int.cases_on a
    (take m : nat, (of_nat_mod_abs m b)⁻¹ ▸ of_nat_nonneg (nat.mod m (nat_abs b)))
    (take m : nat,
      have H3 : 1 + m % (abs b) ≤ (abs b),
        from (!add.comm ▸ add_one_le_of_lt (of_nat_mod_abs_lt m H)),
      calc
        -[1+m] % (abs b) = abs b - 1 - m % (abs b) : neg_succ_of_nat_mod _ H1
          ... = abs b - (1 + m % (abs b))          : by rewrite [*sub_eq_add_neg, neg_add, add.assoc]
          ... ≥ 0                                  : iff.mpr !sub_nonneg_iff_le H3),
!mod_abs ▸ H2

theorem mod_lt (a : ℤ) {b : ℤ} (H : b ≠ 0) : a % b < (abs b) :=
have H1 : abs b > 0, from abs_pos_of_ne_zero H,
have H2 : a % (abs b) < abs b, from
  int.cases_on a
    (take m, of_nat_mod_abs_lt m H)
    (take m : nat,
      have H3 : abs b ≠ 0, from assume H', H (eq_zero_of_abs_eq_zero H'),
      have H4 : 1 + m % (abs b) > 0,
        from add_pos_of_pos_of_nonneg dec_trivial (mod_nonneg _ H3),
      calc
        -[1+m] % (abs b) = abs b - 1 - m % (abs b) : neg_succ_of_nat_mod _ H1
          ... = abs b - (1 + m % (abs b))        : by rewrite [*sub_eq_add_neg, neg_add, add.assoc]
          ... < abs b                            : sub_lt_self _ H4),
!mod_abs ▸ H2

theorem add_mul_mod_self {a b c : ℤ} : (a + b * c) % c = a % c :=
decidable.by_cases
  (assume cz : c = 0, by rewrite [cz, mul_zero, add_zero])
  (assume cnz, by rewrite [(mod_def), !int.add_mul_div_self cnz, right_distrib,
                            sub_add_eq_sub_sub_swap, add_sub_cancel])

theorem add_mul_mod_self_left (a b c : ℤ) : (a + b * c) % b = a % b :=
!mul.comm ▸ !add_mul_mod_self

theorem add_mod_self {a b : ℤ} : (a + b) % b = a % b :=
by rewrite -(int.mul_one b) at {1}; apply add_mul_mod_self_left

theorem add_mod_self_left {a b : ℤ} : (a + b) % a = b % a :=
!add.comm ▸ !add_mod_self

theorem mod_add_mod (m n k : ℤ) : (m % n + k) % n = (m + k) % n :=
by rewrite [eq_div_mul_add_mod m n at {2}, add.assoc, add.comm (m / n * n), add_mul_mod_self]

theorem add_mod_mod (m n k : ℤ) : (m + n % k) % k = (m + n) % k :=
by rewrite [add.comm, mod_add_mod, add.comm]

theorem add_mod_eq_add_mod_right {m n k : ℤ} (i : ℤ) (H : m % n = k % n) :
  (m + i) % n = (k + i) % n :=
by rewrite [-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 rewrite [add.comm, add_mod_eq_add_mod_right _ H, add.comm]

theorem mod_eq_mod_of_add_mod_eq_add_mod_right {m n k i : ℤ}
    (H : (m + i) % n = (k + i) % n) :
  m % n = k % n :=
have H1 : (m + i + (-i)) % n = (k + i + (-i)) % n, from add_mod_eq_add_mod_right _ H,
by rewrite [*add_neg_cancel_right at H1]; apply H1

theorem mod_eq_mod_of_add_mod_eq_add_mod_left {m n k i : ℤ} :
  (i + m) % n = (i + k) % n → m % n = k % n :=
by rewrite [add.comm i m, add.comm i k]; apply mod_eq_mod_of_add_mod_eq_add_mod_right

theorem mul_mod_left (a b : ℤ) : (a * b) % b = 0 :=
by rewrite [-zero_add (a * b), add_mul_mod_self, zero_mod]

theorem mul_mod_right (a b : ℤ) : (a * b) % a = 0 :=
!mul.comm ▸ !mul_mod_left

theorem mod_self {a : ℤ} : a % a = 0 :=
decidable.by_cases
  (assume H : a = 0, H⁻¹ ▸ !mod_zero)
  (assume H : a ≠ 0,
    calc
      a % a = a - a / a * a : rfl
          ... = 0 : by rewrite [!int.div_self H, one_mul, sub_self])

theorem mod_lt_of_pos (a : ℤ) {b : ℤ} (H : b > 0) : a % b < b :=
!abs_of_pos H ▸ !mod_lt (ne.symm (ne_of_lt H))

/- properties of / and % -/

theorem mul_div_mul_of_pos_aux {a : ℤ} (b : ℤ) {c : ℤ}
  (H1 : a > 0) (H2 : c > 0) : a * b / (a * c) = b / c :=
have H3 : a * c ≠ 0, from ne.symm (ne_of_lt (mul_pos H1 H2)),
have H4 : a * (b % c) < a * c, from mul_lt_mul_of_pos_left (!mod_lt_of_pos H2)  H1,
have H5 : a * (b % c) ≥ 0, from mul_nonneg (le_of_lt H1) (!mod_nonneg (ne.symm (ne_of_lt H2))),
calc
  a * b / (a * c) = a * (b / c * c + b % c) / (a * c) : eq_div_mul_add_mod

    ... = (a * (b % c) + a * c * (b / c)) / (a * c)   :
              by rewrite [!add.comm, int.left_distrib, mul.comm _ c, -!mul.assoc]
    ... = a * (b % c) / (a * c) + b / c               : !int.add_mul_div_self_left H3
    ... = 0 + b / c                                   : {!div_eq_zero_of_lt H5 H4}
    ... = b / c                                       : zero_add

theorem mul_div_mul_of_pos {a : ℤ} (b c : ℤ) (H : a > 0) : a * b / (a * c) = b / c :=
lt.by_cases
  (assume H1 : c < 0,
    have H2 : -c > 0, from neg_pos_of_neg H1,
    calc
      a * b / (a * c) = - (a * b / (a * -c)) :
                              by rewrite [-neg_mul_eq_mul_neg, int.div_neg, neg_neg]
                    ... = - (b / -c)         : mul_div_mul_of_pos_aux _ H H2
                    ... = b / c : by rewrite [int.div_neg, neg_neg])
  (assume H1 : c = 0,
    calc
      a * b / (a * c) = 0       : by rewrite [H1, mul_zero, int.div_zero]
                    ... = b / c : by rewrite [H1, int.div_zero])
  (assume H1 : c > 0,
    mul_div_mul_of_pos_aux _ H H1)

theorem mul_div_mul_of_pos_left (a : ℤ) {b : ℤ} (c : ℤ) (H : b > 0) :
  a * b / (c * b) = a / c :=
!mul.comm ▸ !mul.comm ▸ !mul_div_mul_of_pos H

theorem mul_mod_mul_of_pos {a : ℤ} (b c : ℤ) (H : a > 0) : a * b % (a * c) = a * (b % c) :=
by rewrite [(mod_def), mod_def, !mul_div_mul_of_pos H, mul_sub_left_distrib, mul.left_comm]

theorem lt_div_add_one_mul_self (a : ℤ) {b : ℤ} (H : b > 0) : a < (a / b + 1) * b :=
have H : a - a / b * b < b, from !mod_lt_of_pos H,
calc
      a < a / b * b + b    : iff.mpr !lt_add_iff_sub_lt_left H
    ... = (a / b + 1) * b  : by rewrite [right_distrib, one_mul]

theorem div_le_of_nonneg_of_nonneg {a b : ℤ} (Ha : a ≥ 0) (Hb : b ≥ 0) : a / b ≤ a :=
obtain (m : ℕ) (Hm : a = m), from exists_eq_of_nat Ha,
obtain (n : ℕ) (Hn : b = n), from exists_eq_of_nat Hb,
calc
  a / b = of_nat (m / n) : by rewrite [Hm, Hn, of_nat_div]
     ... ≤ m             : of_nat_le_of_nat_of_le !nat.div_le_self
     ... = a             : Hm

theorem abs_div_le_abs (a b : ℤ) : abs (a / b) ≤ abs a :=
have H : ∀a b, b > 0 → abs (a / b) ≤ abs a, from
  take a b,
  assume H1 : b > 0,
  or.elim (le_or_gt 0 a)
    (assume H2 : 0 ≤ a,
      have H3 : 0 ≤ b, from le_of_lt H1,
      calc
        abs (a / b) = a / b   : abs_of_nonneg (int.div_nonneg H2 H3)
                  ... ≤ a     : div_le_of_nonneg_of_nonneg H2 H3
                  ... = abs a : abs_of_nonneg H2)
    (assume H2 : a < 0,
      have H3 : -a - 1 ≥ 0, from le_sub_one_of_lt (neg_pos_of_neg H2),
      have H4 : (-a - 1) / b + 1 ≥ 0,
        from add_nonneg (int.div_nonneg H3 (le_of_lt H1)) (of_nat_le_of_nat_of_le !nat.zero_le),
      have H5 : (-a - 1) / b ≤ -a - 1, from div_le_of_nonneg_of_nonneg H3 (le_of_lt H1),
      calc
        abs (a / b) = abs ((-a - 1) / b + 1) : by rewrite [div_of_neg_of_pos H2 H1, abs_neg]
                  ... = (-a - 1) / b + 1     : abs_of_nonneg H4
                  ... ≤ -a - 1 + 1           : add_le_add_right H5 _
                  ... = abs a                : by rewrite [sub_add_cancel, abs_of_neg H2]),
lt.by_cases
  (assume H1 : b < 0,
    calc
      abs (a / b) = abs (a / -b) : by rewrite [int.div_neg, abs_neg]
                ... ≤ abs a      : H _ _ (neg_pos_of_neg H1))
  (assume H1 : b = 0,
    calc
      abs (a / b) = 0 : by rewrite [H1, int.div_zero, abs_zero]
                ... ≤ abs a : abs_nonneg)
  (assume H1 : b > 0, H _ _ H1)

theorem div_mul_cancel_of_mod_eq_zero {a b : ℤ} (H : a % b = 0) : a / b * b = a :=
by rewrite [eq_div_mul_add_mod a b at {2}, H, add_zero]

theorem mul_div_cancel_of_mod_eq_zero {a b : ℤ} (H : a % b = 0) : b * (a / b) = a :=
!mul.comm ▸ div_mul_cancel_of_mod_eq_zero H

/- dvd -/

theorem dvd_of_of_nat_dvd_of_nat {m n : ℕ} : of_nat m ∣ of_nat n → (#nat m ∣ n) :=
nat.by_cases_zero_pos n
  (assume H, dvd_zero m)
  (take n' : ℕ,
    assume H1 : (#nat n' > 0),
    have H2 : of_nat n' > 0, from of_nat_pos H1,
    assume H3 : of_nat m ∣ of_nat n',
    dvd.elim H3
      (take c,
        assume H4 : of_nat n' = of_nat m * c,
        have H5 : c > 0, from pos_of_mul_pos_left (H4 ▸ H2) !of_nat_nonneg,
        obtain k (H6 : c = of_nat k), from exists_eq_of_nat (le_of_lt H5),
        have H7 : n' = (#nat m * k), from (of_nat.inj (H6 ▸ H4)),
        dvd.intro H7⁻¹))

theorem of_nat_dvd_of_nat_of_dvd {m n : ℕ} (H : #nat m ∣ n) : of_nat m ∣ of_nat n :=
dvd.elim H
  (take k, assume H1 : #nat n = m * k,
    dvd.intro (H1⁻¹ ▸ rfl))

theorem of_nat_dvd_of_nat_iff (m n : ℕ) : of_nat m ∣ of_nat n ↔ m ∣ n :=
iff.intro dvd_of_of_nat_dvd_of_nat of_nat_dvd_of_nat_of_dvd

theorem dvd.antisymm {a b : ℤ} (H1 : a ≥ 0) (H2 : b ≥ 0) : a ∣ b → b ∣ a → a = b :=
begin
  rewrite [-abs_of_nonneg H1, -abs_of_nonneg H2, -*of_nat_nat_abs],
  rewrite [*of_nat_dvd_of_nat_iff, *of_nat_eq_of_nat_iff],
  apply nat.dvd.antisymm
end

theorem dvd_of_mod_eq_zero {a b : ℤ} (H : b % a = 0) : a ∣ b :=
dvd.intro (!mul.comm ▸ div_mul_cancel_of_mod_eq_zero H)

theorem mod_eq_zero_of_dvd {a b : ℤ} (H : a ∣ b) : b % a = 0 :=
dvd.elim H (take z, assume H1 : b = a * z, H1⁻¹ ▸ !mul_mod_right)

theorem dvd_iff_mod_eq_zero (a b : ℤ) : a ∣ b ↔ b % a = 0 :=
iff.intro mod_eq_zero_of_dvd dvd_of_mod_eq_zero

definition dvd.decidable_rel [instance] : decidable_rel dvd :=
take a n, decidable_of_decidable_of_iff _ (iff.symm !dvd_iff_mod_eq_zero)

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 :=
!mul.comm ▸ !int.div_mul_cancel H

protected theorem mul_div_assoc (a : ℤ) {b c : ℤ} (H : c ∣ b) : (a * b) / c = a * (b / c) :=
decidable.by_cases
  (assume cz : c = 0, by rewrite [cz, *int.div_zero, mul_zero])
  (assume cnz : c ≠ 0,
    obtain d (H' : b = d * c), from exists_eq_mul_left_of_dvd H,
    by rewrite [H', -mul.assoc, *(!int.mul_div_cancel cnz)])

theorem div_dvd_div {a b c : ℤ} (H1 : a ∣ b) (H2 : b ∣ c) : b / a ∣ c / a :=
have H3 : b = b / a * a, from (int.div_mul_cancel H1)⁻¹,
have H4 : c = c / a * a, from (int.div_mul_cancel (dvd.trans H1 H2))⁻¹,
decidable.by_cases
  (assume H5 : a = 0,
    have H6: c / a = 0, from (congr_arg _ H5 ⬝ !int.div_zero),
      H6⁻¹ ▸ !dvd_zero)
  (assume H5 : a ≠ 0,
    dvd_of_mul_dvd_mul_right H5 (H3 ▸ H4 ▸ H2))

protected theorem div_eq_iff_eq_mul_right {a b : ℤ} (c : ℤ) (H : b ≠ 0) (H' : b ∣ a) :
  a / b = c ↔ a = b * c :=
iff.intro
  (assume H1, by rewrite [-H1, int.mul_div_cancel' H'])
  (assume H1, by rewrite [H1, !int.mul_div_cancel_left H])

protected theorem div_eq_iff_eq_mul_left {a b : ℤ} (c : ℤ) (H : b ≠ 0) (H' : b ∣ a) :
  a / b = c ↔ a = c * b :=
!mul.comm ▸ !int.div_eq_iff_eq_mul_right H H'

protected theorem eq_mul_of_div_eq_right {a b c : ℤ} (H1 : b ∣ a) (H2 : a / b = c) :
  a = b * c :=
calc
  a     = b * (a / b) : int.mul_div_cancel' H1
    ... = b * c       : H2

protected theorem div_eq_of_eq_mul_right {a b c : ℤ} (H1 : b ≠ 0) (H2 : a = b * c) :
  a / b = c :=
calc
  a / b = b * c / b : H2
    ... = c         : !int.mul_div_cancel_left H1

protected theorem eq_mul_of_div_eq_left {a b c : ℤ} (H1 : b ∣ a) (H2 : a / b = c) :
  a = c * b :=
!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 (!mul.comm ▸ H2)

theorem neg_div_of_dvd {a b : ℤ} (H : b ∣ a) : -a / b = -(a / b) :=
decidable.by_cases
  (assume H1 : b = 0, by rewrite [H1, *int.div_zero, neg_zero])
  (assume H1 : b ≠ 0,
    dvd.elim H
      (take c, assume H' : a = b * c,
        by rewrite [H', neg_mul_eq_mul_neg, *!int.mul_div_cancel_left H1]))

protected theorem sign_eq_div_abs (a : ℤ) : sign a = a / (abs a) :=
decidable.by_cases
  (suppose a = 0, by subst a)
  (suppose a ≠ 0,
    have abs a ≠ 0, from assume H, this (eq_zero_of_abs_eq_zero H),
    have abs a ∣ a, from abs_dvd_of_dvd !dvd.refl,
    eq.symm (iff.mpr (!int.div_eq_iff_eq_mul_left `abs a ≠ 0` this) !eq_sign_mul_abs))

theorem le_of_dvd {a b : ℤ} (bpos : b > 0) (H : a ∣ b) : a ≤ b :=
or.elim !le_or_gt
  (suppose a ≤ 0, le.trans this (le_of_lt bpos))
  (suppose a > 0,
    obtain c (Hc : b = a * c), from exists_eq_mul_right_of_dvd H,
    have a * c > 0, by rewrite -Hc; exact bpos,
    have c > 0, from pos_of_mul_pos_left this (le_of_lt `a > 0`),
    show a ≤ b, from calc
      a     = a * 1 : mul_one
        ... ≤ a * c : mul_le_mul_of_nonneg_left (add_one_le_of_lt `c > 0`) (le_of_lt `a > 0`)
        ... = b     : Hc)

/- / and ordering -/

protected theorem div_mul_le (a : ℤ) {b : ℤ} (H : b ≠ 0) : a / b * b ≤ a :=
calc
  a = a / b * b + a % b : eq_div_mul_add_mod
    ... ≥ a / b * b       : le_add_of_nonneg_right (!mod_nonneg H)

protected theorem div_le_of_le_mul {a b c : ℤ} (H : c > 0) (H' : a ≤ b * c) : a / c ≤ b :=
le_of_mul_le_mul_right (calc
  a / c * c = a / c * c + 0     : add_zero
        ... ≤ a / c * c + a % c : add_le_add_left (!mod_nonneg (ne_of_gt H))
        ... = a                 : eq_div_mul_add_mod
        ... ≤ b * c             : H') H

protected theorem div_le_self (a : ℤ) {b : ℤ} (H1 : a ≥ 0) (H2 : b ≥ 0) : a / b ≤ a :=
or.elim (lt_or_eq_of_le H2)
  (assume H3 : b > 0,
    have H4 : b ≥ 1, from add_one_le_of_lt H3,
    have H5 : a ≤ a * b, from calc
      a    = a * 1 : mul_one
       ... ≤ a * b : !mul_le_mul_of_nonneg_left H4 H1,
    int.div_le_of_le_mul H3 H5)
  (assume H3 : 0 = b,
    by rewrite [-H3, int.div_zero]; apply H1)

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

protected theorem le_div_of_mul_le {a b c : ℤ} (H1 : c > 0) (H2 : a * c ≤ b) : a ≤ b / c :=
have H3 : a * c < (b / c + 1) * c, from
  calc
    a * c ≤ b                 : H2
      ... = b / c * c + b % c : eq_div_mul_add_mod
      ... < b / c * c + c     : add_lt_add_left (!mod_lt_of_pos H1)
      ... = (b / c + 1) * c   : by rewrite [right_distrib, one_mul],
le_of_lt_add_one (lt_of_mul_lt_mul_right H3 (le_of_lt H1))

protected theorem le_div_iff_mul_le {a b c : ℤ} (H : c > 0) : a ≤ b / c ↔ a * c ≤ b :=
iff.intro (!int.mul_le_of_le_div H) (!int.le_div_of_mul_le H)

protected theorem div_le_div {a b c : ℤ} (H : c > 0) (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 : c > 0) (H' : a < b * c) : a / c < b :=
lt_of_mul_lt_mul_right
  (calc
    a / c * c = a / c * c + 0       : add_zero
            ... ≤ a / c * c + a % c : add_le_add_left (!mod_nonneg (ne_of_gt H))
            ... = a                 : eq_div_mul_add_mod
            ... < b * c             : H')
 (le_of_lt H)

protected theorem lt_mul_of_div_lt {a b c : ℤ} (H1 : c > 0) (H2 : a / c < b) : a < b * c :=
have H3 : (a / c + 1) * c ≤ b * c,
  from !mul_le_mul_of_nonneg_right (add_one_le_of_lt H2) (le_of_lt H1),
have H4 : a / c * c + c ≤ b * c, by rewrite [right_distrib at H3, one_mul at H3]; apply H3,
calc
  a     = a / c * c + a % c : eq_div_mul_add_mod
    ... < a / c * c + c     : add_lt_add_left (!mod_lt_of_pos H1)
    ... ≤ b * c             : H4

protected theorem div_lt_iff_lt_mul {a b c : ℤ} (H : c > 0) : a / c < b ↔ a < b * c :=
iff.intro (!int.lt_mul_of_div_lt H) (!int.div_lt_of_lt_mul H)

protected theorem div_le_iff_le_mul_of_div {a b : ℤ} (c : ℤ) (H : b > 0) (H' : b ∣ a) :
  a / b ≤ c ↔ a ≤ c * b :=
by rewrite [propext (!le_iff_mul_le_mul_right H), !int.div_mul_cancel H']

protected theorem le_mul_of_div_le_of_div {a b c : ℤ} (H1 : b > 0) (H2 : b ∣ a) (H3 : a / b ≤ c) :
  a ≤ c * b :=
iff.mp (!int.div_le_iff_le_mul_of_div H1 H2) H3

theorem div_pos_of_pos_of_dvd {a b : ℤ} (H1 : a > 0) (H2 : b ≥ 0) (H3 : b ∣ a) : a / b > 0 :=
have H4 : b ≠ 0, from
  (assume H5 : b = 0,
    have H6 : a = 0, from eq_zero_of_zero_dvd (H5 ▸ H3),
    ne_of_gt H1 H6),
have H6 : (a / b) * b > 0, by rewrite (int.div_mul_cancel H3); apply H1,
pos_of_mul_pos_right H6 H2

theorem div_eq_div_of_dvd_of_dvd {a b c d : ℤ} (H1 : b ∣ a) (H2 : d ∣ c) (H3 : b ≠ 0)
    (H4 : d ≠ 0) (H5 : a * d = b * c) :
  a / b = c / d :=
begin
  apply int.div_eq_of_eq_mul_right H3,
  rewrite [-!int.mul_div_assoc H2],
  apply eq.symm,
  apply int.div_eq_of_eq_mul_left H4,
  apply eq.symm H5
end

end int


import data.real.basic

-- based on video https://www.youtube.com/watch?v=ac9GNeVaWgE

section

variables {f g : ℝ → ℝ}
variable feq : ∀ x y, g (f (x + y)) = f x + (2*x+y) * (g y)

include feq

lemma l2 (x : ℝ) : g (f (-x)) = f x :=
begin
  let h := feq x (-2*x),
  simp at h,
  rw (by linarith : x + (-(2*x)) = -x) at h,
  exact h,
end

lemma l5 (x y : ℝ ) : f (-x-y) = f x + (2*x+y) * g y :=
begin
  rw ← l2 feq ,
  rw (by linarith : -(-x-y) = x+y),
  apply feq,
end

lemma l3 (x y : ℝ) : f x + (2*x+y) * g y = f y + (2*y+x) * g x :=
begin
  let h1 := feq x y,
  let h2 := feq y x,
  rw (by linarith : y + x = x + y) at h2,
  linarith,
end

def gform (a b : ℝ) : Prop := ∀ (x : ℝ) , g x = a * x + b

lemma l4 : ∃ (a b : ℝ), gform feq a b :=
begin
  use g 1 - g 0,
  use g 0,
  intro x,

  let h1 := l3 feq 0 x,
  let h2 := l3 feq 1 0,
  let h3 := l3 feq x 1,

  linarith,
end

lemma l6 (a b : ℝ) (gf : gform feq a b) : ∀ x y : ℝ, f (-x-y) = f x + (2*x+y)*(a*y+b) :=
begin
  intros x y,
  rw ← gf,
  apply l5 feq,
end

lemma l7 (a b : ℝ ) (gf : gform feq a b) : ∀ x : ℝ , f x = a * x^2 - b*x + f 0 :=
begin
  intro x,
  let h1 := l6 feq a b gf 0 (-x),
  simp at h1,
  linarith,
end

theorem solutions : (∀ x : ℝ , f x = 0 ∧ g x = 0) ∨ (∃ c, ∀ x, f x = x^2 + c ∧ g x = x) :=
begin
  rcases l4 feq with ⟨ a, b, gf ⟩,
  have heq : ∀ x, a * (a * x ^ 2 + b * x + f 0) + b = a * x ^ 2 - b * x + f 0 ,
  {
    intro x,
    have h1 := l2 feq x,
    rw gf at h1,
    rw l7 feq a b gf (-x) at h1,
    rw l7 feq a b gf x at h1,
    simp at h1,
    assumption,
  },
  let e0 := heq 0,
  let e1 := heq 1,
  let e2 := heq 2,

  have ha : a = a*a, linarith,
  have hb : a*b = -b, linarith,
  clear e0 e1 e2 heq,

  by_cases a = 0,
  {
    left,
    rw h at hb,
    simp at hb,
    have : ∀ x, g x = 0,
    {
      intro x,
      rw [gf, h ,hb],
      simp,
    },
    intro x,
    split,
    {
      rw ← l2 feq,
      rw this,
    },
    exact this x,
  },
  right,
  have ta : a = 1,
  {
    -- Q: There must be an easier way to do this??
    have : a*(a-1) = 0,
    {
      calc a*(a-1) = a*a-a : by ring
      ... = a-a : by rw ← ha
      ... = 0 : by ring,
    },
    rw mul_eq_zero at this,
    cases this ,
    {
      exfalso,
      exact h this,
    },
    linarith,
  },
  clear h ha,
  rw ta at hb,
  have tb : b = 0, linarith,
  rw [ta,tb] at gf,

  use f 0,
  intro x,
  split,
  {
    have hh := l7 feq 1 0 gf x,
    simp at hh,
    assumption,
  },
  dsimp [gform] at gf,
  specialize gf x,
  simp at gf,
  assumption,
end

end

#check @solutions


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

! This file was ported from Lean 3 source module tactic.norm_swap
! leanprover-community/mathlib commit 9407b03373c8cd201df99d6bc5514fc2db44054f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Logic.Equiv.Defs
import Mathbin.Tactic.NormFin

/-!
# `norm_swap`

Evaluating `swap x y z` for numerals `x y z` that are `ℕ`, `ℤ`, or `ℚ`, via a `norm_num` plugin.
Terms are passed to `eval`, quickly failing if not of the form `swap x y z`.
The expressions for numerals `x y z` are converted to `nat`, and then compared.
Based on equality of these `nat`s, equality proofs are generated using either
`equiv.swap_apply_left`, `equiv.swap_apply_right`, or `swap_apply_of_ne_of_ne`.
-/

open Equiv Tactic Expr

open NormNum

namespace NormSwap

/-- A `norm_num` plugin for normalizing `equiv.swap a b c`
where `a b c` are numerals of `ℕ`, `ℤ`, `ℚ` or `fin n`.

```
example : equiv.swap 1 2 1 = 2 := by norm_num
```
-/
@[norm_num]
unsafe def eval : expr → tactic (expr × expr) := fun e => do
  let (swapt, fun_ty, coe_fn_inst, fexpr, c) ←
    e.match_app_coe_fn <|> fail "did not get an app coe_fn expr"
  guard (fexpr = `` Equiv.swap) <|> fail "coe_fn not of equiv.swap"
  let [α, deceq_inst, a, b] ←
    pure fexpr.get_app_args <|> fail "swap did not have exactly two args applied"
  let na ←
    a.to_rat <|> do
        let (fa, _) ← norm_fin.eval_fin_num a
        fa
  let nb ←
    b.to_rat <|> do
        let (fb, _) ← norm_fin.eval_fin_num b
        fb
  let nc ←
    c.to_rat <|> do
        let (fc, _) ← norm_fin.eval_fin_num c
        fc
  if nc = na then do
      let p ← mk_mapp `equiv.swap_apply_left [α, deceq_inst, a, b]
      pure (b, p)
    else
      if nc = nb then do
        let p ← mk_mapp `equiv.swap_apply_right [α, deceq_inst, a, b]
        pure (a, p)
      else do
        let nic ← mk_instance_cache α
        let hca ←
          Prod.snd <$> prove_ne nic c a nc na <|> do
              let (_, ff, p) ← norm_fin.prove_eq_ne_fin c a
              pure p
        let hcb ←
          Prod.snd <$> prove_ne nic c b nc nb <|> do
              let (_, ff, p) ← norm_fin.prove_eq_ne_fin c b
              pure p
        let p ← mk_mapp `equiv.swap_apply_of_ne_of_ne [α, deceq_inst, a, b, c, hca, hcb]
        pure (c, p)
#align norm_swap.eval norm_swap.eval

end NormSwap


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

/-!
# Lagrange multipliers

In this file we formalize the
[Lagrange multipliers](https://en.wikipedia.org/wiki/Lagrange_multiplier) method of solving
conditional extremum problems: if a function `φ` has a local extremum at `x₀` on the set
`f ⁻¹' {f x₀}`, `f x = (f₀ x, ..., fₙ₋₁ x)`, then the differentials of `fₖ` and `φ` are linearly
dependent. First we formulate a geometric version of this theorem which does not rely on the
target space being `ℝⁿ`, then restate it in terms of coordinates.

## TODO

Formalize Karush-Kuhn-Tucker theorem

## Tags

lagrange multiplier, local extremum

-/

open filter set
open_locale topological_space filter big_operators
variables {E F : Type*} [normed_group E] [normed_space ℝ E] [complete_space E]
  [normed_group F] [normed_space ℝ F] [complete_space F]
  {f : E → F} {φ : E → ℝ} {x₀ : E} {f' : E →L[ℝ] F} {φ' : E →L[ℝ] ℝ}

/-- Lagrange multipliers theorem: if `φ : E → ℝ` has a local extremum on the set `{x | f x = f x₀}`
at `x₀`, both `f : E → F` and `φ` are strictly differentiable at `x₀`, and the codomain of `f` is
a complete space, then the linear map `x ↦ (f' x, φ' x)` is not surjective. -/
lemma is_local_extr_on.range_ne_top_of_has_strict_fderiv_at
  (hextr : is_local_extr_on φ {x | f x = f x₀} x₀) (hf' : has_strict_fderiv_at f f' x₀)
  (hφ' : has_strict_fderiv_at φ φ' x₀) :
  (f'.prod φ').range ≠ ⊤ :=
begin
  intro htop,
  set fφ := λ x, (f x, φ x),
  have A : map φ (𝓝[f ⁻¹' {f x₀}] x₀) = 𝓝 (φ x₀),
  { change map (prod.snd ∘ fφ) (𝓝[fφ ⁻¹' {p | p.1 = f x₀}] x₀) = 𝓝 (φ x₀),
    rw [← map_map, nhds_within, map_inf_principal_preimage,
      (hf'.prod hφ').map_nhds_eq_of_surj htop],
    exact map_snd_nhds_within _ },
  exact hextr.not_nhds_le_map A.ge
end

/-- Lagrange multipliers theorem: if `φ : E → ℝ` has a local extremum on the set `{x | f x = f x₀}`
at `x₀`, both `f : E → F` and `φ` are strictly differentiable at `x₀`, and the codomain of `f` is
a complete space, then there exist `Λ : dual ℝ F` and `Λ₀ : ℝ` such that `(Λ, Λ₀) ≠ 0` and
`Λ (f' x) + Λ₀ • φ' x = 0` for all `x`. -/
lemma is_local_extr_on.exists_linear_map_of_has_strict_fderiv_at
  (hextr : is_local_extr_on φ {x | f x = f x₀} x₀) (hf' : has_strict_fderiv_at f f' x₀)
  (hφ' : has_strict_fderiv_at φ φ' x₀) :
  ∃ (Λ : module.dual ℝ F) (Λ₀ : ℝ), (Λ, Λ₀) ≠ 0 ∧ ∀ x, Λ (f' x) + Λ₀ • φ' x = 0 :=
begin
  rcases submodule.exists_le_ker_of_lt_top _
    (lt_top_iff_ne_top.2 $ hextr.range_ne_top_of_has_strict_fderiv_at hf' hφ') with ⟨Λ', h0, hΛ'⟩,
  set e : ((F →ₗ[ℝ] ℝ) × ℝ) ≃ₗ[ℝ] (F × ℝ →ₗ[ℝ] ℝ) :=
    ((linear_equiv.refl ℝ (F →ₗ[ℝ] ℝ)).prod (linear_map.ring_lmap_equiv_self ℝ ℝ ℝ).symm).trans
      (linear_map.coprod_equiv ℝ),
  rcases e.surjective Λ' with ⟨⟨Λ, Λ₀⟩, rfl⟩,
  refine ⟨Λ, Λ₀, e.map_ne_zero_iff.1 h0, λ x, _⟩,
  convert linear_map.congr_fun (linear_map.range_le_ker_iff.1 hΛ') x using 1,
  -- squeezed `simp [mul_comm]` to speed up elaboration
  simp only [linear_map.coprod_equiv_apply, linear_equiv.refl_apply,
    linear_map.ring_lmap_equiv_self_symm_apply, linear_map.comp_apply,
    continuous_linear_map.coe_coe, continuous_linear_map.prod_apply,
    linear_equiv.trans_apply, linear_equiv.prod_apply, linear_map.coprod_apply,
    linear_map.smul_right_apply, linear_map.one_apply, smul_eq_mul, mul_comm]
end

/-- Lagrange multipliers theorem: if `φ : E → ℝ` has a local extremum on the set `{x | f x = f x₀}`
at `x₀`, and both `f : E → ℝ` and `φ` are strictly differentiable at `x₀`, then there exist
`a b : ℝ` such that `(a, b) ≠ 0` and `a • f' + b • φ' = 0`. -/
lemma is_local_extr_on.exists_multipliers_of_has_strict_fderiv_at_1d
  {f : E → ℝ} {f' : E →L[ℝ] ℝ}
  (hextr : is_local_extr_on φ {x | f x = f x₀} x₀) (hf' : has_strict_fderiv_at f f' x₀)
  (hφ' : has_strict_fderiv_at φ φ' x₀) :
  ∃ (a b : ℝ), (a, b) ≠ 0 ∧ a • f' + b • φ' = 0 :=
begin
  obtain ⟨Λ, Λ₀, hΛ, hfΛ⟩ := hextr.exists_linear_map_of_has_strict_fderiv_at hf' hφ',
  refine ⟨Λ 1, Λ₀, _, _⟩,
  { contrapose! hΛ,
    simp only [prod.mk_eq_zero] at ⊢ hΛ,
    refine ⟨linear_map.ext (λ x, _), hΛ.2⟩,
    simpa [hΛ.1] using Λ.map_smul x 1 },
  { ext x,
    have H₁ : Λ (f' x) = f' x * Λ 1,
    { simpa only [mul_one, algebra.id.smul_eq_mul] using Λ.map_smul (f' x) 1 },
    have H₂ : f' x * Λ 1  + Λ₀ * φ' x = 0,
    { simpa only [algebra.id.smul_eq_mul, H₁] using hfΛ x },
    simpa [mul_comm] using H₂ }
end

/-- Lagrange multipliers theorem, 1d version. Let `f : ι → E → ℝ` be a finite family of functions.
Suppose that `φ : E → ℝ` has a local extremum on the set `{x | ∀ i, f i x = f i x₀}` at `x₀`.
Suppose that all functions `f i` as well as `φ` are strictly differentiable at `x₀`.
Then the derivatives `f' i : E → L[ℝ] ℝ` and `φ' : E →L[ℝ] ℝ` are linearly dependent:
there exist `Λ : ι → ℝ` and `Λ₀ : ℝ`, `(Λ, Λ₀) ≠ 0`, such that `∑ i, Λ i • f' i + Λ₀ • φ' = 0`.

See also `is_local_extr_on.linear_dependent_of_has_strict_fderiv_at` for a version that
states `¬linear_independent ℝ _` instead of existence of `Λ` and `Λ₀`. -/
lemma is_local_extr_on.exists_multipliers_of_has_strict_fderiv_at {ι : Type*} [fintype ι]
  {f : ι → E → ℝ} {f' : ι → E →L[ℝ] ℝ}
  (hextr : is_local_extr_on φ {x | ∀ i, f i x = f i x₀} x₀)
  (hf' : ∀ i, has_strict_fderiv_at (f i) (f' i) x₀)
  (hφ' : has_strict_fderiv_at φ φ' x₀) :
  ∃ (Λ : ι → ℝ) (Λ₀ : ℝ), (Λ, Λ₀) ≠ 0 ∧ ∑ i, Λ i • f' i + Λ₀ • φ' = 0 :=
begin
  letI := classical.dec_eq ι,
  replace hextr : is_local_extr_on φ {x | (λ i, f i x) = (λ i, f i x₀)} x₀,
    by simpa only [function.funext_iff] using hextr,
  rcases hextr.exists_linear_map_of_has_strict_fderiv_at
    (has_strict_fderiv_at_pi.2 (λ i, hf' i)) hφ'
    with ⟨Λ, Λ₀, h0, hsum⟩,
  rcases (linear_equiv.pi_ring ℝ ℝ ι ℝ).symm.surjective Λ with ⟨Λ, rfl⟩,
  refine ⟨Λ, Λ₀, _, _⟩,
  { simpa only [ne.def, prod.ext_iff, linear_equiv.map_eq_zero_iff, prod.fst_zero] using h0 },
  { ext x, simpa [mul_comm] using hsum x }
end

/-- Lagrange multipliers theorem. Let `f : ι → E → ℝ` be a finite family of functions.
Suppose that `φ : E → ℝ` has a local extremum on the set `{x | ∀ i, f i x = f i x₀}` at `x₀`.
Suppose that all functions `f i` as well as `φ` are strictly differentiable at `x₀`.
Then the derivatives `f' i : E → L[ℝ] ℝ` and `φ' : E →L[ℝ] ℝ` are linearly dependent.

See also `is_local_extr_on.exists_multipliers_of_has_strict_fderiv_at` for a version that
that states existence of Lagrange multipliers `Λ` and `Λ₀` instead of using
`¬linear_independent ℝ _` -/
lemma is_local_extr_on.linear_dependent_of_has_strict_fderiv_at {ι : Type*} [fintype ι]
  {f : ι → E → ℝ} {f' : ι → E →L[ℝ] ℝ}
  (hextr : is_local_extr_on φ {x | ∀ i, f i x = f i x₀} x₀)
  (hf' : ∀ i, has_strict_fderiv_at (f i) (f' i) x₀)
  (hφ' : has_strict_fderiv_at φ φ' x₀) :
  ¬linear_independent ℝ (λ i, option.elim i φ' f' : option ι → E →L[ℝ] ℝ) :=
begin
  rw [fintype.linear_independent_iff], push_neg,
  rcases hextr.exists_multipliers_of_has_strict_fderiv_at hf' hφ' with ⟨Λ, Λ₀, hΛ, hΛf⟩,
  refine ⟨λ i, option.elim i Λ₀ Λ, _, _⟩,
  { simpa [add_comm] using hΛf },
  { simpa [function.funext_iff, not_and_distrib, or_comm, option.exists] using hΛ }
end


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro

! This file was ported from Lean 3 source module algebra.order.ring.cone
! leanprover-community/mathlib commit 10b4e499f43088dd3bb7b5796184ad5216648ab1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Order.Ring.Defs

/-!
# Constructing an ordered ring from a ring with a specified positive cone.

-/

/-! ### Positive cones -/

variable {α : Type _} [Ring α] [Nontrivial α]

namespace Ring

/-- A positive cone in a ring consists of a positive cone in underlying `AddCommGroup`,
which contains `1` and such that the positive elements are closed under multiplication. -/
structure PositiveCone (α : Type _) [Ring α] extends AddCommGroup.PositiveCone α where
  /-- In a positive cone, `1` is `nonneg` -/
  one_nonneg : nonneg 1
  /-- In a positive cone, if `a` and `b` are `pos` then so is `a * b` -/
  mul_pos : ∀ a b, pos a → pos b → pos (a * b)
#align ring.positive_cone Ring.PositiveCone

/-- Forget that a positive cone in a ring respects the multiplicative structure. -/
add_decl_doc PositiveCone.toPositiveCone
#align ring.positive_cone.to_positive_cone Ring.PositiveCone.toPositiveCone

/-- A total positive cone in a nontrivial ring induces a linear order. -/
structure TotalPositiveCone (α : Type _) [Ring α] extends PositiveCone α,
  AddCommGroup.TotalPositiveCone α
#align ring.total_positive_cone Ring.TotalPositiveCone
#align ring.total_positive_cone.to_positive_cone Ring.TotalPositiveCone.toPositiveCone_1

/-- Forget that a `TotalPositiveCone` in a ring is total. -/
add_decl_doc TotalPositiveCone.toPositiveCone_1

/-- Forget that a `TotalPositiveCone` in a ring respects the multiplicative structure. -/
add_decl_doc TotalPositiveCone.toTotalPositiveCone
#align ring.total_positive_cone.to_total_positive_cone Ring.TotalPositiveCone.toTotalPositiveCone

theorem PositiveCone.one_pos (C : PositiveCone α) : C.pos 1 :=
  (C.pos_iff _).2 ⟨C.one_nonneg, fun h => one_ne_zero <| C.nonneg_antisymm C.one_nonneg h⟩
#align ring.positive_cone.one_pos Ring.PositiveCone.one_pos

end Ring

open Ring

/-- Construct a `StrictOrderedRing` by designating a positive cone in an existing `Ring`. -/
def StrictOrderedRing.mkOfPositiveCone (C : PositiveCone α) : StrictOrderedRing α :=
  { ‹Ring α›, OrderedAddCommGroup.mkOfPositiveCone C.toPositiveCone with
    exists_pair_ne := ⟨0, 1, fun h => by simpa [← h, C.pos_iff] using C.one_pos⟩,
    zero_le_one := by
      change C.nonneg (1 - 0)
      convert C.one_nonneg
      simp,
    mul_pos := fun x y xp yp => by
      change C.pos (x * y - 0)
      -- porting note: used to be convert, but it relied on unfolding definitions
      rw [sub_zero]
      exact C.mul_pos x y (by rwa [← sub_zero x]) (by rwa [← sub_zero y]) }
#align strict_ordered_ring.mk_of_positive_cone StrictOrderedRing.mkOfPositiveCone

/-- Construct a `LinearOrderedRing` by
designating a positive cone in an existing `Ring`. -/
def LinearOrderedRing.mkOfPositiveCone (C : TotalPositiveCone α) : LinearOrderedRing α :=
  { LinearOrderedAddCommGroup.mkOfPositiveCone C.toTotalPositiveCone,
    StrictOrderedRing.mkOfPositiveCone C.toPositiveCone_1 with }
#align linear_ordered_ring.mk_of_positive_cone LinearOrderedRing.mkOfPositiveCone


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

/-!
# Set family certificates

This file defines the certificator of two families of sets. If we consider set families `𝒜` and `ℬ`
as probabilistic events, the size of the certificator `𝒜 □ ℬ` corresponds to the probability that
`𝒜` and `ℬ` occur "disjointly".

## Main declarations

* `finset.certificator`: Certificator of two elements of a Boolean algebra
* `finset.card_certificator_le`: The Van den Berg-Kesten-Reimer inequality: The probability that `𝒜`
  and `ℬ` occur "disjointly" is less than the product of their probabilities.

## References

* D. Reimer, *Proof of the Van den Berg–Kesten Conjecture*
-/

open_locale classical finset_family

variables {α : Type*}

namespace finset
section boolean_algebra
variables [boolean_algebra α] (s t u : finset α) {a : α}

noncomputable def certificator : finset α :=
(s ∩ t).filter $ λ a, ∃ x y, is_compl x y ∧ (∀ ⦃b⦄, a ⊓ x = b ⊓ x → b ∈ s) ∧
  ∀ ⦃b⦄, a ⊓ y = b ⊓ y → b ∈ t

localized "infix (name := finset.certificator) ` □ `:70 := certificator" in finset_family

variables {s t u}

@[simp] lemma mem_certificator :
  a ∈ s □ t ↔ ∃ x y, is_compl x y ∧ (∀ ⦃b⦄, a ⊓ x = b ⊓ x → b ∈ s) ∧ ∀ ⦃b⦄, a ⊓ y = b ⊓ y → b ∈ t :=
begin
  rw [certificator, mem_filter, and_iff_right_of_imp],
  rintro ⟨u, v, huv, hu, hv⟩,
  exact mem_inter.2 ⟨hu rfl, hv rfl⟩,
end

lemma certificator_subset_inter : s □ t ⊆ s ∩ t := filter_subset _ _
lemma certificator_subset_disj_sups : s □ t ⊆ s ○ t :=
begin
  simp_rw [subset_iff, mem_certificator, mem_disj_sups],
  rintro x ⟨u, v, huv, hu, hv⟩,
  refine ⟨x ⊓ u, hu inf_right_idem.symm, x ⊓ v, hv inf_right_idem.symm,
    huv.disjoint.mono inf_le_right inf_le_right, _⟩,
  rw [←inf_sup_left, huv.codisjoint.eq_top, inf_top_eq],
end

variables (s t u)

lemma certificator_comm : s □ t = t □ s :=
by { ext s, rw [mem_certificator, exists_comm], simp [is_compl_comm, and_comm] }

lemma _root_.is_upper_set.certificator_eq_inter (hs : is_upper_set (s : set α))
  (ht : is_lower_set (t : set α)) :
  s □ t = s ∩ t :=
begin
  refine certificator_subset_inter.antisymm (λ a ha, mem_certificator.2 ⟨a, aᶜ, is_compl_compl, _⟩),
  rw mem_inter at ha,
  simp only [@eq_comm _ ⊥, ←sdiff_eq, inf_idem, right_eq_inf, sdiff_self, sdiff_eq_bot_iff],
  exact ⟨λ b hab, hs hab ha.1, λ b hab, ht hab ha.2⟩,
end

lemma _root_.is_lower_set.certificator_eq_inter (hs : is_lower_set (s : set α))
  (ht : is_upper_set (t : set α)) :
  s □ t = s ∩ t :=
begin
  refine certificator_subset_inter.antisymm (λ a ha,
    mem_certificator.2 ⟨aᶜ, a, is_compl_compl.symm, _⟩),
  rw mem_inter at ha,
  simp only [@eq_comm _ ⊥, ←sdiff_eq, inf_idem, right_eq_inf, sdiff_self, sdiff_eq_bot_iff],
  exact ⟨λ b hab, hs hab ha.1, λ b hab, ht hab ha.2⟩,
end

lemma _root_.is_upper_set.certificator_eq_disj_sups (hs : is_upper_set (s : set α))
  (ht : is_upper_set (t : set α)) :
  s □ t = s ○ t :=
begin
  refine certificator_subset_disj_sups.antisymm (λ a ha, mem_certificator.2 _),
  obtain ⟨x, hx, y, hy, hxy, rfl⟩ := mem_disj_sups.1 ha,
  refine ⟨x, xᶜ, is_compl_compl, _⟩,
  simp only [inf_of_le_right, le_sup_left, right_eq_inf, ←sdiff_eq, hxy.sup_sdiff_cancel_left],
  exact ⟨λ b hab, hs hab hx, λ b hab, ht (hab.trans_le sdiff_le) hy⟩,
end

end boolean_algebra

open_locale finset_family

variables [decidable_eq α] [fintype α] {𝒜 ℬ 𝒞 : finset (finset α)}

/-- The **Van den Berg-Kesten-Reimer Inequality**: The probability that `𝒜` and `ℬ` occur
"disjointly" is less than the product of their probabilities. -/
lemma card_certificator_le : 2 ^ fintype.card α * (𝒜 □ ℬ).card ≤ 𝒜.card * ℬ.card :=
sorry

end finset


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import tactic.fin_cases
import data.nat.prime
import group_theory.perm.sign
import data.finset.intervals

example (f : ℕ → Prop) (p : fin 3) (h0 : f 0) (h1 : f 1) (h2 : f 2) : f p.val :=
begin
  fin_cases *,
  simp, assumption,
  simp, assumption,
  simp, assumption,
end

example (f : ℕ → Prop) (p : fin 0) : f p.val :=
by fin_cases *

example (f : ℕ → Prop) (p : fin 1) (h : f 0) : f p.val :=
begin
  fin_cases p,
  assumption
end

example (x2 : fin 2) (x3 : fin 3) (n : nat) (y : fin n) : x2.val * x3.val = x3.val * x2.val :=
begin
  fin_cases x2;
  fin_cases x3,
  success_if_fail { fin_cases * },
  success_if_fail { fin_cases y },
  all_goals { refl },
end

open finset
example (x : ℕ) (h : x ∈ Ico 2 5) : x = 2 ∨ x = 3 ∨ x = 4 :=
begin
  fin_cases h,
  all_goals { simp }
end

open nat
example (x : ℕ) (h : x ∈ [2,3,5,7]) : x = 2 ∨ x = 3 ∨ x = 5 ∨ x = 7 :=
begin
  fin_cases h,
  all_goals { simp }
end

example (x : ℕ) (h : x ∈ [2,3,5,7]) : true :=
begin
  success_if_fail { fin_cases h with [3,3,5,7] },
  trivial
end

example (x : list ℕ) (h : x ∈ [[1],[2]]) : x.length = 1 :=
begin
  fin_cases h with [[1],[1+1]],
  simp,
  guard_target (list.length [1 + 1] = 1),
  simp
end

 -- testing that `with` arguments are elaborated with respect to the expected type:
example (x : ℤ) (h : x ∈ ([2,3] : list ℤ)) : x = 2 ∨ x = 3 :=
begin
  fin_cases h with [2,3],
  all_goals { simp }
end

instance (n : ℕ) : decidable (prime n) := decidable_prime_1 n
example (x : ℕ) (h : x ∈ (range 10).filter prime) : x = 2 ∨ x = 3 ∨ x = 5 ∨ x = 7 :=
begin
  fin_cases h; exact dec_trivial
end

open equiv.perm
example (x : (Σ (a : fin 4), fin 4)) (h : x ∈ fin_pairs_lt 4) : x.1.val < 4 :=
begin
  fin_cases h; simp,
  any_goals { exact dec_trivial },
end

example (x : fin 3) : x.val < 5 :=
begin
  fin_cases x; exact dec_trivial
end

example (f : ℕ → Prop) (p : fin 3) (h0 : f 0) (h1 : f 1) (h2 : f 2) : f p.val :=
begin
  fin_cases *,
  all_goals { assumption }
end

example (n : ℕ) (h : n % 3 ∈ [0,1]) : true :=
begin
  fin_cases h,
  guard_hyp h : n % 3 = 0, trivial,
  guard_hyp h : n % 3 = 1, trivial,
end


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

! This file was ported from Lean 3 source module ring_theory.polynomial.vieta
! leanprover-community/mathlib commit f694c7dead66f5d4c80f446c796a5aad14707f0e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Polynomial.Splits
import Mathlib.RingTheory.MvPolynomial.Symmetric

/-!
# Vieta's Formula

The main result is `Multiset.prod_X_add_C_eq_sum_esymm`, which shows that the product of
linear terms `X + λ` with `λ` in a `Multiset s` is equal to a linear combination of the
symmetric functions `esymm s`.

From this, we deduce `MvPolynomial.prod_X_add_C_eq_sum_esymm` which is the equivalent formula
for the product of linear terms `X + X i` with `i` in a `Fintype σ` as a linear combination
of the symmetric polynomials `esymm σ R j`.

For `R` be an integral domain (so that `p.roots` is defined for any `p : R[X]` as a multiset),
we derive `Polynomial.coeff_eq_esymm_roots_of_card`, the relationship between the coefficients and
the roots of `p` for a polynomial `p` that splits (i.e. having as many roots as its degree).
-/

open BigOperators Polynomial

namespace Multiset

open Polynomial

section Semiring

variable {R : Type _} [CommSemiring R]

/-- A sum version of Vieta's formula for `multiset`: the product of the linear terms `X + λ` where
`λ` runs through a multiset `s` is equal to a linear combination of the symmetric functions
`esymm s` of the `λ`'s .-/
theorem prod_X_add_C_eq_sum_esymm (s : Multiset R) :
    (s.map fun r => X + C r).prod =
      ∑ j in Finset.range (Multiset.card s + 1), (C (s.esymm j) * X ^ (Multiset.card s - j)) := by
  classical
    rw [prod_map_add, antidiagonal_eq_map_powerset, map_map, ← bind_powerset_len,
      map_bind, sum_bind, Finset.sum_eq_multiset_sum, Finset.range_val, map_congr (Eq.refl _)]
    intro _ _
    rw [esymm, ← sum_hom', ← sum_map_mul_right, map_congr (Eq.refl _)]
    intro s ht
    rw [mem_powersetLen] at ht
    dsimp
    rw [prod_hom' s (Polynomial.C : R →+* R[X])]
    simp [ht, map_const, prod_replicate, prod_hom', map_id', card_sub]
set_option linter.uppercaseLean3 false in
#align multiset.prod_X_add_C_eq_sum_esymm Multiset.prod_X_add_C_eq_sum_esymm

/-- Vieta's formula for the coefficients of the product of linear terms `X + λ` where `λ` runs
through a multiset `s` : the `k`th coefficient is the symmetric function `esymm (card s - k) s`. -/
theorem prod_X_add_C_coeff (s : Multiset R) {k : ℕ} (h : k ≤ Multiset.card s) :
    (s.map fun r => X + C r).prod.coeff k = s.esymm (Multiset.card s - k) := by
  convert Polynomial.ext_iff.mp (prod_X_add_C_eq_sum_esymm s) k using 1
  simp_rw [finset_sum_coeff, coeff_C_mul_X_pow]
  rw [Finset.sum_eq_single_of_mem (Multiset.card s - k) _]
  · rw [if_pos (Nat.sub_sub_self h).symm]
  · intro j hj1 hj2
    suffices k ≠ card s - j by rw [if_neg this]
    · intro hn
      rw [hn, Nat.sub_sub_self (Nat.lt_succ_iff.mp (Finset.mem_range.mp hj1))] at hj2
      exact Ne.irrefl hj2
  · rw [Finset.mem_range]
    exact Nat.sub_lt_succ (Multiset.card s) k
set_option linter.uppercaseLean3 false in
#align multiset.prod_X_add_C_coeff Multiset.prod_X_add_C_coeff

theorem prod_X_add_C_coeff' {σ} (s : Multiset σ) (r : σ → R) {k : ℕ} (h : k ≤ Multiset.card s) :
    (s.map fun i => X + C (r i)).prod.coeff k = (s.map r).esymm (Multiset.card s - k) := by
  erw [← map_map (fun r => X + C r) r, prod_X_add_C_coeff] <;> rw [s.card_map r]; assumption
set_option linter.uppercaseLean3 false in
#align multiset.prod_X_add_C_coeff' Multiset.prod_X_add_C_coeff'

theorem _root_.Finset.prod_X_add_C_coeff {σ} (s : Finset σ) (r : σ → R) {k : ℕ} (h : k ≤ s.card) :
    (∏ i in s, (X + C (r i))).coeff k = ∑ t in s.powersetLen (s.card - k), ∏ i in t, r i := by
  rw [Finset.prod, prod_X_add_C_coeff' _ r h, Multiset.Finset.esymm_map_val]
  rfl
set_option linter.uppercaseLean3 false in
#align finset.prod_X_add_C_coeff Finset.prod_X_add_C_coeff

end Semiring

section Ring

variable {R : Type _} [CommRing R]

theorem esymm_neg (s : Multiset R) (k : ℕ) : (map Neg.neg s).esymm k = (-1) ^ k * esymm s k := by
  rw [esymm, esymm, ← Multiset.sum_map_mul_left, Multiset.powersetLen_map, Multiset.map_map,
    map_congr (Eq.refl _)]
  intro x hx
  rw [(mem_powersetLen.mp hx).right.symm, ← prod_replicate, ← Multiset.map_const]
  nth_rw 3 [← map_id' x]
  rw [← prod_map_mul, map_congr (Eq.refl _)];rfl
  exact fun z _ => neg_one_mul z
#align multiset.esymm_neg Multiset.esymm_neg

theorem prod_X_sub_X_eq_sum_esymm (s : Multiset R) :
    (s.map fun t => X - C t).prod =
      ∑ j in Finset.range (Multiset.card s + 1), (-1) ^ j * (C (s.esymm j) *
      X ^ (Multiset.card s - j)) := by
  conv_lhs =>
    congr
    congr
    ext x
    rw [sub_eq_add_neg]
    rw [← map_neg C x]
  convert prod_X_add_C_eq_sum_esymm (map (fun t => -t) s) using 1
  · rw [map_map]; rfl
  · simp only [esymm_neg, card_map, mul_assoc, map_mul, map_pow, map_neg, map_one]
set_option linter.uppercaseLean3 false in
#align multiset.prod_X_sub_C_eq_sum_esymm Multiset.prod_X_sub_X_eq_sum_esymm

theorem prod_X_sub_C_coeff (s : Multiset R) {k : ℕ} (h : k ≤ Multiset.card s) :
    (s.map fun t => X - C t).prod.coeff k =
    (-1) ^ (Multiset.card s - k) * s.esymm (Multiset.card s - k) := by
  conv_lhs =>
    congr
    congr
    congr
    ext x
    rw [sub_eq_add_neg]
    rw [← map_neg C x]
  convert prod_X_add_C_coeff (map (fun t => -t) s) _ using 1
  · rw [map_map]; rfl
  · rw [esymm_neg, card_map]
  · rwa [card_map]
set_option linter.uppercaseLean3 false in
#align multiset.prod_X_sub_C_coeff Multiset.prod_X_sub_C_coeff

/-- Vieta's formula for the coefficients and the roots of a polynomial over an integral domain
  with as many roots as its degree. -/
theorem _root_.Polynomial.coeff_eq_esymm_roots_of_card [IsDomain R] {p : R[X]}
    (hroots : Multiset.card p.roots = p.natDegree) {k : ℕ} (h : k ≤ p.natDegree) :
    p.coeff k = p.leadingCoeff * (-1) ^ (p.natDegree - k) * p.roots.esymm (p.natDegree - k) := by
  conv_lhs => rw [← C_leadingCoeff_mul_prod_multiset_X_sub_C hroots]
  rw [coeff_C_mul, mul_assoc]; congr
  have : k ≤ card (roots p) := by rw [hroots]; exact h
  convert p.roots.prod_X_sub_C_coeff this using 3 <;> rw [hroots]
#align polynomial.coeff_eq_esymm_roots_of_card Polynomial.coeff_eq_esymm_roots_of_card

/-- Vieta's formula for split polynomials over a field. -/
theorem _root_.Polynomial.coeff_eq_esymm_roots_of_splits {F} [Field F] {p : F[X]}
    (hsplit : p.Splits (RingHom.id F)) {k : ℕ} (h : k ≤ p.natDegree) :
    p.coeff k = p.leadingCoeff * (-1) ^ (p.natDegree - k) * p.roots.esymm (p.natDegree - k) :=
  Polynomial.coeff_eq_esymm_roots_of_card (splits_iff_card_roots.1 hsplit) h
#align polynomial.coeff_eq_esymm_roots_of_splits Polynomial.coeff_eq_esymm_roots_of_splits

end Ring

end Multiset

section MvPolynomial

open Finset Polynomial Fintype

variable (R σ : Type _) [CommSemiring R] [Fintype σ]

/-- A sum version of Vieta's formula for `MvPolynomial`: viewing `X i` as variables,
the product of linear terms `λ + X i` is equal to a linear combination of
the symmetric polynomials `esymm σ R j`. -/
theorem MvPolynomial.prod_C_add_X_eq_sum_esymm :
    (∏ i : σ, (Polynomial.X + Polynomial.C (MvPolynomial.X i))) =
      ∑ j in range (card σ + 1), Polynomial.C
        (MvPolynomial.esymm σ R j) * Polynomial.X ^ (card σ - j) := by
  let s := Finset.univ.val.map fun i : σ => (MvPolynomial.X i : MvPolynomial σ R)
  rw [(_ : card σ = Multiset.card s)]
  · simp_rw [MvPolynomial.esymm_eq_multiset_esymm σ R, Finset.prod_eq_multiset_prod]
    convert Multiset.prod_X_add_C_eq_sum_esymm s
    rw [Multiset.map_map]; rfl
  · rw [Multiset.card_map]
    rfl
set_option linter.uppercaseLean3 false in
#align mv_polynomial.prod_C_add_X_eq_sum_esymm MvPolynomial.prod_C_add_X_eq_sum_esymm

theorem MvPolynomial.prod_X_add_C_coeff (k : ℕ) (h : k ≤ card σ) :
    (∏ i : σ, (Polynomial.X + Polynomial.C (MvPolynomial.X i)) : Polynomial _).coeff k =
    MvPolynomial.esymm σ R (card σ - k) := by
  let s := Finset.univ.val.map fun i => (MvPolynomial.X i : MvPolynomial σ R)
  rw [(_ : card σ = Multiset.card s)] at h⊢
  · rw [MvPolynomial.esymm_eq_multiset_esymm σ R, Finset.prod_eq_multiset_prod]
    convert Multiset.prod_X_add_C_coeff s h
    dsimp
    rw [Multiset.map_map]; rfl
  repeat' rw [Multiset.card_map]; rfl
set_option linter.uppercaseLean3 false in
#align mv_polynomial.prod_X_add_C_coeff MvPolynomial.prod_X_add_C_coeff

end MvPolynomial


/-
M1F 2017-18 Sheet 1 Question 1
Author : Kevin Buzzard

This file should work with any version of lean -- whether you installed it yourself
or are running the version on https://leanprover.github.io/live/latest/

-/
-- We probably need the "law of the excluded middle" for this question -- every
-- proposition is either true or false! Don't even ask me to explain what the
-- other options are, but Lean does not come with this axiom by default (blame
-- the computer scientists) and mathematicians have to add it themselves.
-- It's easy to add though. "em" for excluded middle.

axiom em (X : Prop) : X ∨ ¬ X

variables P Q R S : Prop -- A "Prop" is a proposition, that is, a true/false statement.

-- Sheet 1 Q3. Prove one result and delete the other.

theorem m1f_sheet01_q03_is_T (HP : P) (HnQ : ¬ Q) (HnR : ¬ R) (HS : S) : (R → S) → (P → Q) := sorry
theorem m1f_sheet01_q03_is_F (HP : P) (HnQ : ¬ Q) (HnR : ¬ R) (HS : S) : ¬ ((R → S) → (P → Q)) := sorry


/-
Copyright (c) 2021 David Wärn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Wärn
-/
import topology.separation

/-!
# Idempotents in topological semigroups

This file provides a sufficient condition for a semigroup `M` to contain an idempotent (i.e. an
element `m` such that `m * m = m `), namely that `M` is a nonempty compact Hausdorff space where
right-multiplication by constants is continuous.

We also state a corresponding lemma guaranteeing that a subset of `M` contains an idempotent.
-/

/-- Any nonempty compact Hausdorff semigroup where right-multiplication is continuous contains
an idempotent, i.e. an `m` such that `m * m = m`. -/
@[to_additive "Any nonempty compact Hausdorff additive semigroup where right-addition is continuous
contains an idempotent, i.e. an `m` such that `m + m = m`"]
lemma exists_idempotent_of_compact_t2_of_continuous_mul_left {M} [nonempty M] [semigroup M]
  [topological_space M] [compact_space M] [t2_space M]
  (continuous_mul_left : ∀ r : M, continuous (* r)) : ∃ m : M, m * m = m :=
begin
/- We apply Zorn's lemma to the poset of nonempty closed subsemigroups of `M`. It will turn out that
any minimal element is `{m}` for an idempotent `m : M`. -/
  let S : set (set M) := { N : set M | is_closed N ∧ N.nonempty ∧ ∀ m m' ∈ N, m * m' ∈ N },
  suffices : ∃ N ∈ S, ∀ N' ∈ S, N' ⊆ N → N' = N,
  { rcases this with ⟨N, ⟨N_closed, ⟨m, hm⟩, N_mul⟩, N_minimal⟩,
    use m,
/- We now have an element `m : M` of a minimal subsemigroup `N`, and want to show `m + m = m`.
We first show that every element of `N` is of the form `m' + m`.-/
    have scaling_eq_self : (* m) '' N = N,
    { apply N_minimal,
      { refine ⟨(continuous_mul_left m).is_closed_map _ N_closed,
          ⟨_, ⟨m, hm, rfl⟩⟩, _⟩,
        rintros _ _ ⟨m'', hm'', rfl⟩ ⟨m', hm', rfl⟩,
        exact ⟨m'' * m * m', N_mul _ _ (N_mul _ _ hm'' hm) hm', mul_assoc _ _ _⟩, },
      { rintros _ ⟨m', hm', rfl⟩,
        exact N_mul _ _ hm' hm, }, },
/- In particular, this means that `m' * m = m` for some `m'`. We now use minimality again to show
that this holds for _all_ `m' ∈ N`. -/
    have absorbing_eq_self : N ∩ { m' | m' * m = m} = N,
    { apply N_minimal,
      { refine ⟨N_closed.inter ((t1_space.t1 m).preimage (continuous_mul_left m)), _, _⟩,
        { rw ←scaling_eq_self at hm, exact hm },
        { rintros m'' m' ⟨mem'', eq'' : _ = m⟩ ⟨mem', eq' : _ = m⟩,
          refine ⟨N_mul _ _ mem'' mem', _⟩,
          rw [set.mem_set_of_eq, mul_assoc, eq', eq''], }, },
      apply set.inter_subset_left, },
/- Thus `m * m = m` as desired. -/
    rw ←absorbing_eq_self at hm,
    exact hm.2, },
  apply zorn.zorn_superset,
  intros c hcs hc,
  refine ⟨⋂₀ c, ⟨is_closed_sInter $ λ t ht, (hcs ht).1, _, _⟩, _⟩,
  { obtain rfl | hcnemp := c.eq_empty_or_nonempty,
    { rw set.sInter_empty, apply set.univ_nonempty, },
    convert @is_compact.nonempty_Inter_of_directed_nonempty_compact_closed _ _ _
      (c.nonempty_coe_sort.mpr hcnemp) (coe : c → set M) _ _ _ _,
    { simp only [subtype.range_coe_subtype, set.set_of_mem_eq] } ,
    { refine directed_on_iff_directed.mp (zorn.chain.directed_on _), exact hc.symm, },
    { intro i, exact (hcs i.property).2.1, },
    { intro i, exact (hcs i.property).1.is_compact, },
    { intro i, exact (hcs i.property).1, }, },
  { intros m m' hm hm',
    rw set.mem_sInter,
    intros t ht,
    exact (hcs ht).2.2 m m' (set.mem_sInter.mp hm t ht) (set.mem_sInter.mp hm' t ht), },
  { intros s hs, exact set.sInter_subset_of_mem hs, },
end

/-- A version of `exists_idempotent_of_compact_t2_of_continuous_mul_left` where the idempotent lies
in some specified nonempty compact subsemigroup. -/
@[to_additive exists_idempotent_in_compact_add_subsemigroup "A version of
`exists_idempotent_of_compact_t2_of_continuous_add_left` where the idempotent lies in some specified
nonempty compact additive subsemigroup."]
lemma exists_idempotent_in_compact_subsemigroup {M} [semigroup M] [topological_space M] [t2_space M]
  (continuous_mul_left : ∀ r : M, continuous (* r))
  (s : set M) (snemp : s.nonempty) (s_compact : is_compact s) (s_add : ∀ x y ∈ s, x * y ∈ s) :
  ∃ m ∈ s, m * m = m :=
begin
  let M' := { m // m ∈ s },
  letI : semigroup M' :=
    { mul       := λ p q, ⟨p.1 * q.1, s_add _ _ p.2 q.2⟩,
      mul_assoc := λ p q r, subtype.eq (mul_assoc _ _ _) },
  haveI : compact_space M' := is_compact_iff_compact_space.mp s_compact,
  haveI : nonempty M' := nonempty_subtype.mpr snemp,
  have : ∀ p : M', continuous (* p) := λ p, continuous_subtype_mk _
    ((continuous_mul_left p.1).comp continuous_subtype_val),
  obtain ⟨⟨m, hm⟩, idem⟩ := exists_idempotent_of_compact_t2_of_continuous_mul_left this,
  exact ⟨m, hm, subtype.ext_iff.mp idem⟩,
end


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

import data.set.finite
import group_theory.submonoid.operations
import group_theory.subgroup

/-!
# Finitely generated monoids and groups

We define finitely generated monoids and groups. See also `submodule.fg` and `module.finite` for
finitely-generated modules.

## Main definition

* `submonoid.fg S`, `add_submonoid.fg S` : A submonoid `S` is finitely generated.
* `monoid.fg M`, `add_monoid.fg M` : A typeclass indicating a type `M` is finitely generated as a
monoid.
* `subgroup.fg S`, `add_subgroup.fg S` : A subgroup `S` is finitely generated.
* `group.fg M`, `add_group.fg M` : A typeclass indicating a type `M` is finitely generated as a
group.

-/

/-! ### Monoids and submonoids -/

variables {M N : Type*} [monoid M] [add_monoid N]

section submonoid

/-- A submonoid of `M` is finitely generated if it is the closure of a finite subset of `M`. -/
@[to_additive]
def submonoid.fg (P : submonoid M) : Prop := ∃ S : finset M, submonoid.closure ↑S = P

/-- An additive submonoid of `N` is finitely generated if it is the closure of a finite subset of
`M`. -/
add_decl_doc add_submonoid.fg

/-- An equivalent expression of `submonoid.fg` in terms of `set.finite` instead of `finset`. -/
@[to_additive "An equivalent expression of `add_submonoid.fg` in terms of `set.finite` instead of
`finset`."]
lemma submonoid.fg_iff (P : submonoid M) : submonoid.fg P ↔
  ∃ S : set M, submonoid.closure S = P ∧ S.finite :=
⟨λ ⟨S, hS⟩, ⟨S, hS, finset.finite_to_set S⟩, λ ⟨S, hS, hf⟩, ⟨set.finite.to_finset hf, by simp [hS]⟩⟩

lemma submonoid.fg_iff_add_fg (P : submonoid M) : P.fg ↔ P.to_add_submonoid.fg :=
⟨λ h, let ⟨S, hS, hf⟩ := (submonoid.fg_iff _).1 h in (add_submonoid.fg_iff _).mpr
  ⟨additive.to_mul ⁻¹' S, by simp [← submonoid.to_add_submonoid_closure, hS], hf⟩,
 λ h, let ⟨T, hT, hf⟩ := (add_submonoid.fg_iff _).1 h in (submonoid.fg_iff _).mpr
  ⟨multiplicative.of_add ⁻¹' T, by simp [← add_submonoid.to_submonoid'_closure, hT], hf⟩⟩

lemma add_submonoid.fg_iff_mul_fg (P : add_submonoid N) : P.fg ↔ P.to_submonoid.fg :=
begin
  convert (submonoid.fg_iff_add_fg P.to_submonoid).symm,
  exact set_like.ext' rfl
end

end submonoid

section monoid

variables (M N)

/-- A monoid is finitely generated if it is finitely generated as a submonoid of itself. -/
class monoid.fg : Prop := (out : (⊤ : submonoid M).fg)

/-- An additive monoid is finitely generated if it is finitely generated as an additive submonoid of
itself. -/
class add_monoid.fg : Prop := (out : (⊤ : add_submonoid N).fg)

attribute [to_additive] monoid.fg

variables {M N}

lemma monoid.fg_def : monoid.fg M ↔ (⊤ : submonoid M).fg := ⟨λ h, h.1, λ h, ⟨h⟩⟩

lemma add_monoid.fg_def : add_monoid.fg N ↔ (⊤ : add_submonoid N).fg := ⟨λ h, h.1, λ h, ⟨h⟩⟩

/-- An equivalent expression of `monoid.fg` in terms of `set.finite` instead of `finset`. -/
@[to_additive "An equivalent expression of `add_monoid.fg` in terms of `set.finite` instead of
`finset`."]
lemma monoid.fg_iff : monoid.fg M ↔
  ∃ S : set M, submonoid.closure S = (⊤ : submonoid M) ∧ S.finite :=
⟨λ h, (submonoid.fg_iff ⊤).1 h.out, λ h, ⟨(submonoid.fg_iff ⊤).2 h⟩⟩

lemma monoid.fg_iff_add_fg : monoid.fg M ↔ add_monoid.fg (additive M) :=
⟨λ h, ⟨(submonoid.fg_iff_add_fg ⊤).1 h.out⟩, λ h, ⟨(submonoid.fg_iff_add_fg ⊤).2 h.out⟩⟩

lemma add_monoid.fg_iff_mul_fg : add_monoid.fg N ↔ monoid.fg (multiplicative N) :=
⟨λ h, ⟨(add_submonoid.fg_iff_mul_fg ⊤).1 h.out⟩, λ h, ⟨(add_submonoid.fg_iff_mul_fg ⊤).2 h.out⟩⟩

instance add_monoid.fg_of_monoid_fg [monoid.fg M] : add_monoid.fg (additive M) :=
monoid.fg_iff_add_fg.1 ‹_›

instance monoid.fg_of_add_monoid_fg [add_monoid.fg N] : monoid.fg (multiplicative N) :=
add_monoid.fg_iff_mul_fg.1 ‹_›

end monoid

/-! ### Groups and subgroups -/

variables {G H : Type*} [group G] [add_group H]

section subgroup

/-- A subgroup of `G` is finitely generated if it is the closure of a finite subset of `G`. -/
@[to_additive]
def subgroup.fg (P : subgroup G) : Prop := ∃ S : finset G, subgroup.closure ↑S = P

/-- An additive subgroup of `H` is finitely generated if it is the closure of a finite subset of
`H`. -/
add_decl_doc add_subgroup.fg

/-- An equivalent expression of `subgroup.fg` in terms of `set.finite` instead of `finset`. -/
@[to_additive "An equivalent expression of `add_subgroup.fg` in terms of `set.finite` instead of
`finset`."]
lemma subgroup.fg_iff (P : subgroup G) : subgroup.fg P ↔
  ∃ S : set G, subgroup.closure S = P ∧ S.finite :=
⟨λ⟨S, hS⟩, ⟨S, hS, finset.finite_to_set S⟩, λ⟨S, hS, hf⟩, ⟨set.finite.to_finset hf, by simp [hS]⟩⟩

/-- A subgroup is finitely generated if and only if it is finitely generated as a submonoid. -/
@[to_additive add_subgroup.fg_iff_add_submonoid.fg "An additive subgroup is finitely generated if
and only if it is finitely generated as an additive submonoid."]
lemma subgroup.fg_iff_submonoid_fg (P : subgroup G) : P.fg ↔ P.to_submonoid.fg :=
begin
  split,
  { rintro ⟨S, rfl⟩,
    rw submonoid.fg_iff,
    refine ⟨S ∪ S⁻¹, _, S.finite_to_set.union S.finite_to_set.inv⟩,
    exact (subgroup.closure_to_submonoid _).symm },
  { rintro ⟨S, hS⟩,
    refine ⟨S, le_antisymm _ _⟩,
    { rw [subgroup.closure_le, ←subgroup.coe_to_submonoid, ←hS],
      exact submonoid.subset_closure },
    { rw [← subgroup.to_submonoid_le, ← hS, submonoid.closure_le],
      exact subgroup.subset_closure } }
end

lemma subgroup.fg_iff_add_fg (P : subgroup G) : P.fg ↔ P.to_add_subgroup.fg :=
begin
  rw [subgroup.fg_iff_submonoid_fg, add_subgroup.fg_iff_add_submonoid.fg],
  exact (subgroup.to_submonoid P).fg_iff_add_fg
end

lemma add_subgroup.fg_iff_mul_fg (P : add_subgroup H) :
  P.fg ↔ P.to_subgroup.fg :=
begin
  rw [add_subgroup.fg_iff_add_submonoid.fg, subgroup.fg_iff_submonoid_fg],
  exact add_submonoid.fg_iff_mul_fg (add_subgroup.to_add_submonoid P)
end

end subgroup

section group

variables (G H)

/-- A group is finitely generated if it is finitely generated as a submonoid of itself. -/
class group.fg : Prop := (out : (⊤ : subgroup G).fg)

/-- An additive group is finitely generated if it is finitely generated as an additive submonoid of
itself. -/
class add_group.fg : Prop := (out : (⊤ : add_subgroup H).fg)

attribute [to_additive] group.fg

variables {G H}

lemma group.fg_def : group.fg G ↔ (⊤ : subgroup G).fg := ⟨λ h, h.1, λ h, ⟨h⟩⟩

lemma add_group.fg_def : add_group.fg H ↔ (⊤ : add_subgroup H).fg := ⟨λ h, h.1, λ h, ⟨h⟩⟩

/-- An equivalent expression of `group.fg` in terms of `set.finite` instead of `finset`. -/
@[to_additive "An equivalent expression of `add_group.fg` in terms of `set.finite` instead of
`finset`."]
lemma group.fg_iff : group.fg G ↔
  ∃ S : set G, subgroup.closure S = (⊤ : subgroup G) ∧ S.finite :=
⟨λ h, (subgroup.fg_iff ⊤).1 h.out, λ h, ⟨(subgroup.fg_iff ⊤).2 h⟩⟩

/-- A group is finitely generated if and only if it is finitely generated as a monoid. -/
@[to_additive add_group.fg_iff_add_monoid.fg "An additive group is finitely generated if and only
if it is finitely generated as an additive monoid."]
lemma group.fg_iff_monoid.fg : group.fg G ↔ monoid.fg G :=
⟨λ h, monoid.fg_def.2 $ (subgroup.fg_iff_submonoid_fg ⊤).1 (group.fg_def.1 h),
    λ h, group.fg_def.2 $ (subgroup.fg_iff_submonoid_fg ⊤).2 (monoid.fg_def.1 h)⟩

lemma group_fg.iff_add_fg : group.fg G ↔ add_group.fg (additive G) :=
⟨λ h, ⟨(subgroup.fg_iff_add_fg ⊤).1 h.out⟩, λ h, ⟨(subgroup.fg_iff_add_fg ⊤).2 h.out⟩⟩

lemma add_group.fg_iff_mul_fg : add_group.fg H ↔ group.fg (multiplicative H) :=
⟨λ h, ⟨(add_subgroup.fg_iff_mul_fg ⊤).1 h.out⟩, λ h, ⟨(add_subgroup.fg_iff_mul_fg ⊤).2 h.out⟩⟩

instance add_group.fg_of_group_fg [group.fg G] : add_group.fg (additive G) :=
group_fg.iff_add_fg.1 ‹_›

instance group.fg_of_mul_group_fg [add_group.fg H] : group.fg (multiplicative H) :=
add_group.fg_iff_mul_fg.1 ‹_›

end group


import tidy.tidy
import tidy.rwing
import tactic.ring

lemma diff_zero {a b : ℤ} : a - b = 0 → a = b :=
begin
    intro h1,
    have h2 : a = a - b + b,
    rwing [h2, h1],
end

theorem cancellation_law {a b c : ℤ} (h : a ≠ 0) : a * b = a * c → b = c :=
begin
    intro h1,
    have h2 : a * (b - c) = 0, by rwing h1,
    have h3 : a = 0 ∨ b - c = 0, from eq_zero_or_eq_zero_of_mul_eq_zero h2,
    apply diff_zero (or.resolve_right (or.symm h3) h),
end

theorem zero_prod {a b : ℤ} (h : a = 0 ∨ b = 0) : a * b = 0 :=
begin
    by_cases hc : a = 0,
    rwing hc,
    have hs : b = 0,
    exact (or.resolve_left h hc),
    rwing hs,
end

theorem nonzero_mul {a b : ℤ} (ha : a ≠ 0) (hb : b ≠ 0) : a * b ≠ 0 :=
begin
    by_contradiction hc,
    simp at hc,
    have hm : a = 0 ∨ b = 0, by exact (eq_zero_or_eq_zero_of_mul_eq_zero hc),
    obviously,
end


/-
Conjunctions, disjunctions, implication, iff,
negation
-/

/-
1. Prove that 3 + 3 = 6 and 2 + 6 = 8 implies
that 1 + 1 = 2.
-/

-- answer:
example: 3 + 3 = 6 ∧ 2 + 6 = 8 → 1 + 1 = 2
:=
begin
  assume pf_conj,
  exact rfl,
end

/-
2. Prove that 2 + 5 = 3 or 9 + 1 = 5 implies
that 2 + 3 = 9.
-/

-- answer:
example: 2 + 5 = 3 ∨ 9 + 1 = 5 → 2 + 3 = 9
:=
begin
  assume pf_disj,
  cases pf_disj with left right,
    -- 2 + 5 = 0
    /-
    have pf_contra: 2 + 5 ≠ 0 :=
    begin
      apply nat.no_confusion,
    end,
    contradiction,
    -/
    cases left,
    -- 9 + 1 = 0
    /-
    have pf_contra: 9 + 1 ≠ 0 :=
    begin
      apply nat.no_confusion,
    end,
    contradiction,
    -/
    cases right,
end

/-
3. Prove that ¬(A ∧ B ∧ C) ↔ (¬A ∨ ¬B ∨ ¬C).
You may use the axiom of the excluded middle.
-/

axiom em: ∀(P: Prop), P ∨ ¬P

-- answer:
example: ∀(A B C: Prop),
  ¬(A ∧ B ∧ C) ↔ (¬A ∨ ¬B ∨ ¬C) :=
begin
  assume P Q R,
  split,
    -- ¬(P ∧ Q ∧ R) → ¬P ∨ ¬Q ∨ ¬R
    assume pf_not_conj,
    cases (em P) with pf_p pf_not_p,
      cases (em Q) with pf_q pf_not_q,
        cases (em R) with pf_r pf_not_r,
          -- P ∧ Q ∧ R
          have pf_conj: P ∧ Q ∧ R := ⟨pf_p, ⟨pf_q, pf_r⟩⟩,
          contradiction,
          -- ¬R
          exact or.inr (or.inr pf_not_r),
        -- ¬Q
        exact or.inr (or.inl pf_not_q),
      -- ¬P
      exact or.inl pf_not_p,
      /-
      Think about what we just proved and how we proved
      it. The em principle allowed us to consider two cases
      for each of P, Q, and R. In case any one of them is
      false, the an ease "or introduction" will prove the
      goal. In the case all of them are true, well, that
      contradicts the assumption, and (using false elim)
      we can ignore cases with contradictory assumptions
      because they can't actually happen.
      -/

    -- ¬P ∨ ¬Q ∨ ¬R → ¬(P ∧ Q ∧ R)
    assume pf_disj_not,
    assume pf_conj,
    cases pf_disj_not with pf_not_p pf_disj_not,
      -- ¬P
      have pf_p := pf_conj.left,
      contradiction,
      -- ¬Q ∨ ¬R
      cases pf_disj_not with pf_not_q pf_not_r,
        -- ¬Q
        have pf_q := pf_conj.right.left,
        contradiction,
        -- ¬R
        have pf_r := pf_conj.right.right,
        contradiction,

    /-
    In this case, we've assumed all of P, Q, and R
    are true. In this context, the assumption that at
    least one of them is false is contradictory. What
    the proof script confirms is that this intuition
    can be proved formally.
    -/
end

/-
4. Prove that ¬(A ∨ B ∨ C) ↔ (¬A ∧ ¬B ∧ ¬C).
You may *NOT* use the axiom of the excluded middle.
-/

-- answer:
example: ∀(A B C: Prop),
  ¬(A ∨ B ∨ C) ↔ (¬A ∧ ¬B ∧ ¬C) :=
begin
  intros,
  split,
    -- ¬(A ∨ B ∨ C) → ¬A ∧ ¬B ∧ ¬C
    assume pf_not_disj,
    split,
      -- ¬A
      assume pf_A,
      /-
      Here again the key insight is that from a proof
      of just A we can construct proof of a contradiction
      that directly contradicts an assumption, at which
      point we have shown that this case can be dismissed
      using false elimination (via the contradiction tactic).
      -/
      have pf_disj: A ∨ B ∨ C :=
        or.inl pf_A,
      contradiction,
      split,        -- short for apply and.intro _ _,
        -- ¬B
        assume pf_B,
        -- same trick
        have pf_disj: A ∨ B ∨ C :=
          or.inr (or.inl pf_B),
        contradiction,
        -- ¬C
        assume pf_C,
        -- same trick
        have pf_disj: A ∨ B ∨ C :=
          or.inr (or.inr pf_C),
        contradiction,

    -- ¬A ∧ ¬B ∧ ¬C → ¬(A ∨ B ∨ C)
    assume pf_conj_not,
    assume pf_disj,
    -- each one false + at least one true = contradiction
    cases pf_disj with pf_A pf_disj,
      -- A
      -- basically same trick: expose direct contradition
      have pf_not_A := pf_conj_not.left,
      contradiction,
      -- repeat until done
      cases pf_disj with pf_B pf_C,
        -- B
        have pf_not_B := pf_conj_not.right.left,
        contradiction,
        -- C
        have pf_not_C := pf_conj_not.right.right,
        contradiction,
end

/-
5a. Prove that ¬(A ∨ ¬B) ↔ (¬A ∧ B).
You may use the axiom of the excluded middle.
-/

-- answer:
example: ∀(A B: Prop),
  ¬(A ∨ ¬B) ↔ (¬A ∧ B) :=
begin
  assume X Y,
  split,        -- short for "apply IFF.intro _ _"
    -- ¬(X ∨ ¬Y) → ¬X ∧ Y
    assume pf_not_disj,
    split,      -- short for "apply AND.intro _ _"
      -- ¬X
      assume pf_X,
      -- here's that same trick again
      have pf_disj: X ∨ ¬Y := or.inl pf_X,
      contradiction,
      -- Y
      /-
      Case analysis on (Y ∨ ¬ Y). Think about the two
      cases before proceeding "blindly". In the case that
      Y is true, then the goal is proved. What happens in
      the case where Y is false? Yep: that's a contradiction,
      which you can expose with the same trick we've seen
      several times here already.
      -/
      cases (em Y) with pf_Y pf_not_Y,
        -- Y,
        assumption,
        -- ¬Y
        have pf_disj: X ∨ ¬Y := or.inr pf_not_Y,
        contradiction,

    -- ¬X ∧ Y → ¬(X ∨ ¬Y)
    assume pf_not_X_and_Y,
    assume pf_X_or_not_Y,
    cases pf_X_or_not_Y with pf_X pf_not_Y,
      -- X
      have pf_not_X := pf_not_X_and_Y.left,
      contradiction,
      -- ¬Y
      have pf_Y := pf_not_X_and_Y.right,
      contradiction,
end

/-
5b. Prove that ¬(A ∧ ¬B) ↔ (¬A ∨ B).
You may use the axiom of the excluded middle.
-/

-- answer:
example: ∀(A B: Prop),
  ¬(A ∧ ¬B) ↔ (¬A ∨ B) :=
begin
  intros,
  split,
    -- ¬(A ∧ ¬B) → ¬A ∨ B
    assume pf_not_conj,
    /-
    At this point there's nothing we can do *unless*
    we use excluded middle to consider only two cases,
    one where we have a proof that A is true and one
    where we have a proof that it is not true. Then we
    do the same kind of case analysis for B. In effect
    we're *just looking at the truth table*. There are
    four cases: A true, B true; A true, A false; B true,
    A false; B false. Before proceeding, just think
    about what happens in each case. Write out the
    truth table.
    -/
    cases (em A) with pf_A pf_not_A,
      -- A
      cases (em B) with pf_B pf_not_B,
        -- B
        exact or.inr pf_B,
        -- ¬B
        -- here's that trick again!
        have pf_conj: A ∧ ¬B := ⟨pf_A, pf_not_B⟩,
        contradiction,
      -- ¬A
      exact or.inl pf_not_A,

    -- ¬A ∨ B → ¬(A ∧ ¬B)
    assume pf_disj,
    assume pf_conj,
    /-
    Look at and *think about* what's in the context.
    You must be able to reason logically at this point.
    If ¬ A or B is true, it is true because at least one
    of them is true. If ¬ A is true, that contradicts the
    other assumption, that both A and ¬ B are true. If B
    is true, on the other hand, that's also a contradiction.
    -/
    cases pf_disj with pf_not_A pf_B,
      -- ¬A
      have pf_A := pf_conj.left,
      contradiction,
      -- B
      have pf_not_B := pf_conj.right,
      contradiction,
end

/-
6. Prove that ¬P ∨ ¬Q ∨ R is true if and only
if P → Q → R. You may use the axiom of the
excluded middle.
-/

-- answer:
example: ∀(P Q R: Prop),
  (¬P ∨ ¬Q ∨ R) ↔ (P → Q → R) :=
begin
  intros,
  split,
    -- ¬P ∨ ¬Q ∨ R → (P → Q → R)
    assume pf_disj,
    assume pf_P,
    assume pf_Q,
    /-
    Beyond just mechanically applying tactics,
    stop now and think about what you've got. As
    a mathematician, you want to start to "look
    ahead" to see "what will happen" if you try
    different approaches. Here, for example, you
    can see that if the disjunction is true because
    ¬ P is true, that will immediately give you a
    contradiction that you can use to be done with
    that case. Think ahead about the other case.
    Start to see beyond the current instant, to
    see what's coming if you take certain paths.
    -/
    cases pf_disj with pf_not_P pf_disj,
      -- ¬P
      contradiction,
      cases pf_disj with pf_not_Q pf_R,
        -- ¬Q
        contradiction,
        -- R
        assumption,

    -- (P → Q → R) → ¬P ∨ ¬Q ∨ R
    assume pf_impl,
    /-
    There's no way forward constructively.
    But if we can assume that there are only
    two possible cases for P, Q, and R, then
    we can just consider each case in turn,
    again using what amounts to the method
    of "truth tables".
    -/
    cases (em P) with pf_P pf_not_P,
      -- P
      /-
      Right here you use another absolutely (!!)
      fundamental insight. If you have a proof
      of an implication and you have a proof of
      its premise you can derive a proof of its
      conclusion. In constructive logic this is
      done by "applying" the implication proof
      (a function!) to the premise proof (a valid
      argument).
      -/
      have pf_Q_to_R := pf_impl pf_P,
      cases (em Q) with pf_Q pf_not_Q,
        -- Q
        have pf_R := pf_Q_to_R pf_Q,
        /-
        We have a proof of R and now only
        need to prove a disjunction in which
        R is one of the disjunctions. You have
        to understand the associativity of ∨.
        It's right associative.
        -/
        exact or.inr (or.inr pf_R),
        -- ¬Q
        exact or.inr (or.inl pf_not_Q),
      -- ¬P
      exact or.inl pf_not_P,
end

/-
7. Prove that ¬¬¬P → ¬P. You may use the axiom
of the excluded middle.
-/

-- answer:
example: ∀(P: Prop), ¬¬¬P → ¬P :=
begin
  assume P,
  assume pf_trip_neg,
  assume pf_P,
  /-
  How to proceed here is a little tricky. A key
  insight is that you can apply em to whatever
  proposition you want, to get a proof that is is
  either true or a proof that it is false. Here,
  applying em to ¬ P does the trick. Think ahead
  to see if you can see why. Then *confirm* what
  you see by going through the proof script.
  -/
  cases (em ¬P) with pf_not_P pf_nn_P,
    -- ¬P
    contradiction, -- contradicts P
    -- ¬¬P
    contradiction, -- contradicts ¬¬¬P
end

/-
Universal Quantifiers, Existential Quantifiers, and
Satisfiability.
-/

/-
8. Prove the following statements are satisfiable
or prove that they are not. You may use the axiom
of the excluded middle to prove cases where the
statements are not satisfiable.
-/

/-
8a. (P ∨ Q) ∧ (¬P ∨ Q) ∧ (P ∨ ¬Q)
-/

/-
Note: Problems that start with ∃ are basically
search problems: you have to "searcg for, find,
and then use a witness that makes the proposition
true." In the worse case, use a truth table. That
is the way to systematically consider all possible
solutions. A problem with two "variables" will have
only four cases to consider. You can of course try
a value, and if you get stuck, "backtrack" (go back
and change your choice then try going forward again).

Also note that ∃(P Q: Prop), _ is short for
∃( P : Prop), ∃ (Q : Prop), _.
-/

-- answer:
example: ∃(P Q: Prop),
  (P ∨ Q) ∧ (¬P ∨ Q) ∧ (P ∨ ¬Q) :=
begin
  apply exists.intro true,
  apply exists.intro true,
  split,
    -- P ∨ Q
    exact or.inl true.intro,
    split,
      -- ¬P ∨ Q
      exact or.inr true.intro,
      -- P ∨ ¬Q
      exact or.inl true.intro,
end

/-
8b. (P ∨ Q) ∧ (¬P ∨ Q) ∧ (P ∨ ¬Q) ∧ (¬P ∨ ¬Q)
-/

-- answer:
example: ¬∃(P Q: Prop),
  (P ∨ Q) ∧ (¬P ∨ Q) ∧ (P ∨ ¬Q) ∧ (¬P ∨ ¬Q) :=
begin
  assume pf_exists,
  apply exists.elim pf_exists,
  assume P pf_w',
  apply exists.elim pf_w',
  assume Q pf_w,
  cases (em P) with pf_P pf_not_P,
    cases (em Q) with pf_Q pf_not_Q,
      -- P, Q
      have pf_not_P_or_not_Q := pf_w.right.right.right,
      cases pf_not_P_or_not_Q with pf_not_P pf_not_Q,
        contradiction, contradiction,
      -- P, ¬Q
      have pf_not_P_or_Q := pf_w.right.left,
      cases pf_not_P_or_Q with pf_not_P pf_Q,
        contradiction, contradiction,
    cases (em Q) with pf_Q pf_not_Q,
      -- ¬P, Q
      have pf_P_or_not_Q := pf_w.right.right.left,
      cases pf_P_or_not_Q with pf_P pf_not_Q,
        contradiction, contradiction,
      -- ¬P, ¬Q
      have pf_P_or_Q := pf_w.left,
      cases pf_P_or_Q with pf_P pf_Q,
        contradiction, contradiction,
end

/-
8c. (P ∨ Q ∨ R) ∧ (¬P ∨ Q ∨ R) ∧
     (P ∨ ¬Q ∨ ¬R) ∧ (¬P ∨ ¬Q ∨ ¬R)
-/

-- answer:
example: ∃(P Q R: Prop),
  (P ∨ Q ∨ R) ∧ (¬P ∨ Q ∨ R) ∧
    (P ∨ ¬Q ∨ ¬R) ∧ (¬P ∨ ¬Q ∨ ¬R) :=
begin
  apply exists.intro true,
  apply exists.intro true,
  apply exists.intro false,
  split,
    -- P ∨ Q ∨ R
    exact or.inl true.intro,
    split,
      -- ¬P ∨ Q ∨ R
      exact or.inr (or.inl true.intro),
      split,
        -- P ∨ ¬Q ∨ ¬R
        exact or.inl true.intro,
        -- ¬P ∨ ¬Q ∨ ¬R
        exact or.inr (or.inr false.elim),
end

/-
9. Prove that exists a number such that
it is both even and a multiple of 3.
Use the supplied definitions of even and prime.
-/

def isEven(n: ℕ) := (∃(m: ℕ), m * 2 = n)

def isMult3(n: ℕ) := (∃(m: ℕ), m * 3 = n)

-- answer
example:
  ∃(n: ℕ), isEven n ∧ isMult3 n :=
begin
  have isEven6: isEven 6 := ⟨3, rfl⟩,   -- exists.intro
  have isPrime6: isMult3 6 := ⟨2, rfl⟩, -- exists.intro
  have both := and.intro isEven6 isPrime6,
  exact ⟨6, both⟩,                      -- exists.intro
end

/-
10a. Write the lemma that if there exists
 someone that you can fool all of the time,
 then there always exists someone you can fool.
 Use the supplied axioms, and make sure you use
 at least as many parentheses as needed. (It's
 okay to use more than you need.)
10b. Prove the above lemma.

Note that this problem really requires that
you be able not only to prove but to write
propositions involving several quantifiers,
translating from English into the correct
logical formalism.
-/

axioms Person Time: Type
axiom fool: Person → Time → Prop

-- answers:
example:
  (∃(p: Person), ∀ (t: Time), fool p t) →
  (∀(t: Time), ∃(p: Person), fool p t) :=
begin
  assume pfIdiotExists,
  assume t,
  apply exists.elim pfIdiotExists,
  assume witness pf_witness,
  have pfCurIdiot := pf_witness t,
  exact ⟨witness, pfCurIdiot⟩,
end


import tactic

-- Let `Ω` be a "big underlying set" and let `X` and `Y` and `Z` be subsets

variables (Ω : Type) (X Y Z : set Ω) (a b c x y z : Ω)

namespace xena

/-!

# subsets

Let's think about `X ⊆ Y`. Typeset `⊆` with `\sub` or `\ss`
-/

-- `X ⊆ Y` is the same as `∀ a, a ∈ X → a ∈ Y` , by definition.

lemma subset_def : X ⊆ Y ↔ ∀ a, a ∈ X → a ∈ Y :=
begin
  -- true by definition
  refl
end

lemma subset_refl : X ⊆ X :=
begin
  sorry,
end

lemma subset_trans (hXY : X ⊆ Y) (hYZ : Y ⊆ Z) : X ⊆ Z :=
begin
  -- If you start with `rw subset_def at *` then you
  -- will have things like `hYZ : ∀ (a : Ω), a ∈ Y → a ∈ Z`
  -- You need to think of `hYZ` as a function, which has two
  -- inputs: first a term `a` of type `Ω`, and second a proof `haY` that `a ∈ Y`.
  -- It then produces one output `haZ`, a proof that `a ∈ Z`.
  -- You can also think of it as an implication:
  -- "if a is in Ω, and if a ∈ Y, then a ∈ Z". Because it's an implication,
  -- you can `apply hYZ`. This is a really useful skill!
  sorry
end

/-!

# Equality of sets

Two sets are equal if and only if they have the same elements.
The name of this theorem is `set.ext_iff`.
-/

example : X = Y ↔ (∀ a, a ∈ X ↔ a ∈ Y) :=
begin
  exact set.ext_iff
end

-- In practice, you often have a goal `⊢ X = Y` and you want to reduce
-- it to `a ∈ X ↔ a ∈ Y` for an arbitary `a : Ω`. This can be done with
-- the `ext` tactic.

lemma subset.antisymm (hXY : X ⊆ Y) (hYX : Y ⊆ X) : X = Y :=
begin
  -- start with `ext a`,
  sorry
end

/-!

### Unions and intersections

Type `\cup` or `\un` for `∪`, and `\cap` or `\i` for `∩`

-/

lemma union_def : a ∈ X ∪ Y ↔ a ∈ X ∨ a ∈ Y :=
begin
  -- true by definition
  refl,
end

lemma inter_def : a ∈ X ∩ Y ↔ a ∈ X ∧ a ∈ Y :=
begin
  -- true by definition
  refl,
end

-- You can rewrite with those lemmas above if you're not comfortable with
-- assuming they're true by definition.

-- union lemmas

lemma union_self : X ∪ X = X :=
begin
  sorry
end

lemma subset_union_left : X ⊆ X ∪ Y :=
begin
  sorry
end

lemma subset_union_right : Y ⊆ X ∪ Y :=
begin
  sorry
end

lemma union_subset_iff : X ∪ Y ⊆ Z ↔ X ⊆ Z ∧ Y ⊆ Z :=
begin
  sorry
end

variable (W : set Ω)

lemma union_subset_union (hWX : W ⊆ X) (hYZ : Y ⊆ Z) : W ∪ Y ⊆ X ∪ Z :=
begin
  sorry
end

lemma union_subset_union_left (hXY : X ⊆ Y) : X ∪ Z ⊆ Y ∪ Z :=
begin
  sorry
end

-- etc etc

-- intersection lemmas

lemma inter_subset_left : X ∩ Y ⊆ X :=
begin
  sorry
end

-- don't forget `ext` to make progress with equalities of sets

lemma inter_self : X ∩ X = X :=
begin
  sorry
end

lemma inter_comm : X ∩ Y = Y ∩ X :=
begin
  sorry
end

lemma inter_assoc : X ∩ (Y ∩ Z) = (X ∩ Y) ∩ Z :=
begin
  sorry
end

/-!

### Forall and exists

-/

lemma not_exists_iff_forall_not : ¬ (∃ a, a ∈ X) ↔ ∀ b, ¬ (b ∈ X) :=
begin
  sorry,
end

example : ¬ (∀ a, a ∈ X) ↔ ∃ b, ¬ (b ∈ X) :=
begin
  sorry,
end

end xena