import ..library.src_ordered_field

namespace mth1001

namespace myreal

section ordered

variables {R : Type} [myordered_field R]

open_locale classical

open myordered_field

/-
The three basic axiom of an orderd field are:

1. `trichotomy`,
2. `pos_add_of_pos_of_pos`, and
3. `pos_mul_of_pos_of_pos`,

as exemplified below
-/

example (x : R) : pos x ∧ ¬x = 0 ∧ ¬pos (-x)
               ∨ ¬pos x ∧ x = 0  ∧ ¬pos (-x)
               ∨ ¬pos x ∧ x ≠ 0 ∧ pos (-x) := trichotomy x

example (x y : R) : pos x → pos y → pos (x + y) := pos_add_of_pos_of_pos x y

example (x y : R) : pos x → pos y → pos (x * y) := pos_mul_of_pos_of_pos x y

-- In the example below, we see that the square of non-zero positive number is positive.
example (x : R) (h : x ≠ (0 : R)) : pos (pow1 x 2) :=
begin
  unfold pow1, -- Use the definition of exponentiation.
  rcases trichotomy x with ⟨hpx, _, _⟩ | ⟨_, rfl, _⟩ | ⟨_, _, hpnx⟩,
  { rw one_mul, exact pos_mul_of_pos_of_pos _ _ hpx hpx, },
  { rw mul_zero, contradiction, },
  { rw [one_mul, ←neg_mul_neg_self],
    exact pos_mul_of_pos_of_pos _ _ hpnx hpnx,},
end

-- Exercise 177:
-- Use trichotomy on `(1 : R)`, as in the example above.
lemma pos_one : pos (1 : R) :=
begin
  sorry
end

-- Below, we see that every non-zero natural number (seen as a term of type `R`) is positive.
lemma pos_nat (n : ℕ) : n ≠ 0 → pos (n : R) :=
begin
  induction n with k hk,
  { intro _, contradiction, },
  { intro _,
    rw coe_nat_succ,
    by_cases h₁ : k = 0,
    { rw h₁,
      change pos((0 : R) + (1 : R)),
      rw zero_add,
      exact pos_one, },
    { exact pos_add_of_pos_of_pos _ _ (hk h₁) pos_one }, },
end

-- The lemmas below are used to work with the definition of `<`.

lemma lt_iff_pos_sub (x y : R) : x < y ↔ pos (y -x) := by refl

lemma lt_iff_pos_neg (x y : R) : x < y ↔ pos (y + -x) := by refl

-- Exercise 178:
lemma gt_zero_mul_of_gt_zero_of_gt_zero {a b : R} (h₁ : 0 < a) (h₂ : 0 < b) : 0 < a * b :=
begin
  sorry
end

-- Exercise 179:
lemma neg_pos {x : R} : 0 < -x ↔ x < 0:=
begin
  repeat {rw lt_iff_pos_neg},
  sorry  end

-- Exercise 180:
lemma trichotomy' (x y: R) : x < y ∧ ¬x = y ∧ ¬y < x ∨
                               ¬x < y ∧ x = y ∧ ¬y < x ∨
                               ¬x < y ∧ ¬x = y ∧ y < x :=
begin
  repeat {rw lt_iff_pos_sub},
  have : x - y = -(y - x),
  { sorry, },
  sorry
end

-- Exercise 181:
lemma lt_trans {x y z : R} : x < y → y < z → x < z :=
begin
  repeat {rw lt_iff_pos_sub},
  sorry
end

-- Exercise 182:
lemma add_lt_add_iff_right_mpr {x y : R} (z : R) : x < y → x + z < y + z :=
begin
  sorry
end

-- Exercise 183:
lemma add_lt_add_iff_right_mp {x y : R} (z : R) : x + z < y + z → x < y :=
begin
  sorry
end

-- Exercise 184:
lemma add_lt_add_iff_right {x y : R} (z : R) : x + z < y + z ↔ x < y :=
begin
  sorry
end

-- Exercise 185:
theorem neg_lt_neg_iff  {a b : R} : -a < -b ↔ b < a :=
begin
  sorry
end

-- Exercise 186:
lemma mul_lt_mul_left_mpr {x y z : R} : 0 < z → x < y → z * x < z * y :=
begin
  sorry
end

-- Exercise 187:
theorem add_lt_add {a b c d : R} : a < b → c < d → a + c < b + d :=
begin
  sorry
end

-- Exercise 188:
lemma lt_irrefl {x : R} : ¬x < x :=
begin
  sorry
end

-- Exercise 189:
-- Use `lt_irrefl` to prove the following.
theorem ne_of_gt {a b : R} (h : a > b) : a ≠ b :=
begin
  sorry  end

-- The following lemma is used to work with the definition of `≤`.

lemma le_iff_lt_or_eq {x y : R} : x ≤ y ↔ ((x < y) ∨ x = y) := by refl

-- Exercise 190:
lemma le_refl (x : R) : x ≤ x :=
sorry

-- Exercise 191:
-- Though it looks complicated, you can fill in the `sorry` below using only the
-- `split`, `intro`, and `exact` tactics (with and introduction and hypotheses).
lemma not_le_iff_lt (x y : R) : ¬(x ≤ y) ↔ (y < x) :=
begin
  rw le_iff_lt_or_eq,
  push_neg,
  rcases trichotomy' x y with ⟨hxlty, _, _⟩ | ⟨_, hxy, hnyltx ⟩  | ⟨hnxlty, hnxy, hxlty ⟩ ,
  { split,
    { rintro ⟨hnxy, _⟩,
      contradiction, },
    { intros hyltx, exfalso,
      exact lt_irrefl (lt_trans hxlty hyltx), }, },
  { split,
    { rintro ⟨_, hnxy⟩,
      contradiction, },
    { intro hyltx, contradiction, }, },
  { sorry, },
end

-- Exercise 192:
-- Use `neg_le_iff_lt` to prove the result below.
lemma not_lt_iff_le (x y : R) : ¬(x < y) ↔ (y ≤ x) :=
sorry

-- Exercise 193:
lemma neg_nonneg {x : R} : 0 ≤ -x ↔ x ≤ 0 :=
begin
  repeat {rw le_iff_lt_or_eq},
  have k : 0 < -x ↔ x < 0, from neg_pos,
  sorry
end

-- Exercise 194:
lemma le_trans (x y z : R) : x ≤ y → y ≤ z → x ≤ z :=
begin
  rintro (h₁ | rfl) (h₂ | rfl),
  { sorry, },
  { sorry, },
  { sorry, },
  { sorry, },
end

-- Exercise 195:
lemma lt_of_le_of_lt {a b c : R} (h₁ : a ≤ b) (h₂ : b < c) : a < c :=
begin
  sorry
end

-- Exercise 196:
-- Use `rcases trichotomy' x y` (see examples above) to prove the following.
lemma le_total (x y : R) : x ≤ y ∨ y ≤ x :=
begin
  sorry
end

-- Exercise 197:
lemma anti_symm {x y : R} : x ≤ y → y ≤ x → x = y :=
begin
  sorry
end

-- Exercise 198:
theorem neg_le_neg_iff {a b : R} : -a ≤ -b ↔ b ≤ a :=
begin
  repeat {rw le_iff_lt_or_eq},
  split,
  { rintro (hlt | heq),
    { left, rwa ←neg_lt_neg_iff, },
    { right, rw [←neg_neg a, heq, neg_neg], }, },
  { sorry, },
end

-- Exercise 199:
theorem add_le_add {a b c d : R} : a ≤ b → c ≤ d → a + c ≤ b + d :=
begin
  sorry
end

-- Exercise 200:
theorem mul_self_non_neg (a : R) : 0 ≤ a * a:=
begin
  rcases trichotomy' 0 a with ⟨posa, _⟩ | ⟨_, eq0, _⟩ | ⟨_, _, nega⟩,
  { sorry, },
  { sorry, },
  { sorry, },
end

-- Exercise 201:
lemma non_neg_mul_of_non_neg_of_non_neg {a b : R} (h₁ : 0 ≤ a) (h₂ : 0 ≤ b) : 0 ≤ a * b :=
begin
  cases h₁ with apos aeq0,
  { cases h₂ with bpos beq0,
    { sorry, },
    { right, rw [←beq0, mul_zero], }, },
  { sorry, },
end

-- Exercise 202:
lemma non_neg_of_non_neg_mul_of_pos {x y : R} (h₁ : 0 ≤ x * y) (h₂ : 0 < x) : 0 ≤ y :=
begin
  sorry
end

lemma non_neg_mul_iff_non_neg_and_non_neg_or_non_pos_and_non_pos (a b : R)
  : 0 ≤ a * b ↔ (0 ≤ a ∧ 0 ≤ b) ∨ (a ≤ 0 ∧ b ≤ 0) :=
begin
  split,
  { intro h₁,
    by_cases h₂ : 0 ≤ a,
    { by_cases h₃ : a = 0,
      { rw h₃,
        exact or.elim (le_total b 0) (λ h₄, or.inr ⟨le_refl 0, h₄⟩) (λ h₄, or.inl ⟨le_refl 0, h₄⟩), },
      { have h₄ : 0 < a, from or.elim h₂ id (λ aeq0, absurd aeq0.symm h₃),
        have h₅ : 0 ≤ b, from non_neg_of_non_neg_mul_of_pos h₁ h₄,
        exact or.inl ⟨or.inl h₄, h₅⟩, }, },
    { rw not_le_iff_lt at h₂,
      right,
      have k : b ≤ 0,
      { by_contra h₃,
        rw not_le_iff_lt at h₃,
        rw ←neg_pos at h₂,
        have h₄ : 0 < b * -a, from gt_zero_mul_of_gt_zero_of_gt_zero h₃ h₂,
        rw [←neg_mul_eq_mul_neg, mul_comm, neg_pos] at h₄,
        exact lt_irrefl (lt_of_le_of_lt h₁ h₄), },
      exact ⟨or.inl h₂, k⟩, }, },
  { rintro (⟨h₁, h₂⟩ | ⟨h₁, h₂⟩),
    { exact non_neg_mul_of_non_neg_of_non_neg h₁ h₂, },
    { rw ←neg_mul_neg a b,
      rw ←neg_nonneg at h₁ h₂,
      exact non_neg_mul_of_non_neg_of_non_neg h₁ h₂, }, },
end

-- Exercise 203:
-- Modify the proof of the second case to prove the first case.
theorem inv_pos {a : R}  (h : a ≠ 0) : 0 < a⁻¹ ↔ 0 < a :=
begin
  split,
  { sorry, },
  { intro k,
    have h₂ : 0 ≤ (a⁻¹ * a⁻¹), from mul_self_non_neg a⁻¹,
    rw le_iff_lt_or_eq at h₂,
    cases h₂ with posainvsq eq0,
    { convert mul_lt_mul_left_mpr k posainvsq,
      { rw mul_zero, },
      { rw [←mul_assoc, mul_inv a h, one_mul], }, },
    { have h₃ : a⁻¹ = 0,
      { cases eq_zero_or_eq_zero_of_mul_eq_zero _ _ eq0.symm;
        assumption, },
      exact absurd h₃ (inv_ne_zero h), }, },
end

-- Exercise 204:
theorem inv_lt_inv {a b : R} (h₁ : 0  < a) (h₂ : 0 < b) : a⁻¹ < b⁻¹ ↔ b < a :=
begin
  split,
  { sorry, },
  { intro h₃,
    have h₅ : a ≠ 0, from ne_of_gt h₁,
    have k₁ : a⁻¹ > 0, from (inv_pos h₅).mpr h₁,
    have h₄ : a⁻¹ * b < a⁻¹ * a, from mul_lt_mul_left_mpr k₁ h₃,
    rw inv_mul a h₅ at h₄,
    have h₇ : b ≠ 0, from ne_of_gt h₂,
    have k₂ : b⁻¹ > 0, from (inv_pos h₇).mpr h₂,
    have h₆ :  b⁻¹ * (a⁻¹ * b) < b⁻¹ * 1, from mul_lt_mul_left_mpr k₂ h₄,
    rw [mul_comm, mul_assoc, mul_inv b h₇, mul_one, mul_one] at h₆,
    exact h₆, },
end

end ordered

section max_abs

variables {R : Type} [myordered_field R]

open_locale classical

open myordered_field

/-
The absolute value `abs a` of `a : R` is defined to be by maximum of
`a` and `-a`.
-/

example (a : R) : abs a = max a (-a) := rfl

/-
By definition, `max a b` is `a` if `b ≤ a`, otherwise it is `b`.

Note the use of `if_pos` and `if_neg` below to distiguish between the cases where
`b ≤ a` and `¬(b ≤ a)` in the definition of `max`.
-/

lemma le_max_left (a b : R) : a ≤ max a b :=
begin
  unfold max,
  by_cases h : b ≤ a,
  { rw (if_pos h),
    exact le_refl a, },
  { rw (if_neg h),
    rw not_le_iff_lt at h,
    left, exact h, },
end

-- Exercise 205:
lemma le_max_right (a b : R) : b ≤ max a b :=
begin
  unfold max,
  by_cases h : b ≤ a,
  { rw (if_pos h),
    sorry, },
  { rw (if_neg h),
    sorry, },
end

-- Exercise 206:
-- Prove this using the template of the above two results.
lemma max_choice (a b : R) : max a b = a ∨ max a b = b :=
begin
  sorry
end

lemma neg_le_abs (a : R) : -a ≤ abs a :=
begin
  unfold abs max,
  by_cases h : -a ≤ a,
  { rw (if_pos h), exact h, },
  { rw (if_neg h), exact le_refl (-a), },
end

-- Exercise 207:
lemma le_abs_self (a : R) : a ≤ abs a :=
begin
  sorry
end

-- Exercise 208:
theorem triangle_inequality (x y : R) : abs (x + y) ≤ abs x + abs y :=
begin
  by_cases h : -(x+y) ≤ x+y,
  { have : abs (x+y) = x + y,
    { unfold abs max,
      rw (if_pos h), },
    rw this,
    have h₁ : x ≤ abs x, from le_abs_self x,
    have h₂ : y ≤ abs y, from le_abs_self y,
    exact add_le_add h₁ h₂, },
  { sorry, },
end

end max_abs

section upper_bounds_lower_bounds_sup

open myordered_field

variables {R : Type} [myordered_field R]

/-
Here are archetypal applications of the definitions of `upper_bound`, `lower_bound`,
`bounded_above`, `bounded_below`, `bounded`, and `is_sup`.
-/

example (u : R) (S : set R) (h : ∀ s ∈ S, s ≤ u) : upper_bound u S := h
example (v : R) (S : set R) (h : ∀ s ∈ S, v ≤ s) : lower_bound v S := h
example (S : set R) (h : ∃ u : R, upper_bound u S) : bounded_above S := h
example (S : set R) (h : ∃ v : R, lower_bound v S) : bounded_below S := h
example (S : set R) (h₁ : bounded_above S) (h₂ : bounded_below S) : bounded S := and.intro h₁ h₂
example (u : R) (S : set R) (h₁ : upper_bound u S) (h₂ : ∀ v : R, upper_bound v S → u ≤ v)
: is_sup u S := and.intro h₁ h₂

-- Exercise 209:
theorem sup_uniqueness (S : set R) (a b : R) (h₁ : is_sup a S) (h₂ : is_sup b S) : a = b :=
begin
  cases h₁ with h₃ h₄,
  cases h₂ with h₅ h₆,
  apply anti_symm,
  { sorry, },
  { sorry, },
end

-- Exercise 210:
-- In this example, we show _every_ real number `u` is an upper bound of the empty set.
theorem empty_set_upper_bound (u : R) : upper_bound u ∅ :=
begin
  sorry
end

-- Exercise 211:
theorem empty_set_lower_bound (v : R) : lower_bound v ∅ :=
begin
  sorry
end

-- Exercise 212:
-- Given `S` a set of real numbers, given `s ∈ S`, given `u` and `v` are upper and lower bounds
-- of `S`, respectively, then `v ≤ u`.
example (S : set R) (u v : R) (h₁ : upper_bound u S) (h₂ : lower_bound v S) (s : R) (h₃ : s ∈ S)
  : v ≤ u :=
begin
  sorry
end

-- Exercise 213:
-- However, it's *not true* that for every set `S` of real numbers, for all real numbers `u` and `v`,
-- if `u` and `v` are upper and lower bounds of `S`, respectively, then `v ≤ u`.
-- Hint: start with `push_neg` and think of the results above.
example : ¬(∀ (S : set R), ∀ u v : R, upper_bound u S → lower_bound v S → v ≤ u) :=
begin
  sorry
end

end upper_bounds_lower_bounds_sup

end myreal

end mth1001


-- Exercises
-- #2

open classical

variables p q r s : Prop

example : (p → r ∨ s) → ((p → r) ∨ (p → s)) :=
assume h : p → r ∨ s,
show (p → r) ∨ (p → s),
from or.elim (em p)
  (assume hp : p,
    have hrs : r ∨ s := h hp,
    or.elim hrs
    (assume hr : r, or.inl (λ hp' : p, hr))
    (assume hs : s, or.inr (λ hp' : p, hs))
  )
  (assume hnp : ¬p,
    or.inl (assume hp : p, show r, from absurd hp hnp)
  )

example : ¬(p ∧ q) → ¬p ∨ ¬q :=
  assume h : ¬(p ∧ q),
  show ¬p ∨ ¬q,
  from or.elim (em p)
  (assume hp : p,
    have hnq : ¬q,
    from (assume hq : q, h ⟨hp, hq⟩),
    or.inr hnq
  )
  (assume hnp : ¬p, or.inl hnp)

-- I need lemma1 and dne to prove the next example
-- This seems too complicated.
-- Is there a shorter proof of ¬(p → q) → p ∧ ¬q?
lemma lemma1 {p q : Prop} (h : ¬q → ¬p) : p → q :=
  show p → q,
  from assume hp : p,
    or.elim (em q)
      (assume hq : q, hq)
      (assume hnq : ¬q, absurd hp (h hnq))

theorem dne {p : Prop} (h : ¬¬p) : p :=
or.elim (em p)
  (assume hp : p, hp)
  (assume hnp : ¬p, absurd hnp h)

example : ¬(p → q) → p ∧ ¬q :=
assume h : ¬(p → q),
have hnq : ¬q := (λ hq : q, h (λ hp : p, hq)),
suffices hp : p, from ⟨hp, hnq⟩,
show p,
from have hdnp : ¬¬p :=
  (assume hnp: ¬p,
    have hnqnp : ¬q → ¬p := (λ hnq' : ¬q, hnp),
    have hpq : p → q := lemma1 hnqnp,
    show false, from (h hpq)
  ),
  dne hdnp

example : (p → q) → (¬p ∨ q) :=
assume h : p → q,
or.elim (em p)
(assume hp : p, or.inr (h hp))
(assume hnp : ¬p, or.inl hnp)

example : (¬q → ¬p) → (p → q) :=
assume h : ¬q → ¬p, lemma1 h

example : p ∨ ¬p := em p

example : (((p → q) → p) → p) :=
assume h : (p → q) → p,
or.elim (em q)
(assume hq : q, h (assume hp : p, hq))
(assume hnq : ¬q,
  dne (assume hnp: ¬p,
    have hnqnp : ¬q → ¬p := (λ hnq', hnp),
    have hpq : p → q := lemma1 hnqnp,
    show false,
    from hnp (h hpq)
  )
)


import data.set.basic
/-
Tactics you may consider
-intro(s)
-apply
-exact
-/

variables {α : Type*} (r s t : set α)

example : s ⊆ s :=
by { intros x xs, exact xs }

theorem subset.refl : s ⊆ s := λ x xs, xs

example : r ⊆ s → s ⊆ t → r ⊆ t :=
begin
  intros rs st x xr,
  apply st,
  apply rs,
  exact xr,
end

theorem subset.trans : r ⊆ s → s ⊆ t → r ⊆ t :=
begin
  intros rs st x xr,
  exact st (rs xr),
end


universe u
variables (α : Type u) (a b c d : α)
variables (hab : a = b) (hcb : c = b) (hcd : c = d)

example : a = d := (hab.trans hcb.symm).trans hcd


/-
Warmup: Function composition.
-/

/-
If we know that P implies Q and that Q
implies R, we can conclude that P → R.
The name, "hypothetical syllogism", or
"chain rule" is given to this reasoning
principle.

Here's an example.

Suppose P → Q express the idea that "if
it's raining then the streets are wet,
and Q → R, "if the streets are wet then
it takes longer to stop." We can deduce
"if it's raining then it takes longer
to stop.

This rule is sometimes called the chain
rule. It also shows that implication is
transitive. We can write it explicitly
as an inference rule:

{ P Q : Prop } (pq : P → Q) (qr : Q → R)
---------------------------------------- chain
              pr : (P → R)

We can also verify that it's a valid
rule by proving it. The proof will be
a function that takes P, Q, R, pq, and
qr as arguments and that derives a proof,
pr, of P → Q, the latter also a function
that assumes a proof of P and derives a
proof of R.
-/

def chain : ∀ { P Q R : Prop }, (P → Q) → (Q → R) → (P → R) :=
        /-
        To prove this proposition, we ...
        -/

        /-
        assume P, Q, and R are propositions...
        -/
        (λ P : Prop,
        (λ Q : Prop,
        (λ R : Prop,

        /-
        and assume we're given proofs of P → Q and Q → P
        -/
        (λ pq : P → Q,
        (λ qr : Q → R,

        /-
        Now we show P → R by ...
        first assuming a proof of P ...
        -/
        (λ p : P,

        /-
        then deriving a proof of R.
        -/
        qr (pq p)

        ) ) ) ) ) )

/-
Now we explain how we can simplify this
expression by letting Lean infer types
and figure out grouping of expressions
on its own, without the parentheses.
-/

/-
We can leave out the explicit types and let
Lean infer them from context.
-/

def chain' : ∀ { P Q R : Prop }, (P → Q) → (Q → R) → (P → R) :=
        (λ P, (λ Q, (λ R, (λ pq,(λ qr, (λ p, qr (pq p) ) ) ) ) ) )

/-
We also don't need the parenthesis, as the
lambda expressions associate to the right in
any case.
-/
def chain'' : ∀ { P Q R : Prop }, (P → Q) → (Q → R) → (P → R) :=
        λ P, λ Q, λ R, λ pq, λ qr, λ p, qr (pq p)

/- Finally, Lean lets us use a single λ followed
by names for multiple arguments, giving us the
simplest statement of this theorem.
-/

def chain''' : ∀ { P Q R : Prop }, (P → Q) → (Q → R) → (P → R) :=
        λ P Q R pq qr p, qr (pq p)

/-
To make the logic a little clearer, we could
insert a lambda as follows. This might help
the reader by making it clearer that in the
context of P, Q, R, pq, and pr, we can derive
of a proof of P → R in the form of a function
that takes a proof, p : P and derives a proof
of R.
-/
def chain'''' : ∀ { P Q R : Prop }, (P → Q) → (Q → R) → (P → R) :=
        λ P Q R pq qr,
                λ  p, qr (pq p)

/-
We could also write the proof as a tactic script.
-/

def chain_tactic : ∀ { P Q R : Prop }, (P → Q) → (Q → R) → (P → R) :=
begin
        assume P Q R: Prop,
        assume pq : P → Q,
        assume qr : Q → R,
        show P → R,
        from
                begin
                assume p : P,
                show R,
                from qr (pq p)
                end
end

/-
We can leave out the explicit types and run
all the assume lines together here, as well,
yielding this more concise, albeit perhaps
less immediately understandable, script.
-/
def chain_tactic' : ∀ { P Q R : Prop }, (P → Q) → (Q → R) → (P → R) :=
begin
        assume P Q R pq qr,
        show P → R,
        from
        begin
                assume p,
                show R,
                from qr (pq p)
        end
end

/-
Finally, you can write the same theorem in
the form of an ordinary function definition,
in which case assumptions are represented as
arguments, the return type is made explicit,
and the body of the function is just as it
is in all the preceding examples. The return
type could be left implicit, but that would
make the code harder to understand, as it'd
force the reader to figure out the type of
the expression, qr (pq p).
-/

def chain_prog (P Q R : Prop) (pq: (P → Q)) (qr: Q → R) (p : P): R :=
        qr (pq p)

/-
-/

variables P Q R : Prop
variable pq : P → Q
variable qr : P → R

theorem pr : P → R :=
begin
apply chain Q,
end

def compose { P Q R : Prop } (pq : P ↔ Q) (qr: Q ↔ R)
        : P ↔ R :=
        iff.intro
                (compose (qr.left) (pq.left) )
                (compose (qr.right) (qr.left) )

/-
def iff_compose (P Q R: Prop) (pq: P ↔ Q) (qr: Q ↔ R) : P ↔ R :=
        iff.intro
                (compose )
                _
-/

/-
EXERCISE:

Prove that ↔ is transitive. That is, if you
assume P, Q and R are arbitrary propositions,
and that you have proof of P ↔ Q and of Q ↔ R,
then you can derive a proof of P ↔ R.
-/

/-
Prove ∀ P : Prop, P ↔ (P → P)
-/

theorem foo: ∀ P : Prop, P ↔ (P → P),
        assume (P : Prop) (pfbi: P ↔ (P → P)),
        have forward := pfbi.left,
        have backward := pfbi.right,


-- Diferencia_de_diferencia_de_conjuntos.lean
-- Diferencia de diferencia de conjuntos
-- José A. Alonso Jiménez <https://jaalonso.github.io>
-- Sevilla, 23-abril-2022
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que
--    (s \ t) \ u ⊆ s \ (t ∪ u)
-- ----------------------------------------------------------------------

import data.set.basic
open set

variable {α : Type}
variables s t u : set α

-- 1ª demostración
-- ===============

example : (s \ t) \ u ⊆ s \ (t ∪ u) :=
begin
  intros x hx,
  cases hx with hxst hxnu,
  cases hxst with hxs hxnt,
  split,
  { exact hxs },
  { dsimp,
    by_contradiction hxtu,
    cases hxtu with hxt hxu,
    { apply hxnt,
      exact hxt, },
    { apply hxnu,
      exact hxu, }},
end

-- 2ª demostración
-- ===============

example : (s \ t) \ u ⊆ s \ (t ∪ u) :=
begin
  rintros x ⟨⟨hxs, hxnt⟩, hxnu⟩,
  split,
  { exact hxs },
  { by_contradiction hxtu,
    cases hxtu with hxt hxu,
    { exact hxnt hxt, },
    { exact hxnu hxu, }},
end

-- 3ª demostración
-- ===============

example : (s \ t) \ u ⊆ s \ (t ∪ u) :=
begin
  rintros x ⟨⟨xs, xnt⟩, xnu⟩,
  use xs,
  rintros (xt | xu),
  { contradiction, },
  { contradiction, },
end

-- 4ª demostración
-- ===============

example : (s \ t) \ u ⊆ s \ (t ∪ u) :=
begin
  rintros x ⟨⟨xs, xnt⟩, xnu⟩,
  use xs,
  rintros (xt | xu); contradiction,
end

-- 5ª demostración
-- ===============

example : (s \ t) \ u ⊆ s \ (t ∪ u) :=
begin
  intros x xstu,
  simp at *,
  finish,
end

-- 6ª demostración
-- ===============

example : (s \ t) \ u ⊆ s \ (t ∪ u) :=
begin
  intros x xstu,
  finish,
end

-- 7ª demostración
-- ===============

example : (s \ t) \ u ⊆ s \ (t ∪ u) :=
by rw diff_diff

-- 8ª demostración
-- ===============

example : (s \ t) \ u ⊆ s \ (t ∪ u) :=
by tidy


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import algebra.group_with_zero.power
import data.list.prod_monoid
import data.multiset.basic

/-!
# Sums and products over multisets

In this file we define products and sums indexed by multisets. This is later used to define products
and sums indexed by finite sets.

## Main declarations

* `multiset.prod`: `s.prod f` is the product of `f i` over all `i ∈ s`. Not to be mistaken with
  the cartesian product `multiset.product`.
* `multiset.sum`: `s.sum f` is the sum of `f i` over all `i ∈ s`.
-/

variables {ι α β γ : Type*}

namespace multiset
section comm_monoid
variables [comm_monoid α] {s t : multiset α} {a : α} {m : multiset ι} {f g : ι → α}

/-- Product of a multiset given a commutative monoid structure on `α`.
  `prod {a, b, c} = a * b * c` -/
@[to_additive "Sum of a multiset given a commutative additive monoid structure on `α`.
  `sum {a, b, c} = a + b + c`"]
def prod : multiset α → α := foldr (*) (λ x y z, by simp [mul_left_comm]) 1

@[to_additive]
lemma prod_eq_foldr (s : multiset α) :  prod s = foldr (*) (λ x y z, by simp [mul_left_comm]) 1 s :=
rfl

@[to_additive]
lemma prod_eq_foldl (s : multiset α) : prod s = foldl (*) (λ x y z, by simp [mul_right_comm]) 1 s :=
(foldr_swap _ _ _ _).trans (by simp [mul_comm])

@[simp, norm_cast, to_additive] lemma coe_prod (l : list α) : prod ↑l = l.prod := prod_eq_foldl _

@[simp, to_additive]
lemma prod_to_list (s : multiset α) : s.to_list.prod = s.prod :=
begin
  conv_rhs { rw ←coe_to_list s },
  rw coe_prod,
end

@[simp, to_additive] lemma prod_zero : @prod α _ 0 = 1 := rfl

@[simp, to_additive]
lemma prod_cons (a : α) (s) : prod (a ::ₘ s) = a * prod s := foldr_cons _ _ _ _ _

@[simp, to_additive]
lemma prod_singleton (a : α) : prod {a} = a :=
by simp only [mul_one, prod_cons, singleton_eq_cons, eq_self_iff_true, prod_zero]

@[simp, to_additive]
lemma prod_add (s t : multiset α) : prod (s + t) = prod s * prod t :=
quotient.induction_on₂ s t $ λ l₁ l₂, by simp

lemma prod_nsmul (m : multiset α) : ∀ (n : ℕ), (n • m).prod = m.prod ^ n
| 0       := by { rw [zero_nsmul, pow_zero], refl }
| (n + 1) :=
  by rw [add_nsmul, one_nsmul, pow_add, pow_one, prod_add, prod_nsmul n]

@[simp, to_additive] lemma prod_repeat (a : α) (n : ℕ) : (repeat a n).prod = a ^ n :=
by simp [repeat, list.prod_repeat]

@[to_additive nsmul_count]
lemma pow_count [decidable_eq α] (a : α) : a ^ s.count a = (s.filter (eq a)).prod :=
by rw [filter_eq, prod_repeat]

@[to_additive]
lemma prod_hom [comm_monoid β] (s : multiset α) (f : α →* β) : (s.map f).prod = f s.prod :=
quotient.induction_on s $ λ l, by simp only [l.prod_hom f, quot_mk_to_coe, coe_map, coe_prod]

@[to_additive]
lemma prod_hom' [comm_monoid β] (s : multiset ι) (f : α →* β) (g : ι → α) :
  (s.map $ λ i, f $ g i).prod = f (s.map g).prod :=
by { convert (s.map g).prod_hom f, exact (map_map _ _ _).symm }

@[to_additive]
lemma prod_hom₂ [comm_monoid β] [comm_monoid γ] (s : multiset ι) (f : α → β → γ)
  (hf : ∀ a b c d, f (a * b) (c * d) = f a c * f b d) (hf' : f 1 1 = 1) (f₁ : ι → α) (f₂ : ι → β) :
  (s.map $ λ i, f (f₁ i) (f₂ i)).prod = f (s.map f₁).prod (s.map f₂).prod :=
quotient.induction_on s $ λ l,
  by simp only [l.prod_hom₂ f hf hf', quot_mk_to_coe, coe_map, coe_prod]

@[to_additive]
lemma prod_hom_rel [comm_monoid β] (s : multiset ι) {r : α → β → Prop} {f : ι → α} {g : ι → β}
  (h₁ : r 1 1) (h₂ : ∀ ⦃a b c⦄, r b c → r (f a * b) (g a * c)) :
  r (s.map f).prod (s.map g).prod :=
quotient.induction_on s $ λ l,
  by simp only [l.prod_hom_rel h₁ h₂, quot_mk_to_coe, coe_map, coe_prod]

@[to_additive]
lemma prod_map_one : prod (m.map (λ i, (1 : α))) = 1 := by rw [map_const, prod_repeat, one_pow]

@[simp, to_additive]
lemma prod_map_mul : (m.map $ λ i, f i * g i).prod = (m.map f).prod * (m.map g).prod :=
m.prod_hom₂ (*) mul_mul_mul_comm (mul_one _) _ _

@[to_additive sum_map_nsmul]
lemma prod_map_pow {n : ℕ} : (m.map $ λ i, f i ^ n).prod = (m.map f).prod ^ n :=
m.prod_hom' (pow_monoid_hom n) _

@[to_additive]
lemma prod_map_prod_map (m : multiset β) (n : multiset γ) {f : β → γ → α} :
  prod (m.map $ λ a, prod $ n.map $ λ b, f a b) = prod (n.map $ λ b, prod $ m.map $ λ a, f a b) :=
multiset.induction_on m (by simp) (λ a m ih, by simp [ih])

@[to_additive]
lemma prod_induction (p : α → Prop) (s : multiset α) (p_mul : ∀ a b, p a → p b → p (a * b))
  (p_one : p 1) (p_s : ∀ a ∈ s, p a) :
  p s.prod :=
begin
  rw prod_eq_foldr,
  exact foldr_induction (*) (λ x y z, by simp [mul_left_comm]) 1 p s p_mul p_one p_s,
end

@[to_additive]
lemma prod_induction_nonempty (p : α → Prop) (p_mul : ∀ a b, p a → p b → p (a * b))
  (hs : s ≠ ∅) (p_s : ∀ a ∈ s, p a) :
  p s.prod :=
begin
  revert s,
  refine multiset.induction _ _,
  { intro h,
    exfalso,
    simpa using h },
  intros a s hs hsa hpsa,
  rw prod_cons,
  by_cases hs_empty : s = ∅,
  { simp [hs_empty, hpsa a] },
  have hps : ∀ x, x ∈ s → p x, from λ x hxs, hpsa x (mem_cons_of_mem hxs),
  exact p_mul a s.prod (hpsa a (mem_cons_self a s)) (hs hs_empty hps),
end

lemma dvd_prod : a ∈ s → a ∣ s.prod :=
quotient.induction_on s (λ l a h, by simpa using list.dvd_prod h) a

lemma prod_dvd_prod_of_le (h : s ≤ t) : s.prod ∣ t.prod :=
begin
  obtain ⟨z, rfl⟩ := multiset.le_iff_exists_add.1 h,
  simp only [prod_add, dvd_mul_right],
end

end comm_monoid

lemma prod_dvd_prod_of_dvd [comm_monoid β] {S : multiset α} (g1 g2 : α → β)
  (h : ∀ a ∈ S, g1 a ∣ g2 a) :
  (multiset.map g1 S).prod ∣ (multiset.map g2 S).prod :=
begin
  apply multiset.induction_on' S, { simp },
  intros a T haS _ IH,
  simp [mul_dvd_mul (h a haS) IH]
end

section add_comm_monoid
variables [add_comm_monoid α]

/-- `multiset.sum`, the sum of the elements of a multiset, promoted to a morphism of
`add_comm_monoid`s. -/
def sum_add_monoid_hom : multiset α →+ α :=
{ to_fun := sum,
  map_zero' := sum_zero,
  map_add' := sum_add }

@[simp] lemma coe_sum_add_monoid_hom : (sum_add_monoid_hom : multiset α → α) = sum := rfl

end add_comm_monoid

section comm_monoid_with_zero
variables [comm_monoid_with_zero α]

lemma prod_eq_zero {s : multiset α} (h : (0 : α) ∈ s) : s.prod = 0 :=
begin
  rcases multiset.exists_cons_of_mem h with ⟨s', hs'⟩,
  simp [hs', multiset.prod_cons]
end

variables [no_zero_divisors α] [nontrivial α] {s : multiset α}

lemma prod_eq_zero_iff : s.prod = 0 ↔ (0 : α) ∈ s :=
quotient.induction_on s $ λ l, by { rw [quot_mk_to_coe, coe_prod], exact list.prod_eq_zero_iff }

lemma prod_ne_zero (h : (0 : α) ∉ s) : s.prod ≠ 0 := mt prod_eq_zero_iff.1 h

end comm_monoid_with_zero

section comm_group
variables [comm_group α] {m : multiset ι} {f g : ι → α}

@[simp, to_additive]
lemma prod_map_inv' : (m.map $ λ i, (f i)⁻¹).prod = (m.map f).prod ⁻¹ :=
by { convert (m.map f).prod_hom comm_group.inv_monoid_hom, rw map_map, refl }

@[simp, to_additive]
lemma prod_map_div : (m.map $ λ i, f i / g i).prod = (m.map f).prod / (m.map g).prod :=
m.prod_hom₂ (/) mul_div_comm' (div_one' _) _ _

@[to_additive]
lemma prod_map_zpow {n : ℤ} : (m.map $ λ i, f i ^ n).prod = (m.map f).prod ^ n :=
by { convert (m.map f).prod_hom (zpow_group_hom _), rw map_map, refl }

@[simp] lemma coe_inv_monoid_hom : (comm_group.inv_monoid_hom : α → α) = has_inv.inv := rfl

@[simp, to_additive]
lemma prod_map_inv (m : multiset α) : (m.map has_inv.inv).prod = m.prod⁻¹ :=
m.prod_hom comm_group.inv_monoid_hom

end comm_group

section comm_group_with_zero
variables [comm_group_with_zero α] {m : multiset ι} {f g : ι → α}

@[simp]
lemma prod_map_inv₀ : (m.map $ λ i, (f i)⁻¹).prod = (m.map f).prod ⁻¹ :=
by { convert (m.map f).prod_hom inv_monoid_with_zero_hom.to_monoid_hom, rw map_map, refl }

@[simp]
lemma prod_map_div₀ : (m.map $ λ i, f i / g i).prod = (m.map f).prod / (m.map g).prod :=
m.prod_hom₂ (/) (λ _ _ _ _, (div_mul_div _ _ _ _).symm) (div_one _) _ _

lemma prod_map_zpow₀ {n : ℤ} : prod (m.map $ λ i, f i ^ n) = (m.map f).prod ^ n :=
by { convert (m.map f).prod_hom (zpow_group_hom₀ _), rw map_map, refl }

end comm_group_with_zero

section semiring
variables [semiring α] {a : α} {s : multiset ι} {f : ι → α}

lemma sum_map_mul_left : sum (s.map (λ i, a * f i)) = a * sum (s.map f) :=
multiset.induction_on s (by simp) (λ i s ih, by simp [ih, mul_add])

lemma sum_map_mul_right : sum (s.map (λ i, f i * a)) = sum (s.map f) * a :=
multiset.induction_on s (by simp) (λ a s ih, by simp [ih, add_mul])

end semiring

section comm_semiring
variables [comm_semiring α]

lemma dvd_sum {a : α} {s : multiset α} : (∀ x ∈ s, a ∣ x) → a ∣ s.sum :=
multiset.induction_on s (λ _, dvd_zero _)
  (λ x s ih h, by { rw sum_cons, exact dvd_add
    (h _ (mem_cons_self _ _)) (ih $ λ y hy, h _ $ mem_cons.2 $ or.inr hy) })

end comm_semiring

/-! ### Order -/

section ordered_comm_monoid
variables [ordered_comm_monoid α] {s t : multiset α} {a : α}

@[to_additive sum_nonneg]
lemma one_le_prod_of_one_le : (∀ x ∈ s, (1 : α) ≤ x) → 1 ≤ s.prod :=
quotient.induction_on s $ λ l hl, by simpa using list.one_le_prod_of_one_le hl

@[to_additive]
lemma single_le_prod : (∀ x ∈ s, (1 : α) ≤ x) → ∀ x ∈ s, x ≤ s.prod :=
quotient.induction_on s $ λ l hl x hx, by simpa using list.single_le_prod hl x hx

@[to_additive]
lemma prod_le_of_forall_le (s : multiset α) (n : α) (h : ∀ x ∈ s, x ≤ n) : s.prod ≤ n ^ s.card :=
begin
  induction s using quotient.induction_on,
  simpa using list.prod_le_of_forall_le _ _ h,
end

@[to_additive all_zero_of_le_zero_le_of_sum_eq_zero]
lemma all_one_of_le_one_le_of_prod_eq_one :
  (∀ x ∈ s, (1 : α) ≤ x) → s.prod = 1 → ∀ x ∈ s, x = (1 : α) :=
begin
  apply quotient.induction_on s,
  simp only [quot_mk_to_coe, coe_prod, mem_coe],
  exact λ l, list.all_one_of_le_one_le_of_prod_eq_one,
end

@[to_additive]
lemma prod_le_prod_of_rel_le (h : s.rel (≤) t) : s.prod ≤ t.prod :=
begin
  induction h with _ _ _ _ rh _ rt,
  { refl },
  { rw [prod_cons, prod_cons],
    exact mul_le_mul' rh rt }
end

@[to_additive]
lemma prod_map_le_prod (f : α → α) (h : ∀ x, x ∈ s → f x ≤ x) : (s.map f).prod ≤ s.prod :=
prod_le_prod_of_rel_le $ rel_map_left.2 $ rel_refl_of_refl_on h

@[to_additive]
lemma prod_le_sum_prod (f : α → α) (h : ∀ x, x ∈ s → x ≤ f x) : s.prod ≤ (s.map f).prod :=
@prod_map_le_prod (order_dual α) _ _ f h

@[to_additive card_nsmul_le_sum]
lemma pow_card_le_prod (h : ∀ x ∈ s, a ≤ x) : a ^ s.card ≤ s.prod :=
by { rw [←multiset.prod_repeat, ←multiset.map_const], exact prod_map_le_prod _ h }

@[to_additive sum_le_card_nsmul]
lemma prod_le_pow_card (h : ∀ x ∈ s, x ≤ a) : s.prod ≤ a ^ s.card :=
@pow_card_le_prod (order_dual α) _ _ _ h

end ordered_comm_monoid

lemma prod_nonneg [ordered_comm_semiring α] {m : multiset α} (h : ∀ a ∈ m, (0 : α) ≤ a) :
  0 ≤ m.prod :=
begin
  revert h,
  refine m.induction_on _ _,
  { rintro -, rw prod_zero, exact zero_le_one },
  intros a s hs ih,
  rw prod_cons,
  exact mul_nonneg (ih _ $ mem_cons_self _ _) (hs $ λ a ha, ih _ $ mem_cons_of_mem ha),
end

@[to_additive]
lemma prod_eq_one_iff [canonically_ordered_monoid α] {m : multiset α} :
  m.prod = 1 ↔ ∀ x ∈ m, x = (1 : α) :=
quotient.induction_on m $ λ l, by simpa using list.prod_eq_one_iff l

@[to_additive]
lemma le_prod_of_mem [canonically_ordered_monoid α] {m : multiset α} {a : α} (h : a ∈ m) :
  a ≤ m.prod :=
begin
  obtain ⟨m', rfl⟩ := exists_cons_of_mem h,
  rw [prod_cons],
  exact _root_.le_mul_right (le_refl a),
end

@[to_additive le_sum_of_subadditive_on_pred]
lemma le_prod_of_submultiplicative_on_pred [comm_monoid α] [ordered_comm_monoid β]
  (f : α → β) (p : α → Prop) (h_one : f 1 = 1) (hp_one : p 1)
  (h_mul : ∀ a b, p a → p b → f (a * b) ≤ f a * f b)
  (hp_mul : ∀ a b, p a → p b → p (a * b)) (s : multiset α) (hps : ∀ a, a ∈ s → p a) :
  f s.prod ≤ (s.map f).prod :=
begin
  revert s,
  refine multiset.induction _ _,
  { simp [le_of_eq h_one] },
  intros a s hs hpsa,
  have hps : ∀ x, x ∈ s → p x, from λ x hx, hpsa x (mem_cons_of_mem hx),
  have hp_prod : p s.prod, from prod_induction p s hp_mul hp_one hps,
  rw [prod_cons, map_cons, prod_cons],
  exact (h_mul a s.prod (hpsa a (mem_cons_self a s)) hp_prod).trans (mul_le_mul_left' (hs hps) _),
end

@[to_additive le_sum_of_subadditive]
lemma le_prod_of_submultiplicative [comm_monoid α] [ordered_comm_monoid β]
  (f : α → β) (h_one : f 1 = 1) (h_mul : ∀ a b, f (a * b) ≤ f a * f b) (s : multiset α) :
  f s.prod ≤ (s.map f).prod :=
le_prod_of_submultiplicative_on_pred f (λ i, true) h_one trivial (λ x y _ _ , h_mul x y) (by simp)
  s (by simp)

@[to_additive le_sum_nonempty_of_subadditive_on_pred]
lemma le_prod_nonempty_of_submultiplicative_on_pred [comm_monoid α] [ordered_comm_monoid β]
  (f : α → β) (p : α → Prop) (h_mul : ∀ a b, p a → p b → f (a * b) ≤ f a * f b)
  (hp_mul : ∀ a b, p a → p b → p (a * b)) (s : multiset α) (hs_nonempty : s ≠ ∅)
  (hs : ∀ a, a ∈ s → p a) :
  f s.prod ≤ (s.map f).prod :=
begin
  revert s,
  refine multiset.induction _ _,
  { intro h,
    exfalso,
    exact h rfl },
  rintros a s hs hsa_nonempty hsa_prop,
  rw [prod_cons, map_cons, prod_cons],
  by_cases hs_empty : s = ∅,
  { simp [hs_empty] },
  have hsa_restrict : (∀ x, x ∈ s → p x), from λ x hx, hsa_prop x (mem_cons_of_mem hx),
  have hp_sup : p s.prod,
    from prod_induction_nonempty p hp_mul hs_empty hsa_restrict,
  have hp_a : p a, from hsa_prop a (mem_cons_self a s),
  exact (h_mul a _ hp_a hp_sup).trans (mul_le_mul_left' (hs hs_empty hsa_restrict) _),
end

@[to_additive le_sum_nonempty_of_subadditive]
lemma le_prod_nonempty_of_submultiplicative [comm_monoid α] [ordered_comm_monoid β]
  (f : α → β) (h_mul : ∀ a b, f (a * b) ≤ f a * f b) (s : multiset α) (hs_nonempty : s ≠ ∅) :
  f s.prod ≤ (s.map f).prod :=
le_prod_nonempty_of_submultiplicative_on_pred f (λ i, true) (by simp [h_mul]) (by simp) s
  hs_nonempty (by simp)

@[simp] lemma sum_map_singleton (s : multiset α) : (s.map (λ a, ({a} : multiset α))).sum = s :=
multiset.induction_on s (by simp) (by simp [singleton_eq_cons])

lemma abs_sum_le_sum_abs [linear_ordered_add_comm_group α] {s : multiset α} :
  abs s.sum ≤ (s.map abs).sum :=
le_sum_of_subadditive _ abs_zero abs_add s

end multiset

@[to_additive]
lemma monoid_hom.map_multiset_prod [comm_monoid α] [comm_monoid β] (f : α →* β) (s : multiset α) :
  f s.prod = (s.map f).prod :=
(s.prod_hom f).symm


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson, Jalex Stark.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.polynomial.monic
import Mathlib.tactic.linarith.default
import Mathlib.PostPort

universes u w

namespace Mathlib

/-!
# Polynomials

Lemmas for the interaction between polynomials and ∑ and ∏.

## Main results

- `nat_degree_prod_of_monic` : the degree of a product of monic polynomials is the product of
    degrees. We prove this only for [comm_semiring R],
    but it ought to be true for [semiring R] and list.prod.
- `nat_degree_prod` : for polynomials over an integral domain,
    the degree of the product is the sum of degrees
- `leading_coeff_prod` : for polynomials over an integral domain,
    the leading coefficient is the product of leading coefficients
- `prod_X_sub_C_coeff_card_pred` carries most of the content for computing
    the second coefficient of the characteristic polynomial.
-/

namespace polynomial

theorem nat_degree_prod_le {R : Type u} {ι : Type w} (s : finset ι) [comm_semiring R] (f : ι → polynomial R) : nat_degree (finset.prod s fun (i : ι) => f i) ≤ finset.sum s fun (i : ι) => nat_degree (f i) := sorry

/--
The leading coefficient of a product of polynomials is equal to
the product of the leading coefficients, provided that this product is nonzero.

See `leading_coeff_prod` (without the `'`) for a version for integral domains,
where this condition is automatically satisfied.
-/
theorem leading_coeff_prod' {R : Type u} {ι : Type w} (s : finset ι) [comm_semiring R] (f : ι → polynomial R) (h : (finset.prod s fun (i : ι) => leading_coeff (f i)) ≠ 0) : leading_coeff (finset.prod s fun (i : ι) => f i) = finset.prod s fun (i : ι) => leading_coeff (f i) := sorry

/--
The degree of a product of polynomials is equal to
the product of the degrees, provided that the product of leading coefficients is nonzero.

See `nat_degree_prod` (without the `'`) for a version for integral domains,
where this condition is automatically satisfied.
-/
theorem nat_degree_prod' {R : Type u} {ι : Type w} (s : finset ι) [comm_semiring R] (f : ι → polynomial R) (h : (finset.prod s fun (i : ι) => leading_coeff (f i)) ≠ 0) : nat_degree (finset.prod s fun (i : ι) => f i) = finset.sum s fun (i : ι) => nat_degree (f i) := sorry

theorem nat_degree_prod_of_monic {R : Type u} {ι : Type w} (s : finset ι) [comm_semiring R] (f : ι → polynomial R) [nontrivial R] (h : ∀ (i : ι), i ∈ s → monic (f i)) : nat_degree (finset.prod s fun (i : ι) => f i) = finset.sum s fun (i : ι) => nat_degree (f i) := sorry

theorem coeff_zero_prod {R : Type u} {ι : Type w} (s : finset ι) [comm_semiring R] (f : ι → polynomial R) : coeff (finset.prod s fun (i : ι) => f i) 0 = finset.prod s fun (i : ι) => coeff (f i) 0 := sorry

-- Eventually this can be generalized with Vieta's formulas

-- plus the connection between roots and factorization.

theorem prod_X_sub_C_next_coeff {R : Type u} {ι : Type w} [comm_ring R] [nontrivial R] {s : finset ι} (f : ι → R) : next_coeff (finset.prod s fun (i : ι) => X - coe_fn C (f i)) = -finset.sum s fun (i : ι) => f i := sorry

theorem prod_X_sub_C_coeff_card_pred {R : Type u} {ι : Type w} [comm_ring R] [nontrivial R] (s : finset ι) (f : ι → R) (hs : 0 < finset.card s) : coeff (finset.prod s fun (i : ι) => X - coe_fn C (f i)) (finset.card s - 1) = -finset.sum s fun (i : ι) => f i := sorry

theorem nat_degree_prod {R : Type u} {ι : Type w} (s : finset ι) [comm_ring R] [no_zero_divisors R] (f : ι → polynomial R) [nontrivial R] (h : ∀ (i : ι), i ∈ s → f i ≠ 0) : nat_degree (finset.prod s fun (i : ι) => f i) = finset.sum s fun (i : ι) => nat_degree (f i) := sorry

theorem leading_coeff_prod {R : Type u} {ι : Type w} (s : finset ι) [comm_ring R] [no_zero_divisors R] (f : ι → polynomial R) : leading_coeff (finset.prod s fun (i : ι) => f i) = finset.prod s fun (i : ι) => leading_coeff (f i) := sorry


/-
Copyright © 2020 Nicolò Cavalleri. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nicolò Cavalleri
-/
import geometry.manifold.algebra.lie_group

/-!
# Smooth structures

In this file we define smooth structures that build on Lie groups. We prefer using the term smooth
instead of Lie mainly because Lie ring has currently another use in mathematics.
-/

open_locale manifold

section smooth_ring
variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
{H : Type*} [topological_space H]
{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]

set_option default_priority 100 -- see Note [default priority]

/-- A smooth (semi)ring is a (semi)ring `R` where addition and multiplication are smooth.
If `R` is a ring, then negation is automatically smooth, as it is multiplication with `-1`. -/
-- See note [Design choices about smooth algebraic structures]
class smooth_ring (I : model_with_corners 𝕜 E H)
  (R : Type*) [semiring R] [topological_space R] [charted_space H R]
  extends has_smooth_add I R : Prop :=
(smooth_mul : smooth (I.prod I) I (λ p : R×R, p.1 * p.2))

instance smooth_ring.to_has_smooth_mul (I : model_with_corners 𝕜 E H)
  (R : Type*) [semiring R] [topological_space R] [charted_space H R] [h : smooth_ring I R] :
  has_smooth_mul I R := { ..h }

instance smooth_ring.to_lie_add_group (I : model_with_corners 𝕜 E H)
  (R : Type*) [ring R] [topological_space R] [charted_space H R] [smooth_ring I R] :
  lie_add_group I R :=
{ compatible := λ e e', has_groupoid.compatible (cont_diff_groupoid ⊤ I),
  smooth_add := smooth_add I,
  smooth_neg := by simpa only [neg_one_mul] using @smooth_mul_left 𝕜 _ H _ E _ _ I R _ _ _ _ (-1) }

end smooth_ring

instance field_smooth_ring {𝕜 : Type*} [nontrivially_normed_field 𝕜] :
  smooth_ring 𝓘(𝕜) 𝕜 :=
{ smooth_mul :=
  begin
    rw smooth_iff,
    refine ⟨continuous_mul, λ x y, _⟩,
    simp only [prod.mk.eta] with mfld_simps,
    rw cont_diff_on_univ,
    exact cont_diff_mul,
  end,
  ..normed_space_lie_add_group }

variables {𝕜 R E H : Type*} [topological_space R] [topological_space H]
  [nontrivially_normed_field 𝕜] [normed_add_comm_group E] [normed_space 𝕜 E]
  [charted_space H R] (I : model_with_corners 𝕜 E H)

/-- A smooth (semi)ring is a topological (semi)ring. This is not an instance for technical reasons,
see note [Design choices about smooth algebraic structures]. -/
lemma topological_semiring_of_smooth [semiring R] [smooth_ring I R] :
  topological_semiring R :=
{ .. has_continuous_mul_of_smooth I, .. has_continuous_add_of_smooth I }


import topology.metric_space.basic

section
variables {α : Type*} [partial_order α]
variables x y z : α

#check x ≤ y
#check (le_refl x : x ≤ x)
#check (le_trans : x ≤ y → y ≤ z → x ≤ z)

#check x < y
#check (lt_irrefl x : ¬ x < x)
#check (lt_trans : x < y → y < z → x < z)
#check (lt_of_le_of_lt : x ≤ y → y < z → x < z)
#check (lt_of_lt_of_le : x < y → y ≤ z → x < z)

example : x < y ↔ x ≤ y ∧ x ≠ y :=
lt_iff_le_and_ne

end

section
variables {α : Type*} [lattice α]
variables x y z : α

#check x ⊓ y
#check (inf_le_left : x ⊓ y ≤ x)
#check (inf_le_right : x ⊓ y ≤ y)
#check (le_inf : z ≤ x → z ≤ y → z ≤ x ⊓ y)

#check x ⊔ y
#check (le_sup_left : x ≤ x ⊔ y)
#check (le_sup_right: y ≤ x ⊔ y)
#check (sup_le : x ≤ z → y ≤ z → x ⊔ y ≤ z)

example : x ⊓ y = y ⊓ x :=
begin
  apply le_antisymm,
  -- The original example (and solution) uses `repeat`
  apply le_inf,
  exact inf_le_right,
  exact inf_le_left,
  apply le_inf,
  exact inf_le_right,
  exact inf_le_left,
end

example : x ⊓ y ⊓ z = x ⊓ (y ⊓ z) := sorry
example : x ⊔ y = y ⊔ x := sorry
example : x ⊔ y ⊔ z = x ⊔ (y ⊔ z) := sorry

theorem absorb1 : x ⊓ (x ⊔ y) = x := sorry
theorem absorb2 : x ⊔ (x ⊓ y) = x := sorry

end

section
variables {α : Type*} [distrib_lattice α]
variables x y z : α

#check (inf_sup_left : x ⊓ (y ⊔ z) = (x ⊓ y) ⊔ (x ⊓ z))
#check (inf_sup_right : (x ⊔ y) ⊓ z = (x ⊓ z) ⊔ (y ⊓ z))
#check (sup_inf_left : x ⊔ (y ⊓ z) = (x ⊔ y) ⊓ (x ⊔ z))
#check (sup_inf_right : (x ⊓ y) ⊔ z = (x ⊔ z) ⊓ (y ⊔ z))

end

section
variables {α : Type*} [lattice α]
variables a b c : α

example (h : ∀ x y z : α, x ⊓ (y ⊔ z) = (x ⊓ y) ⊔ (x ⊓ z)) :
  a ⊔ (b ⊓ c) = (a ⊔ b) ⊓ (a ⊔ c) :=
sorry

example (h : ∀ x y z : α, x ⊔ (y ⊓ z) = (x ⊔ y) ⊓ (x ⊔ z)) :
  a ⊓ (b ⊔ c) = (a ⊓ b) ⊔ (a ⊓ c) :=
sorry

end

section
variables {R : Type*} [ordered_ring R]
variables a b c : R

#check (add_le_add_left : a ≤ b → ∀ c, c + a ≤ c + b)
#check (mul_pos : 0 < a → 0 < b → 0 < a * b)

#check (mul_nonneg : 0 ≤ a → 0 ≤ b → 0 ≤ a * b)

example : a ≤ b → 0 ≤ b - a := sorry

example : 0 ≤ b - a → a ≤ b := sorry

example (h : a ≤ b) (h' : 0 ≤ c) : a * c ≤ b * c := sorry

end

section
variables {X : Type*} [metric_space X]
variables x y z : X

#check (dist_self x : dist x x = 0)
#check (dist_comm x y : dist x y = dist y x)
#check (dist_triangle x y z : dist x z ≤ dist x y + dist y z)

example (x y : X) : 0 ≤ dist x y :=
begin
  have : 0 ≤ dist x y * 2,
  calc
  0   = dist x x            : by rw dist_self
  ... ≤ dist x y + dist y x : dist_triangle x y x
  ... ≤ dist x y * 2        : by {rw dist_comm, ring},
  linarith [nonneg_of_mul_nonneg_left this],
  end

end


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Amelia Livingston, Yury Kudryashov,
Neil Strickland, Aaron Anderson
-/

import algebra.group_with_zero

/-!
# Divisibility

This file defines the basics of the divisibility relation in the context of `(comm_)` `monoid`s
`(_with_zero)`.

## Main definitions

 * `monoid.has_dvd`

## Implementation notes

The divisibility relation is defined for all monoids, and as such, depends on the order of
  multiplication if the monoid is not commutative. There are two possible conventions for
  divisibility in the noncommutative context, and this relation follows the convention for ordinals,
  so `a | b` is defined as `∃ c, b = a * c`.

## Tags

divisibility, divides
-/

variables {α : Type*}

section monoid

variables [monoid α] {a b c : α}

/-- There are two possible conventions for divisibility, which coincide in a `comm_monoid`.
    This matches the convention for ordinals. -/
@[priority 100]
instance monoid_has_dvd : has_dvd α :=
has_dvd.mk (λ a b, ∃ c, b = a * c)

-- TODO: this used to not have c explicit, but that seems to be important
--       for use with tactics, similar to exist.intro
theorem dvd.intro (c : α) (h : a * c = b) : a ∣ b :=
exists.intro c h^.symm

alias dvd.intro ← dvd_of_mul_right_eq

theorem exists_eq_mul_right_of_dvd (h : a ∣ b) : ∃ c, b = a * c := h

theorem dvd.elim {P : Prop} {a b : α} (H₁ : a ∣ b) (H₂ : ∀ c, b = a * c → P) : P :=
exists.elim H₁ H₂

@[refl, simp] theorem dvd_refl (a : α) : a ∣ a :=
dvd.intro 1 (by simp)

local attribute [simp] mul_assoc mul_comm mul_left_comm

@[trans] theorem dvd_trans (h₁ : a ∣ b) (h₂ : b ∣ c) : a ∣ c :=
match h₁, h₂ with
| ⟨d, (h₃ : b = a * d)⟩, ⟨e, (h₄ : c = b * e)⟩ :=
  ⟨d * e, show c = a * (d * e), by simp [h₃, h₄]⟩
end

alias dvd_trans ← dvd.trans

theorem one_dvd (a : α) : 1 ∣ a := dvd.intro a (by simp)

@[simp] theorem dvd_mul_right (a b : α) : a ∣ a * b := dvd.intro b rfl

theorem dvd_mul_of_dvd_left (h : a ∣ b) (c : α) : a ∣ b * c :=
dvd.elim h (λ d h', begin rw [h', mul_assoc], apply dvd_mul_right end)

theorem dvd_of_mul_right_dvd (h : a * b ∣ c) : a ∣ c :=
dvd.elim h (begin intros d h₁, rw [h₁, mul_assoc], apply dvd_mul_right end)

end monoid

section comm_monoid

variables [comm_monoid α] {a b c : α}

theorem dvd.intro_left (c : α) (h : c * a = b) : a ∣ b :=
dvd.intro _ (begin rewrite mul_comm at h, apply h end)

alias dvd.intro_left ← dvd_of_mul_left_eq

theorem exists_eq_mul_left_of_dvd (h : a ∣ b) : ∃ c, b = c * a :=
dvd.elim h (assume c, assume H1 : b = a * c, exists.intro c (eq.trans H1 (mul_comm a c)))

theorem dvd.elim_left {P : Prop} (h₁ : a ∣ b) (h₂ : ∀ c, b = c * a → P) : P :=
exists.elim (exists_eq_mul_left_of_dvd h₁) (assume c, assume h₃ : b = c * a, h₂ c h₃)

@[simp] theorem dvd_mul_left (a b : α) : a ∣ b * a := dvd.intro b (mul_comm a b)

theorem dvd_mul_of_dvd_right (h : a ∣ b) (c : α) : a ∣ c * b :=
begin rw mul_comm, exact dvd_mul_of_dvd_left h _ end

local attribute [simp] mul_assoc mul_comm mul_left_comm

theorem mul_dvd_mul : ∀ {a b c d : α}, a ∣ b → c ∣ d → a * c ∣ b * d
| a ._ c ._ ⟨e, rfl⟩ ⟨f, rfl⟩ := ⟨e * f, by simp⟩

theorem mul_dvd_mul_left (a : α) {b c : α} (h : b ∣ c) : a * b ∣ a * c :=
mul_dvd_mul (dvd_refl a) h

theorem mul_dvd_mul_right (h : a ∣ b) (c : α) : a * c ∣ b * c :=
mul_dvd_mul h (dvd_refl c)

theorem dvd_of_mul_left_dvd (h : a * b ∣ c) : b ∣ c :=
dvd.elim h (λ d ceq, dvd.intro (a * d) (by simp [ceq]))

end comm_monoid

section monoid_with_zero

variables [monoid_with_zero α] {a : α}

theorem eq_zero_of_zero_dvd (h : 0 ∣ a) : a = 0 :=
dvd.elim h (assume c, assume H' : a = 0 * c, eq.trans H' (zero_mul c))

/-- Given an element `a` of a commutative monoid with zero, there exists another element whose
    product with zero equals `a` iff `a` equals zero. -/
@[simp] lemma zero_dvd_iff : 0 ∣ a ↔ a = 0 :=
⟨eq_zero_of_zero_dvd, λ h, by rw h⟩

@[simp] theorem dvd_zero (a : α) : a ∣ 0 := dvd.intro 0 (by simp)

end monoid_with_zero

/-- Given two elements `b`, `c` of a `cancel_monoid_with_zero` and a nonzero element `a`,
 `a*b` divides `a*c` iff `b` divides `c`. -/
theorem mul_dvd_mul_iff_left [cancel_monoid_with_zero α] {a b c : α}
  (ha : a ≠ 0) : a * b ∣ a * c ↔ b ∣ c :=
exists_congr $ λ d, by rw [mul_assoc, mul_right_inj' ha]

/-- Given two elements `a`, `b` of a commutative `cancel_monoid_with_zero` and a nonzero
  element `c`, `a*c` divides `b*c` iff `a` divides `b`. -/
theorem mul_dvd_mul_iff_right [comm_cancel_monoid_with_zero α] {a b c : α} (hc : c ≠ 0) :
  a * c ∣ b * c ↔ a ∣ b :=
exists_congr $ λ d, by rw [mul_right_comm, mul_left_inj' hc]

/-!
### Units in various monoids
-/

namespace units

section monoid
variables [monoid α] {a b : α} {u : units α}

/-- Elements of the unit group of a monoid represented as elements of the monoid
    divide any element of the monoid. -/
lemma coe_dvd : ↑u ∣ a := ⟨↑u⁻¹ * a, by simp⟩

/-- In a monoid, an element `a` divides an element `b` iff `a` divides all
    associates of `b`. -/
lemma dvd_mul_right : a ∣ b * u ↔ a ∣ b :=
iff.intro
  (assume ⟨c, eq⟩, ⟨c * ↑u⁻¹, by rw [← mul_assoc, ← eq, units.mul_inv_cancel_right]⟩)
  (assume ⟨c, eq⟩, eq.symm ▸ dvd_mul_of_dvd_left (dvd_mul_right _ _) _)

/-- In a monoid, an element a divides an element b iff all associates of `a` divide `b`.-/
lemma mul_right_dvd : a * u ∣ b ↔ a ∣ b :=
iff.intro
  (λ ⟨c, eq⟩, ⟨↑u * c, eq.trans (mul_assoc _ _ _)⟩)
  (λ h, dvd_trans (dvd.intro ↑u⁻¹ (by rw [mul_assoc, u.mul_inv, mul_one])) h)

end monoid

section comm_monoid
variables [comm_monoid α] {a b : α} {u : units α}

/-- In a commutative monoid, an element `a` divides an element `b` iff `a` divides all left
    associates of `b`. -/
lemma dvd_mul_left : a ∣ u * b ↔ a ∣ b := by { rw mul_comm, apply dvd_mul_right }

/-- In a commutative monoid, an element `a` divides an element `b` iff all
  left associates of `a` divide `b`.-/
lemma mul_left_dvd : ↑u * a ∣ b ↔ a ∣ b :=
by { rw mul_comm, apply mul_right_dvd }

end comm_monoid

end units

namespace is_unit

section monoid

variables [monoid α] {a b u : α} (hu : is_unit u)
include hu

/-- Units of a monoid divide any element of the monoid. -/
@[simp] lemma dvd : u ∣ a := by { rcases hu with ⟨u, rfl⟩, apply units.coe_dvd, }

@[simp] lemma dvd_mul_right : a ∣ b * u ↔ a ∣ b :=
by { rcases hu with ⟨u, rfl⟩, apply units.dvd_mul_right, }

/-- In a monoid, an element a divides an element b iff all associates of `a` divide `b`.-/
@[simp] lemma mul_right_dvd : a * u ∣ b ↔ a ∣ b :=
by { rcases hu with ⟨u, rfl⟩, apply units.mul_right_dvd, }

end monoid

section comm_monoid
variables [comm_monoid α] (a b u : α) (hu : is_unit u)
include hu

/-- In a commutative monoid, an element `a` divides an element `b` iff `a` divides all left
    associates of `b`. -/
@[simp] lemma dvd_mul_left : a ∣ u * b ↔ a ∣ b :=
by { rcases hu with ⟨u, rfl⟩, apply units.dvd_mul_left, }

/-- In a commutative monoid, an element `a` divides an element `b` iff all
  left associates of `a` divide `b`.-/
@[simp] lemma mul_left_dvd : u * a ∣ b ↔ a ∣ b :=
by { rcases hu with ⟨u, rfl⟩, apply units.mul_left_dvd, }

end comm_monoid

end is_unit

section comm_monoid_with_zero

variable [comm_monoid_with_zero α]

/-- `dvd_not_unit a b` expresses that `a` divides `b` "strictly", i.e. that `b` divided by `a`
is not a unit. -/
def dvd_not_unit (a b : α) : Prop := a ≠ 0 ∧ ∃ x, ¬is_unit x ∧ b = a * x

lemma dvd_not_unit_of_dvd_of_not_dvd {a b : α} (hd : a ∣ b) (hnd : ¬ b ∣ a) :
  dvd_not_unit a b :=
begin
  split,
  { rintro rfl, exact hnd (dvd_zero _) },
  { rcases hd with ⟨c, rfl⟩,
    refine ⟨c, _, rfl⟩,
    rintro ⟨u, rfl⟩,
    simpa using hnd }
end

end comm_monoid_with_zero


import data.rat.basic
       data.nat.parity
       tactic

lemma even_if_square_even {n : ℕ} (hn2 : 2 ∣ (n*n)) : 2 ∣ n :=
begin
  by_contra hc,
  have hmod2 : n % 2 = 1, from nat.not_even_iff.mp hc,
  set k := n / 2 with hk,
  have hn : n = 1 + 2*k,
  { rw [←nat.mod_add_div n 2, hmod2] },
  have hnn : n*n = 1 + 2*(2*k + 2*k*k),
  { rw hn, ring },
  rw [nat.dvd_iff_mod_eq_zero, hnn] at hn2,
  norm_num at hn2,
end

theorem sqrt_2_irrational : ¬∃ (p : ℚ), p^2 = 2 :=
begin
  by_contra h,
  cases h with p hp,
  set m := int.nat_abs p.num with hm,
  set n := p.denom with hn,
  have hm2 : p.num * p.num = m * m,
  { norm_cast,
    rw [hm, int.nat_abs_mul_self] },
  have hcop := p.cop,
  rw [←hm, ←hn] at hcop,
  rw [pow_two, rat.eq_iff_mul_eq_mul, rat.mul_self_num, rat.mul_self_denom, hm2, ←hn] at hp,
  norm_cast at hp,
  rw mul_one at hp,
  have hmmeven : 2 ∣ m * m,
  { rw hp,
    exact nat.dvd_mul_right _ _ },
  have hmeven : 2 ∣ m, from even_if_square_even hmmeven,
  have hmeven := hmeven,
  cases hmeven with k hk,
  rw [hk, mul_mul_mul_comm, mul_assoc, nat.mul_right_inj (show 0 < 2, by norm_num)] at hp,
  have hnneven : 2 ∣ n * n,
  { rw ←hp,
    exact nat.dvd_mul_right _ _ },
  have hneven : 2 ∣ n, from even_if_square_even hnneven,
  refine nat.not_coprime_of_dvd_of_dvd (by norm_num) hmeven hneven hcop,
end


/-
Theorem 1 in Section 9.4 of the whitepaper, dealing with the encoding of an instruction as a field
element.
-/
import starkware.cairo.lean.semantics.cpu
import starkware.cairo.lean.semantics.air_encoding.constraints

open_locale big_operators

/-
Note: this is needed for the `classical.some`, but we can possibly remove it
based on the data from the range_check, if we assume `F` has decidable equality.
-/
noncomputable theory

/-
The tilde encoding of bit vectors.
-/

namespace bitvec

variables {n : ℕ} (b : bitvec n)

def tilde (i : fin (n + 1)) : ℕ :=
∑ j in i.rev.range, 2^(j.rev.cast_succ - i : ℕ) * (b.nth j.rev).to_nat

@[simp] theorem tilde_last : b.tilde (fin.last n) = 0 :=
by rw [tilde, fin.rev_last, fin.sum_range_zero]

theorem tilde_succ (i : fin n) :
  b.tilde i.cast_succ = 2 * b.tilde i.succ + (b.nth i).to_nat :=
begin
  rw [tilde, tilde, fin.rev_cast_succ, fin.sum_range_succ, finset.mul_sum,
      add_comm, fin.rev_rev, nat.sub_self, pow_zero, one_mul, ←fin.cast_succ_rev],
  congr' 1,
  apply finset.sum_congr rfl,
  intro j, rw [fin.mem_range, fin.cast_succ_lt_cast_succ_iff], intro hj,
  rw [←mul_assoc, ←pow_succ, fin.coe_succ, nat.sub_succ, fin.coe_cast_succ, fin.coe_cast_succ], congr, symmetry, apply nat.succ_pred_eq_of_pos,
  apply nat.sub_pos_of_lt,
  rwa [←fin.lt_iff_coe_lt_coe, ←fin.rev_lt_rev_iff, fin.rev_rev]
end

section

variables {α : Type*} [semiring α]

theorem tilde_spec (f : fin (n + 1) → α)
    (h0 : f (fin.last n) = 0)
    (hsucc : ∀ i : fin n, f i.cast_succ = 2 * f i.succ + (b.nth i).to_nat) :
  f = λ i, b.tilde i :=
begin
  ext i, rw ←fin.rev_rev i,
  generalize : i.rev = j,
  apply fin.induction_on j,
  { rw [fin.rev_zero, h0, tilde_last, nat.cast_zero] },
  intros i ih,
  rw [←fin.cast_succ_rev, tilde_succ, hsucc, ←fin.rev_cast_succ, ih],
  simp
end

end

theorem tilde_spec_nat (f : fin (n + 1) → ℕ)
    (h0 : f (fin.last n) = 0)
    (hsucc : ∀ i : fin n, f i.cast_succ = 2 * f i.succ + (b.nth i).to_nat) :
  f = b.tilde :=
by { rw (tilde_spec b f h0); simp, exact hsucc }

theorem tilde_zero_eq : b.tilde 0 = b.to_natr :=
begin
  rw [bitvec.to_natr, tilde, fin.rev_zero, fin.range_last, fin.coe_zero],
  induction n with n ih,
  { rw [vector.eq_nil b], refl },
  rw [fin.sum_univ_cast_succ],
  conv { to_rhs, rw ←vector.cons_head_tail b },
  rw [vector.reverse_cons, bitvec.to_nat_append, ←ih (vector.tail b)],
  congr,
  { rw [mul_comm, finset.mul_sum],
    apply finset.sum_congr rfl,
    intros j _,
    simp, rw [←mul_assoc, ←pow_succ, fin.rev_cast_succ],
    congr,
    apply tsub_eq_of_eq_add_rev,
    rw [add_comm, add_assoc, add_comm 1, nat.sub_add_cancel],
    exact j.2, },
  rw [bitvec.singleton_to_nat], simp
end

def from_tilde (f : fin (n+1) → ℕ) : bitvec n :=
vector.of_fn (λ i : fin n, bool.of_nat $
  (f i.cast_succ - 2 * f i.succ))

theorem from_tilde_tilde : from_tilde b.tilde = b :=
begin
  ext i, dsimp [from_tilde],
  rw [vector.nth_of_fn, tilde_succ, add_comm, nat.add_sub_cancel, bool.of_nat_to_nat]
end

theorem tilde_zero_inj {b1 b2 : bitvec n} (h : b1.tilde 0 = b2.tilde 0) : b1 = b2 :=
begin
  rw [tilde_zero_eq, tilde_zero_eq] at h,
  have := to_nat_inj h,
  have h' := congr_arg vector.reverse this,
  rwa [vector.reverse_reverse, vector.reverse_reverse] at h'
end

end bitvec

/-
Converting an instruction to a natural number.

This is only needed for the uniqueness theorem below, which may not be necessary for the
correctness proof.
-/

namespace instruction

theorem to_nat_le (inst : instruction) : inst.to_nat < 2^63 :=
calc
  inst.to_nat ≤ (2^16 - 1) + 2^16 * (2^16 - 1) + 2^32 * (2^16 - 1) + 2^48 * (2^15 - 1) :
    begin
      apply add_le_add,
      apply add_le_add,
      apply add_le_add,
      apply inst.off_dst.to_natr_le,
      apply nat.mul_le_mul_left,
      apply inst.off_op0.to_natr_le,
      apply nat.mul_le_mul_left,
      apply inst.off_op1.to_natr_le,
      apply nat.mul_le_mul_left,
      apply bitvec.to_natr_le
    end
  ... = 2^63 - 1 : by norm_num
  ... < 2^63     : by norm_num

theorem to_nat_eq (inst : instruction) :
  inst.to_nat = inst.off_dst.to_natr + 2^16 * (inst.off_op0.to_natr +
    2^16 * (inst.off_op1.to_natr + 2^16 * inst.flags.to_natr)) :=
by { rw [instruction.to_nat], ring }

theorem to_nat_inj {i1 i2 : instruction} (h : i1.to_nat = i2.to_nat) : i1 = i2 :=
begin
  have nez : 2^16 ≠ 0, norm_num,
  rw [to_nat_eq, to_nat_eq] at h,
  have h1 : i1.off_dst.to_natr = i2.off_dst.to_natr,
  { have := congr_arg (λ i, i % 2^16) h, dsimp at this,
    simp [nat.add_mul_mod_self_left] at this,
    rw [nat.mod_eq_of_lt i1.off_dst.to_natr_lt] at this,
    rwa [nat.mod_eq_of_lt i2.off_dst.to_natr_lt] at this },
  rw [h1, add_right_inj, mul_right_inj' nez] at h,
  have h2 : i1.off_op0.to_natr = i2.off_op0.to_natr,
  { have := congr_arg (λ i, i % 2^16) h, dsimp at this,
    simp [nat.add_mul_mod_self_left] at this,
    rw [nat.mod_eq_of_lt i1.off_op0.to_natr_lt] at this,
    rwa [nat.mod_eq_of_lt i2.off_op0.to_natr_lt] at this },
  rw [h2, add_right_inj, mul_right_inj' nez] at h,
  have h3 : i1.off_op1.to_natr = i2.off_op1.to_natr,
  { have := congr_arg (λ i, i % 2^16) h, dsimp at this,
    simp [nat.add_mul_mod_self_left] at this,
    rw [nat.mod_eq_of_lt i1.off_op1.to_natr_lt] at this,
    rwa [nat.mod_eq_of_lt i2.off_op1.to_natr_lt] at this },
  rw [h3, add_right_inj, mul_right_inj' nez] at h,
  apply instruction.ext _ _ (bitvec.to_natr_inj h1) (bitvec.to_natr_inj h2)
      (bitvec.to_natr_inj h3) (bitvec.to_natr_inj h)
end

end instruction

/-
Theorem 1.
-/

section theorem_one

variables {F : Type*} [field F]
-- so far, this is not used: [fintype F]
variable  (char_ge: ring_char F ≥ 2^63)

/- the data -/

variables {inst
           off_op0_tilde
           off_op1_tilde
           off_dst_tilde : F }

variable  {f_tilde : tilde_type F}

/- the constraints -/

variable  h_instruction : inst = off_dst_tilde + 2^16 * off_op0_tilde + 2^32 * off_op1_tilde +
                                   2^48 * f_tilde 0

variable  h_bit : ∀ i : fin 15, f_tilde.to_f i * (f_tilde.to_f i - 1) = 0

variable  h_last_value : f_tilde ⟨15, by norm_num⟩ = 0

variable  off_op0_in_range : ∃ j : ℕ, j < 2^16 ∧ off_op0_tilde = ↑j

variable  off_op1_in_range : ∃ j : ℕ, j < 2^16 ∧ off_op1_tilde = ↑j

variable  off_dst_in_range  : ∃ j : ℕ, j < 2^16 ∧ off_dst_tilde = ↑j

/- recovering the instruction -/

def off_op0_nat := classical.some off_op0_in_range

theorem off_op0_lt : @off_op0_nat F _ _ off_op0_in_range < 2^16 :=
(classical.some_spec off_op0_in_range).left

theorem off_op0_eq : off_op0_tilde = ↑(@off_op0_nat F _ _ off_op0_in_range) :=
(classical.some_spec off_op0_in_range).right

def off_op1_nat := classical.some off_op1_in_range

theorem off_op1_lt : @off_op1_nat F _ _ off_op1_in_range < 2^16 :=
(classical.some_spec off_op1_in_range).left

theorem off_op1_eq : off_op1_tilde = ↑(@off_op1_nat F _ _ off_op1_in_range) :=
(classical.some_spec off_op1_in_range).right

def off_dst_nat := classical.some off_dst_in_range

theorem off_dst_lt : @off_dst_nat F _ _ off_dst_in_range < 2^16 :=
(classical.some_spec off_dst_in_range).left

theorem off_dst_eq : off_dst_tilde = ↑(@off_dst_nat F _ _ off_dst_in_range) :=
(classical.some_spec off_dst_in_range).right

section

include h_bit

theorem exists_bool_f_tilde_eq (i : fin 15) :
  ∃ b : bool, f_tilde.to_f i = ↑(b.to_nat) :=
begin
  cases eq_zero_or_eq_zero_of_mul_eq_zero (h_bit i) with h h,
  { use ff, rw [h], simp only [bool.to_nat, bool.cond_ff, nat.cast_zero]},
  use tt, rw [eq_of_sub_eq_zero h], exact nat.cast_one.symm
end

end

def flag_vec : bitvec 15 := vector.of_fn $ λ i, classical.some (exists_bool_f_tilde_eq h_bit i)

theorem flag_vec_spec (i : fin 15) : ↑((flag_vec h_bit).nth i).to_nat = f_tilde.to_f i :=
by rw [flag_vec, vector.nth_of_fn, ←classical.some_spec (exists_bool_f_tilde_eq h_bit i)]

section
include h_bit h_last_value

theorem f_tilde_eq : f_tilde = λ i, (flag_vec h_bit).tilde i :=
begin
  apply bitvec.tilde_spec _ _ h_last_value,
  intro i,
  rw add_comm (2 * f_tilde _),
  apply eq_add_of_sub_eq,
  symmetry, apply flag_vec_spec
end
end

def the_instruction : instruction :=
{ off_dst := bitvec.of_natr 16 (off_dst_nat off_dst_in_range),
  off_op0 := bitvec.of_natr 16 (off_op0_nat off_op0_in_range),
  off_op1 := bitvec.of_natr 16 (off_op1_nat off_op1_in_range),
  flags   := flag_vec h_bit }

/-
The main theorem:
-/

section
include h_instruction h_last_value

theorem inst_eq : inst = (the_instruction h_bit off_op0_in_range
                        off_op1_in_range off_dst_in_range).to_nat :=
begin
  rw [h_instruction, the_instruction, instruction.to_nat],
  simp [bitvec.to_natr_of_natr],
  have := congr_fun (f_tilde_eq h_bit h_last_value) 0,
  dsimp at this,
  rw [nat.mod_eq_of_lt (off_op0_lt off_op0_in_range),
         nat.mod_eq_of_lt (off_op1_lt off_op1_in_range),
         nat.mod_eq_of_lt (off_dst_lt off_dst_in_range),
         ←off_op0_eq off_op0_in_range,
         ←off_op1_eq off_op1_in_range,
         ←off_dst_eq off_dst_in_range,
         this, bitvec.tilde_zero_eq]
end
end

theorem off_dst_tilde_eq : off_dst_tilde =
  ↑(the_instruction h_bit off_op0_in_range off_op1_in_range off_dst_in_range).off_dst.to_natr :=
begin
  dsimp [the_instruction],
  transitivity,
  apply (off_dst_eq off_dst_in_range),
  rw [bitvec.to_natr_of_natr, nat.mod_eq_of_lt (off_dst_lt off_dst_in_range)]
end

theorem off_op0_tilde_eq : off_op0_tilde =
  ↑(the_instruction h_bit off_op0_in_range  off_op1_in_range off_dst_in_range).off_op0.to_natr :=
begin
  dsimp [the_instruction],
  transitivity,
  apply (off_op0_eq off_op0_in_range),
  rw [bitvec.to_natr_of_natr, nat.mod_eq_of_lt (off_op0_lt off_op0_in_range)]
end

theorem off_op1_tilde_eq : off_op1_tilde =
  ↑(the_instruction h_bit off_op0_in_range off_op1_in_range off_dst_in_range).off_op1.to_natr :=
begin
  dsimp [the_instruction],
  transitivity,
  apply (@off_op1_eq F _ _ off_op1_in_range),
  rw [bitvec.to_natr_of_natr, nat.mod_eq_of_lt (off_op1_lt off_op1_in_range)]
end

theorem f_tilde_to_f_eq : ∀ i, f_tilde.to_f i =
  ↑((the_instruction h_bit off_op0_in_range off_op1_in_range
      off_dst_in_range).flags.nth i).to_nat :=
begin
  intro i,
  dsimp [the_instruction],
  symmetry,
  apply flag_vec_spec
end

section uniqueness
include char_ge

theorem inst_unique (i1 i2 : instruction) (h : (i1.to_nat : F) = i2.to_nat) :
  i1 = i2 :=
begin
  have h1 : i1.to_nat < ring_char F, from lt_of_lt_of_le i1.to_nat_le char_ge,
  have h2 : i2.to_nat < ring_char F, from lt_of_lt_of_le i2.to_nat_le char_ge,
  have : i1.to_nat = i2.to_nat, from nat.cast_inj_of_lt_char h1 h2 h,
  exact instruction.to_nat_inj this
end

include h_instruction h_last_value

theorem inst_unique' (i : instruction) (h : inst = i.to_nat) :
  i = the_instruction h_bit off_op0_in_range off_op1_in_range off_dst_in_range :=
begin
  apply inst_unique char_ge,
  rw ←h, apply inst_eq, apply h_instruction, apply h_last_value
end
end uniqueness

end theorem_one


/-
Copyright (c) 2020 Patrick Stevens. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Stevens
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.ring_exp
import Mathlib.data.nat.parity
import Mathlib.data.nat.choose.sum
import Mathlib.PostPort

namespace Mathlib

/-!
# Primorial

This file defines the primorial function (the product of primes less than or equal to some bound),
and proves that `primorial n ≤ 4 ^ n`.

## Notations

We use the local notation `n#` for the primorial of `n`: that is, the product of the primes less
than or equal to `n`.
-/

/-- The primorial `n#` of `n` is the product of the primes less than or equal to `n`.
-/
def primorial (n : ℕ) : ℕ :=
  finset.prod (finset.filter nat.prime (finset.range (n + 1))) fun (p : ℕ) => p

theorem primorial_succ {n : ℕ} (n_big : 1 < n) (r : n % bit0 1 = 1) : primorial (n + 1) = primorial n := sorry

theorem dvd_choose_of_middling_prime (p : ℕ) (is_prime : nat.prime p) (m : ℕ) (p_big : m + 1 < p) (p_small : p ≤ bit0 1 * m + 1) : p ∣ nat.choose (bit0 1 * m + 1) (m + 1) := sorry

theorem prod_primes_dvd {s : finset ℕ} (n : ℕ) (h : ∀ (a : ℕ), a ∈ s → nat.prime a) (div : ∀ (a : ℕ), a ∈ s → a ∣ n) : (finset.prod s fun (p : ℕ) => p) ∣ n := sorry

theorem primorial_le_4_pow (n : ℕ) : primorial n ≤ bit0 (bit0 1) ^ n := sorry


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Johannes Hölzl
-/
import dynamics.fixed_points.basic
import topology.separation

/-!
# Topological properties of fixed points

Currently this file contains two lemmas:

- `is_fixed_pt_of_tendsto_iterate`: if `f^n(x) → y` and `f` is continuous at `y`, then `f y = y`;
- `is_closed_fixed_points`: the set of fixed points of a continuous map is a closed set.

## TODO

fixed points, iterates
-/

variables {α : Type*} [topological_space α] [t2_space α] {f : α → α}

open function filter
open_locale topological_space

/-- If the iterates `f^[n] x` converge to `y` and `f` is continuous at `y`,
then `y` is a fixed point for `f`. -/
lemma is_fixed_pt_of_tendsto_iterate {x y : α} (hy : tendsto (λ n, f^[n] x) at_top (𝓝 y))
  (hf : continuous_at f y) :
  is_fixed_pt f y :=
begin
  refine tendsto_nhds_unique ((tendsto_add_at_top_iff_nat 1).1 _) hy,
  simp only [iterate_succ' f],
  exact hf.tendsto.comp hy
end

/-- The set of fixed points of a continuous map is a closed set. -/
lemma is_closed_fixed_points (hf : continuous f) : is_closed (fixed_points f) :=
is_closed_eq hf continuous_id


import data.real.basic
import tactic

namespace vilnius

example (P Q : Prop) : P ∧ Q → Q :=
begin
  intro hPQ,
  cases hPQ with hP hQ,
  exact hQ,
end

example (P Q R : Prop) : (R → P) ∧ (P → Q) → (R → Q) :=
begin
  intro hPQR,
  intro hR,
  cases hPQR with hRP hPQ,
  apply hPQ,
  apply hRP,
  exact hR,
end

end vilnius


import Catlib4.Basic
import Catlib4.Category.Category
import Catlib4.Category.Remarkable

namespace CategoryTheory.Category

universe u v

def product_category (C D : Category.{u,v+1}) : Category.{u,v+1} where
  α := C × D
  hom a b := (a.1 ⟶ b.1) × (a.2 ⟶ b.2)
  id a := (𝟙 a.1, 𝟙 a.2)
  comp f g := (f.1 ≫ g.1, f.2 ≫ g.2)
  id_comp' _ := Prod.ext' (C.id_comp _) (D.id_comp _)
  comp_id' _ := Prod.ext' (C.comp_id _) (D.comp_id _)
  assoc' _ _ _ := Prod.ext' (C.assoc _ _ _) (D.assoc _ _ _)

instance : HasCatProduct Category Category Category where
  catProduct := product_category

instance {C D : Category.{u,v+1}} : HasHom (C.α × D.α) :=
  inferInstanceAs (HasHom (C ×c D))

namespace Product

def assoc (A B C : Category) : ((A ×c B) ×c C) ⥤ (A ×c (B ×c C)) where
  obj := λ ((a, b), c) => (a, (b, c))
  map := λ ((f, g), h) => (f, (g, h))
  map_id' := λ _ => rfl
  map_comp' := λ _ _ => rfl

def symm (A B : Category) : (A ×c B) ⥤ (B ×c A) where
  obj := λ (a, b) => (b, a)
  map := λ (f, g) => (g, f)
  map_id' := λ _ => rfl
  map_comp' := λ _ _ => rfl

theorem symmetric (A B : Category) : symm A B ≫ symm B A = 𝟙 (A ×c B) := rfl

def functor_product {A B C D : Category} (F : A ⥤ C) (G : B ⥤ D) : A ×c B ⥤ C ×c D where
  obj := λ (x, y) => (F.obj x, G.obj y)
  map f := (F.map f.1, G.map f.2)
  map_id' _ := Prod.ext' (F.map_id _) (G.map_id' _)
  map_comp' _ _ := Prod.ext' (F.map_comp _ _) (G.map_comp _ _)

instance {A B C D : Category} : HasCatProduct (A ⥤ C) (B ⥤ D) (A ×c B ⥤ C ×c D) where
  catProduct := functor_product

def unit_left (C : Category) : (1 : Category) ×c C ⥤ C where
  obj := λ (_, a) => a
  map := λ (_, f) => f
  map_id' _ := rfl
  map_comp' _ _ := rfl

def unit_left_inv (C : Category) : C ⥤ (1 : Category) ×c C where
  obj := λ a => (PUnit.unit, a)
  map := λ f => (PUnit.unit, f)
  map_id' _ := rfl
  map_comp' _ _ := rfl

def unit_right (C : Category) : C ×c (1 : Category) ⥤ C where
  obj := λ (a, _) => a
  map := λ (f, _) => f
  map_id' _ := rfl
  map_comp' _ _ := rfl

def unit_right_inv (C : Category) : C ⥤ C ×c (1 : Category) where
  obj := λ a => (a, PUnit.unit)
  map := λ f => (f, PUnit.unit)
  map_id' _ := rfl
  map_comp' _ _ := rfl

end Product

end CategoryTheory.Category


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

A tactic pushing negations into an expression
-/

import logic.basic
import algebra.order

open tactic expr

namespace push_neg
section

universe u
variable  {α : Sort u}
variables (p q : Prop)
variable  (s : α → Prop)

local attribute [instance, priority 10] classical.prop_decidable
theorem not_not_eq : (¬ ¬ p) = p := propext not_not
theorem not_and_eq : (¬ (p ∧ q)) = (p → ¬ q) := propext not_and
theorem not_or_eq : (¬ (p ∨ q)) = (¬ p ∧ ¬ q) := propext not_or_distrib
theorem not_forall_eq : (¬ ∀ x, s x) = (∃ x, ¬ s x) := propext not_forall
theorem not_exists_eq : (¬ ∃ x, s x) = (∀ x, ¬ s x) := propext not_exists
theorem not_implies_eq : (¬ (p → q)) = (p ∧ ¬ q) := propext not_imp

theorem classical.implies_iff_not_or : (p → q) ↔ (¬ p ∨ q) := imp_iff_not_or

theorem not_eq (a b : α) : (¬ a = b) ↔ (a ≠ b) := iff.rfl

variable  {β : Type u}
variable [linear_order β]
theorem not_le_eq (a b : β) : (¬ (a ≤ b)) = (b < a) := propext not_le
theorem not_lt_eq (a b : β) : (¬ (a < b)) = (b ≤ a) := propext not_lt
end

meta def whnf_reducible (e : expr) : tactic expr := whnf e reducible

private meta def transform_negation_step (e : expr) :
  tactic (option (expr × expr)) :=
do e ← whnf_reducible e,
   match e with
   | `(¬ %%ne) :=
      (do ne ← whnf_reducible ne,
      match ne with
      | `(¬ %%a)      := do pr ← mk_app ``not_not_eq [a],
                            return (some (a, pr))
      | `(%%a ∧ %%b)  := do pr ← mk_app ``not_and_eq [a, b],
                            return (some (`((%%a : Prop) → ¬ %%b), pr))
      | `(%%a ∨ %%b)  := do pr ← mk_app ``not_or_eq [a, b],
                            return (some (`(¬ %%a ∧ ¬ %%b), pr))
      | `(%%a ≤ %%b)  := do e ← to_expr ``(%%b < %%a),
                            pr ← mk_app ``not_le_eq [a, b],
                            return (some (e, pr))
      | `(%%a < %%b)  := do e ← to_expr ``(%%b ≤ %%a),
                            pr ← mk_app ``not_lt_eq [a, b],
                            return (some (e, pr))
      | `(Exists %%p) := do pr ← mk_app ``not_exists_eq [p],
                            e ← match p with
                                | (lam n bi typ bo) := do
                                    body ← mk_app ``not [bo],
                                    return (pi n bi typ body)
                                | _ := tactic.fail "Unexpected failure negating ∃"
                                end,
                            return (some (e, pr))
      | (pi n bi d p) := if p.has_var then do
                            pr ← mk_app ``not_forall_eq [lam n bi d p],
                            body ← mk_app ``not [p],
                            e ←  mk_app ``Exists [lam n bi d body],
                            return (some (e, pr))
                         else do
                            pr ← mk_app ``not_implies_eq [d, p],
                            `(%%_ = %%e') ← infer_type pr,
                            return (some (e', pr))
      | _             := return none
      end)
    | _        := return none
  end

private meta def transform_negation : expr → tactic (option (expr × expr))
| e :=
do (some (e', pr)) ← transform_negation_step e | return none,
   (some (e'', pr')) ← transform_negation e' | return (some (e', pr)),
   pr'' ← mk_eq_trans pr pr',
   return (some (e'', pr''))

meta def normalize_negations (t : expr) : tactic (expr × expr) :=
do (_, e, pr) ← simplify_top_down ()
                   (λ _, λ e, do
                       oepr ← transform_negation e,
                       match oepr with
                       | (some (e', pr)) := return ((), e', pr)
                       | none            := do pr ← mk_eq_refl e, return ((), e, pr)
                       end)
                   t { eta := ff },
   return (e, pr)

meta def push_neg_at_hyp (h : name) : tactic unit :=
do H ← get_local h,
   t ← infer_type H,
   (e, pr) ← normalize_negations t,
   replace_hyp H e pr,
   skip

meta def push_neg_at_goal : tactic unit :=
do H ← target,
   (e, pr) ← normalize_negations H,
   replace_target e pr
end push_neg

open interactive (parse loc.ns loc.wildcard)
open interactive.types (location texpr)
open lean.parser (tk ident many) interactive.loc
local postfix `?`:9001 := optional
local postfix *:9001 := many
open push_neg

/--
Push negations in the goal of some assumption.

For instance, a hypothesis `h : ¬ ∀ x, ∃ y, x ≤ y` will be transformed by `push_neg at h` into
`h : ∃ x, ∀ y, y < x`. Variables names are conserved.

This tactic pushes negations inside expressions. For instance, given an assumption
```lean
h : ¬ ∀ ε > 0, ∃ δ > 0, ∀ x, |x - x₀| ≤ δ → |f x - y₀| ≤ ε)
```
writing `push_neg at h` will turn `h` into
```lean
h : ∃ ε, ε > 0 ∧ ∀ δ, δ > 0 → (∃ x, |x - x₀| ≤ δ ∧ ε < |f x - y₀|),
```

(the pretty printer does *not* use the abreviations `∀ δ > 0` and `∃ ε > 0` but this issue
has nothing to do with `push_neg`).
Note that names are conserved by this tactic, contrary to what would happen with `simp`
using the relevant lemmas. One can also use this tactic at the goal using `push_neg`,
at every assumption and the goal using `push_neg at *` or at selected assumptions and the goal
using say `push_neg at h h' ⊢` as usual.
-/
meta def tactic.interactive.push_neg : parse location → tactic unit
| (loc.ns loc_l) :=
  loc_l.mmap'
    (λ l, match l with
          | some h := do push_neg_at_hyp h,
                          try $ interactive.simp_core { eta := ff } failed tt
                                 [simp_arg_type.expr ``(push_neg.not_eq)] []
                                 (interactive.loc.ns [some h])
          | none   := do push_neg_at_goal,
                          try `[simp only [push_neg.not_eq] { eta := ff }]
          end)
| loc.wildcard := do
    push_neg_at_goal,
    local_context >>= mmap' (λ h, push_neg_at_hyp (local_pp_name h)) ,
    try `[simp only [push_neg.not_eq] at * { eta := ff }]

add_tactic_doc
{ name       := "push_neg",
  category   := doc_category.tactic,
  decl_names := [`tactic.interactive.push_neg],
  tags       := ["logic"] }

lemma imp_of_not_imp_not (P Q : Prop) : (¬ Q → ¬ P) → (P → Q) :=
λ h hP, classical.by_contradiction (λ h', h h' hP)

/-- Matches either an identifier "h" or a pair of identifiers "h with k" -/
meta def name_with_opt : lean.parser (name × option name) :=
prod.mk <$> ident <*> (some <$> (tk "with" >> ident) <|> return none)

/--
Transforms the goal into its contrapositive.

* `contrapose`     turns a goal `P → Q` into `¬ Q → ¬ P`
* `contrapose!`    turns a goal `P → Q` into `¬ Q → ¬ P` and pushes negations inside `P` and `Q`
  using `push_neg`
* `contrapose h`   first reverts the local assumption `h`, and then uses `contrapose` and `intro h`
* `contrapose! h`  first reverts the local assumption `h`, and then uses `contrapose!` and `intro h`
* `contrapose h with new_h` uses the name `new_h` for the introduced hypothesis
-/
meta def tactic.interactive.contrapose (push : parse (tk "!" )?) :
  parse name_with_opt? → tactic unit
| (some (h, h')) := get_local h >>= revert >> tactic.interactive.contrapose none >>
  intro (h'.get_or_else h) >> skip
| none :=
  do `(%%P → %%Q) ← target | fail "The goal is not an implication, and you didn't specify an assumption",
  cp ← mk_mapp ``imp_of_not_imp_not [P, Q] <|> fail "contrapose only applies to nondependent arrows between props",
  apply cp,
  when push.is_some $ try (tactic.interactive.push_neg (loc.ns [none]))

add_tactic_doc
{ name       := "contrapose",
  category   := doc_category.tactic,
  decl_names := [`tactic.interactive.contrapose],
  tags       := ["logic"] }