/-
Copyright (c) 2020 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Yaël Dillies
-/
import data.nat.pow
import tactic.by_contra

/-!
# Natural number logarithms

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

This file defines two `ℕ`-valued analogs of the logarithm of `n` with base `b`:
* `log b n`: Lower logarithm, or floor **log**. Greatest `k` such that `b^k ≤ n`.
* `clog b n`: Upper logarithm, or **c**eil **log**. Least `k` such that `n ≤ b^k`.

These are interesting because, for `1 < b`, `nat.log b` and `nat.clog b` are respectively right and
left adjoints of `nat.pow b`. See `pow_le_iff_le_log` and `le_pow_iff_clog_le`.
-/

namespace nat

/-! ### Floor logarithm -/

/-- `log b n`, is the logarithm of natural number `n` in base `b`. It returns the largest `k : ℕ`
such that `b^k ≤ n`, so if `b^k = n`, it returns exactly `k`. -/
@[pp_nodot] def log (b : ℕ) : ℕ → ℕ
| n :=
  if h : b ≤ n ∧ 1 < b then
    have n / b < n,
      from div_lt_self ((zero_lt_one.trans h.2).trans_le h.1) h.2,
    log (n / b) + 1
  else 0

@[simp] lemma log_eq_zero_iff {b n : ℕ} : log b n = 0 ↔ n < b ∨ b ≤ 1 :=
begin
  rw [log, ite_eq_right_iff],
  simp only [nat.succ_ne_zero, imp_false, decidable.not_and_distrib, not_le, not_lt]
end

lemma log_of_lt {b n : ℕ} (hb : n < b) : log b n = 0 :=
log_eq_zero_iff.2 (or.inl hb)

lemma log_of_left_le_one {b : ℕ} (hb : b ≤ 1) (n) : log b n = 0 :=
log_eq_zero_iff.2 (or.inr hb)

@[simp] lemma log_pos_iff {b n : ℕ} : 0 < log b n ↔ b ≤ n ∧ 1 < b :=
by rw [pos_iff_ne_zero, ne.def, log_eq_zero_iff, not_or_distrib, not_lt, not_le]

lemma log_pos {b n : ℕ} (hb : 1 < b) (hbn : b ≤ n) : 0 < log b n := log_pos_iff.2 ⟨hbn, hb⟩

lemma log_of_one_lt_of_le {b n : ℕ} (h : 1 < b) (hn : b ≤ n) : log b n = log b (n / b) + 1 :=
by { rw log, exact if_pos ⟨hn, h⟩ }

@[simp] lemma log_zero_left : ∀ n, log 0 n = 0 := log_of_left_le_one zero_le_one
@[simp] lemma log_zero_right (b : ℕ) : log b 0 = 0 := log_eq_zero_iff.2 (le_total 1 b)
@[simp] lemma log_one_left : ∀ n, log 1 n = 0 := log_of_left_le_one le_rfl
@[simp] lemma log_one_right (b : ℕ) : log b 1 = 0 := log_eq_zero_iff.2 (lt_or_le _ _)

/-- `pow b` and `log b` (almost) form a Galois connection. See also `nat.pow_le_of_le_log` and
`nat.le_log_of_pow_le` for individual implications under weaker assumptions. -/
lemma pow_le_iff_le_log {b : ℕ} (hb : 1 < b) {x y : ℕ} (hy : y ≠ 0) : b ^ x ≤ y ↔ x ≤ log b y :=
begin
  induction y using nat.strong_induction_on with y ih generalizing x,
  cases x,
  { exact iff_of_true hy.bot_lt (zero_le _) },
  rw log, split_ifs,
  { have b_pos : 0 < b := zero_le_one.trans_lt hb,
    rw [succ_eq_add_one, add_le_add_iff_right, ←ih (y / b) (div_lt_self hy.bot_lt hb)
      (nat.div_pos h.1 b_pos).ne', le_div_iff_mul_le b_pos, pow_succ'] },
  { exact iff_of_false (λ hby, h ⟨(le_self_pow x.succ_ne_zero _).trans hby, hb⟩)
      (not_succ_le_zero _) }
end

lemma lt_pow_iff_log_lt {b : ℕ} (hb : 1 < b) {x y : ℕ} (hy : y ≠ 0) : y < b ^ x ↔ log b y < x :=
lt_iff_lt_of_le_iff_le (pow_le_iff_le_log hb hy)

lemma pow_le_of_le_log {b x y : ℕ} (hy : y ≠ 0) (h : x ≤ log b y) : b ^ x ≤ y :=
begin
  refine (le_or_lt b 1).elim (λ hb, _) (λ hb, (pow_le_iff_le_log hb hy).2 h),
  rw [log_of_left_le_one hb, nonpos_iff_eq_zero] at h,
  rwa [h, pow_zero, one_le_iff_ne_zero]
end

lemma le_log_of_pow_le {b x y : ℕ} (hb : 1 < b) (h : b ^ x ≤ y) : x ≤ log b y :=
begin
  rcases ne_or_eq y 0 with hy | rfl,
  exacts [(pow_le_iff_le_log hb hy).1 h, (h.not_lt (pow_pos (zero_lt_one.trans hb) _)).elim]
end

lemma pow_log_le_self (b : ℕ) {x : ℕ} (hx : x ≠ 0) : b ^ log b x ≤ x :=
pow_le_of_le_log hx le_rfl

lemma log_lt_of_lt_pow {b x y : ℕ} (hy : y ≠ 0) : y < b ^ x → log b y < x :=
lt_imp_lt_of_le_imp_le (pow_le_of_le_log hy)

lemma lt_pow_of_log_lt {b x y : ℕ} (hb : 1 < b) : log b y < x → y < b ^ x :=
lt_imp_lt_of_le_imp_le (le_log_of_pow_le hb)

lemma lt_pow_succ_log_self {b : ℕ} (hb : 1 < b) (x : ℕ) :
  x < b ^ (log b x).succ :=
lt_pow_of_log_lt hb (lt_succ_self _)

lemma log_eq_iff {b m n : ℕ} (h : m ≠ 0 ∨ 1 < b ∧ n ≠ 0) :
  log b n = m ↔ b ^ m ≤ n ∧ n < b ^ (m + 1) :=
begin
  rcases em (1 < b ∧ n ≠ 0) with ⟨hb, hn⟩|hbn,
  { rw [le_antisymm_iff, ← lt_succ_iff, ← pow_le_iff_le_log, ← lt_pow_iff_log_lt, and.comm];
      assumption },
  { have hm : m ≠ 0, from h.resolve_right hbn,
    rw [not_and_distrib, not_lt, ne.def, not_not] at hbn,
    rcases hbn with hb|rfl,
    { simpa only [log_of_left_le_one hb, hm.symm, false_iff, not_and, not_lt]
        using le_trans (pow_le_pow_of_le_one' hb m.le_succ) },
    { simpa only [log_zero_right, hm.symm, false_iff, not_and, not_lt, le_zero_iff, pow_succ]
        using mul_eq_zero_of_right _ } }
end

lemma log_eq_of_pow_le_of_lt_pow {b m n : ℕ} (h₁ : b ^ m ≤ n) (h₂ : n < b ^ (m + 1)) :
  log b n = m :=
begin
  rcases eq_or_ne m 0 with rfl | hm,
  { rw [pow_one] at h₂, exact log_of_lt h₂ },
  { exact (log_eq_iff (or.inl hm)).2 ⟨h₁, h₂⟩ }
end

lemma log_pow {b : ℕ} (hb : 1 < b) (x : ℕ) : log b (b ^ x) = x :=
log_eq_of_pow_le_of_lt_pow le_rfl (pow_lt_pow hb x.lt_succ_self)

lemma log_eq_one_iff' {b n : ℕ} : log b n = 1 ↔ b ≤ n ∧ n < b * b:=
by rw [log_eq_iff (or.inl one_ne_zero), pow_add, pow_one]

lemma log_eq_one_iff {b n : ℕ} : log b n = 1 ↔ n < b * b ∧ 1 < b ∧ b ≤ n :=
log_eq_one_iff'.trans ⟨λ h, ⟨h.2, lt_mul_self_iff.1 (h.1.trans_lt h.2), h.1⟩, λ h, ⟨h.2.2, h.1⟩⟩

lemma log_mul_base {b n : ℕ} (hb : 1 < b) (hn : n ≠ 0) : log b (n * b) = log b n + 1 :=
begin
  apply log_eq_of_pow_le_of_lt_pow; rw [pow_succ'],
  exacts [mul_le_mul_right' (pow_log_le_self _ hn) _,
    (mul_lt_mul_right (zero_lt_one.trans hb)).2 (lt_pow_succ_log_self hb _)]
end

lemma log_monotone {b : ℕ} : monotone (log b) :=
begin
  refine monotone_nat_of_le_succ (λ n, _),
  cases le_or_lt b 1 with hb hb,
  { rw log_of_left_le_one hb, exact zero_le _ },
  { exact le_log_of_pow_le hb (pow_log_le_add_one _ _) }
end

@[mono] lemma log_mono_right {b n m : ℕ} (h : n ≤ m) : log b n ≤ log b m :=
log_monotone h

@[mono] lemma log_anti_left {b c n : ℕ} (hc : 1 < c) (hb : c ≤ b) : log b n ≤ log c n :=
begin
  rcases eq_or_ne n 0 with rfl | hn, { rw [log_zero_right, log_zero_right] },
  apply le_log_of_pow_le hc,
  calc c ^ log b n ≤ b ^ log b n : pow_le_pow_of_le_left' hb _
               ... ≤ n           : pow_log_le_self _ hn
end

lemma log_antitone_left {n : ℕ} : antitone_on (λ b, log b n) (set.Ioi 1) :=
λ _ hc _ _ hb, log_anti_left (set.mem_Iio.1 hc) hb

@[simp] lemma log_div_base (b n : ℕ) : log b (n / b) = log b n - 1 :=
begin
  cases le_or_lt b 1 with hb hb,
  { rw [log_of_left_le_one hb, log_of_left_le_one hb, nat.zero_sub] },
  cases lt_or_le n b with h h,
  { rw [div_eq_of_lt h, log_of_lt h, log_zero_right] },
  rw [log_of_one_lt_of_le hb h, add_tsub_cancel_right]
end

@[simp] lemma log_div_mul_self (b n : ℕ) : log b (n / b * b) = log b n :=
begin
  cases le_or_lt b 1 with hb hb,
  { rw [log_of_left_le_one hb, log_of_left_le_one hb] },
  cases lt_or_le n b with h h,
  { rw [div_eq_of_lt h, zero_mul, log_zero_right, log_of_lt h] },
  rw [log_mul_base hb (nat.div_pos h (zero_le_one.trans_lt hb)).ne', log_div_base,
    tsub_add_cancel_of_le (succ_le_iff.2 $ log_pos hb h)]
end

private lemma add_pred_div_lt {b n : ℕ} (hb : 1 < b) (hn : 2 ≤ n) : (n + b - 1) / b < n :=
begin
  rw [div_lt_iff_lt_mul (zero_lt_one.trans hb), ←succ_le_iff, ←pred_eq_sub_one,
    succ_pred_eq_of_pos (add_pos (zero_lt_one.trans hn) (zero_lt_one.trans hb))],
  exact add_le_mul hn hb,
end

/-! ### Ceil logarithm -/

/-- `clog b n`, is the upper logarithm of natural number `n` in base `b`. It returns the smallest
`k : ℕ` such that `n ≤ b^k`, so if `b^k = n`, it returns exactly `k`. -/
@[pp_nodot] def clog (b : ℕ) : ℕ → ℕ
| n :=
  if h : 1 < b ∧ 1 < n then
    have (n + b - 1)/b < n := add_pred_div_lt h.1 h.2,
    clog ((n + b - 1)/b) + 1
  else 0

lemma clog_of_left_le_one {b : ℕ} (hb : b ≤ 1) (n : ℕ) : clog b n = 0 :=
by rw [clog, if_neg (λ h : 1 < b ∧ 1 < n, h.1.not_le hb)]

lemma clog_of_right_le_one {n : ℕ} (hn : n ≤ 1) (b : ℕ) : clog b n = 0 :=
by rw [clog, if_neg (λ h : 1 < b ∧ 1 < n, h.2.not_le hn)]

@[simp] lemma clog_zero_left (n : ℕ) : clog 0 n = 0 :=
clog_of_left_le_one zero_le_one _

@[simp] lemma clog_zero_right (b : ℕ) : clog b 0 = 0 :=
clog_of_right_le_one zero_le_one _

@[simp] lemma clog_one_left (n : ℕ) : clog 1 n = 0 :=
clog_of_left_le_one le_rfl _

@[simp] lemma clog_one_right (b : ℕ) : clog b 1 = 0 :=
clog_of_right_le_one le_rfl _

lemma clog_of_two_le {b n : ℕ} (hb : 1 < b) (hn : 2 ≤ n) :
  clog b n = clog b ((n + b - 1)/b) + 1 :=
by rw [clog, if_pos (⟨hb, hn⟩ : 1 < b ∧ 1 < n)]

lemma clog_pos {b n : ℕ} (hb : 1 < b) (hn : 2 ≤ n) : 0 < clog b n :=
by { rw clog_of_two_le hb hn, exact zero_lt_succ _ }

lemma clog_eq_one {b n : ℕ} (hn : 2 ≤ n) (h : n ≤ b) : clog b n = 1 :=
begin
  rw [clog_of_two_le (hn.trans h) hn, clog_of_right_le_one],
  have n_pos : 0 < n := zero_lt_two.trans_le hn,
  rw [←lt_succ_iff, nat.div_lt_iff_lt_mul (n_pos.trans_le h), ←succ_le_iff,
    ←pred_eq_sub_one, succ_pred_eq_of_pos (add_pos n_pos (n_pos.trans_le h)), succ_mul, one_mul],
  exact add_le_add_right h _,
end

/--`clog b` and `pow b` form a Galois connection. -/
lemma le_pow_iff_clog_le {b : ℕ} (hb : 1 < b) {x y : ℕ} : x ≤ b ^ y ↔ clog b x ≤ y :=
begin
  induction x using nat.strong_induction_on with x ih generalizing y,
  cases y,
  { rw [pow_zero],
    refine ⟨λ h, (clog_of_right_le_one h b).le, _⟩,
    simp_rw ←not_lt,
    contrapose!,
    exact clog_pos hb },
  have b_pos : 0 < b := zero_lt_two.trans_le hb,
  rw clog, split_ifs,
  { rw [succ_eq_add_one, add_le_add_iff_right, ←ih ((x + b - 1)/b) (add_pred_div_lt hb h.2),
      nat.div_le_iff_le_mul_add_pred b_pos,
      ← pow_succ, add_tsub_assoc_of_le (nat.succ_le_of_lt b_pos), add_le_add_iff_right] },
  { exact iff_of_true ((not_lt.1 (not_and.1 h hb)).trans $ succ_le_of_lt $ pow_pos b_pos _)
    (zero_le _) }
end

lemma pow_lt_iff_lt_clog {b : ℕ} (hb : 1 < b) {x y : ℕ} : b ^ y < x ↔ y < clog b x :=
lt_iff_lt_of_le_iff_le (le_pow_iff_clog_le hb)

lemma clog_pow (b x : ℕ) (hb : 1 < b) : clog b (b ^ x) = x :=
eq_of_forall_ge_iff $ λ z,
by { rw ←le_pow_iff_clog_le hb, exact (pow_right_strict_mono hb).le_iff_le }

lemma pow_pred_clog_lt_self {b : ℕ} (hb : 1 < b) {x : ℕ} (hx : 1 < x) :
  b ^ (clog b x).pred < x :=
begin
  rw [←not_le, le_pow_iff_clog_le hb, not_le],
  exact pred_lt (clog_pos hb hx).ne',
end

lemma le_pow_clog {b : ℕ} (hb : 1 < b) (x : ℕ) : x ≤ b ^ clog b x :=
(le_pow_iff_clog_le hb).2 le_rfl

@[mono] lemma clog_mono_right (b : ℕ) {n m : ℕ} (h : n ≤ m) : clog b n ≤ clog b m :=
begin
  cases le_or_lt b 1 with hb hb,
  { rw clog_of_left_le_one hb, exact zero_le _ },
  { rw ←le_pow_iff_clog_le hb,
    exact h.trans (le_pow_clog hb _) }
end

@[mono] lemma clog_anti_left {b c n : ℕ} (hc : 1 < c) (hb : c ≤ b) : clog b n ≤ clog c n :=
begin
  rw ← le_pow_iff_clog_le (lt_of_lt_of_le hc hb),
  calc
    n ≤ c ^ clog c n : le_pow_clog hc _
  ... ≤ b ^ clog c n : pow_le_pow_of_le_left (zero_lt_one.trans hc).le hb _
end

lemma clog_monotone (b : ℕ) : monotone (clog b) :=
λ x y, clog_mono_right _

lemma clog_antitone_left {n : ℕ} : antitone_on (λ b : ℕ, clog b n) (set.Ioi 1) :=
λ _ hc _ _ hb, clog_anti_left (set.mem_Iio.1 hc) hb

lemma log_le_clog (b n : ℕ) : log b n ≤ clog b n :=
begin
  obtain hb | hb := le_or_lt b 1,
  { rw log_of_left_le_one hb,
    exact zero_le _},
  cases n,
  { rw log_zero_right,
    exact zero_le _},
  exact (pow_right_strict_mono hb).le_iff_le.1 ((pow_log_le_self b n.succ_ne_zero).trans $
    le_pow_clog hb _),
end

end nat


import MyNat.Definition
namespace MyNat
open MyNat
/-!

# Proposition world.

## Level 4: `apply`.

Let's do the same level again a different way:

![diagram](../assets/propositions_diag.svg)

We are given a proof `p` of `P` and our goal is to find a proof of `U`, or
in other words to find a path through the maze that links `P` to `U`.
In level 3 we solved this by using `have`s to move forward, from `P`
to `Q` to `T` to `U`. Using the `apply` tactic we can instead construct
the path backwards, moving from `U` to `T` to `Q` to `P`.

Our goal is to prove `U`. But `l:T ⟹ U` is
an implication which we are assuming, so it would suffice to prove `T`.
Tell Lean this by starting the proof below with

`apply l,`

and notice that our assumptions don't change but *the goal changes*
from `⊢ U` to `⊢ T`.

Keep `apply`ing implications until your goal is `P`, and try not
to get lost! Now solve this goal
with `exact p`. Note: you will need to learn the difference between
`exact p` (which works) and `exact P` (which doesn't, because `P` is
not a proof of `P`).

## Lemma : maze₂
We can solve a maze.
-/
lemma maze₂ (P Q R S T U: Prop)
(p : P)
(h : P → Q)
(i : Q → R)
(j : Q → T)
(k : S → T)
(l : T → U)
: U := by
  apply l
  apply j
  apply h
  exact p

/-!
Next up [Level 5](./Level5.lean.md)
-/


/- Even and odd natural numbers. -/

import data.nat.modeq
import ent.basic
import ent.modeq
import ent.xor

namespace nat

-- * Definition

def even (a : ℕ) := a ≡ 0 [MOD 2]
def odd (a : ℕ) := a ≡ 1 [MOD 2]

instance decidable_even {a : ℕ} : decidable (even a) :=
  by unfold even; apply_instance
instance decidable_odd {a : ℕ} : decidable (odd a) :=
  by unfold odd; apply_instance

-- * Basic facts

theorem even_iff_two_dvd {a : ℕ} : even a ↔ 2 ∣ a := modeq.modeq_zero_iff

theorem even_or_odd (a : ℕ) : even a ∨ odd a :=
  mod_two_eq_zero_or_one a

theorem not_even_and_odd (a : ℕ) : ¬ (even a ∧ odd a) :=
  λ ⟨ea, oa⟩,
  have h : 0 ≡ 1 [MOD 2] := ea.symm.trans oa,
  (dec_trivial : ¬ (0 ≡ 1 [MOD 2])) h

theorem even_xor_odd {a : ℕ} : xor (even a) (odd a) :=
  xor.mk (even_or_odd a) (not_even_and_odd a)

theorem odd_plus_odd_is_even {a b : ℕ} : odd a → odd b → even (a + b) :=
  modeq.modeq_add

theorem odd_plus_even_is_odd {a b : ℕ} : odd a → even b → odd (a + b) :=
  modeq.modeq_add

theorem even_plus_odd_is_odd {a b : ℕ} : even a → odd b → odd (a + b) :=
  modeq.modeq_add

theorem odd_minus_odd_is_even {a b : ℕ} (H : a ≤ b) : odd a → odd b → even (b - a) :=
  begin
    intros oa ob,
    cases even_or_odd (b - a) with eba oba,
    { assumption },
    { have h : even (a + (b - a)) := odd_plus_odd_is_even oa oba,
      rw add_sub_of_le H at h,
      have := and.intro h ob,
      have := not_even_and_odd b,
      contradiction }
  end

theorem even_times_any_is_even {a b : ℕ} : even a → even (a * b) := λ ea,
  even_iff_two_dvd.mpr $ dvd.trans (even_iff_two_dvd.mp ea) (dvd_mul_right a b)

theorem two_n_even (n : ℕ) : even (2 * n) :=
  even_times_any_is_even (dec_trivial : 2 ≡ 0 [MOD 2])

theorem two_n_not_odd (n : ℕ) : ¬ (odd (2 * n)) :=
  even_xor_odd.resolve_right.mpr (two_n_even n)

theorem odd_times_odd_is_odd {a b : ℕ} : odd a → odd b → odd (a * b) := modeq.modeq_mul

theorem even_square_is_even {a : ℕ} : even a → even (a^2) :=
  by rw pow_two; apply even_times_any_is_even

theorem odd_square_is_odd {a : ℕ} : odd a → odd (a^2) := begin
  intro oa,
  rw pow_two,
  exact (odd_times_odd_is_odd oa oa)
end

theorem even_iff_square_even {a : ℕ} : even a ↔ even (a^2) :=
  iff.intro even_square_is_even
  (even_xor_odd.resolve_right.mp ∘ mt odd_square_is_odd ∘
   even_xor_odd.resolve_right.mpr)

theorem odd_iff_square_odd {a : ℕ} : odd a ↔ odd (a^2) :=
  iff.intro odd_square_is_odd
  (even_xor_odd.resolve_left.mp ∘ mt even_square_is_even ∘
   even_xor_odd.resolve_left.mpr)

/- This is longer anyways
theorem odd_iff_square_odd {a : ℕ} : odd a ↔ odd (a^2) :=
calc odd a ↔ ¬ even a      : even_xor_odd.resolve_left.symm
     ...   ↔ ¬ even (a^2)  : not_congr even_iff_square_even
     ...   ↔ odd (a^2)     : even_xor_odd.resolve_left
-/

theorem not_both_even_if_coprime {a b : ℕ} : coprime a b → ¬ (even a ∧ even b)
  := begin
  intros a_b eab, cases eab with ea eb,
  rw even_iff_two_dvd at ea eb,
  have := not_coprime_of_dvd_of_dvd dec_trivial ea eb, contradiction
end

end nat

open nat

-- * Squares of even and odd numbers mod 4

lemma odd_number_lemma {a : ℕ} (o : odd a) : ∃ k : ℕ, a = 2*k + 1 := modeq.rep_of_modeq o dec_trivial

lemma odd_square_lemma {k : ℕ} : (2*k+1)^2 = 4*(k*k + k) + 1 :=
  calc
    (2*k+1)^2 = (2*k + 1) * (2*k + 1)     : by rw nat.pow_two
    ...       = 2*k * (2*k + 1) + 1 * (2*k + 1) : by rw right_distrib
    ...       = 2*k * (2*k + 1) + 2*k + 1 : by simp
    ...       = 2*k * (2*k) + 2*k * 1 + 2*k + 1 : by rw left_distrib
    ...       = 2*k*2*k + 2*k * 1 + 2*k + 1   : by rw ←mul_assoc
    ...       = 2*k*2*k + 2*k + 2*k + 1   : by simp
    ...       = 2*(k*2)*k + 2*k + 2*k + 1 : by rw ←mul_assoc
    ...       = 2*(2*k)*k + 2*k + 2*k + 1 : by rw (mul_comm k 2)
    ...       = 2*2*k*k + 2*k + 2*k + 1   : by rw ←mul_assoc
    ...       = 4*k*k + 2*k + 2*k + 1     : by refl
    ...       = 4*k*k + (2*k + 2*k) + 1   : by rw (add_assoc (4*k*k) (2*k) (2*k))
    ...       = 4*k*k + (2 + 2)*k + 1     : by rw (right_distrib 2 2 k)
    ...       = 4*k*k + 4*k + 1           : by refl
    ...       = 4*(k*k) + 4*k + 1         : by rw mul_assoc
    ...       = 4*(k*k + k) + 1           : by rw left_distrib

theorem odd_square_mod_four {a : ℕ} : odd a → a^2 ≡ 1 [MOD 4] :=
  begin
    intro o,
    cases modeq.rep_of_modeq o dec_trivial with k,
    rw [h, odd_square_lemma],
    apply modeq.modeq_of_rep
  end

theorem even_square_mod_four {a : ℕ} : even a → a^2 ≡ 0 [MOD 4] :=
  begin
    intro e,
    rw modeq.modeq_zero_iff,
    have h : 2 ∣ a := begin rw ←modeq.modeq_zero_iff, assumption end,
    have h2 : 4 ∣ a^2 := begin
      rw nat.pow_two,
      apply (mul_dvd_mul h h)
    end,
    assumption
  end

theorem square_two_mod_four {a : ℕ} : ¬ (a^2 ≡ 2 [MOD 4]) :=
  begin
    intro,
    cases even_or_odd a,
    { have h1 : 2 ≡ 0 [MOD 4] :=
        modeq.trans (modeq.symm a_1) (even_square_mod_four h),
      have h2 : ¬ (2 ≡ 0 [MOD 4]) := dec_trivial,
      exact h2 h1 },
    { have h1 : 2 ≡ 1 [MOD 4] :=
        modeq.trans (modeq.symm a_1) (odd_square_mod_four h),
      have h2 : ¬ (2 ≡ 1 [MOD 4]) := dec_trivial,
      exact h2 h1 }
  end


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics
import data.real.basic -- imports the real numbers

/-!

# The real numbers in Lean

Lean has a copy of of the real numbers. It's called `real`,
but we use the usual notation `ℝ`. Put your cursor on the `ℝ` to find
out how to type it in VS Code.

In this sheet you will prove some basic equalities and inequalities
between "numerical expressions" in Lean. A numeral is something like `37`,
and a numerical expression is something like `(37 + 6) / 4`. To make
things a bit harder, I will throw in some `∃` statements. To make
progress on an `∃` goal, use the `use` tactic.

## Tactics

New tactics you'll need to know about:

* `norm_num` (proves equalities and inequalities involving numerical expressions)
* `use` (if the goal is `∃ x, x + 37 = 42` then `use 8` will change the goal
*        to `8 + 37 = 42`, and `use 10` will change it to `10 + 37 = 42`.

-/

example : (2 : ℝ) + 2 = 4 :=
begin
  norm_num,
end

example : (2 : ℝ) + 2 ≠ 5 :=
begin
  norm_num,
end

example : (2 : ℝ) + 2 < 5 :=
begin
  norm_num,
end

example : ∃ (x : ℝ), 3 * x + 7 = 12 :=
begin
  use 5/3,
  norm_num,
end

example : ∃ (x : ℝ), 3 * x + 7 ≠ 12 :=
begin
  use 3,
  norm_num,
end

example : ∃ (x y : ℝ), 2 * x + 3 * y = 7 ∧ x + 2 * y = 4 :=
begin
  use [2, 1],
  split;
  norm_num,
end


import tactic -- hide
import data.real.basic -- hide

/-
## Divisibility of an obvious multiple

Recall that a natural number $d$ divides another one $n$ if there is some $t$
such that $n = dt$. Below you have the *Lean* definition:
-/
lemma divides_def {d n : ℕ} : d ∣ n ↔ ∃ t, n = d * t
:= iff.rfl -- hide

/- Axiom : divides_def
d ∣ n ↔ ∃ t, n = d * t
-/

/-
The following useful lemma just says that any natural number divides
a multiple of itself, and its proof should just be one or two lines.
-/

/- Lemma :
Every natural number $k$ divides $k \cdot r$
-/
lemma divides_mul_left {k k' r : ℕ} : (k ∣ k') → k ∣ k' * r :=
begin
  intro h,
  cases h with s hs,
  use r * s,
  rw hs,
  ring,

end

lemma divides_mul_right {k k' r : ℕ} : (k ∣ k') → (k ∣ r * k') := by {rw mul_comm, exact divides_mul_left} -- hide

/- Axiom : divides_mul_right
k ∣ k' → k ∣ r * k'
-/


-- import the definitions of uniform space via entourages
import uniform_structure.entourages

-- import the definition of pseudometric space
import pseudometric_space

-- In this exercise we will show that a pseudometric on a set X
-- gives rise to a collection of entourages for X

-- This is a question about pseudometrics so let's put it
-- in the pseudometric namespace

namespace pseudometric

-- Let X be a set (or a type), and let d be a pseudometric on X
variables {X : Type} (d : X → X → ℝ) [is_pseudometric d]

-- Define U ⊆ X × X to be an entourage if there exists ε > 0 such
-- that d(x,y)≤ε → (x,y) ∈ U

def entourages :=
  {U : set (X × X) | ∃ ε > 0, ∀ x y : X, d x y ≤ ε → (x,y) ∈ U}

-- this lemma is true by definition
lemma mem_entourages (U : set (X × X)) :
  U ∈ entourages d ↔ ∃ ε > 0, ∀ x y : X, d x y ≤ ε → (x,y) ∈ U := iff.rfl

-- The exerise is to show that the 5 axioms of a uniform space are
-- satisfied.

-- Hint: You can `rw mem_entourages` to change from `U ∈ entourages d` to the
-- explicit epsilon definition.

-- Hint: if `hU : U ∈ entourages d` then `obtain ⟨ε, hε, hεU⟩ := hU` will
-- get you the ε which is a witness to U being an entourage for d.

-- Axiom 1: the diagonal is in U
lemma refl (U : set (X × X)) (hU : U ∈ entourages d) :
  ∀ (x : X), (x, x) ∈ U :=
begin
  sorry
end

-- Axiom 2: anything bigger than an entourage is an entourage
lemma bigger (U V : set (X × X)) (hU : U ∈ entourages d) (hUV : U ⊆ V) :
  V ∈ entourages d :=
begin
  sorry
end

-- Axiom 3: Intersection of two entourages is an entourage
lemma inter (U V : set (X × X)) (hU : U ∈ entourages d) (hV : V ∈ entourages d) :
  U ∩ V ∈ entourages d :=
begin
  sorry
end

-- Axiom 4: the "square root" axiom.
-- You'll need `mem_comp_ent` here (defined in the entourages file)
lemma comp (U : set (X × X)) (hU : U ∈ entourages d) :
 ∃ (V : set (X × X)) (H : V ∈ entourages d), V ∘ V ⊆ U :=
begin
  sorry
end

-- Axiom 5: the "transpose" axiom.
lemma symm (U : set (X × X)) (hU : U ∈ entourages d) :
  {z : X × X | (z.snd, z.fst) ∈ U} ∈ entourages d :=
begin
  sorry
end

definition to_entourages : uniform_space_entourage X :=
{ entourages := entourages d,
  refl := refl d,
  bigger := bigger d,
  inter := inter d,
  comp := comp d,
  symm := symm d }

end pseudometric


-- real numbers
import data.real.basic

-- useful lemmas
import xenalib.M1F.help_for_0107

noncomputable theory

def A : set ℝ := { x | x^2 < 3}
def B : set ℝ := { x | x^2 < 3 ∧ ∃ y : ℤ, x = y}
def C : set ℝ := { x | x^3 < 3}

definition real_half := (1 / 2 : ℝ)
-- useful lemmas

definition B_is_minus_one_zero_one : ∀ {x : ℝ}, x ∈ B ↔ x = -1 ∨ x = 0 ∨ x = 1
:= Q0107.B_is_minus_one_zero_one

definition real_half_not_in_B : real_half ∉ B
:= Q0107.real_half_not_in_B

-- For each part x, prove exactly one of part_x_true and
-- part_x_false, and comment out the other one!

theorem part_a_true : (1/2 : ℝ) ∈ A ∩ B := sorry
theorem part_a_false : ¬ (1/2 : ℝ) ∈ A ∩ B := sorry
theorem part_b_true : (1/2 : ℝ) ∈ A ∪ B := sorry
theorem part_b_false : ¬ (1/2 : ℝ) ∈ A ∪ B := sorry
theorem part_c_true : A ⊆ C := sorry
theorem part_c_false : ¬ A ⊆ C := sorry
theorem part_d_true : B ⊆ C := sorry
theorem part_d_false : ¬ B ⊆ C := sorry
theorem part_e_true : C ⊆ A ∪ B := sorry
theorem part_e_false : ¬ C ⊆ A ∪ B := sorry
theorem part_f_true : (A ∩ B) ∪ C = (A ∪ B) ∩ C := sorry
theorem part_f_false : ¬ (A ∩ B) ∪ C = (A ∪ B) ∩ C := sorry


import ..lovelib
import ..lectures.love01_definitions_and_statements_demo

/-! # LoVe Homework 5: Inductive Predicates and Big Step Semantics

Homework must be done individually.

This homework combines material from Ch. 5 and part of Ch. 8 of the Hitchhiker's Guide.
-/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-!
## Chapter 5: Inductive Predicates

## Question 1 (3 points + 1 bonus point): A Type of λ-Terms

Recall the type of λ-terms from question 3 of exercise 4: -/

inductive term : Type
| var : string → term
| lam : string → term → term
| app : term → term → term

/-! 1.1 (1 point). Define an inductive predicate `is_lam` that returns `true` if
its argument is of the form `term.lam …` and that returns false otherwise. -/

-- enter your definition here

/-! 1.2 (2 points). Validate your answer to question 1.1 by proving the following
lemmas: -/

lemma is_lam_lam (s : string) (t : term) :
  is_lam (term.lam s t) :=
sorry

lemma not_is_lam_var (s : string) :
  ¬ is_lam (term.var s) :=
sorry

lemma not_is_lam_app (t u : term) :
  ¬ is_lam (term.app t u) :=
sorry

/-! 1.3 (1 bonus point). Define an inductive predicate `is_βnf` that determines
whether a λ-term is in β-normal form. A λ-term is in β-normal form if it
contains no subterm of the form `(λx, t) u`, i.e., a λ-expression applied to an
argument. Another way to characterize the β-normal form is to say that no
β-reduction is possible in the term.

Hint: Use `is_lam` somewhere. -/

-- enter your definition here

/-! ## Question 2 (4 points): Transitive Closure

In mathematics, the transitive closure `R⁺` of a binary relation `R` over a
set `A` can be defined as the smallest solution satisfying the following rules:

    (base) for all `a, b ∈ A`, if `a R b`, then `a R⁺ b`;
    (step) for all `a, b, c ∈ A`, if `a R b` and `b R⁺ c`, then `a R⁺ c`.

In Lean, we can define this notion as follows, by identifying the set `A` with
the type `α`: -/

inductive tc_v1 {α : Type} (r : α → α → Prop) : α → α → Prop
| base {a b : α}   : r a b → tc_v1 a b
| step {a b c : α} : r a b → tc_v1 b c → tc_v1 a c

/-! 2.1 (1 point). Rule `(step)` makes it convenient to extend transitive chains
by adding links to the left. Another way to define the transitive closure `R⁺`
would use replace `(step)` with the following right-leaning rule:

    (pets) for all `a, b, c ∈ A`, if `a R⁺ b` and `b R c`, then `a R⁺ c`.

Define a predicate `tc_v2` that embodies this alternative definition. -/

-- enter your definition here

/-! 2.2 (1 point). Yet another definition of the transitive closure `R⁺` would
use the following symmetric rule instead of `(step)` or `(pets)`:

    (trans) for all `a, b, c ∈ A`, if `a R⁺ b` and `b R⁺ c`, then `a R⁺ c`.

Define a predicate `tc_v3` that embodies this alternative definition. -/

-- enter your definition here

/-! 2.3 (1 point). Prove that `(step)` also holds as a lemma about `tc_v3`. -/

lemma tc_v3_step {α : Type} (r : α → α → Prop) (a b c : α) (rab : r a b)
    (tbc : tc_v3 r b c) :
  tc_v3 r a c :=
sorry

/-! 2.4 (1 point). Prove the following lemma by rule induction: -/

lemma tc_v1_pets {α : Type} (r : α → α → Prop) (c : α) :
  ∀a b, tc_v1 r a b → r b c → tc_v1 r a c :=
sorry

/-! ## Question 3 (5 points): Arithmetic expressions

Recall the type of arithmetic expressions from lecture 1 and its evaluation
function: -/

#check aexp
#check eval

/-! Let us introduce the following abbreviation for an environment that maps
variable names to values: -/

def envir : Type :=
string → ℤ

/-! 3.1 (2 points). Complete the following Lean definition of a big-step-style
semantics for arithmetic expressions. The predicate `big_step` (`⟹`) relates
an arithmetic expression, an environment, and the value to which it the
expression evaluates in the given environment: -/

inductive big_step : aexp × envir → ℤ → Prop
| num {i env} : big_step (aexp.num i, env) i

infix ` ⟹ ` : 110 := big_step

/-! 3.2 (1 point). Prove the following lemma to validate your definition
above. -/

lemma big_step_add_two_two (env : envir) :
  (aexp.add (aexp.num 2) (aexp.num 2), env) ⟹ 4 :=
sorry

/-! 3.3 (2 points). Prove that the big-step semantics is sound with respect to
the `eval` function: -/

lemma big_step_sound (env : envir) (a : aexp) (i : ℤ) :
  (a, env) ⟹ i → eval env a = i :=
sorry

end LoVe


import NNG.Metadata

Level 4

Title "Addition"

Introduction
"
Peano defined addition `a + b` by induction on `b`, or,
more precisely, by *recursion* on `b`. He first explained how to add 0 to a number:
this is the base case.

* `add_zero (a : ℕ) : a + 0 = a`

We will call this theorem `add_zero`. It has just appeared in your inventory!
Mathematicians sometimes call it \"Lemma 2.1\" or \"Hypothesis P6\" or something. But
computer scientists call it `add_zero` because it tells you
what the answer to \"$x$ add zero\" is. It's a *much* better name than \"Lemma 2.1\".
Even better, we can use the rewrite tactic with `add_zero`.
If you ever see `x + 0` in your goal, `rewrite [add_zero]` will simplify it to `x`.
This is because `add_zero` is a proof that `x + 0 = x` (more precisely,
`add_zero x` is a proof that `x + 0 = x` but Lean can figure out the `x` from the context).

Now here's the inductive step. If you know how to add `d` to `a`, then
Peano tells you how to add `succ(d)` to `a`. It looks like this:

* `add_succ (a d : ℕ) : a + succ(d) = succ (a + d)`

What's going on here is that we assume `a + d` is already
defined, and we define `a + succ(d)` to be the number after it.
This is also in your inventory now -- `add_succ` tells you
how to add a successor to something. If you ever see `... + succ ...`
in your goal, you should be able to use `rewrite [add_succ]` to make
progress. Here is a simple example where we shall see both. Let's prove
that $x$ add the number after $0$ is the number after $x$.

Observe that the goal mentions `... + succ ...`. So type

`rewrite [add_succ]`

and hit enter; see the goal change.
"

Statement (a : ℕ ) : a + succ 0 = succ a := by
  rewrite [add_succ]
  rewrite [add_zero]
  rfl

Message (a : ℕ) : succ (a + 0) = succ a  => "
Do you see that the goal now mentions ` ... + 0 ...`? So type

`rewrite [add_zero]`

and try to finish the level alone from there.
"

Conclusion "Congratulations for completing your fourth level! This is the end of the tutorial part
of the game. Serious things start in the next level."

Tactics rfl rewrite

Lemmas add_succ add_zero


variable (α : Type) (p q : α → Prop)

example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
  have h_lhs : (∀ x, p x ∧ q x) → (∀ x, p x) ∧ (∀ x, q x) :=
    (fun h : (∀ x, p x ∧ q x) =>
      And.intro
      (fun y : α =>
          (show (p y) from (h y).left))
      (fun y : α =>
          (show (q y) from (h y).right)))
  have h_rhs :  (∀ x, p x) ∧ (∀ x, q x) → (∀ x, p x ∧ q x):=
    (fun h : (∀ x, p x) ∧ (∀ x, q x) =>
      (fun y : α =>
        And.intro ((And.left h) y) ((And.right h) y)))
  Iff.intro h_lhs h_rhs

example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) :=
  fun f : (∀ x, p x → q x) =>
  fun g : (∀ x, p x) =>
  (fun y : α =>
    (f y) (g y))

example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x :=
  fun f : (∀ x, p x) ∨ (∀ x, q x) =>
  (fun y : α =>
    Or.elim f
      (fun f1 : (∀ x, p x) =>
        Or.inl (f1 y))
      (fun f2 : (∀ x, q x) =>
        Or.inr (f2 y)))

example : ∃ x : Nat, x > 0 :=
  have h : 1 > 0 := Nat.zero_lt_succ 0
  Exists.intro 1 h

example (x : Nat) (h : x > 0) : ∃ y, y < x :=
  Exists.intro 0 h

#check @Exists.intro

variable (α : Type) (p q : α → Prop)

example (h : ∃ x, p x ∧ q x) : ∃ x, q x ∧ p x:=
  Exists.elim h
    (fun w =>
      (fun hw : p w ∧ q w =>
        Exists.intro w (And.intro hw.right hw.left)))

def is_even (a : Nat) := ∃ b, a = 2 * b

theorem even_plus_even (h1 : is_even a) (h2 : is_even b) : is_even (a + b) :=
  match h1, h2 with
  | ⟨w1, hw1⟩, ⟨w2, hw2⟩ => ⟨w1 + w2 , by rw [hw1, hw2, Nat.mul_add]⟩


/-
Copyright (c) 2020 Bolton Bailey. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bolton Bailey
-/
import data.fintype.basic
import group_theory.order_of_element
import tactic.zify
import data.nat.totient

/-!
# The Lucas test for primes.

This file implements the Lucas test for primes (not to be confused with the Lucas-Lehmer test for
Mersenne primes). A number `a` witnesses that `n` is prime if `a` has order `n-1` in the
multiplicative group of integers mod `n`. This is checked by verifying that `a^(n-1) = 1 (mod n)`
and `a^d ≠ 1 (mod n)` for any divisor `d | n - 1`. This test is the basis of the Pratt primality
certificate.

## TODO

- Bonus: Show the reverse implication i.e. if a number is prime then it has a Lucas witness.
  Use `units.is_cyclic` from `ring_theory/integral_domain` to show the group is cyclic.
- Write a tactic that uses this theorem to generate Pratt primality certificates
- Integrate Pratt primality certificates into the norm_num primality verifier

## Implementation notes

Note that the proof for `lucas_primality` relies on analyzing the multiplicative group
modulo `p`. Despite this, the theorem still holds vacuously for `p = 0` and `p = 1`: In these
cases, we can take `q` to be any prime and see that `hd` does not hold, since `a^((p-1)/q)` reduces
to `1`.
-/

/--
If `a^(p-1) = 1 mod p`, but `a^((p-1)/q) ≠ 1 mod p` for all prime factors `q` of `p-1`, then `p`
is prime. This is true because `a` has order `p-1` in the multiplicative group mod `p`, so this
group must itself have order `p-1`, which only happens when `p` is prime.
-/
theorem lucas_primality (p : ℕ) (a : zmod p) (ha : a^(p-1) = 1)
  (hd : ∀ q : ℕ, q.prime → q ∣ (p-1) → a^((p-1)/q) ≠ 1) : p.prime :=
begin
  have h0 : p ≠ 0, { rintro ⟨⟩, exact hd 2 nat.prime_two (dvd_zero _) (pow_zero _) },
  have h1 : p ≠ 1, { rintro ⟨⟩, exact hd 2 nat.prime_two (dvd_zero _) (pow_zero _) },
  have hp1 : 1 < p := lt_of_le_of_ne h0.bot_lt h1.symm,
  have order_of_a : order_of a = p-1,
  { apply order_of_eq_of_pow_and_pow_div_prime _ ha hd,
    exact tsub_pos_of_lt hp1, },
  haveI : ne_zero p := ⟨h0⟩,
  rw nat.prime_iff_card_units,
  -- Prove cardinality of `units` of `zmod p` is both `≤ p-1` and `≥ p-1`
  refine le_antisymm (nat.card_units_zmod_lt_sub_one hp1) _,
  have hp' : p - 2 + 1 = p - 1 := tsub_add_eq_add_tsub hp1,
  let a' : (zmod p)ˣ := units.mk_of_mul_eq_one a (a ^ (p-2)) (by rw [←pow_succ, hp', ha]),
  calc p - 1 = order_of a : order_of_a.symm
  ... = order_of a' : order_of_injective (units.coe_hom (zmod p)) units.ext a'
  ... ≤ fintype.card (zmod p)ˣ : order_of_le_card_univ,
end


/-
Copyright (c) 2020 Zhouhang Zhou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhouhang Zhou, Yury Kudryashov
-/
import data.indicator_function
import analysis.normed_space.basic

/-!
# Indicator function and norm

This file contains a few simple lemmas about `set.indicator` and `norm`.

## Tags
indicator, norm
-/

variables {α E : Type*} [normed_group E] {s t : set α} (f : α → E) (a : α)

open set

lemma norm_indicator_eq_indicator_norm :
  ∥indicator s f a∥ = indicator s (λa, ∥f a∥) a :=
flip congr_fun a (indicator_comp_of_zero norm_zero).symm

lemma nnnorm_indicator_eq_indicator_nnnorm :
  nnnorm (indicator s f a) = indicator s (λa, nnnorm (f a)) a :=
flip congr_fun a (indicator_comp_of_zero nnnorm_zero).symm

lemma norm_indicator_le_of_subset (h : s ⊆ t) (f : α → E) (a : α) :
  ∥indicator s f a∥ ≤ ∥indicator t f a∥ :=
begin
  simp only [norm_indicator_eq_indicator_norm],
  exact indicator_le_indicator_of_subset ‹_› (λ _, norm_nonneg _) _
end

lemma indicator_norm_le_norm_self : indicator s (λa, ∥f a∥) a ≤ ∥f a∥ :=
indicator_le_self' (λ _ _, norm_nonneg _) a

lemma norm_indicator_le_norm_self : ∥indicator s f a∥ ≤ ∥f a∥ :=
by { rw norm_indicator_eq_indicator_norm, apply indicator_norm_le_norm_self }


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

! This file was ported from Lean 3 source module data.nat.even_odd_rec
! leanprover-community/mathlib commit 18a5306c091183ac90884daa9373fa3b178e8607
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Nat.Basic
import Mathlib.Init.Data.Nat.Bitwise
/-! # A recursion principle based on even and odd numbers. -/

-- porting note: TODO:
-- Remove dependence on deprecated defintions bit0, bit1.
set_option linter.deprecated false

namespace Nat

/-- Recursion principle on even and odd numbers: if we have `P 0`, and for all `i : ℕ` we can
extend from `P i` to both `P (2 * i)` and `P (2 * i + 1)`, then we have `P n` for all `n : ℕ`.
This is nothing more than a wrapper around `Nat.binaryRec`, to avoid having to switch to
dealing with `bit0` and `bit1`. -/

@[elab_as_elim]
def evenOddRec {P : ℕ → Sort _} (h0 : P 0) (h_even : ∀ (n) (_ : P n), P (2 * n))
    (h_odd : ∀ (n) (_ : P n), P (2 * n + 1)) (n : ℕ) : P n :=
  binaryRec h0 (fun
    | false, i, hi => (bit0_val i ▸ h_even i hi : P (bit0 i))
    | true, i, hi => (bit1_val i ▸ h_odd i hi : P (bit1 i))) n
#align nat.even_odd_rec Nat.evenOddRec

@[simp]
theorem evenOddRec_zero (P : ℕ → Sort _) (h0 : P 0) (h_even : ∀ i, P i → P (2 * i))
    (h_odd : ∀ i, P i → P (2 * i + 1)) : @evenOddRec _ h0 h_even h_odd 0 = h0 :=
  binaryRec_zero _ _
#align nat.even_odd_rec_zero Nat.evenOddRec_zero

@[simp]
theorem evenOddRec_even (n : ℕ) (P : ℕ → Sort _) (h0 : P 0) (h_even : ∀ i, P i → P (2 * i))
    (h_odd : ∀ i, P i → P (2 * i + 1)) (H : h_even 0 h0 = h0) :
    @evenOddRec _ h0 h_even h_odd (2 * n) = h_even n (evenOddRec h0 h_even h_odd n) :=
  have : ∀ a, bit false n = a →
      HEq (@evenOddRec _ h0 h_even h_odd a) (h_even n (evenOddRec h0 h_even h_odd n))
    | _, rfl => by rw [evenOddRec, binaryRec_eq]; apply eq_rec_heq; exact H
  eq_of_heq (this _ (bit0_val _))
#align nat.even_odd_rec_even Nat.evenOddRec_even

@[simp]
theorem evenOddRec_odd (n : ℕ) (P : ℕ → Sort _) (h0 : P 0) (h_even : ∀ i, P i → P (2 * i))
    (h_odd : ∀ i, P i → P (2 * i + 1)) (H : h_even 0 h0 = h0) :
    @evenOddRec _ h0 h_even h_odd (2 * n + 1) = h_odd n (evenOddRec h0 h_even h_odd n) :=
  have : ∀ a, bit true n = a →
      HEq (@evenOddRec _ h0 h_even h_odd a) (h_odd n (evenOddRec h0 h_even h_odd n))
    | _, rfl => by rw [evenOddRec, binaryRec_eq]; apply eq_rec_heq; exact H
  eq_of_heq (this _ (bit1_val _))
#align nat.even_odd_rec_odd Nat.evenOddRec_odd

end Nat


import tactic
import data.nat.basic
import data.nat.prime

noncomputable theory
open_locale classical

lemma two_dvd_of_two_dvd_sq {n : ℕ} (hn : 2 ∣ n ^ 2) : 2 ∣ n :=
begin
  apply nat.prime.dvd_of_dvd_pow,
  { exact nat.prime_two },
  exact hn,
end

lemma two_dvd_of_two_dvd_sq' {m n : ℕ} (hmn : 2 * m ^ 2 = n ^ 2) : 2 ∣ n :=
begin
  apply two_dvd_of_two_dvd_sq,
  use m^2, rw hmn,
end

example (a b c : ℕ) (hc : 0 < c) (h : c * a = c * b) : a = b :=
begin
  -- library_search succeeds here
  rwa nat.mul_right_inj at h,
  assumption,
end

lemma two_dvd_of_two_dvd_sq'' {m n : ℕ} (hmn : 2 * m ^ 2 = n ^ 2) : 2 ∣ m :=
begin
  apply two_dvd_of_two_dvd_sq,
  have hn := two_dvd_of_two_dvd_sq' hmn,
  cases hn with k hk,
  use k^2,
  rw hk at hmn, clear hk,
  have : 0 < 2 := by norm_num,
  rw ← nat.mul_right_inj this,
  ring at hmn, ring, assumption,
end

lemma gcd_div_left (a b : ℕ) : (nat.gcd a b) ∣ a :=
begin
  rw nat.gcd_eq_right_iff_dvd,
  apply nat.gcd_gcd_self_right_left,
end

-- maynbe the next one is a level and the previous one is provided?
lemma gcd_div_right (a b : ℕ) : (nat.gcd a b) ∣ b :=
begin
  rw nat.gcd_comm,
  apply gcd_div_left,
end

-- i think the following two lemma can be "levels".
lemma eq_zero_of_sq_eq_zero (m : ℕ) (hm : m ^ 2 = 0) : m = 0 :=
begin
  simp only [nat.pow_two] at hm,
  simp only [nat.mul_eq_zero, or_self] at hm,
  assumption,
end

lemma sq_eq_zero_iff_eq_zero (m : ℕ) : m ^ 2 = 0 ↔ m = 0 :=
begin
  split,
  { apply eq_zero_of_sq_eq_zero },
  intro h, rw h, ring,
end

lemma coprime_of_div_gcd
  (m n m' n' k : ℕ)
  (hk : k = nat.gcd m n)
  (hmk : m = k * m')
  (hnk : n = k * n')
  (hm : 0 < m)
  (hn : 0 < n)
: nat.coprime m' n' :=
begin
  have key := nat.gcd_mul_left k m' n',
  rw [← hmk, ← hnk, ← hk] at key,
  symmetry' at key,
  rw nat.mul_right_eq_self_iff at key, exact key,
  -- generates side goal 0 < k
  rw hk,
  apply nat.gcd_pos_of_pos_left,
  exact hm,
end

lemma wlog_nonzero {m n : ℕ} (hm : m ≠ 0) (hmn : 2 * m^2 = n^2) : n ≠ 0 :=
begin
  contrapose! hm,
  rw hm at hmn, ring at hmn,
  rw ← sq_eq_zero_iff_eq_zero,
  rw nat.mul_eq_zero at hmn,
  norm_num at hmn, exact hmn,
end

lemma gcd_ne_zero {m n : ℕ} (hm : m ≠ 0) (hn : n ≠ 0) : nat.gcd m n ≠ 0 :=
begin
  rw ← nat.pos_iff_ne_zero,
  apply nat.gcd_pos_of_pos_left,
  rwa nat.pos_iff_ne_zero, -- omega works
end

lemma ne_zero_of_mul_ne_zero {m k m' : ℕ}
  (hm : m ≠ 0)
  (hkm : m = k * m') :
  m' ≠ 0 :=
begin
  contrapose! hm,
  rw hkm,
  rw hm, ring
end

lemma wlog_coprime_aux {m n k : ℕ}
  (hmn : 2 * (k * m) ^ 2 = (k * n) ^ 2)
  (hk : k ≠ 0) :
  2 * m ^ 2 = n ^ 2 :=
begin
  ring at *,
  rwa nat.mul_left_inj at hmn,
  rw nat.pos_iff_ne_zero,
  contrapose! hk,
  apply eq_zero_of_sq_eq_zero,
  ring at *,
  assumption,
end

lemma wlog_coprime {m n : ℕ} (hm : m ≠ 0) (hmn : 2 * m ^ 2 = n ^ 2) :
∃ m' n', m' ≠ 0  ∧  2 * m' ^ 2 = n' ^ 2 ∧ nat.coprime m' n' :=
begin
  set k := m.gcd n,
  -- We want to divide by k. To set that up,
  -- we prove that k is not zero
  have hn : n ≠ 0 := wlog_nonzero hm hmn,
  have hk : k ≠ 0 := gcd_ne_zero hm hn,
  -- and we prove that k divides m and n
  have hkm : k ∣ m := gcd_div_left m n,
  have hkn : k ∣ n := gcd_div_right m n,
  -- here we extract the quotients m' and n'
  cases hkm with m' hkm,
  cases hkn with n' hkn,
  use [m', n'],
  split, -- ⊢	m' ≠ 0
  { apply ne_zero_of_mul_ne_zero hm hkm },
  split, -- ⊢	2 * m' ^ 2 = n' ^ 2
  { rw [hkm, hkn] at hmn,
    apply wlog_coprime_aux hmn,
    assumption },
  -- 	⊢	m'.coprime n'
  apply coprime_of_div_gcd m n m' n' k,
  -- this generates a bunch of conditions we'll tackle one at a time
  { refl }, -- this is true by definition of k
  { exact hkm },
  { exact hkn },
  { rw nat.pos_iff_ne_zero, exact hm },
  { rw nat.pos_iff_ne_zero, exact hn },
end

lemma not_coprime_of_common_factor {m n k : ℕ}
  (hk : 1 < k) (hm : m ≠ 0) (hn : n ≠ 0)  (hmk : k ∣ m) (hnk : k ∣ n) :
¬ nat.coprime n m :=
begin
  -- library_search,
  exact nat.not_coprime_of_dvd_of_dvd hk hnk hmk,
end

lemma sqrt2_irrational_aux {m n : ℕ} (hm : m ≠ 0) (hmn : 2 * m^2 = n^2) : false :=
begin
  have h2 := wlog_coprime hm hmn, clear hmn hm m n,
  rcases h2 with ⟨m, n, h , hm, hmn ⟩,
  contrapose h, clear h,
  have : 1 < 2, norm_num, -- linarith also works
  contrapose! hmn,
  apply not_coprime_of_common_factor this,
  { apply wlog_nonzero hmn, assumption, },
  { assumption },
  { apply two_dvd_of_two_dvd_sq', exact hm, },
  apply two_dvd_of_two_dvd_sq'',
  exact hm,
end

theorem sqrt2_irrational :
¬ ∃ p q : ℕ,
  p ≠ 0 ∧ 2 * p^2 = q^2 :=
begin
  push_neg,
  intros,
  by_cases hp : p = 0,
  { left, exact hp }, right,
  by_contra h, push_neg at h,
  apply sqrt2_irrational_aux hp h,
end


/-
Copyright (c) 2021 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics

/-!

# Logic in Lean, example sheet 3 : "not" (`¬`)

We learn about how to manipulate `¬ P` in Lean.

# Important : the definition of `¬ P`

In Lean, `¬ P` is *defined* to mean `P → false`. So `¬ P` and `P → false`
are *the same thing* and can be used interchangeably. You can change
from one to the other for free.

## Tactics

You'll need to know about the tactics from the previous sheets,
and also the following tactics:

* `change` (optional)
* `by_contra`
* `by_cases`

### The `change` tactic

The `change` tactic changes a goal to a goal which
is *equal to it by definition*. The example you need to know
is that `¬ P` and `P → false` are equal by definition.

If your goal is `⊢ ¬ P` then `change P → false,` will
change it to `P → false`. Similarly if you have a hypothesis
`h : ¬ P` then `change P → false at h,` will change it to `h : P → false`.

Note that this tactic is just for psychological purposes. If you finish
a proof which uses this tactic, try commenting out the `change` lines
and note that it doesn't break.

### The `by_contra` tactic

If your goal is `⊢ P` and you want to prove it by contradiction,
`by_contra h,` will change the goal to `false` and add a hypothesis
`h : ¬ P`.

### The `by_cases` tactic

If `P : Prop` is a true-false statement then `by_cases hP : P,`
turns your goal into two goals, one with hypothesis `hP : P`
and the other with hypothesis `hP : ¬ P`.

-/

-- Throughout this sheet, `P`, `Q` and `R` will denote propositions.

variables (P Q R : Prop)

example : ¬ P → (P → false) :=
begin
  sorry,
end

example : ¬ true → false :=
begin
  sorry
end

example : false → ¬ true :=
begin
  sorry
end

example : ¬ false → true :=
begin
  sorry
end

example : true → ¬ false :=
begin
  sorry
end

example : false → ¬ P :=
begin
  sorry
end

example : P → ¬ P → false :=
begin
  sorry
end

example : P → ¬ (¬ P) :=
begin
  sorry
end

example : (P → Q) → (¬ Q → ¬ P) :=
begin
  sorry
end

example : ¬ ¬ false → false :=
begin
  sorry
end

example : ¬ ¬ P → P :=
begin
  sorry
end

example : (¬ Q → ¬ P) → (P → Q) :=
begin
  sorry,
end


variables (α : Type) (p q : α → Prop)

example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) := ⟨
  assume h: (∀ x, p x ∧ q x),
  show (∀ x, p x) ∧ (∀ x, q x), from (
    have h1: ∀ x, p x, from λ x, (h x).left,
    have h2: ∀ x, q x, from λ x, (h x).right,
    ⟨h1, h2⟩
  ),

  assume h: (∀ x, p x) ∧ (∀ x, q x),
  λ x, ⟨(h.left x), (h.right x)⟩
⟩

example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) := (
  assume (h1: ∀ x, p x → q x) (h2: ∀ x, p x),
  λ x, (h1 x) (h2 x)
)

example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x := (
  assume h: (∀ x, p x) ∨ (∀ x, q x),
  or.elim h (
    assume hp: ∀ x, p x,
    λ x, or.inl (hp x)
  ) (
    assume hq: ∀ x, q x,
    λ x, or.inr (hq x)
  )
)


section propositional

variables P Q R : Prop

------------------------------------------------
-- Proposições de dupla negaço:
------------------------------------------------

theorem doubleneg_intro :
  P → ¬¬P  :=
begin
  intro hp,
  intro hnp,
  contradiction,
end

theorem doubleneg_elim :
  ¬¬P → P  :=
begin
  intro hp,
  by_cases h : P,
  exact h,
  contradiction,
end

theorem doubleneg_law :
  ¬¬P ↔ P  :=
begin
  apply iff.intro,
  apply doubleneg_elim,
  apply doubleneg_intro,
end

------------------------------------------------
-- Comutatividade dos ∨,∧:
------------------------------------------------

theorem disj_comm :
  (P ∨ Q) → (Q ∨ P)  :=
begin
  intro h,
  cases h with hp hq,
  right,
  exact hp,
  left,
  exact hq,
end

theorem conj_comm :
  (P ∧ Q) → (Q ∧ P)  :=
begin
  intro h,
  cases h with hp hq,
  split,
  exact hq,
  exact hp,
end

------------------------------------------------
-- Proposições de interdefinabilidade dos →,∨:
------------------------------------------------

theorem impl_as_disj_converse :
  (¬P ∨ Q) → (P → Q)  :=
begin
  intro h,
  intro hp,
  cases h with hnp hq,
  contradiction,
  assumption,
end

theorem disj_as_impl :
  (P ∨ Q) → (¬P → Q)  :=
begin
  intro h,
  intro hnp,
  cases h with hnp hq,
  contradiction,
  assumption,
end

------------------------------------------------
-- Proposições de contraposição:
------------------------------------------------

theorem impl_as_contrapositive :
  (P → Q) → (¬Q → ¬P)  :=
begin
  intro h,
  intro hnq,
  intro hnp,
  have hq : Q := h hnp,
  contradiction,
end

theorem impl_as_contrapositive_converse :
  (¬Q → ¬P) → (P → Q)  :=
begin
  intro h,
  intro hp,
  by_contra hcq,
  apply h,
  exact hcq,
  exact hp,
end

theorem contrapositive_law :
  (P → Q) ↔ (¬Q → ¬P)  :=
begin
  apply iff.intro,
  apply impl_as_contrapositive,
  apply impl_as_contrapositive_converse,
end

------------------------------------------------
-- A irrefutabilidade do LEM:
------------------------------------------------

theorem lem_irrefutable :
  ¬¬(P∨¬P)  :=
begin
  intro h,
  apply h,
  right,
  intro hp,
  apply h,
  left,
  exact hp,
end

------------------------------------------------
-- A lei de Peirce
------------------------------------------------

theorem peirce_law_weak :
  ((P → Q) → P) → ¬¬P  :=
begin
  intro h,
  intro hnnp,
  apply hnnp,
  apply h,
  intro hp,
  contradiction,
end

------------------------------------------------
-- Proposições de interdefinabilidade dos ∨,∧:
------------------------------------------------

theorem disj_as_negconj :
  P∨Q → ¬(¬P∧¬Q)  :=
begin
  intro h,
  intro hnh,
  cases hnh with hnp hnq,
  cases h with hp hq,
  contradiction,
  contradiction,
end

theorem conj_as_negdisj :
  P∧Q → ¬(¬P∨¬Q)  :=
begin
  intro h,
  intro hnh,
  cases h with hp hq,
  cases hnh with hnp hnq,
  contradiction,
  contradiction,
end

------------------------------------------------
-- As leis de De Morgan para ∨,∧:
------------------------------------------------

theorem demorgan_disj :
  ¬(P∨Q) → (¬P ∧ ¬Q)  :=
begin
  intro h,
  split,
  intro hp,
  apply h,
  left,
  exact hp,
  intro hq,
  apply h,
  right,
  exact hq,
end

theorem demorgan_disj_converse :
  (¬P ∧ ¬Q) → ¬(P∨Q)  :=
begin
  intro h,
  intro g,
  cases g with hp hq,
  cases h with hnp hnq,
  contradiction,
  cases h with hnp hnq,
  contradiction,
end

theorem demorgan_conj :
  ¬(P∧Q) → (¬Q ∨ ¬P)  :=
begin
  intro h,
  by_contra hcsecond,
  apply h,
  split,
  by_contra hcp,
  apply hcsecond,
  right,
  exact hcp,
  by_contra hcq,
  apply hcsecond,
  left,
  exact hcq,
end

theorem demorgan_conj_converse :
  (¬Q ∨ ¬P) → ¬(P∧Q)  :=
begin
  intro h,
  intro g,
  cases g with hq hp,
  cases h with hnq hnp,
  contradiction,
  contradiction,
end

theorem demorgan_conj_law :
  ¬(P∧Q) ↔ (¬Q ∨ ¬P)  :=
begin
  apply iff.intro,
  apply demorgan_conj,
  apply demorgan_conj_converse,
end

theorem demorgan_disj_law :
  ¬(P∨Q) ↔ (¬P ∧ ¬Q)  :=
begin
  apply iff.intro,
  apply demorgan_disj,
  apply demorgan_disj_converse,
end

------------------------------------------------
-- Proposições de distributividade dos ∨,∧:
------------------------------------------------

theorem distr_conj_disj :
  P∧(Q∨R) → (P∧Q)∨(P∧R)  :=
begin
  intro h,
  cases h with hp hsecond,
  cases hsecond with hq hr,
  left,
  split,
  exact hp,
  exact hq,
  right,
  split,
  exact hp,
  exact hr,
end

theorem distr_conj_disj_converse :
  (P∧Q)∨(P∧R) → P∧(Q∨R)  :=
begin
  intro h,
  cases h with hsecond hthird,
  cases hsecond with hp hq,
  split,
  exact hp,
  left,
  exact hq,
  cases hthird with hp hr,
  split,
  exact hp,
  right,
  exact hr,
end

theorem distr_disj_conj :
  P∨(Q∧R) → (P∨Q)∧(P∨R)  :=
begin
  intro h,
  cases h with hp hsecond,
  split,
  left,
  exact hp,
  left,
  exact hp,
  cases hsecond with hq hr,
  split,
  right,
  exact hq,
  right,
  exact hr,
end

theorem distr_disj_conj_converse :
  (P∨Q)∧(P∨R) → P∨(Q∧R)  :=
begin
  intro h,
  cases h with hsecond hthird,
  cases hsecond with hp hq,
  left,
  exact hp,
  cases hthird with hp hr,
  left,
  exact hp,
  right,
  split,
  exact hq,
  exact hr,
end

------------------------------------------------
-- Currificação
------------------------------------------------

theorem curry_prop :
  ((P∧Q)→R) → (P→(Q→R))  :=
begin
  intro h,
  intro hp,
  intro hq,
  apply h,
  split,
  exact hp,
  exact hq,
end

theorem uncurry_prop :
  (P→(Q→R)) → ((P∧Q)→R)  :=
begin
  intro h,
  intro hsecond,
  apply h,
  cases hsecond with hp hq,
  exact hp,
  cases hsecond with hp hq,
  exact hq,
end

------------------------------------------------
-- Reflexividade da →:
------------------------------------------------

theorem impl_refl :
  P → P  :=
begin
  intro hp,
  exact hp
end

------------------------------------------------
-- Weakening and contraction:
------------------------------------------------

theorem weaken_disj_right :
  P → (P∨Q)  :=
begin
  intro hp,
  left,
  exact hp,
end

theorem weaken_disj_left :
  Q → (P∨Q)  :=
begin
  intro hq,
  right,
  exact hq,
end

theorem weaken_conj_right :
  (P∧Q) → P  :=
begin
  intro h,
  cases h with hp hq,
  exact hp,
end

theorem weaken_conj_left :
  (P∧Q) → Q  :=
begin
  intro h,
  cases h with hp hq,
  exact hq,
end

theorem conj_idempot :
  (P∧P) ↔ P :=
begin
  apply iff.intro,
  intro h,
  cases h with hp hp,
  exact hp,
  intro hp,
  split,
  exact hp,
  exact hp,
end

theorem disj_idempot :
  (P∨P) ↔ P  :=
begin
  apply iff.intro,
  intro h,
  cases h with hp hp,
  exact hp,
  exact hp,
  intro h,
  left,
  exact h,
end

end propositional

----------------------------------------------------------------

section predicate

variable U : Type
variables P Q : U -> Prop

------------------------------------------------
-- As leis de De Morgan para ∃,∀:
------------------------------------------------

theorem demorgan_exists :
  ¬(∃x, P x) → (∀x, ¬P x)  :=
begin
  intro hnepx,
  intro x,
  intro hpx,
  apply hnepx,
  existsi x,
  exact hpx,
end

theorem demorgan_exists_converse :
  (∀x, ¬P x) → ¬(∃x, P x)  :=
begin
  sorry,
end

theorem demorgan_forall :
  ¬(∀x, P x) → (∃x, ¬P x)  :=
begin
  sorry,
end

theorem demorgan_forall_converse :
  (∃x, ¬P x) → ¬(∀x, P x)  :=
begin
  sorry,
end

theorem demorgan_forall_law :
  ¬(∀x, P x) ↔ (∃x, ¬P x)  :=
begin
  apply iff.intro,
  apply demorgan_forall,
  apply demorgan_forall_converse,
end

theorem demorgan_exists_law :
  ¬(∃x, P x) ↔ (∀x, ¬P x)  :=
begin
  apply iff.intro,
  apply demorgan_exists,
  apply demorgan_exists_converse,
end

------------------------------------------------
-- Proposições de interdefinabilidade dos ∃,∀:
------------------------------------------------

theorem exists_as_neg_forall :
  (∃x, P x) → ¬(∀x, ¬P x)  :=
begin
  sorry,
end

theorem forall_as_neg_exists :
  (∀x, P x) → ¬(∃x, ¬P x)  :=
begin
  sorry,
end

theorem forall_as_neg_exists_converse :
  ¬(∃x, ¬P x) → (∀x, P x)  :=
begin
  sorry,
end

theorem exists_as_neg_forall_converse :
  ¬(∀x, ¬P x) → (∃x, P x)  :=
begin
  sorry,
end

theorem forall_as_neg_exists_law :
  (∀x, P x) ↔ ¬(∃x, ¬P x)  :=
begin
  apply iff.intro,
  apply forall_as_neg_exists,
  apply forall_as_neg_exists_converse,
end

theorem exists_as_neg_forall_law :
  (∃x, P x) ↔ ¬(∀x, ¬P x)  :=
begin
  apply iff.intro,
  apply exists_as_neg_forall,
  apply exists_as_neg_forall_converse,
end

------------------------------------------------
--  Proposições de distributividade de quantificadores:
------------------------------------------------

theorem exists_conj_as_conj_exists :
  (∃x, P x ∧ Q x) → (∃x, P x) ∧ (∃x, Q x)  :=
begin
  sorry,
end

theorem exists_disj_as_disj_exists :
  (∃x, P x ∨ Q x) → (∃x, P x) ∨ (∃x, Q x)  :=
begin
  sorry,
end

theorem exists_disj_as_disj_exists_converse :
  (∃x, P x) ∨ (∃x, Q x) → (∃x, P x ∨ Q x)  :=
begin
  sorry,
end

theorem forall_conj_as_conj_forall :
  (∀x, P x ∧ Q x) → (∀x, P x) ∧ (∀x, Q x)  :=
begin
  sorry,
end

theorem forall_conj_as_conj_forall_converse :
  (∀x, P x) ∧ (∀x, Q x) → (∀x, P x ∧ Q x)  :=
begin
  sorry,
end

theorem forall_disj_as_disj_forall_converse :
  (∀x, P x) ∨ (∀x, Q x) → (∀x, P x ∨ Q x)  :=
begin
  sorry,
end

/- NOT THEOREMS --------------------------------

theorem forall_disj_as_disj_forall :
  (∀x, P x ∨ Q x) → (∀x, P x) ∨ (∀x, Q x)  :=
begin
end

theorem exists_conj_as_conj_exists_converse :
  (∃x, P x) ∧ (∃x, Q x) → (∃x, P x ∧ Q x)  :=
begin
end

---------------------------------------------- -/

end predicate


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

Structures with multiplicative and additive components, including semirings, rings, and fields.
The development is modeled after Isabelle's library.
-/

import logic.eq logic.connectives data.unit data.sigma data.prod
import algebra.binary algebra.group
open eq eq.ops

variable {A : Type}

/- auxiliary classes -/

structure distrib [class] (A : Type) extends has_mul A, has_add A :=
(left_distrib : ∀a b c, mul a (add b c) = add (mul a b) (mul a c))
(right_distrib : ∀a b c, mul (add a b) c = add (mul a c) (mul b c))

theorem left_distrib [distrib A] (a b c : A) : a * (b + c) = a * b + a * c :=
!distrib.left_distrib

theorem right_distrib [distrib A] (a b c : A) : (a + b) * c = a * c + b * c :=
!distrib.right_distrib

structure mul_zero_class [class] (A : Type) extends has_mul A, has_zero A :=
(zero_mul : ∀a, mul zero a = zero)
(mul_zero : ∀a, mul a zero = zero)

theorem zero_mul [simp] [mul_zero_class A] (a : A) : 0 * a = 0 := !mul_zero_class.zero_mul
theorem mul_zero [simp] [mul_zero_class A] (a : A) : a * 0 = 0 := !mul_zero_class.mul_zero

structure zero_ne_one_class [class] (A : Type) extends has_zero A, has_one A :=
(zero_ne_one : zero ≠ one)

theorem zero_ne_one [s: zero_ne_one_class A] : 0 ≠ (1:A) := @zero_ne_one_class.zero_ne_one A s

/- semiring -/

structure semiring [class] (A : Type) extends add_comm_monoid A, monoid A, distrib A,
    mul_zero_class A

section semiring
  variables [s : semiring A] (a b c : A)
  include s

  theorem one_add_one_eq_two : 1 + 1 = (2:A) :=
  by unfold bit0

  theorem ne_zero_of_mul_ne_zero_right {a b : A} (H : a * b ≠ 0) : a ≠ 0 :=
  suppose a = 0,
  have a * b = 0, by rewrite [this, zero_mul],
  H this

  theorem ne_zero_of_mul_ne_zero_left {a b : A} (H : a * b ≠ 0) : b ≠ 0 :=
  suppose b = 0,
  have a * b = 0, by rewrite [this, mul_zero],
  H this

  local attribute right_distrib [simp]

  theorem distrib_three_right (a b c d : A) : (a + b + c) * d = a * d + b * d + c * d :=
  by simp
end semiring

/- comm semiring -/

structure comm_semiring [class] (A : Type) extends semiring A, comm_monoid A
-- TODO: we could also define a cancelative comm_semiring, i.e. satisfying
-- c ≠ 0 → c * a = c * b → a = b.

section comm_semiring
  variables [s : comm_semiring A] (a b c : A)
  include s

  protected definition algebra.dvd (a b : A) : Prop := ∃c, b = a * c

  definition comm_semiring_has_dvd [instance] [priority algebra.prio] : has_dvd A :=
  has_dvd.mk algebra.dvd

  theorem dvd.intro {a b c : A} (H : a * c = b) : a ∣ b :=
  exists.intro _ H⁻¹

  theorem dvd_of_mul_right_eq {a b c : A} (H : a * c = b) : a ∣ b := dvd.intro H

  theorem dvd.intro_left {a b c : A} (H : c * a = b) : a ∣ b :=
  dvd.intro (by rewrite mul.comm at H; exact H)

  theorem dvd_of_mul_left_eq {a b c : A} (H : c * a = b) : a ∣ b := dvd.intro_left H

  theorem exists_eq_mul_right_of_dvd {a b : A} (H : a ∣ b) : ∃c, b = a * c := H

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

  theorem exists_eq_mul_left_of_dvd {a b : A} (H : a ∣ b) : ∃c, b = c * a :=
  dvd.elim H (take c, assume H1 : b = a * c, exists.intro c (H1 ⬝ !mul.comm))

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

  theorem dvd.refl [simp] : a ∣ a :=
  dvd.intro !mul_one

  theorem dvd.trans {a b c : A} (H₁ : a ∣ b) (H₂ : b ∣ c) : a ∣ c :=
  dvd.elim H₁
    (take d, assume H₃ : b = a * d,
      dvd.elim H₂
        (take e, assume H₄ : c = b * e,
          dvd.intro
            (show a * (d * e) = c, by rewrite [-mul.assoc, -H₃, H₄])))

  theorem eq_zero_of_zero_dvd {a : A} (H : 0 ∣ a) : a = 0 :=
    dvd.elim H (take c, assume H' : a = 0 * c, H' ⬝ !zero_mul)

  theorem dvd_zero [simp] : a ∣ 0 := dvd.intro !mul_zero

  theorem one_dvd [simp] : 1 ∣ a := dvd.intro !one_mul

  theorem dvd_mul_right [simp] : a ∣ a * b := dvd.intro rfl

  theorem dvd_mul_left [simp] : a ∣ b * a :=
  by simp

  theorem dvd_mul_of_dvd_left {a b : A} (H : a ∣ b) (c : A) : a ∣ b * c :=
  dvd.elim H
    (take d,
      suppose b = a * d,
      dvd.intro
        (show a * (d * c) = b * c, by simp))

  theorem dvd_mul_of_dvd_right {a b : A} (H : a ∣ b) (c : A) : a ∣ c * b :=
  !mul.comm ▸ (dvd_mul_of_dvd_left H _)

  theorem mul_dvd_mul {a b c d : A} (dvd_ab : a ∣ b) (dvd_cd : c ∣ d) : a * c ∣ b * d :=
  dvd.elim dvd_ab
    (take e, suppose b = a * e,
      dvd.elim dvd_cd
        (take f, suppose d = c * f,
          dvd.intro
            (show a * c * (e * f) = b * d,
             by simp)))

  theorem dvd_of_mul_right_dvd {a b c : A} (H : a * b ∣ c) : a ∣ c :=
  dvd.elim H (take d, assume Habdc : c = a * b * d, dvd.intro (!mul.assoc⁻¹ ⬝ Habdc⁻¹))

  theorem dvd_of_mul_left_dvd {a b c : A} (H : a * b ∣ c) : b ∣ c :=
  dvd_of_mul_right_dvd (mul.comm a b ▸ H)

  theorem dvd_add {a b c : A} (Hab : a ∣ b) (Hac : a ∣ c) : a ∣ b + c :=
  dvd.elim Hab
    (take d, suppose b = a * d,
      dvd.elim Hac
        (take e, suppose c = a * e,
          dvd.intro (show a * (d + e) = b + c,
                     by rewrite [left_distrib]; substvars)))
end comm_semiring

/- ring -/

structure ring [class] (A : Type) extends add_comm_group A, monoid A, distrib A

theorem ring.mul_zero [simp] [ring A] (a : A) : a * 0 = 0 :=
have a * 0 + 0 = a * 0 + a * 0, from calc
  a * 0 + 0 = a * (0 + 0)   : by simp
        ... = a * 0 + a * 0 : by rewrite left_distrib,
show a * 0 = 0, from (add.left_cancel this)⁻¹

theorem ring.zero_mul [simp] [ring A] (a : A) : 0 * a = 0 :=
have 0 * a + 0 = 0 * a + 0 * a, from calc
  0 * a + 0 = (0 + 0) * a   : by simp
        ... = 0 * a + 0 * a : by rewrite right_distrib,
show 0 * a = 0, from  (add.left_cancel this)⁻¹

definition ring.to_semiring [trans_instance] [s : ring A] : semiring A :=
⦃ semiring, s,
  mul_zero := ring.mul_zero,
  zero_mul := ring.zero_mul ⦄

section
  variables [s : ring A] (a b c d e : A)
  include s

  theorem neg_mul_eq_neg_mul : -(a * b) = -a * b :=
  neg_eq_of_add_eq_zero
    begin
      rewrite [-right_distrib, add.right_inv, zero_mul]
    end

  theorem neg_mul_eq_mul_neg : -(a * b) = a * -b :=
   neg_eq_of_add_eq_zero
     begin
       rewrite [-left_distrib, add.right_inv, mul_zero]
     end

  theorem neg_mul_eq_neg_mul_symm [simp] : - a * b = - (a * b) := eq.symm !neg_mul_eq_neg_mul
  theorem mul_neg_eq_neg_mul_symm [simp] : a * - b = - (a * b) := eq.symm !neg_mul_eq_mul_neg

  theorem neg_mul_neg : -a * -b = a * b :=
  by simp

  theorem neg_mul_comm : -a * b = a * -b :=
  by simp

  theorem neg_eq_neg_one_mul : -a = -1 * a :=
  by simp

  theorem mul_sub_left_distrib : a * (b - c) = a * b - a * c :=
  calc
    a * (b - c) = a * b + a * -c : left_distrib
            ... = a * b - a * c  : by simp

  theorem mul_sub_right_distrib : (a - b) * c = a * c - b * c :=
  calc
    (a - b) * c = a * c  + -b * c : right_distrib
            ... = a * c - b * c   : by simp

  -- TODO: can calc mode be improved to make this easier?
  -- TODO: there is also the other direction. It will be easier when we
  -- have the simplifier.

  theorem mul_add_eq_mul_add_iff_sub_mul_add_eq : a * e + c = b * e + d ↔ (a - b) * e + c = d :=
  calc
    a * e + c = b * e + d ↔ a * e + c = d + b * e : by rewrite {b*e+_}add.comm
      ... ↔ a * e + c - b * e = d : iff.symm !sub_eq_iff_eq_add
      ... ↔ a * e - b * e + c = d : by rewrite sub_add_eq_add_sub
      ... ↔ (a - b) * e + c = d   : by rewrite mul_sub_right_distrib

  theorem mul_add_eq_mul_add_of_sub_mul_add_eq : (a - b) * e + c = d → a * e + c = b * e + d :=
  iff.mpr !mul_add_eq_mul_add_iff_sub_mul_add_eq

  theorem sub_mul_add_eq_of_mul_add_eq_mul_add : a * e + c = b * e + d → (a - b) * e + c = d :=
  iff.mp !mul_add_eq_mul_add_iff_sub_mul_add_eq

  theorem mul_neg_one_eq_neg : a * (-1) = -a :=
    have a + a * -1 = 0, from calc
      a + a * -1 = a * 1 + a * -1 : by simp
             ... = a * (1 + -1)   : left_distrib
             ... = 0              : by simp,
    symm (neg_eq_of_add_eq_zero this)

  theorem ne_zero_and_ne_zero_of_mul_ne_zero {a b : A} (H : a * b ≠ 0) : a ≠ 0 ∧ b ≠ 0 :=
    have a ≠ 0, from
      (suppose a = 0,
        have a * b = 0, by rewrite [this, zero_mul],
        absurd this H),
    have b ≠ 0, from
      (suppose b = 0,
        have a * b = 0, by rewrite [this, mul_zero],
        absurd this H),
    and.intro `a ≠ 0` `b ≠ 0`
end

structure comm_ring [class] (A : Type) extends ring A, comm_semigroup A

definition comm_ring.to_comm_semiring [trans_instance] [s : comm_ring A] : comm_semiring A :=
⦃ comm_semiring, s,
  mul_zero := mul_zero,
  zero_mul := zero_mul ⦄

section
  variables [s : comm_ring A] (a b c d e : A)
  include s

  local attribute left_distrib right_distrib [simp]

  theorem mul_self_sub_mul_self_eq : a * a - b * b = (a + b) * (a - b) :=
  by simp

  theorem mul_self_sub_one_eq : a * a - 1 = (a + 1) * (a - 1) :=
  by simp

  theorem add_mul_self_eq : (a + b) * (a + b) = a*a + 2*a*b + b*b :=
  calc (a + b)*(a + b) = a*a + (1+1)*a*b + b*b : by simp
               ...     = a*a + 2*a*b + b*b     : by rewrite one_add_one_eq_two

  theorem dvd_neg_iff_dvd : (a ∣ -b) ↔ (a ∣ b) :=
  iff.intro
    (suppose a ∣ -b,
      dvd.elim this
        (take c, suppose -b = a * c,
          dvd.intro
            (show a * -c = b,
             by rewrite [-neg_mul_eq_mul_neg, -this, neg_neg])))
    (suppose a ∣ b,
      dvd.elim this
        (take c, suppose b = a * c,
          dvd.intro
            (show a * -c = -b,
             by rewrite [-neg_mul_eq_mul_neg, -this])))

  theorem dvd_neg_of_dvd : (a ∣ b) → (a ∣ -b) :=
  iff.mpr !dvd_neg_iff_dvd

  theorem dvd_of_dvd_neg : (a ∣ -b) → (a ∣ b) :=
  iff.mp !dvd_neg_iff_dvd

  theorem neg_dvd_iff_dvd : (-a ∣ b) ↔ (a ∣ b) :=
  iff.intro
    (suppose -a ∣ b,
      dvd.elim this
        (take c, suppose b = -a * c,
          dvd.intro
            (show a * -c = b, by rewrite [-neg_mul_comm, this])))
    (suppose a ∣ b,
      dvd.elim this
        (take c, suppose b = a * c,
          dvd.intro
            (show -a * -c = b, by rewrite [neg_mul_neg, this])))

  theorem neg_dvd_of_dvd : (a ∣ b) → (-a ∣ b) :=
  iff.mpr !neg_dvd_iff_dvd

  theorem dvd_of_neg_dvd : (-a ∣ b) → (a ∣ b) :=
  iff.mp !neg_dvd_iff_dvd

  theorem dvd_sub (H₁ : (a ∣ b)) (H₂ : (a ∣ c)) : (a ∣ b - c) :=
  dvd_add H₁ (!dvd_neg_of_dvd H₂)
end

/- integral domains -/

structure no_zero_divisors [class] (A : Type) extends has_mul A, has_zero A :=
(eq_zero_or_eq_zero_of_mul_eq_zero : ∀a b, mul a b = zero → a = zero ∨ b = zero)

theorem eq_zero_or_eq_zero_of_mul_eq_zero {A : Type} [no_zero_divisors A] {a b : A}
    (H : a * b = 0) :
  a = 0 ∨ b = 0 :=
!no_zero_divisors.eq_zero_or_eq_zero_of_mul_eq_zero H

theorem eq_zero_of_mul_self_eq_zero {A : Type} [no_zero_divisors A] {a : A} (H : a * a = 0) :
  a = 0 :=
or.elim (eq_zero_or_eq_zero_of_mul_eq_zero H) (assume H', H') (assume H', H')

structure integral_domain [class] (A : Type) extends comm_ring A, no_zero_divisors A,
    zero_ne_one_class A

section
  variables [s : integral_domain A] (a b c d e : A)
  include s

  theorem mul_ne_zero {a b : A} (H1 : a ≠ 0) (H2 : b ≠ 0) : a * b ≠ 0 :=
  suppose a * b = 0,
  or.elim (eq_zero_or_eq_zero_of_mul_eq_zero this) (assume H3, H1 H3) (assume H4, H2 H4)

  theorem eq_of_mul_eq_mul_right {a b c : A} (Ha : a ≠ 0) (H : b * a = c * a) : b = c :=
  have b * a - c * a = 0, from iff.mp !eq_iff_sub_eq_zero H,
  have (b - c) * a = 0, by rewrite [mul_sub_right_distrib, this],
  have b - c = 0, from or_resolve_left (eq_zero_or_eq_zero_of_mul_eq_zero this) Ha,
  iff.elim_right !eq_iff_sub_eq_zero this

  theorem eq_of_mul_eq_mul_left {a b c : A} (Ha : a ≠ 0) (H : a * b = a * c) : b = c :=
  have a * b - a * c = 0, from iff.mp !eq_iff_sub_eq_zero H,
  have a * (b - c) = 0, by rewrite [mul_sub_left_distrib, this],
  have b - c = 0, from or_resolve_right (eq_zero_or_eq_zero_of_mul_eq_zero this) Ha,
  iff.elim_right !eq_iff_sub_eq_zero this

  -- TODO: do we want the iff versions?

  theorem eq_zero_of_mul_eq_self_right {a b : A} (H₁ : b ≠ 1) (H₂ : a * b = a) : a = 0 :=
  have b - 1 ≠ 0, from
    suppose b - 1 = 0, H₁ (!zero_add ▸ eq_add_of_sub_eq this),
  have a * b - a = 0,   by simp,
  have a * (b - 1) = 0, by rewrite [mul_sub_left_distrib, mul_one]; apply this,
    show a = 0, from or_resolve_left (eq_zero_or_eq_zero_of_mul_eq_zero this) `b - 1 ≠ 0`

  theorem eq_zero_of_mul_eq_self_left {a b : A} (H₁ : b ≠ 1) (H₂ : b * a = a) : a = 0 :=
    eq_zero_of_mul_eq_self_right H₁ (!mul.comm ▸ H₂)

  theorem mul_self_eq_mul_self_iff (a b : A) : a * a = b * b ↔ a = b ∨ a = -b :=
  iff.intro
    (suppose a * a = b * b,
      have (a - b) * (a + b) = 0,
        by rewrite [mul.comm, -mul_self_sub_mul_self_eq, this, sub_self],
      have a - b = 0 ∨ a + b = 0, from !eq_zero_or_eq_zero_of_mul_eq_zero this,
      or.elim this
        (suppose a - b = 0, or.inl (eq_of_sub_eq_zero this))
        (suppose a + b = 0, or.inr (eq_neg_of_add_eq_zero this)))
    (suppose a = b ∨ a = -b, or.elim this
      (suppose a = b,  by rewrite this)
      (suppose a = -b, by rewrite [this, neg_mul_neg]))

  theorem mul_self_eq_one_iff (a : A) : a * a = 1 ↔ a = 1 ∨ a = -1 :=
  have a * a = 1 * 1 ↔ a = 1 ∨ a = -1, from mul_self_eq_mul_self_iff a 1,
  by rewrite mul_one at this; exact this

  -- TODO: c - b * c → c = 0 ∨ b = 1 and variants

  theorem dvd_of_mul_dvd_mul_left {a b c : A} (Ha : a ≠ 0) (Hdvd : (a * b ∣ a * c)) : (b ∣ c) :=
  dvd.elim Hdvd
    (take d,
      suppose a * c = a * b * d,
      have b * d = c, from eq_of_mul_eq_mul_left Ha (mul.assoc a b d ▸ this⁻¹),
      dvd.intro this)

  theorem dvd_of_mul_dvd_mul_right {a b c : A} (Ha : a ≠ 0) (Hdvd : (b * a ∣ c * a)) : (b ∣ c) :=
  dvd.elim Hdvd
    (take d,
      suppose c * a = b * a * d,
      have b * d * a = c * a, from by rewrite [mul.right_comm, -this],
      have b * d = c, from eq_of_mul_eq_mul_right Ha this,
      dvd.intro this)
end

namespace norm_num

local attribute bit0 bit1 add1 [reducible]
local attribute right_distrib left_distrib [simp]

theorem mul_zero [mul_zero_class A] (a : A) : a * zero = zero :=
by simp

theorem zero_mul [mul_zero_class A] (a : A) : zero * a = zero :=
by simp

theorem mul_one [monoid A] (a : A) : a * one = a :=
by simp

theorem mul_bit0 [distrib A] (a b : A) : a * (bit0 b) = bit0 (a * b) :=
by simp

theorem mul_bit0_helper [distrib A] (a b t : A) (H : a * b = t) : a * (bit0 b) = bit0 t :=
by rewrite -H; simp

theorem mul_bit1 [semiring A] (a b : A) : a * (bit1 b) = bit0 (a * b) + a :=
by simp

theorem mul_bit1_helper [semiring A] (a b s t : A) (Hs : a * b = s) (Ht : bit0 s + a  = t) :
        a * (bit1 b) = t :=
by simp

theorem subst_into_prod [has_mul A] (l r tl tr t : A) (prl : l = tl) (prr : r = tr)
        (prt : tl * tr = t) :
        l * r = t :=
by simp

theorem mk_cong (op : A → A) (a b : A) (H : a = b) : op a = op b :=
by simp

theorem neg_add_neg_eq_of_add_add_eq_zero [add_comm_group A] (a b c : A) (H : c + a + b = 0) :
        -a + -b = c :=
begin
  apply add_neg_eq_of_eq_add,
  apply neg_eq_of_add_eq_zero,
  simp
end

theorem neg_add_neg_helper [add_comm_group A] (a b c : A) (H : a + b = c) : -a + -b = -c :=
begin apply iff.mp !neg_eq_neg_iff_eq, simp end

theorem neg_add_pos_eq_of_eq_add [add_comm_group A] (a b c : A) (H : b = c + a) : -a + b = c :=
begin apply neg_add_eq_of_eq_add, simp end

theorem neg_add_pos_helper1 [add_comm_group A] (a b c : A) (H : b + c = a) : -a + b = -c :=
begin apply neg_add_eq_of_eq_add, apply eq_add_neg_of_add_eq H end

theorem neg_add_pos_helper2 [add_comm_group A] (a b c : A) (H : a + c = b) : -a + b = c :=
begin apply neg_add_eq_of_eq_add, rewrite H end

theorem pos_add_neg_helper [add_comm_group A] (a b c : A) (H : b + a = c) : a + b = c :=
by simp

theorem sub_eq_add_neg_helper [add_comm_group A] (t₁ t₂ e w₁ w₂: A) (H₁ : t₁ = w₁)
        (H₂ : t₂ = w₂) (H : w₁ + -w₂ = e) : t₁ - t₂ = e :=
by simp

theorem pos_add_pos_helper [add_comm_group A] (a b c h₁ h₂ : A) (H₁ : a = h₁) (H₂ : b = h₂)
        (H : h₁ + h₂ = c) : a + b = c :=
by simp

theorem subst_into_subtr [add_group A] (l r t : A) (prt : l + -r = t) : l - r = t :=
by simp

theorem neg_neg_helper [add_group A] (a b : A) (H : a = -b) : -a = b :=
by simp

theorem neg_mul_neg_helper [ring A] (a b c : A) (H : a * b = c) : (-a) * (-b) = c :=
by simp

theorem neg_mul_pos_helper [ring A] (a b c : A) (H : a * b = c) : (-a) * b = -c :=
by simp

theorem pos_mul_neg_helper [ring A] (a b c : A) (H : a * b = c) : a * (-b) = -c :=
by simp

end norm_num

attribute [simp]
  zero_mul mul_zero
  at simplifier.unit

attribute [simp]
  neg_mul_eq_neg_mul_symm mul_neg_eq_neg_mul_symm
  at simplifier.neg

attribute [simp]
  left_distrib right_distrib
  at simplifier.distrib


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

! This file was ported from Lean 3 source module algebra.regular.pow
! leanprover-community/mathlib commit 46a64b5b4268c594af770c44d9e502afc6a515cb
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Hom.Iterate
import Mathlib.Algebra.Regular.Basic

/-!
# Regular elements

## Implementation details

Group powers and other definitions import a lot of the algebra hierarchy.
Lemmas about them are kept separate to be able to provide `IsRegular` early in the
algebra hierarchy.

-/

variable {R : Type _} {a b : R}

section Monoid

variable [Monoid R]

/-- Any power of a left-regular element is left-regular. -/
theorem IsLeftRegular.pow (n : ℕ) (rla : IsLeftRegular a) : IsLeftRegular (a ^ n) := by
  simp only [IsLeftRegular, ← mul_left_iterate, rla.iterate n]
#align is_left_regular.pow IsLeftRegular.pow

/-- Any power of a right-regular element is right-regular. -/
theorem IsRightRegular.pow (n : ℕ) (rra : IsRightRegular a) : IsRightRegular (a ^ n) := by
  rw [IsRightRegular, ← mul_right_iterate]
  exact rra.iterate n
#align is_right_regular.pow IsRightRegular.pow

/-- Any power of a regular element is regular. -/
theorem IsRegular.pow (n : ℕ) (ra : IsRegular a) : IsRegular (a ^ n) :=
  ⟨IsLeftRegular.pow n ra.left, IsRightRegular.pow n ra.right⟩
#align is_regular.pow IsRegular.pow

/-- An element `a` is left-regular if and only if a positive power of `a` is left-regular. -/
theorem IsLeftRegular.pow_iff {n : ℕ} (n0 : 0 < n) : IsLeftRegular (a ^ n) ↔ IsLeftRegular a := by
  refine' ⟨_, IsLeftRegular.pow n⟩
  rw [← Nat.succ_pred_eq_of_pos n0, pow_succ']
  exact IsLeftRegular.of_mul
#align is_left_regular.pow_iff IsLeftRegular.pow_iff

/-- An element `a` is right-regular if and only if a positive power of `a` is right-regular. -/
theorem IsRightRegular.pow_iff {n : ℕ} (n0 : 0 < n) :
    IsRightRegular (a ^ n) ↔ IsRightRegular a := by
  refine' ⟨_, IsRightRegular.pow n⟩
  rw [← Nat.succ_pred_eq_of_pos n0, pow_succ]
  exact IsRightRegular.of_mul
#align is_right_regular.pow_iff IsRightRegular.pow_iff

/-- An element `a` is regular if and only if a positive power of `a` is regular. -/
theorem IsRegular.pow_iff {n : ℕ} (n0 : 0 < n) : IsRegular (a ^ n) ↔ IsRegular a :=
  ⟨fun h => ⟨(IsLeftRegular.pow_iff n0).mp h.left, (IsRightRegular.pow_iff n0).mp h.right⟩, fun h =>
    ⟨IsLeftRegular.pow n h.left, IsRightRegular.pow n h.right⟩⟩
#align is_regular.pow_iff IsRegular.pow_iff

end Monoid


import data.real.basic

import tactic.suggest

noncomputable theory
open_locale classical

/-
# Chapter 6 : Completeness

## Level 1

In the Completeness world, youj will be solving proofs regarding
theroems and properties of bounded sets of reals.

In Lean, we define the lower bounds of a set A such that
∀ x : ℝ, | ∀ a ∈ A, x ≤ a. Essentially, for any number x,
x is less than or equal to any element a in the set A.

For the upper bounds, we define the upper bounds of a set A such that
∀ x : ℝ, | ∀ a ∈ A, a ≤ x. Saying that for any number x,
x is greater than or equal to any element a in the set A.

For this proof, prove that there is a unique max on a set A of real numbers.
-/

def up_bounds (A : set ℝ) := { x : ℝ | ∀ a ∈ A, a ≤ x}

def is_maximum (a : ℝ) (A : set ℝ) := a ∈ A ∧ a ∈ up_bounds A

infix ` is_a_max_of `:55 := is_maximum

def low_bounds (A : set ℝ) := { x : ℝ | ∀ a ∈ A, x ≤ a}

def is_inf (x : ℝ) (A : set ℝ) := x is_a_max_of (low_bounds A)

infix ` is_an_inf_of `:55 := is_inf

lemma unique_max (A : set ℝ) (x y : ℝ) (hx : x is_a_max_of A) (hy : y is_a_max_of A) : x = y :=
begin
  -- We first break our assumptions in their two constituent pieces.
  -- We are free to choose the name following `with`
  cases hx with x_in x_up,
  cases hy with y_in y_up,
  -- Assumption `x_up` means x isn't less than elements of A, let's apply this to y
  specialize x_up y,
  -- Assumption `x_up` now needs the information that `y` is indeed in `A`.
  specialize x_up y_in,
  -- Let's do this quicker with roles swapped
  specialize y_up x x_in,
  -- We explained to Lean the idea of this proof.
  -- Now we know `x ≤ y` and `y ≤ x`, and Lean shouldn't need more help.
  -- `linarith` proves equalities and inequalities that follow linearly from
  -- the assumption we have.
  linarith,
end


import .love12_basic_mathematical_structures_demo

/-! # LoVe Exercise 12: Basic Mathematical Structures -/

set_option pp.beta true

namespace LoVe

/-! ## Question 1: Type Classes

Recall the datatype `btree` we introduced earlier: -/

#check btree

/-! The following function takes two trees and attaches copies of the second
tree to each leaf of the first tree. -/

def btree.graft {α : Type} : btree α → btree α → btree α
| btree.empty        u := u
| (btree.node a l r) u := btree.node a (btree.graft l u) (btree.graft r u)

#reduce btree.graft (btree.node 1 btree.empty btree.empty)
  (btree.node 2 btree.empty btree.empty)

/-! 1.1. Prove the following two lemmas by structural induction on `t`. -/

lemma btree.graft_assoc {α : Type} (t u v : btree α) :
  btree.graft (btree.graft t u) v = btree.graft t (btree.graft u v) :=
sorry

lemma btree.graft_empty {α : Type} (t : btree α) :
  btree.graft t btree.empty = t :=
sorry

/-! 1.2. Declare btree an instance of `add_monoid` using `graft` as addition
operator. -/

#print add_monoid

@[instance] def btree.add_monid {α : Type} : add_monoid (btree α) :=
sorry

/-! 1.3. Explain why `btree` with `graft` as addition cannot be declared an
instance of `add_group`. -/

#print add_group

/-! 1.4 (**optional**). Prove the following lemma illustrating why `btree` with
`graft` as addition does not constitute an `add_group`. -/

lemma btree.add_left_neg_counterexample :
  ∃x : btree ℕ, ∀ y : btree ℕ, btree.graft y x ≠ btree.empty :=
sorry

/-! ## Question 2: Multisets and Finsets

Recall the following definitions from the lecture: -/

#check multiset.elems
#check finset.elems
#check list.elems

/-! 2.1. Prove that the multiset of nodes does not change when mirroring a tree.

Hints:

* Perform structural induction on `t`.

* The `cc` tactic also works with set operations. -/

lemma multiset.elems_mirror (t : btree ℕ) :
  multiset.elems (mirror t) = multiset.elems t :=
sorry

/-! 2.2. Prove that the finite set of nodes does not change when mirroring a
tree. -/

lemma finset.elems_mirror (t : btree ℕ) :
  finset.elems (mirror t) = finset.elems t :=
sorry

/-! 2.3. Show that this does not hold for the list of nodes by providing a
tree `t` for which `nodes_list t ≠ nodes_list (mirror t)`.

If you define a suitable counterexample, the proof below will succeed. -/

def rotten_tree : btree ℕ :=
sorry

#eval list.elems rotten_tree
#eval list.elems (mirror rotten_tree)

lemma list.elems_mirror_counterexample :
  ∃t : btree ℕ, list.elems t ≠ list.elems (mirror t) :=
begin
  apply exists.intro rotten_tree,
  exact dec_trivial
end

end LoVe


import data.bool
import data.int.gcd
import tactic

def mod' (a: ℤ) (b: ℕ): ℤ := a - b * ((a + b/2) / b)

theorem mod'_eq (a: ℤ) (b: ℕ): mod' a b = ((a + b / 2) % b - b / 2) :=
begin
	simp [mod', int.mod_def],
	linarith,
end

theorem mod_lower_bound (a: ℤ) (b: ℕ) (h: b ≠ 0): mod' a b ≥ -((b: ℤ) / 2) :=
by simp [mod'_eq, int.mod_nonneg, int.coe_nat_ne_zero, h]

theorem div_mul_gt (a: ℤ) { b: ℤ } (h: b > 0):  a / b * b > a - b := begin
	have := int.div_add_mod a b,
	have : (a / b) * b = a - a % b := by linarith,
	rw this,
	have := int.mod_lt a (ne_of_gt h),
	rw int.abs_eq_nat_abs at this,
	rw int.nat_abs_of_nonneg (le_of_lt h) at this,
	linarith,
end

theorem mod_upper_bound (a: ℤ) (b: ℕ) (h: b ≠ 0): (mod' a b) ≤ (b: ℤ) / 2 :=
begin
	set m := (a + (b: ℤ) / 2) % b with m_def,

	suffices : m ≤ (b: ℤ) / 2 + (b: ℤ) / 2, {
		rw [mod'_eq],
		linarith,
	},

	have : m ≤ (b: ℤ) - 1 := begin
		have := int.mod_lt (a + (b: ℤ) / 2) (int.coe_nat_ne_zero.mpr h),
		simp at this,
		exact int.le_sub_one_iff.mpr this,
	end,

	have c : (b: ℤ) - 1 ≤ (b: ℤ) / 2 * 2 := begin
		have : (2: ℤ) > 0 := by linarith,
		have := div_mul_gt b this,
		linarith,
	end,

	linarith,
end

theorem mod_abs_bound (a: ℤ) (b: ℕ) (h: b ≠ 0): (mod' a b).nat_abs ≤ b / 2 :=
begin
	rw ←int.coe_nat_le,
	rw ←int.abs_eq_nat_abs,
	rw abs_le,
	exact and.intro (mod_lower_bound a b h) (mod_upper_bound a b h),
end


theorem IffNotNot {p: Prop}:
  p ↔ ¬ ¬ p := by {
  apply Iff.intro;
  {exact fun h hn => hn h;}
  {
    intro h;
    by_cases hp: p;
    {exact hp;}
    {exact False.elim (h hp);}
  }
}

theorem ImpIffNotImpNot {p q: Prop}:
  (p → q) ↔ (¬ q → ¬ p) := by {
  apply Iff.intro;
  {exact fun h hnq hp => hnq (h hp);}
  {
    intro h hp;
    by_cases hq: q;
    {exact hq;}
    {exact False.elim ((h hq) hp);}
  }
}
theorem IffIffNotIffNot {p q: Prop}:
  (p ↔ q) ↔ (¬ q ↔ ¬ p) := by {
  apply Iff.intro;
  {exact fun h => ⟨ImpIffNotImpNot.1 h.1,ImpIffNotImpNot.1 h.2⟩;}
  {exact fun h => ⟨ImpIffNotImpNot.2 h.1,ImpIffNotImpNot.2 h.2⟩;}
}

theorem NotExistsImpForall {α : Sort u} {p: α → Prop}:
  (¬ (∃a: α, p a)) → (∀a: α, ¬ p a) :=
fun h a ha => h (Exists.intro a ha)
theorem NotFoallImpExists {α : Sort u} {p: α → Prop}:
  ¬ (∀a: α, p a) → (∃a: α, ¬ p a) := by {
  intro h;
  by_cases ha : (∃a: α, ¬ p a);
  {exact ha;}
  {exact False.elim (h (fun a => IffNotNot.2 (NotExistsImpForall ha a)));}
}

theorem ExistsIffNotForall {α : Sort u} {p: α → Prop}:
  (¬ (∃a: α, p a)) ↔ (∀a: α, ¬ p a) := by {
  apply Iff.intro;
  {exact NotExistsImpForall;}
  {exact fun h ⟨a, pa⟩ => (h a) pa;}
}
theorem ForallIffNotExists {α : Sort u} {p: α → Prop}:
  ¬ (∀a: α, p a) ↔ (∃a: α, ¬ p a) := by {
  apply Iff.intro;
  {exact NotFoallImpExists;}
  {exact fun ⟨a, pa⟩ h => pa (h a);}
}

theorem NotOrIffNotAndNot {p q:Prop}:
  ¬ (p ∨ q) ↔ (¬ p) ∧ (¬ q) := by {
  apply Iff.intro;
  {
    intro h;
    by_cases hp:p;
    {exact False.elim (h (Or.inl hp));}
    {
      by_cases hq:q;
      {exact False.elim (h (Or.inr hq));}
      {exact (And.intro hp hq)}
    }
  }
  {
    intro h hn;
    cases hn;
    case mpr.inl hn => {exact h.1 hn}
    case mpr.inr hn => {exact h.2 hn}
  }
}

theorem NotAndIffNotOrNot {p q:Prop}:
  ¬ (p ∧ q) ↔ (¬ p) ∨ (¬ q) := by {
  apply Iff.intro;
  {
    intro h;
    by_cases hp:p;
    {
      by_cases hq:q;
      {exact False.elim (h (And.intro hp hq))}
      {exact Or.inr hq;}
    }
    {exact Or.inl hp;}
  }
  {
    intro h hn;
    cases h;
    case mpr.inl h => {exact h hn.1}
    case mpr.inr h => {exact h hn.2}
  }
}


import logic.basic -- Needed for imp_false

section question11

variables P Q R : Prop

example (h : P ∧ (Q ∧ R)) : (P ∧ Q) ∧ R :=
begin
  sorry
end

end question11

section question6

variables P Q R : Prop

example : (P ∧ R) ∨ (Q ∧ R) → (P ∨ Q) ∧ R :=
begin
  sorry
end

end question6

section question9

variables A B C : Prop

example (h : C → A ∨ B) : (C ∧ ¬A) → B :=
begin
  sorry
end

-- HINT: for this question, you may find it useful to to use `exfalso, contradiction` somewhere in the proof

end question9


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

! This file was ported from Lean 3 source module algebra.dual_number
! leanprover-community/mathlib commit b8d2eaa69d69ce8f03179a5cda774fc0cde984e4
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.TrivSqZeroExt

/-!
# Dual numbers

The dual numbers over `R` are of the form `a + bε`, where `a` and `b` are typically elements of a
commutative ring `R`, and `ε` is a symbol satisfying `ε^2 = 0`. They are a special case of
`TrivSqZeroExt R M` with `M = R`.

## Notation

In the `DualNumber` locale:

* `R[ε]` is a shorthand for `DualNumber R`
* `ε` is a shorthand for `DualNumber.eps`

## Main definitions

* `DualNumber`
* `DualNumber.eps`
* `DualNumber.lift`

## Implementation notes

Rather than duplicating the API of `TrivSqZeroExt`, this file reuses the functions there.

## References

* https://en.wikipedia.org/wiki/Dual_number
-/

variable {R : Type _}

/-- The type of dual numbers, numbers of the form $a + bε$ where $ε^2 = 0$.-/
abbrev DualNumber (R : Type _) : Type _ :=
  TrivSqZeroExt R R
#align dual_number DualNumber

/-- The unit element $ε$ that squares to zero. -/
def DualNumber.eps [Zero R] [One R] : DualNumber R :=
  TrivSqZeroExt.inr 1
#align dual_number.eps DualNumber.eps

-- mathport name: dual_number.eps
scoped[DualNumber] notation "ε" => DualNumber.eps

-- mathport name: dual_number
scoped[DualNumber] postfix:1024 "[ε]" => DualNumber

open DualNumber

namespace DualNumber

open TrivSqZeroExt

@[simp]
theorem fst_eps [Zero R] [One R] : fst ε = (0 : R) :=
  fst_inr _ _
#align dual_number.fst_eps DualNumber.fst_eps

@[simp]
theorem snd_eps [Zero R] [One R] : snd ε = (1 : R) :=
  snd_inr _ _
#align dual_number.snd_eps DualNumber.snd_eps

/-- A version of `TrivSqZeroExt.snd_mul` with `*` instead of `•`. -/
@[simp]
theorem snd_mul [Semiring R] (x y : R[ε]) : snd (x * y) = fst x * snd y + snd x * fst y :=
  TrivSqZeroExt.snd_mul _ _
#align dual_number.snd_mul DualNumber.snd_mul

@[simp]
theorem eps_mul_eps [Semiring R] : (ε * ε : R[ε]) = 0 :=
  inr_mul_inr _ _ _
#align dual_number.eps_mul_eps DualNumber.eps_mul_eps

@[simp]
theorem inr_eq_smul_eps [MulZeroOneClass R] (r : R) : inr r = (r • ε : R[ε]) :=
  ext (MulZeroClass.mul_zero r).symm (mul_one r).symm
#align dual_number.inr_eq_smul_eps DualNumber.inr_eq_smul_eps

/-- For two algebra morphisms out of `R[ε]` to agree, it suffices for them to agree on `ε`. -/
@[ext]

variable {A : Type _} [CommSemiring R] [Semiring A] [Algebra R A]

/-- A universal property of the dual numbers, providing a unique `R[ε] →ₐ[R] A` for every element
of `A` which squares to `0`.

This isomorphism is named to match the very similar `complex.lift`. -/
@[simps!]
def lift : { e : A // e * e = 0 } ≃ (R[ε] →ₐ[R] A) :=
  Equiv.trans
    (show { e : A // e * e = 0 } ≃ { f : R →ₗ[R] A // ∀ x y, f x * f y = 0 } from
      (LinearMap.ringLmapEquivSelf R ℕ A).symm.toEquiv.subtypeEquiv fun a => by
        dsimp
        simp_rw [smul_mul_smul]
        refine' ⟨fun h x y => h.symm ▸ smul_zero _, fun h => by simpa using h 1 1⟩)
    TrivSqZeroExt.lift
#align dual_number.lift DualNumber.lift

-- When applied to `ε`, `DualNumber.lift` produces the element of `A` that squares to 0.
-- @[simp] -- Porting note: simp can prove this
theorem lift_apply_eps (e : { e : A // e * e = 0 }) : @lift R _ _ _ _ e (ε : R[ε]) = e := by
  simp only [lift_apply_apply, fst_eps, map_zero, snd_eps, one_smul, zero_add]
#align dual_number.lift_apply_eps DualNumber.lift_apply_eps

-- Lifting `DualNumber.eps` itself gives the identity.
@[simp]
theorem lift_eps : lift ⟨ε, eps_mul_eps⟩ = AlgHom.id R R[ε] :=
  algHom_ext <| lift_apply_eps _
#align dual_number.lift_eps DualNumber.lift_eps

end DualNumber


/-
We've already seen that we can assert
that a proposition is true by defining
a variable to have that proposition as
its type, and we can prove the proposition
by assigning a proof term to the variable.
-/

lemma zeqz : 0 = 0 := eq.refl 0

/-
Sometimes it's harder to write an exact
proof term (here, eq.refl 0). In these
cases it can help to figure out a proof
term step by step. Lean supports step
by step development of proof terms with
what are called tactic-based proving.
Here's an equivalent tactic-based proof.
-/

lemma zeqz' : 0 = 0 :=
begin
  apply eq.refl 0,
end

/-
In this case, the proof is so simple
that writing a script is more work.
The key thing to see here, though, is
the "apply" tactic. It applies some
already known rule, here eq.refl, to
move from a state in which something
is to be proved to a state in which
something new has been proved.
-/

/-
Now open the Lean Messages panel by typing
control-shift-enter or command-shift-enter
(Windows/Mac). Now place your cursor first
at the start of the "apply". The message
window will display the "tactic state" at
this point in the script. The state say
that nothing is assumed and the remaining
goal to be proved is 0 = 0. Now move your
cursor to the next line, before the "end."
The tactic state is empty, nothing is left
to be proved, QED.
-/

/-
EXERCISE. Define zeqz'' as also
being of type 0 = 0, but after the :=,
just write begin on the next line and
then an end on the following line. You
need to type the begin and end lines
before continuing.
-/

/-
HOW TO SOLVE IT:

Initially there will be an error. Hover
over the red squiggle under the "end."
It tells you that you haven't yet proved
something that remains to be proved, and
it tells you what remains to be proved.

Insert a blank line between the begin and
end. The tactic state tells you what is
known at a given point in a tactic script
(before the turnstile character, ⊢, and
what remains to be proved, after. Here,
the goal that remains is 0 = 0.

If you then click on the next line, end,
Lean tells you that the proof-generating
tactic script between the begin and end
lines failed because some goal remains to
be proved.

In general, a tactic will only partially
prove a goal, leaving some parts still to
be proved. In such cases, more tactics
are then used to finish the construction
of the required proof. Tactic commands
are separated by commas. We'll see more
later.

Go ahead and type the required tactic
between begin and end. Click on the
line with the tactic, then on the end. Watch how the tactic state changes as
you go from line to line.
-/

/-
You might have noticed that while "apply
eq.refl 0" finishes the proof, so does
just "apply eq.refl". In this case, Lean
infers both arguments to eq.refl from
context. That, in fact, is what rfl does.
It's not technically a tactic. It is just
using type inference to infer both of the
arguments needed for eq.refl!

Some people refer to such a script as a
proof. A better way to think about it is
as a step-by-step recipe for building a
proof. The actual proof at the end of the
day is the proof object that the script
constructs: eq.refl 0, in this case.
-/


-- Pruebas_de_length_(repeat_x_n)_Ig_n.lean
-- Pruebas de length (repeat x n) = n
-- José A. Alonso Jiménez
-- Sevilla, 7 de septiembre de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- En Lean están definidas las funciones length y repeat tales que
-- + (length xs) es la longitud de la lista xs. Por ejemplo,
--      length [1,2,5,2] = 4
-- + (repeat x n) es la lista que tiene el elemento x n veces. Por
--   ejemplo,
--      repeat 7 3 = [7, 7, 7]
--
-- Demostrar que
--    length (repeat x n) = n
-- ---------------------------------------------------------------------

import data.list.basic
open nat
open list

set_option pp.structure_projections false

variable {α : Type}
variable (x : α)
variable (n : ℕ)

-- 1ª demostración
example :
  length (repeat x n) = n :=
begin
  induction n with n HI,
  { calc length (repeat x 0)
          = length []                : congr_arg length (repeat.equations._eqn_1 x)
      ... = 0                        : length.equations._eqn_1 },
  { calc length (repeat x (succ n))
         = length (x :: repeat x n)  : congr_arg length (repeat.equations._eqn_2 x n)
     ... = length (repeat x n) + 1   : length.equations._eqn_2 x (repeat x n)
     ... = n + 1                     : congr_arg2 (+) HI rfl
     ... = succ n                    : rfl, },
end

-- 2ª demostración
example :
  length (repeat x n) = n :=
begin
  induction n with n HI,
  { calc length (repeat x 0)
          = length []                : rfl
      ... = 0                        : rfl },
  { calc length (repeat x (succ n))
         = length (x :: repeat x n)  : rfl
     ... = length (repeat x n) + 1   : rfl
     ... = n + 1                     : by rw HI
     ... = succ n                    : rfl, },
end

-- 3ª demostración
example : length (repeat x n) = n :=
begin
  induction n with n HI,
  { refl, },
  { dsimp,
    rw HI, },
end

-- 4ª demostración
example : length (repeat x n) = n :=
begin
  induction n with n HI,
  { simp, },
  { simp [HI], },
end

-- 5ª demostración
example : length (repeat x n) = n :=
by induction n ; simp [*]

-- 6ª demostración
example : length (repeat x n) = n :=
nat.rec_on n
  ( show length (repeat x 0) = 0, from
      calc length (repeat x 0)
           = length []                : rfl
       ... = 0                        : rfl )
  ( assume n,
    assume HI : length (repeat x n) = n,
    show length (repeat x (succ n)) = succ n, from
      calc length (repeat x (succ n))
           = length (x :: repeat x n) : rfl
       ... = length (repeat x n) + 1  : rfl
       ... = n + 1                    : by rw HI
       ... = succ n                   : rfl )

-- 7ª demostración
example : length (repeat x n) = n :=
nat.rec_on n
  ( by simp )
  ( λ n HI, by simp [HI])

-- 8ª demostración
example : length (repeat x n) = n :=
length_repeat x n

-- 9ª demostración
example : length (repeat x n) = n :=
by simp

-- 10ª demostración
lemma length_repeat_1 :
  ∀ n, length (repeat x n) = n
| 0 := by calc length (repeat x 0)
               = length ([] : list α)         : rfl
           ... = 0                            : rfl
| (n+1) := by calc length (repeat x (n + 1))
                   = length (x :: repeat x n) : rfl
               ... = length (repeat x n) + 1  : rfl
               ... = n + 1                    : by rw length_repeat_1

-- 11ª demostración
lemma length_repeat_2 :
  ∀ n, length (repeat x n) = n
| 0     := by simp
| (n+1) := by simp [*]


open classical

variables (α : Type*) (p q : α → Prop)
variable r : Prop

example : (∃ x : α, r) → r :=
assume ⟨w,hw⟩, hw

example (a : α) : r → (∃ x : α, r) :=
assume r,
exists.intro a r

example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r :=
iff.intro
(assume h: ∃ x, p x ∧ r,
  exists.elim h
  (assume w,
   assume hw: p w ∧ r,
   show (∃ x, p x) ∧ r,
    from ⟨exists.intro w hw.left, hw.right ⟩ ))
(assume h: (∃ x, p x) ∧ r,
  exists.elim h.left
  (assume wl,
   assume hwl: p wl,
   show ∃ x, p x ∧ r,
    from exists.intro wl ⟨hwl,  h.right⟩ ))

example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
iff.intro
(assume h: ∃ x, p x ∨ q x,
  exists.elim h
  (assume w,
  assume hw: p w ∨ q w,
  hw.elim
    (assume hp: p w,
      or.inl (exists.intro w hp))
    (assume hq: q w,
      or.inr (exists.intro w hq))))
(assume h: (∃ x, p x) ∨ (∃ x, q x),
  h.elim
    -- short version
    (assume ⟨w, hw⟩, ⟨w, (or.inl hw)⟩)
    -- long version
    (assume hq: ∃ x, q x,
      exists.elim hq
      (assume w,
      assume hw: q w,
      show ∃ x, p x ∨ q x, from  exists.intro w (or.inr hw)))
)

example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) :=
iff.intro
(assume h: ∀ x, p x,
 show ¬ (∃ x, ¬ p x), from
 (assume h1: ∃ x, ¬ p x,
  show false, from exists.elim h1
    (assume w,
     assume hw: ¬ p w,
     hw (h w)
    )
 )
)
(
 assume h: ¬ (∃ x, ¬ p x),
 assume w,
 or.elim (em (p w))
  (assume pw: p w,
   show p w, from pw)
  (assume npw: ¬ p w,
   show p w, from absurd (exists.intro w npw) h)
)

example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) := sorry

example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) := sorry
example : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) := sorry

example : (∀ x, p x → r) ↔ (∃ x, p x) → r := sorry
example (a : α) : (∃ x, p x → r) ↔ (∀ x, p x) → r := sorry
example (a : α) : (∃ x, r → p x) ↔ (r → ∃ x, p x) := sorry

-- 4.6 exercises

-- 3. barber paradox