import Lean4Axiomatic.AbstractAlgebra

/-!
# Fundamental definitions and properties of natural numbers

Closely follows the [Peano axioms](https://en.wikipedia.org/wiki/Peano_axioms).
-/

namespace Lean4Axiomatic.Natural

/-!
## Axioms
-/

/--
Defines the primitive building blocks of all natural numbers.

Provides the first two Peano axioms; see `Axioms.Base` for the rest.
-/
class Constructors (ℕ : outParam Type) :=
  /--
  **Peano axiom 1**: `zero` is a natural number.

  We start at zero instead of one because it gives nicer algebraic properties;
  zero being the identity element for addition, for example.
  -/
  zero : ℕ

  /--
  **Peano axiom 2**: `step n` is a natural number for every natural number `n`.

  The intuition is that `step zero` represents the number one,
  `step (step zero)` represents two, `step (step (step zero))` is three, and in
  general `step n` is the next number after `n` when counting up.

  Other sources call this the _successor_ function, often abbreviated `S`,
  `suc`, or `succ`. Using `step` is just as short, and conveys a similar
  meaning, while not sounding like a word with negative connotations.
  -/
  step : ℕ → ℕ

export Constructors (zero step)

/-- Definitions pertaining to equality of natural number values. -/
class Equality (ℕ : Type) :=
  /-- Natural numbers have a decidable equality relation. -/
  eqvOp? : Relation.Equivalence.EqvOp? ℕ

attribute [instance] Equality.eqvOp?

export Equality (eqvOp?)

/-- Definitions pertaining to numeric literal support for natural numbers. -/
class Literals (ℕ : outParam Type) [outParam (Constructors ℕ)] [outParam (Equality ℕ)] :=
  /--
  Enables representation of natural numbers by numeric literals.

  Lean uses this instance to automatically replace literal values `n : Nat`
  with `OfNat.ofNat ℕ n` in expressions where `ℕ` is expected. For example, the
  raw literal `2` is represented as `succ (succ zero) : Nat`. In a context
  where `2` is expected to have type `ℕ`, Lean would use this instance to
  replace it with the term `OfNat.ofNat ℕ (succ (succ zero))`.

  The interpretation of this representation must be equivalent to the
  corresponding `Nat` values. The `literal_zero` and `literal_step` properties
  enforce this requirement.
  -/
  literal {n : Nat} : OfNat ℕ n

  /-- The numeric literal `0` represents the natural number `zero`. -/
  literal_zero : OfNat.ofNat (α := ℕ) Nat.zero ≃ zero

  /--
  If the numeric literal `ℓ : Nat` represents the natural number `k`, then the
  literal `Nat.succ ℓ` represents the natural number `step k`.
  -/
  literal_step {n : Nat}
    : OfNat.ofNat (α := ℕ) (Nat.succ n) ≃ step (OfNat.ofNat n)

attribute [instance default+1] Literals.literal

export Literals (literal literal_step literal_zero)

/--
Packages together the basic properties of natural numbers, to reduce the amount
of class references needed for more advanced properties.
-/
class Core (ℕ : Type) extends Constructors ℕ, Equality ℕ, Literals ℕ :=
  /--
  The `step` function preserves equality of natural numbers; if two natural
  numbers are equal, they are still equal after `step` is applied to both.
   -/
  step_substitutive : AA.Substitutive₁ (α := ℕ) step (· ≃ ·) (· ≃ ·)

attribute [instance] Core.step_substitutive

export Core (step_substitutive)

/--
Provides the remaining Peano axioms for natural numbers (see `Constructors`
for the first two).
-/
class Axioms (ℕ : outParam Type) [outParam (Core ℕ)] :=
  /-- **Peano axiom 3**: zero is not the successor of any natural number. -/
  step_neqv_zero {n : ℕ} : step n ≄ 0

  /--
  **Peano axiom 4**: two natural numbers are equal if their successors are.
  -/
  step_injective : AA.Injective (α := ℕ) step (· ≃ ·) (· ≃ ·)

  /--
  **Peano axiom 5**: the principle of mathematical induction.

  Given a predicate on natural numbers (here named `motive`), assert that it
  holds of all natural numbers if the following criteria are met:
  1. (base case) `motive 0` holds;
  1. (inductive case) `motive (step n)` holds whenever `motive n` holds, for
     all `n : ℕ`.
  -/
  ind {motive : ℕ → Prop}
    : motive 0 → (∀ n, motive n → motive (step n)) → ∀ n, motive n

attribute [instance] Axioms.step_injective

export Axioms (ind step_injective step_neqv_zero)

/-!
## Derived properties
-/

variable {ℕ : Type}
variable [Core ℕ]
variable [Axioms ℕ]

/--
Equivalent to `Axioms.ind` but with a more convenient argument order when using
the `apply` tactic.
-/
def ind_on
    {motive : ℕ → Prop} (n : ℕ)
    (zero : motive 0) (step : ∀ m, motive m → motive (step m)) : motive n
    :=
  Axioms.ind zero step n

/--
Similar to `ind_on`, but doesn't provide an inductive hypothesis. Useful for
proofs that need a case split but not the full power of induction.
-/
def cases_on
    {motive : ℕ → Prop} (n : ℕ)
    (zero : motive 0) (step : ∀ n, motive (step n)) : motive n
    :=
  ind_on n zero (λ n _ => step n)

/-- A natural number is never equal to its successor. -/
theorem step_neqv {n : ℕ} : step n ≄ n := by
  apply ind_on (motive := λ n => step n ≄ n) n
  case zero =>
    show step 0 ≄ 0
    exact step_neqv_zero
  case step =>
    intro n (ih : step n ≄ n)
    show step (step n) ≄ step n
    intro (_ : step (step n) ≃ step n)
    show False
    apply ih
    show step n ≃ n
    exact AA.inject ‹step (step n) ≃ step n›

end Lean4Axiomatic.Natural


import .lovelib

/-! # LoVe Exercise 3: Forward Proofs -/

set_option pp.beta true

namespace LoVe

/-! ## Question 1: Connectives and Quantifiers

1.1. Supply structured proofs of the following lemmas. -/

lemma I (a : Prop) :
  a → a :=
assume ha : a,
show a, from
  ha

lemma K (a b : Prop) :
  a → b → b :=
assume ha: a,
assume hb: b,
show b, from
  hb

lemma C (a b c : Prop) :
  (a → b → c) → b → a → c :=
assume habc: (a → b → c),
assume hb: b,
assume ha: a,
show c, from
  habc ha hb

lemma proj_1st (a : Prop) :
  a → a → a :=
assume ha1,
assume ha2: a,
show a, from
  ha1

/-! Please give a different answer than for `proj_1st`. -/

lemma proj_2nd (a : Prop) :
  a → a → a :=
assume ha1: a,
assume ha2: a,
show a, from
  ha2

lemma some_nonsense (a b c : Prop) :
  (a → b → c) → a → (a → c) → b → c :=
assume habc: (a → b → c),
assume ha: a,
assume hac: (a → c),
assume hb: b,
show c, from
  habc ha hb

/-! 1.2. Supply a structured proof of the contraposition rule. -/

lemma contrapositive (a b : Prop) :
  (a → b) → ¬ b → ¬ a :=
assume hab: a → b,
assume nb: ¬ b,
show ¬ a, from
begin
  apply not.intro,
  intro,
  apply nb,
  apply hab,
  apply a_1,
end

/-! 1.3. Supply a structured proof of the distributivity of `∀` over `∧`. -/

lemma forall_and {α : Type} (p q : α → Prop) :
  (∀x, p x ∧ q x) ↔ (∀x, p x) ∧ (∀x, q x) :=
iff.intro
  (assume pq: ∀ (x : α), p x ∧ q x,
    have px : (∀x, p x) :=
      fix x: α,
      and.elim_left (pq x),
    have qx :(∀x, q x) :=
      fix x: α,
      and.elim_right (pq x),
    show (∀x, p x) ∧ (∀x, q x), from
      and.intro px qx
  )
  (assume pq: (∀x, p x) ∧ (∀x, q x),
    fix x: α,
    have px: p x :=
      and.elim_left pq x,
    have qx: q x :=
      and.elim_right pq x,
    show (p x) ∧ (q x), from
      and.intro px qx
  )
/-! 1.4. Reuse, if possible, the lemma `forall_and` you proved above to prove
the following instance of the lemma. -/

lemma forall_and_inst {α : Type} (r s : α → α → Prop) :
  (∀x, r x x ∧ s x x) ↔ (∀x, r x x) ∧ (∀x, s x x) :=
forall_and _ _

/-! ## Question 2: Chain of Equalities

2.1. Write the following proof using `calc`.

      `(a + b) * (a + b)`
    `= a * (a + b) + b * (a + b)`
    `= a * a + a * b + b * a + b * b`
    `= a * a + a * b + a * b + b * b`
    `= a * a + 2 * a * b + b * b`

Hint: You might need the tactics `simp` and `cc` and the lemmas `mul_add`,
`add_mul`, and `two_mul`. -/

lemma binomial_square (a b : ℕ) :
  (a + b) * (a + b) = a * a + 2 * a * b + b * b :=
calc (a + b) * (a + b)
    = a * (a + b) + b * (a + b): by rewrite add_mul
... = a * a + a * b + b * (a + b): by rewrite <- mul_add
... = a * a + a * b + (b * a + b * b): by simp [mul_add b a b]
... = a * a + (a * b + a * b) + b * b: by cc
... = a * a + 2 * (a * b) + b * b: by rewrite two_mul (a * b)
... = a * a + 2 * a * b + b * b: by cc

/-! 2.2. Prove the same argument again, this time as a structured proof. Try to
reuse as much of the above proof idea as possible. -/

lemma binomial_square₂ (a b : ℕ) :
  (a + b) * (a + b) = a * a + 2 * a * b + b * b :=
have h1: (a + b) * (a + b) = a * (a + b) + b * (a + b), by rewrite add_mul,
have h2: a * (a + b) + b * (a + b) = a * a + a * b + b * (a + b), by rewrite <- mul_add,
have h3: a * a + a * b + b * (a + b) = a * a + a * b + (b * a + b * b), by simp [mul_add b a b],
have h4: (a + b) * (a + b) = a * a + (a * b + a * b) + b * b, by cc,
have h5: a * a + (a * b + a * b) + b * b = a * a + 2 * (a * b) + b * b, by rewrite two_mul (a * b),
show (a + b) * (a + b) = a * a + 2 * a * b + b * b, from
begin
  cc,
end

/-! 2.3. Prove the same lemma again, this time using tactics. -/

lemma binomial_square₃ (a b : ℕ) :
  (a + b) * (a + b) = a * a + 2 * a * b + b * b :=
begin
  simp [add_mul, mul_add, two_mul],
  cc
end

/-! ## Question 3 (**optional**): One-Point Rules

3.1 (**optional**). Prove that the following wrong formulation of the one-point
rule for `∀` is inconsistent, using a structured proof. -/

axiom forall.one_point_wrong {α : Type} {t : α} {p : α → Prop} :
  (∀x : α, x = t ∧ p x) ↔ p t

lemma proof_of_false :
  false :=
sorry

/-! 3.2 (**optional**). Prove that the following wrong formulation of the
one-point rule for `∃` is inconsistent, using a tactical or structured proof. -/

axiom exists.one_point_wrong {α : Type} {t : α} {p : α → Prop} :
  (∃x : α, x = t → p x) ↔ p t

lemma proof_of_false₂ :
  false :=
sorry

end LoVe


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import data.polynomial.degree.definitions

/-!
# Cancel the leading terms of two polynomials

## Definition

* `cancel_leads p q`: the polynomial formed by multiplying `p` and `q` by monomials so that they
  have the same leading term, and then subtracting.

## Main Results
The degree of `cancel_leads` is less than that of the larger of the two polynomials being cancelled.
Thus it is useful for induction or minimal-degree arguments.
-/
namespace polynomial
noncomputable theory

variables {R : Type*}

section comm_ring
variables [comm_ring R] (p q : polynomial R)

/-- `cancel_leads p q` is formed by multiplying `p` and `q` by monomials so that they
  have the same leading term, and then subtracting. -/
def cancel_leads : polynomial R :=
C p.leading_coeff * X ^ (p.nat_degree - q.nat_degree) * q -
C q.leading_coeff * X ^ (q.nat_degree - p.nat_degree) * p

variables {p q}

@[simp] lemma neg_cancel_leads : - p.cancel_leads q = q.cancel_leads p := neg_sub _ _

lemma dvd_cancel_leads_of_dvd_of_dvd {r : polynomial R} (pq : p ∣ q) (pr : p ∣ r) :
  p ∣ q.cancel_leads r :=
dvd_sub (dvd.trans pr (dvd.intro_left _ rfl)) (dvd.trans pq (dvd.intro_left _ rfl))

end comm_ring

lemma nat_degree_cancel_leads_lt_of_nat_degree_le_nat_degree [integral_domain R]
  {p q : polynomial R} (h : p.nat_degree ≤ q.nat_degree) (hq : 0 < q.nat_degree) :
  (p.cancel_leads q).nat_degree < q.nat_degree :=
begin
  by_cases hp : p = 0,
  { convert hq,
    simp [hp, cancel_leads], },
  rw [cancel_leads, sub_eq_add_neg, nat.sub_eq_zero_of_le h, pow_zero, mul_one],
  by_cases h0 :
      C p.leading_coeff * q + -(C q.leading_coeff * X ^ (q.nat_degree - p.nat_degree) * p) = 0,
  { convert hq,
    simp only [h0, nat_degree_zero], },
  have hq0 : ¬ q = 0,
  { contrapose! hq,
    simp [hq] },
  apply lt_of_le_of_ne,
  { rw [← with_bot.coe_le_coe, ← degree_eq_nat_degree h0, ← degree_eq_nat_degree hq0],
    apply le_trans (degree_add_le _ _),
    rw ← leading_coeff_eq_zero at hp hq0,
    simp only [max_le_iff, degree_C hp, degree_C hq0, le_refl q.degree, true_and, nat.cast_with_bot,
      nsmul_one, degree_neg, degree_mul, zero_add, degree_X, degree_pow],
    rw leading_coeff_eq_zero at hp hq0,
    rw [degree_eq_nat_degree hp, degree_eq_nat_degree hq0, ← with_bot.coe_add, with_bot.coe_le_coe,
      nat.sub_add_cancel h], },
  { contrapose! h0,
    rw [← leading_coeff_eq_zero, leading_coeff, h0, mul_assoc, mul_comm _ p,
      ← nat.sub_add_cancel h, add_comm _ p.nat_degree],
    simp only [coeff_mul_X_pow, coeff_neg, coeff_C_mul, nat.add_sub_cancel_left, coeff_add],
    rw [add_comm p.nat_degree, nat.sub_add_cancel h, ← leading_coeff, ← leading_coeff,
      mul_comm _ q.leading_coeff, ← sub_eq_add_neg, ← mul_sub, sub_self, mul_zero] }
end

end polynomial


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

/-!
# Sorting a finite type

This file provides two equivalences for linearly ordered fintypes:
* `mono_equiv_of_fin`: Order isomorphism between `α` and `fin (card α)`.
* `fin_sum_equiv_of_finset`: Equivalence between `α` and `fin m ⊕ fin n` where `m` and `n` are
  respectively the cardinalities of some `finset α` and its complement.
-/

open finset

/-- Given a linearly ordered fintype `α` of cardinal `k`, the order isomorphism
`mono_equiv_of_fin α h` is the increasing bijection between `fin k` and `α`. Here, `h` is a proof
that the cardinality of `α` is `k`. We use this instead of an isomorphism `fin (card α) ≃o α` to
avoid casting issues in further uses of this function. -/
def mono_equiv_of_fin (α : Type*) [fintype α] [linear_order α] {k : ℕ} (h : fintype.card α = k) :
  fin k ≃o α :=
(univ.order_iso_of_fin h).trans $ (order_iso.set_congr _ _ coe_univ).trans order_iso.set.univ

variables {α : Type*} [decidable_eq α] [fintype α] [linear_order α] {m n : ℕ} {s : finset α}

/-- If `α` is a linearly ordered fintype, `s : finset α` has cardinality `m` and its complement has
cardinality `n`, then `fin m ⊕ fin n ≃ α`. The equivalence sends elements of `fin m` to
elements of `s` and elements of `fin n` to elements of `sᶜ` while preserving order on each
"half" of `fin m ⊕ fin n` (using `set.order_iso_of_fin`). -/
def fin_sum_equiv_of_finset (hm : s.card = m) (hn : sᶜ.card = n) : fin m ⊕ fin n ≃ α :=
calc fin m ⊕ fin n ≃ (s : set α) ⊕ (sᶜ : set α) :
  equiv.sum_congr (s.order_iso_of_fin hm).to_equiv $
    (sᶜ.order_iso_of_fin hn).to_equiv.trans $ equiv.set.of_eq s.coe_compl
... ≃ α : equiv.set.sum_compl _

@[simp] lemma fin_sum_equiv_of_finset_inl (hm : s.card = m) (hn : sᶜ.card = n) (i : fin m) :
  fin_sum_equiv_of_finset hm hn (sum.inl i) = s.order_emb_of_fin hm i :=
rfl

@[simp] lemma fin_sum_equiv_of_finset_inr (hm : s.card = m) (hn : sᶜ.card = n) (i : fin n) :
  fin_sum_equiv_of_finset hm hn (sum.inr i) = sᶜ.order_emb_of_fin hn i :=
rfl


/-
how to use only exact to prove 0 + n = n:
-/
inductive mynat : Type
| zero : mynat
| succ : mynat → mynat

#print nat.add

open mynat
-- def add' : mynat → mynat → mynat
-- | a  zero     := a
-- | a  (succ b) := succ (add' a b)
constant add' : mynat → mynat → mynat

notation 0 := mynat.zero
-- notation a` + `b := add' a b

axiom add_zero' (a : mynat) : add' a 0 = a
axiom add_succ' (a b : mynat) : add' a (succ b) = succ(add' a b)

lemma zero_add'(n : mynat) : add' 0 n = n :=
begin
  induction n with d hd,
  rw add_zero',
  /-
  λ (n : mynat),
  mynat.rec ((id ((eq.refl (add' 0 0 = 0)).rec (add_zero' 0))).mpr (eq.refl 0))
    (λ (d : mynat) (hd : add' 0 d = d), sorry) n
  -/
  rw [add_succ', hd],
  /-
  λ (n : mynat),
  mynat.rec ((id ((eq.refl (add' 0 0 = 0)).rec (add_zero' 0))).mpr (eq.refl 0))
    (λ (d : mynat) (hd : add' 0 d = d),
       (id ((eq.refl (add' 0 d.succ = d.succ)).rec (add_succ' 0 d))).mpr
         ((id ((eq.refl ((add' 0 d).succ = d.succ)).rec hd)).mpr (eq.refl d.succ)))
    n
  -/
end
#print zero_add'

notation a ++ b := add' a b

lemma add_assoc' (a b c : mynat) : (a ++ b) ++ c = a ++ (b ++ c) :=
begin
induction c with c hc,
rw add_zero',
rw add_zero',
rw add_succ',
rw add_succ',
rw add_succ',
rw hc,
end

lemma add_right_comm (a b c : mynat) : a + b + c = a + c + b :=
begin
  -- a + b + c
  rw add_assoc,
  rw add_comm,
  -- <=> rotate permutation (231)
  -- b + c + a
  rw add_assoc,
  rw add_comm,
  -- c + a + b
  rw add_assoc,
  rw add_comm,
  -- a + b + c
end

/-

lemma succ_add (a b : mynat) : succ a + b = succ (a + b) :=
begin
  induction b with b hb,
  repeat {rw add_zero, },
  rw add_succ,
  rw add_succ,
  rw hb,
  refl,

-- n the set of natural numbers, addition is commutative.
-- In other words, for all natural numbers a and b, we have a + b = b + a
lemma add_comm (a b : mynat) : a + b = b + a :=
begin
  induction a with a ha,
  rw [zero_add, add_zero],
  refl,
  rw add_succ,
  rw succ_add,
  rw ha,
  refl,
end

theorem succ_eq_add_one (n : mynat) : succ n = n + 1 :=
begin
  induction n with n hn,
  rw one_eq_succ_zero,
  rw zero_add, refl,
  rw succ_add,
end

lemma add_right_comm (a b c : mynat) : a + b + c = a + c + b :=
begin
  rw add_assoc,
  rw add_comm,
  apply eq.symm,
  rw add_comm,
  rw add_assoc,
  have : a + c = c + a, from add_comm a c,
  rw this, refl,
end

-/


import .src_07_existential_quantification

variables p q r : Prop

namespace mth1001

section or_elimination

/-
We've seen how to introduce a statement of the form `p ∨ q`. In this section, we'll see
how to _use_ a premise `h : p ∨ q`.

Suppose you have `h : p ∨ q` and you know both
1. `r` follows from `p` and
2. `r` follows from `q`,
then you may derive `r`. This is known as or elimination.
-/

/-
Here's a template for a tactic-mode application of or elimination. The line
  `cases h with hp hq`
decomposes `h` and creates two subgoals:
1. a goal of deriving `r`, where `h` has been replaced with `hp : p` in the context and
2. a goal of deriving `r`, where `h` has been replaced with `hq : q` in the context.

These goals are closed through implication elimination.
-/
example (h : p ∨ q) (k₁ : p → r) (k₂ : q → r) : r :=
begin
  cases h with hp hq,
  { exact k₁ hp },
  { exact k₂ hq },
end

/-
For a term-style proof, we use the theorem `or.elim`.
-/
#check @or.elim
/-
We see that `or.elim` (ignore the `@` for now) has type
  `∀ {a b c : Prop}, a ∨ b → (a → c) → (b → c) → c`
This means that `or.elim` takes three arguments, one of type `a ∨ b`, one of type `a → c`,
and one of type `b → c`. It returns a proof of `c`.

Recall that the braces in `∀ {a b c : Prop}` tell Lean that the arguments `a`, `b`, and `c`
are implicit - you need not supply them explicity.
-/

/-
We now use `or.elim` to give a term-style proof of the above result.
-/
example (h : p ∨ q) (k₁ : p → r) (k₂ : q → r) : r :=
or.elim h k₁ k₂

/-
HINT: when constructing a proof term, you can replace arguments with `_`. Even when Lean
cannot infer the argument, it will give you information about the goal and the context.

For instance, replacing `k₂` above with `_` gives the following information:
```
don't know how to synthesize placeholder
context:
p q r : Prop,
h : p ∨ q,
k₁ : p → r,
k₂ : q → r
⊢ q → r
```

The goal is presented as `⊢ q → r`. It's clear that this goal matches exactly the premise `k₂`.
-/

-- Exercise 050:
/-
We can mimic the tactic-mode proof by replacing `k₁` and `k₂` in the proof term
  `or.elim h k₁ k₂`
with more complicated terms. Though inefficient in this case, it provides a useful template
for more sophisticated examples.
-/
example (h : p ∨ q) (k₁ : p → r) (k₂ : q → r) : r :=
or.elim h
( assume hp, k₁ hp )
sorry

-- Exercise 051:
example (h : (p ∧ q) ∨ (q ∧ r)) : q :=
begin
  cases h with h₁ h₂,
  sorry,
  sorry,
end

-- Exercise 052:
example (h : (p ∧ q) ∨ (q ∧ r)) : q :=
or.elim h
sorry
sorry
/-
The combination of the following two results is called right distributivity of `∧` over `∨`
(you don't need to remember this name!)
-/

-- Exercise 053:
theorem or_and_distrib_right1 : (p ∧ r) ∨ (q ∧ r) → (p ∨ q) ∧ r :=
begin
  intro h,
  cases h with hpr hqr,
  { split,
    { left, exact hpr.left },
    { sorry, } },
  { sorry, },
end

-- Exercise 054:
-- See the next example for a hint.
theorem or_and_distrib_right2 : (p ∨ q) ∧ r → (p ∧ r) ∨ (q ∧ r) :=
begin
  sorry
end

-- If you're stuck with the exercise above, here's a hint:
example : (p ∨ q) ∧ r → (p ∧ r) ∨ (q ∧ r) :=
begin
  intro h,
  cases h with hpq hr,
  cases hpq with hp hq,
  { sorry, },
  { sorry, },
end

/-
We'll present some more examples using `odd` and `even` numbers. You don't need to understand
all the details of the theorem, but it's worth nothing two points

(1) Suppose `h` is an equation or if and only if expression, for example `h : a = b`.
The tactic `rw h` looks for `a` in the goal and replaces it with `b`. However, `rw ←h` looks
for `b` in the goals and replaces it with `a`.

(2) The `linarith` tactic automatically uses any relevant premises in the context to solve linear
equations and inequalities.

(3) The `ring` tactic simplies algebraic expressions, whether linear or not.
-/
open int

theorem even_or_odd (m : ℤ) : even m ∨ odd m :=
begin
  cases (mod_two_eq_zero_or_one m) with h,
  { left,
    use (m/2),
    rw [←(mod_add_div m 2), h],
    ring,
    rw int.mul_div_cancel_left,
    linarith, },
  { right,
    use (m/2),
    rw [←(mod_add_div m 2), h, add_comm],
    congr' 2,
    rw [add_comm, int.add_mul_div_left],
    norm_num,
    linarith, },
end

-- Exercise 055:
-- We use the theorem above in proving the following.
example (b : ℤ) : even b ∨ odd (b + 8) :=
begin
  cases even_or_odd b with h,
  { sorry, },
  { sorry, },
end

-- Exercise 056:
theorem even_mul_add_one (a : ℤ) : even (a * (a + 1)) :=
begin
  sorry
end

end or_elimination

/-
SUMMARY:

* Or elimination.
* Tactic-style elimination using `cases`.
* Term-sytle elimination using `or.elim`.

* Using the `_` placeholder.

-/

end mth1001


import .love10_denotational_semantics_demo

/-! # LoVe Exercise 10: Denotational Semantics -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1: Monotonicity

1.1. Prove the following lemma from the lecture. -/

lemma monotone_comp {α β : Type} [partial_order α] (f g : α → set (β × β))
    (hf : monotone f) (hg : monotone g) :
  monotone (λa, f a ◯ g a) :=
begin
  intros a₁ a₂ ha b hb,
  cases' hb with m hm,
  cases' hm,
  apply exists.intro m,
  apply and.intro,
  { exact hf _ _ ha left },
  { exact hg _ _ ha right }
end

/-! 1.2. Prove its cousin. -/

lemma monotone_restrict {α β : Type} [partial_order α] (f : α → set (β × β))
    (p : β → Prop) (hf : monotone f) :
  monotone (λa, f a ⇃ p) :=
begin
  intros a₁ a₂ ha b hb,
  cases' hb,
  apply and.intro,
  { apply hf _ _ ha,
    exact left },
  { exact right }
end

/-! ## Question 2: Regular Expressions

__Regular expressions__, or __regexes__, are a highly popular tool for software
development, to analyze textual inputs. Regexes are generated by the following
grammar:

    R ::= ∅
        | ε
        | a
        | R ⬝ R
        | R + R
        | R*

Informally, the semantics of regular expressions is as follows:

* `∅` accepts nothing;
* `ε` accepts the empty string;
* `a` accepts the atom `a`;
* `R ⬝ R` accepts the concatenation of two regexes;
* `R + R` accepts either of two regexes;
* `R*` accepts arbitrary many repetitions of a regex.

Notice the rough correspondence with a WHILE language:

    `∅` ~ diverging statement (e.g., `while true do skip`)
    `ε` ~ `skip`
    `a` ~ `:=`
    `⬝` ~ `;`
    `+` ~ `if then else`
    `*` ~ `while` loop -/

inductive regex (α : Type) : Type
| nothing : regex
| empty   : regex
| atom    : α → regex
| concat  : regex → regex → regex
| alt     : regex → regex → regex
| star    : regex → regex

/-! In this exercise, we explore an alternative semantics of regular
expressions. Namely, we can imagine that the atoms represent binary relations,
instead of letters or symbols. Concatenation corresponds to composition of
relations, and alternation is union. Mathematically, regexes and binary
relations are both instances of Kleene algebras.

2.1. Complete the following translation of regular expressions to relations.

Hint: Exploit the correspondence with the WHILE language. -/

def rel_of_regex {α : Type} : regex (set (α × α)) → set (α × α)
| regex.nothing        := ∅
| regex.empty          := Id
| (regex.atom s)       := s
| (regex.concat r₁ r₂) := rel_of_regex r₁ ◯ rel_of_regex r₂
| (regex.alt r₁ r₂)    := rel_of_regex r₁ ∪ rel_of_regex r₂
| (regex.star r)       := lfp (λX, (rel_of_regex r ◯ X) ∪ Id)

/-! 2.2. Prove the following recursive equation about your definition. -/

lemma rel_of_regex_star {α : Type} (r : regex (set (α × α))) :
  rel_of_regex (regex.star r) =
  rel_of_regex (regex.alt (regex.concat r (regex.star r)) regex.empty) :=
begin
  apply lfp_eq,
  apply monotone_union,
  { apply monotone_comp,
    { exact monotone_const _ },
    { exact monotone_id } },
  { exact monotone_const _ }
end

end LoVe


-- Imagen_inversa_de_la_imagen.lean
-- Imagen inversa de la imagen
-- José A. Alonso Jiménez
-- Sevilla, 7 de junio de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que si s es un subconjunto del dominio de la función f,
-- entonces s está contenido en la [imagen inversa](https://bit.ly/3ckseBL)
-- de la [imagen de s por f](https://bit.ly/3x2Jxij); es decir,
--    s ⊆ f⁻¹[f[s]]
-- ----------------------------------------------------------------------

import data.set.basic

open set

variables {α : Type*} {β : Type*}
variable  f : α → β
variable  s : set α

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

example : s ⊆ f ⁻¹' (f '' s) :=
begin
  intros x xs,
  apply mem_preimage.mpr,
  apply mem_image_of_mem,
  exact xs,
end

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

example : s ⊆ f ⁻¹' (f '' s) :=
begin
  intros x xs,
  apply mem_image_of_mem,
  exact xs,
end

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

example : s ⊆ f ⁻¹' (f '' s) :=
λ x, mem_image_of_mem f

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

example : s ⊆ f ⁻¹' (f '' s) :=
begin
  intros x xs,
  show f x ∈ f '' s,
  use [x, xs],
end

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

example : s ⊆ f ⁻¹' (f '' s) :=
begin
  intros x xs,
  use [x, xs],
end

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

example : s ⊆ f ⁻¹' (f '' s) :=
subset_preimage_image f s


import algebra.ring.basic
import algebra.algebra.subalgebra
import algebra.group.defs
import analysis.special_functions.pow
import data.nat.parity
import data.nat.prime
import data.pnat.basic
import data.int.parity
import data.zmod.basic
import data.rat.basic
import data.real.basic
import data.real.irrational
import data.zsqrtd.basic
import ring_theory.subring
import tactic
import tactic.slim_check
import data.equiv.ring
import algebra.punit_instances
open rat
open nat
open tactic
open real

-- Garrett Birkhoff and Saunders Mac Lane: A survey of modern algebra, 4th ed

namespace ch1A

-- 1.1 Commutative Rings

-- Integral domain

#check integral_domain

-- An integral domain of interest for number theory consists of all a + b √ 2, a and b ∈ ℤ

#check ℤ√2

-- 1.2. Elementary Properties of Commutative Rings

universe u

variables {α : Type u} [comm_ring α] {a b c d z x₁ x₂ :  α}

lemma rule_1 : (a+b)*c=a*c+b*c := add_mul _ _ _
lemma rule_2_plus : (0 + a = a) := zero_add _
lemma rule_2_times : (1 * a = a) := one_mul _

lemma rule_3 : (∀ (a : α), a + z = a) → z = 0 :=
begin
  intro h1,
  have h2 := h1 0,
  exact add_left_eq_self.mp (congr_arg (has_add.add z) (congr_arg (has_add.add z) (h1 z))),
end

lemma rule_4 : a + b = a + c → b = c := (add_right_inj a).mp

lemma rule_5 : a + x₁ = 0 → a + x₂ = 0 → x₁ = x₂ :=
begin
  intro h1,
  intro h2,
  exact neg_unique h1 h2,
end

lemma rule_6 : a + x₁ = b → a + x₂ = b → x₁ = x₂ :=
begin
  intro h1,
  intro h2,
  rw ← h1 at h2,
  exact rule_4 (eq.symm h2),
end

lemma rule_7a : a * 0 = 0 := mul_zero a
lemma rule_7b  : 0 * a = 0 := zero_mul a

lemma rule_8 : (∀ (a : α), a*z = a) → z = 1 :=
begin
  intro h1,
  exact (eq_one_iff_eq_one_of_mul_eq_one (h1 1)).mp rfl,
end

lemma rule_9 : (-a)*(-b) = a*b := neg_mul_neg _ _

/- Theorem 1. The cancellation law of multiplication for integral domains
is equivalent in a commutative ring to the assertion that
a product of nonzero factors is not 0. -/

theorem theorem_1 :
  (∀ a b c : α, c ≠ 0 → c*a = c*b → a = b) ↔
  (∀ a b : α, a ≠ 0 → b ≠ 0 → a * b ≠ 0) :=
begin
  split,
  { intros H a b ha hb ab,
    refine hb (H _ _ _ ha _),
    have hc := mul_zero a,
    rw hc,
    rw ab,
  },
  { intros H a b c hc e,
    rw ← sub_eq_zero at e ⊢,
    refine by_contra (λ h, _),
    refine H c (a - b) hc h _,
    have hd := left_distrib c a (-b),
    have he := sub_eq_add_neg a b,
    rw ← he at hd,
    have hf := norm_num.mul_pos_neg c b (c * b) rfl,
    rw hf at hd,
    have hg := sub_eq_add_neg (c*a) (c*b),
    rw ← hg at hd,
    rw hd,
    exact e,
  },
end

#check left_distrib c a (-b)
/- A subdomain of an integral domain D is a subset of D
which is also an integral domain, for the same operations of addition and
multiplication. -/

variables {R : Type*} [integral_domain R] {D : subring R}
example : integral_domain D := subring.subring.domain D

-- Exercises for section 1.2

lemma ex1a : (a+b)*(c+d) = (a*c+b*c) + (a*d + b*d) :=
begin
  ring,
end

lemma ex1b1 : a+(b+(c+d))=(a+b)+(c+d) :=
begin
  ring,
end

lemma ex1b2 : (a+b)+(c+d)=((a+b)+c)+d :=
begin
  ring,
end

lemma ex1c : a+(b+c) = (c+a)+b:=
begin
  ring,
end

lemma ex1d : a*(b*c)=c*(a*b) :=
begin
  ring,
end

lemma ex1e : a*(b+(c+d))=(a*b+a*c)+a*d :=
begin
  ring,
end

lemma ex1f : (a+b)*(c+d) = (a*c+b*c) + (a*d + b*d) :=
begin
  ring,
end

#check rule_8

lemma ex2b : 1*1=1 :=
begin
  ring,
end

/- Exercise 2c.  The only idempotents of an integral domain are 0 and 1. -/
variables {β : Type u} [integral_domain β] {x : β}
lemma ex2c : ∀ (x : β), x*x = x → (x = 0 ∨ x = 1) :=
begin
  intro x,
  intro h1,
  conv_rhs at h1 { rw ← mul_one x, },
  have h2 := sub_eq_zero.mpr h1,
  rw (mul_sub x x 1).symm at h2,
  have h3 := mul_eq_zero.mp h2,
  by_cases h4 : x = 0,
  by_cases h5 : x-1 = 0,
  exact or.inl h4,
  exact or.inl h4,
  refine or.inr _,
  exact (mul_right_inj' h4).mp h1,
end

lemma ex2c_JC (h1 : x * x = x) : x = 0 ∨ x = 1 := -- Johan Commelin
by simp [← @sub_eq_zero β _ _ 1, ← mul_eq_zero, mul_sub, h1]

lemma ex2c_KL {x : β} (h1 : x * x = x) : x = 0 ∨ x = 1 := -- Kenny Lau
or_iff_not_imp_left.2 $ λ hx, mul_left_cancel' hx $ h1.trans (mul_one x).symm

lemma ex3a : -(-a) = a :=
begin
  ring,
end

lemma ex3b : -(0 : α ) = 0 :=
begin
  ring,
end

lemma ex3c : -(a+b) = (-a) + (-b) :=
begin
  ring,
end

lemma ex3d : -a = (-1)*a :=
begin
  ring,
end

lemma ex3e1 : (-a)*b=a*(-b) :=
begin
  ring,
end

lemma ex3e2 : a*(-b)=-(a*b) :=
begin
  ring,
end

#check rule_9

lemma ex4 : (-1)*(-1) = (1:α) :=
begin
  ring,
end

end ch1A

namespace ch1B

universe u
variables {α : Type u} [integral_domain α] {a b c d : α}

lemma ex5a: (a-b) + (c-d) = (a+c)-(b+d) :=
begin
  ring,
end

lemma ex5b : (a-b)-(c-d) = (a+d)-(b+c) :=
begin
  ring,
end

lemma ex5c : (a-b)*(c-d) = (a*c + b*d)-(a*d+b*c)  :=
begin
  ring,
end

lemma ex5d : a-b=c-d ↔ a+d=b+c :=
begin
  split,
  {
    intro h,
    apply_fun (λ t, t+b+d) at h,
    conv at h
    begin
      to_lhs,
      rw sub_add_cancel,
    end,
    conv at h
    begin
      to_rhs,
      rw sub_add_eq_add_sub,
      rw sub_add,
      rw sub_self,
      rw sub_zero,
    end,
    have swap := add_comm c b,
    rw swap at h,
    assumption,
  },
  {
    intro h,
    apply_fun (λ t, t-b-d) at h,
    conv at h
    begin
      to_lhs,
      rw ← sub_add_eq_add_sub,
      rw ← add_sub,
      rw sub_self,
      rw add_zero,
    end,
    conv at h
    begin
      to_rhs,
      rw ← sub_add_eq_add_sub,
      rw sub_self,
      rw zero_add,
    end,
    assumption,
  },
end

lemma ex5e : (a-b)*c = a*c - b*c :=
begin
  ring,
end

instance (x : ℤ) : decidable (even x) :=
  decidable_of_iff' _ even_iff_two_dvd

theorem ex6a :  ¬ ∃ s : subring ℤ, ∀ x, x ∈ s ↔ even x := -- Mario Carneiro
λ ⟨S, h⟩, absurd ((h 1).1 S.one_mem) dec_trivial

theorem ex6b :  ¬ ∃ s : subring ℤ, ∀ x, x ∈ s ↔ odd x :=
begin
  intro h1,
  cases h1 with S h,
  have h2 := h 0,
  have h3 := h2.1,
  have h4 := S.zero_mem,
  have h5 := h3 h4,
  have h6 := (@int.odd_iff_not_even 0).1,
  have h7 := h6 h5,
  have h8 := absurd h7 dec_trivial,
  exact h8,
end

theorem ex6c :  ¬ ∃ s : subring ℤ, ∀ x, x ∈ s ↔ (0:ℤ) < x :=
begin
  intro h1,
  cases h1 with S h,
  have h2 := h (0:ℤ),
  have h3 := subring.zero_mem S,
  have h4 := h2.1,
  have h5 := h4 h3,
  have h6 := lt_irrefl (0:ℤ),
  exact h6 h5,
end

-- Mario Carneiro
theorem ex6d : ¬ ∃ s : subring ℝ, ∀ x : ℝ, x ∈ s ↔ ∃ a b : ℤ, x = a + b * 5 ^ (1/4:ℝ) :=
begin
  rintro ⟨S, h⟩,
  simp only [one_div] at h,
  have hY : (5 ^ (2⁻¹:ℝ) : ℝ) = (5 ^ (4⁻¹:ℝ) : ℝ) * (5 ^ (4⁻¹:ℝ) : ℝ),
    by rw ← real.rpow_add; norm_num,
  have hX : (5 : ℝ) = (5 ^ (2⁻¹:ℝ) : ℝ) * (5 ^ (2⁻¹:ℝ) : ℝ),
    by rw ← real.rpow_add; norm_num,
  set X := (5 ^ (2⁻¹:ℝ):ℝ) with eX,
  have : X ∈ S,
  { have : (5 ^ (4⁻¹:ℝ) : ℝ) ∈ S := (h _).2 ⟨0, 1, by simp⟩,
    have := S.mul_mem this this,
    rwa hY },
  rcases (h _).1 this with ⟨a, b, e⟩, clear this,
  rw ← sub_eq_iff_eq_add' at e,
  have := congr (congr_arg (*) e) e,
  rw [mul_mul_mul_comm, ← hY, sub_mul, mul_sub, ← hX, ← sub_eq_zero] at this,
  have : X * (2 * a + b * b : ℤ) = (5 + a * a : ℤ),
  { symmetry, simp [← sub_eq_zero], refine eq.trans (by ring) this },
  by_cases h0 : ((2 * a + b * b : ℤ) : ℝ) = 0,
  { simp [h0] at this, linarith only [mul_self_nonneg ((a:ℤ):ℝ), this] },
  rw ← eq_div_iff h0 at this,
  refine (irrational_iff_ne_rational _).1 _ _ _ this,
  rw ← show real.sqrt 5 = X, by rw [eX, real.sqrt_eq_rpow, one_div],
  exact_mod_cast nat.prime.irrational_sqrt (by norm_num : nat.prime 5),
end

/- Set s is closed under addition and multiplication, so if

a b c d : ℤ
x = a + b * 9 ^ (1/4:ℝ)
y = c + d * 9 ^ (1/4:ℝ)

then

x + y = (a+c) + (b +d)* 9 ^ (1/4:ℝ)
(a+c): ℤ
(b+d): ℤ
hence

(x+y)∈ s
and

9 ^ (1/4:ℝ) *9 ^ (1/4:ℝ) =(3:ℤ)
and

x *y=(a*c+b*d*3)+(a*d+b*c)* 9 ^ (1/4:ℝ)
(a*c+b*d*3): ℤ
(a*d+b*c): ℤ
hence

(x*y)∈ s
and hence

s : subring ℝ -/
-- Eric Wieser
/-- The image of `zsqrtd` in `ℝ`.  -/
@[simps]
noncomputable def zsqrtd.to_real {d : ℤ } (h : 0 ≤ d) : ℤ√d →+* ℝ := {
  to_fun := λ a, a.1 + a.2*real.sqrt d,
  map_zero' := by simp,
  map_add' := λ a b, by { simp, ring, },
  map_one' := by simp,
  map_mul' := λ a b, by {
    have : (↑a.re + ↑a.im * real.sqrt d) * (↑b.re + ↑b.im * real.sqrt d) =
             ↑a.re * ↑b.re + (↑a.re * ↑b.im + ↑a.im * ↑b.re) * real.sqrt d
                           + ↑a.im * ↑b.im * (real.sqrt d * real.sqrt d) := by ring,
    simp [this, real.mul_self_sqrt (int.cast_nonneg.mpr h)],
    ring, } }

-- Eric Wieser
abbreviation is_an_integral_domain {α : Type*} [ring α] (s : set α) := ∃ (sr : subring α) [integral_domain sr], s = sr

lemma nine_equals_3_times_3 : (9:ℝ)=(3:ℝ)*(3:ℝ) :=
begin
  linarith,
end

lemma three_is_gt_0 : (0:ℝ) < (3:ℝ) :=
begin
  linarith,
end

lemma three_is_gte_0 : (0:ℝ) ≤ (3:ℝ) :=
begin
  linarith,
end

lemma sqrt_of_9_is_3 : (3:ℝ) = (real.sqrt (9:ℝ)) :=
begin
  have h1 := nine_equals_3_times_3,
  rw h1,
  have h2 := three_is_gte_0,
  have h3 := real.sqrt_mul_self h2,
  rw ← h1 at h3,
  rw ← h1,
  exact eq.symm h3,
end

lemma half_plus_half_equals_1: (1/2:ℝ)+(1/2:ℝ)=1 :=
begin
  linarith,
end

lemma x_equals_sqrtx_times_sqrtx (x:ℝ): 0 < x → x = x^(1/2:ℝ) * x^(1/2:ℝ) :=
begin
  intro h1,
  have h2 := real.rpow_add h1,
  have h3 := h2 (1/2) (1/2),
  have h4 := half_plus_half_equals_1,
  rw h4 at h3,
  have h5 := real.rpow_one x,
  rw h5 at h3,
  exact h3,
end

lemma x_is_0 (x:ℝ) : x ≥ 0 → ¬(0 < x) → x = 0 :=
begin
  intro h1,
  intro h2,
  linarith,
end

lemma half_ne_0 : (1/2:ℝ)  ≠ (0:ℝ) :=
begin
  linarith,
end

lemma zero_le_0 : (0:ℝ) ≤ (0:ℝ) :=
begin
  linarith,
end

lemma sqrt_0_equals_0 : real.sqrt 0 = 0 :=
begin
  have h1 := zero_le_0,
  exact real.sqrt_eq_zero_of_nonpos h1,
end

lemma x_gt_0_implies_sqrt_x_gt_0 (x:ℝ): x ≥ 0 → x^(1/2:ℝ) ≥ 0 :=
begin
  intro h1,
  exact real.rpow_nonneg_of_nonneg h1 (1 / 2),
end

lemma sqrt_x_equals_sqrt_x (x:ℝ) : x ≥ 0 → x^(1/2:ℝ) = real.sqrt x :=
begin
  intro h,
  have h1 := x_equals_sqrtx_times_sqrtx x,
  by_cases h2 : 0 < x,
  {
    have h3 := h1 h2,
    conv
    begin
      to_rhs,
      rw h3,
    end,
    have h5 := x_gt_0_implies_sqrt_x_gt_0 x,
    have h6 := h5 h,
    have h4 := real.sqrt_mul_self h6,
    exact eq.symm h4,
  },
  {
    have h3 := x_is_0 x,
    have h4 := h3 h,
    have h5 := h4 h2,
    rw h5,
    have h6 := @real.zero_rpow (1/2:ℝ),
    have h7 := half_ne_0,
    have h8 := h6 h7,
    rw h8,
    have h9 := sqrt_0_equals_0,
    exact eq.symm h9,
  }
end

lemma x_mul_x_pow_y_equals_x_pow_y_plus_y (x y : ℝ) : 0 < x → (x * x)^y = x^(y+y) :=
begin
  intro h,
  have h1 := le_of_lt h,
  have h2 := @real.mul_rpow x x y h1 h1,
  rw h2,
  have h3 := real.rpow_add h y y,
  exact eq.symm h3,
end

lemma fourth_root_of_9_equals_sqrt_sqrt : (9:ℝ) ^ (1/4:ℝ) = real.sqrt (real.sqrt (9:ℝ)) :=
begin
  have h1 := nine_equals_3_times_3,
  have h2 := three_is_gt_0,
  have h7 := three_is_gte_0,
  have h3 := sqrt_of_9_is_3,
  rw ← h3,
  rw h1,
  have h4 := sqrt_x_equals_sqrt_x (3:ℝ),
  have h5 := h4 h7,
  rw ← h5,
  have h6 := x_mul_x_pow_y_equals_x_pow_y_plus_y 3 (1/4),
  have h8 := h6 h2,
  rw h8,
  ring,
end

lemma fourth_root_of_nine_equals_sqrt_3 : (9:ℝ) ^ (1/4:ℝ) = real.sqrt 3 :=
begin
  have h1 := fourth_root_of_9_equals_sqrt_sqrt,
  rw h1,
  have h2 := sqrt_of_9_is_3,
  rw h2,
end

theorem ex6e : is_an_integral_domain {x : ℝ | ∃ a b : ℤ, x = a + b * (9:ℝ) ^ (1/4:ℝ)} :=
begin
  refine ⟨(zsqrtd.to_real (show 0 ≤ (3 : ℤ), by norm_num)).range, _, _⟩,
  apply_instance,
  ext,
  rw [fourth_root_of_nine_equals_sqrt_3],
  simp [zsqrtd.to_real],
  split,
  {
    intro h1,
    cases h1 with a ha,
    cases ha with b hb,
    use {re := a, im := b},
    rw hb,
  },
  {
    intro h1,
    cases h1 with y hy,
    rw ← hy,
    use [y.re, y.im],
  }
end

lemma useful : ((9 : ℝ) ^ (4⁻¹ : ℝ)) * (9 ^ (4⁻¹ : ℝ)) = 3 :=
begin
  rw ← mul_rpow,
  convert pow_nat_rpow_nat_inv (show (0 : ℝ) ≤ 3, by norm_num) (show 0 < 4, by norm_num) using 2,
  all_goals {norm_num}
end

def A : subring ℝ :=
{ carrier := {x | ∃ a b : ℤ, x = a + b * (9:ℝ) ^ (1/4:ℝ)},
  one_mem' := ⟨1, 0, by simp⟩,
  mul_mem' := begin
    rintro _ _ ⟨a1, b1, rfl⟩ ⟨a2, b2, rfl⟩,
    use [a1 * a2 + 3 * b1 * b2, a1 * b2 + a2 * b1],
    simp [mul_add, add_mul, mul_assoc, mul_left_comm, useful],
    ring,
  end,
  zero_mem' := ⟨0, 0, by simp⟩,
  add_mem' := by { rintro _ _ ⟨a1, b1, rfl⟩ ⟨a2, b2, rfl⟩,
                   use [a1 + a2, b1 + b2],
                   simp, ring },
  neg_mem' := by { rintro _ ⟨a, b, rfl⟩,
                   use [-a, -b],
                   simp, ring },
   }

theorem ex6e_kevin_buzzard : is_an_integral_domain {x : ℝ | ∃ a b : ℤ, x = a + b * (9:ℝ) ^ (1/4:ℝ)} :=
⟨A, infer_instance, rfl⟩

theorem ex6e_mario_carneiro : is_an_integral_domain {x : ℝ | ∃ a b : ℤ, x = a + b * (9:ℝ) ^ (1/4:ℝ)} :=
begin
  refine ⟨(zsqrtd.to_real (show 0 ≤ (3 : ℤ), by norm_num)).range, _, _⟩,
  apply_instance,
  ext,
  rw calc (9:ℝ) ^ (1/4:ℝ) = (9:ℝ)^((2:ℕ)⁻¹ * (1/2) : ℝ) : by norm_num
    ... = ((3^2:ℝ)^((2:ℕ)⁻¹:ℝ)) ^ (1/2:ℝ) : by rw real.rpow_mul; norm_num
    ... = real.sqrt 3 : by rw [real.pow_nat_rpow_nat_inv, real.sqrt_eq_rpow]; norm_num,
  simp [zsqrtd.to_real],
  exact ⟨λ ⟨x,y,h⟩, ⟨⟨x,y⟩, h.symm⟩, λ ⟨⟨x,y⟩,h⟩, ⟨x,y, h.symm⟩⟩,
end

-- Exercise 6F

-- Mario Carneiro, Hanting Zhang
lemma eq_two_pow_of_dvd_two_pow {a n : ℕ} : a ∣ 2 ^ n → ∃ m : ℕ, a = 2 ^ m :=
begin
  intro h1,
  have h2 := (@dvd_prime_pow 2 nat.prime_two n a).1 h1,
  cases h2 with m hm,
  cases hm with H hH,
  finish,
end

lemma succ_def (m: ℕ) : m.succ = m + 1 := rfl

lemma pow_two_ne_zero (n : ℕ): 2^n ≠ 0 :=
begin
  induction n with d hd,
  simp,
  rw (succ_def d),
  rw (pow_succ 2 d),
  simp,
  intro h,
  finish,
end

-- Mario Carneiro
lemma plus_injective {a b : ℚ} {n m : ℕ} (ha : a.denom = 2 ^ n) (hb : b.denom = 2 ^ m) :
  ∃ k : ℕ, (a + b).denom = 2 ^ k :=
begin
  apply @eq_two_pow_of_dvd_two_pow _ (n + m),
  rw [rat.add_num_denom, ← int.coe_nat_mul, ha, hb, ← pow_add, ← int.coe_nat_dvd],
  apply rat.denom_dvd,
end

-- Mario Carneiro
lemma mul_injective {a b : ℚ} {n m : ℕ} (ha : a.denom = 2 ^ n) (hb : b.denom = 2 ^ m) :
  ∃ k : ℕ, (a * b).denom = 2 ^ k :=
begin
  apply @eq_two_pow_of_dvd_two_pow _ (n + m),
  rw [rat.mul_num_denom, ha, hb, ← pow_add, ← int.coe_nat_dvd],
  apply rat.denom_dvd,
end

noncomputable def B : subring ℚ :=
{
  carrier := {x : ℚ | ∃ n : ℕ, x.denom = 2 ^ n },
  one_mem' /- (1 : M) ∈ carrier) -/ :=
  begin
    rw set.mem_set_of_eq,
    use 0,
    simp,
  end,
  mul_mem' /- {a b} : a ∈ carrier → b ∈ carrier → a * b ∈ carrier) -/ :=
  begin
    intros a b h1 h2,
    rw set.mem_set_of_eq at h1,
    rw set.mem_set_of_eq at h2,
    cases h1 with n hn,
    cases h2 with m hm,
    rw set.mem_set_of_eq,
    exact (mul_injective hn hm),
  end,
  zero_mem' /- (0 : M) ∈ carrier -/ :=
  begin
    rw set.mem_set_of_eq,
    use 0,
    simp,
    exact rfl,
  end,
  add_mem' /- {a b} : a ∈ carrier → b ∈ carrier → a + b ∈ carrier -/:=
  begin
    intro a,
    intro b,
    intro h1,
    intro h2,
    rw set.mem_set_of_eq at h1,
    rw set.mem_set_of_eq at h2,
    cases h1 with n hn,
    cases h2 with m hm,
    rw set.mem_set_of_eq,
    exact (plus_injective hn hm),
  end,
  neg_mem' /- {x} : x ∈ carrier →d -x ∈ carrier -/:=
  begin
    intro x,
    intro h1,
    rw set.mem_set_of_eq at h1,
    cases h1 with n hn,
    rw set.mem_set_of_eq,
    use n,
    simp,
    exact hn,
  end,
 }

theorem ex6f : is_an_integral_domain {x : ℚ | ∃ n : ℕ, x.denom = 2 ^ n }  :=
⟨B, infer_instance, rfl⟩

namespace ex7A

inductive R
| zero
| one

open R

def R.add : R → R → R
| zero zero := zero
| zero one := one
| one zero := one
| one one := zero

def R.mul : R → R → R
| zero zero := zero
| zero one := zero
| one zero := zero
| one one := one

def R.neg : R → R
| zero := zero
| one := one

instance : has_add R := ⟨R.add⟩
instance : has_mul R := ⟨R.mul⟩
instance : has_zero R := ⟨zero⟩
instance : has_one R := ⟨one⟩
instance : has_neg R := ⟨R.neg⟩

theorem R.exists_pair_ne : ∃ (x y : R), x ≠ y :=
begin
   use [R.zero, R.one],
end

theorem R.zero_add (a : R): 0 + a = a :=
begin
   cases a,
   repeat { exact rfl },
end

theorem R.add_zero (a : R): a + 0 = a :=
begin
   cases a,
   repeat { exact rfl },
end

theorem R.one_mul (a : R): 1 * a = a :=
begin
   cases a,
   repeat { exact rfl },
end

theorem R.mul_one (a : R): a * 1 = a :=
begin
   cases a,
   repeat { exact rfl },
end

theorem R.add_assoc (a b c : R): a + b + c = a + (b + c) :=
begin
   cases a,
   cases b,
   cases c,
   repeat { exact rfl },
   cases c,
   repeat { exact rfl },
   cases b,
   cases c,
   repeat { exact rfl },
   cases c,
   repeat { exact rfl },
end

theorem R.add_left_neg (a : R): -a + a = 0 :=
begin
   cases a,
   repeat { exact rfl },
end

theorem R.add_comm (a b : R): a + b = b + a :=
begin
   cases a,
   cases b,
   repeat { exact rfl },
   cases b,
   repeat { exact rfl },
end

theorem R.mul_assoc (a b c : R): a * b * c = a * (b * c) :=
begin
   cases a,
   cases b,
   cases c,
   repeat { exact rfl },
   cases c,
   repeat { exact rfl },
   cases b,
   cases c,
   repeat { exact rfl },
   cases c,
   repeat { exact rfl },
end

theorem R.left_distrib (a b c : R): a * (b + c) = a * b + a * c :=
begin
   cases a,
   cases b,
   cases c,
   repeat { exact rfl },
   cases c,
   repeat { exact rfl },
   cases b,
   cases c,
   repeat { exact rfl },
   cases c,
   repeat { exact rfl },
end

theorem R.right_distrib (a b c : R): (a + b) * c = a * c + b * c :=
begin
   cases a,
   cases b,
   cases c,
   repeat { exact rfl },
   cases c,
   repeat { exact rfl },
   cases b,
   cases c,
   repeat { exact rfl },
   cases c,
   repeat { exact rfl },
end

theorem R.mul_comm (a b : R): a * b = b * a :=
begin
   cases a,
   cases b,
   repeat { exact rfl },
   cases b,
   repeat { exact rfl },
end

theorem R.eq_zero_or_eq_zero_of_mul_eq_zero (a b : R) (h: a * b = 0): a = 0 ∨ b = 0:=
begin
   cases a,
   cases b,
   left,
   exact rfl,
   left,
   exact rfl,
   cases b,
   right,
   exact rfl,
   exfalso,
   finish,
end

instance ex7a_kyle_miller : integral_domain R :=
{
  zero := R.zero,
  one := R.one,
  add := R.add,
  mul := R.mul,
  add_assoc := R.add_assoc,
  zero_add := R.zero_add,
  add_zero := R.add_zero,
  neg := R.neg,
  add_left_neg := R.add_left_neg,
  add_comm := R.add_comm,
  one_mul := R.one_mul,
  mul_assoc := R.mul_assoc,
  mul_one := R.mul_one ,
  left_distrib := R.left_distrib,
  right_distrib := R.right_distrib,
  mul_comm := R.mul_comm,
  exists_pair_ne := R.exists_pair_ne,
  eq_zero_or_eq_zero_of_mul_eq_zero := R.eq_zero_or_eq_zero_of_mul_eq_zero,
}

instance : fact (nat.prime 2) := nat.prime_two

-- this is `@field.to_integral_domain _ (zmod.field 2)` under the hood
instance ex7a_eric_wieser : integral_domain (zmod 2) := by apply_instance

end ex7A

namespace ex7b

inductive R
| zero

open R

def R.add : R → R → R
| zero zero := zero

def R.mul : R → R → R
| zero zero := zero

def R.neg : R → R
| zero := zero

instance : has_add R := ⟨R.add⟩
instance : has_mul R := ⟨R.mul⟩
instance : has_zero R := ⟨zero⟩
instance : has_neg R := ⟨R.neg⟩

theorem R.zero_add (a : R): 0 + a = a :=
begin
   cases a,
   repeat { exact rfl },
end

theorem R.add_zero (a : R): a + 0 = a :=
begin
   cases a,
   repeat { exact rfl },
end

theorem R.add_assoc (a b c : R): a + b + c = a + (b + c) :=
begin
  cases a,
  cases b,
  cases c,
  refl,
end

theorem R.add_left_neg (a : R): -a + a = 0 :=
begin
   cases a,
   refl,
end

theorem R.add_comm (a b : R): a + b = b + a :=
begin
   cases a,
   cases b,
   refl,
end

theorem R.mul_assoc (a b c : R): a * b * c = a * (b * c) :=
begin
   cases a,
   cases b,
   cases c,
   refl,
end

theorem R.left_distrib (a b c : R): a * (b + c) = a * b + a * c :=
begin
   cases a,
   cases b,
   cases c,
   refl,
end

theorem R.right_distrib (a b c : R): (a + b) * c = a * c + b * c :=
begin
   cases a,
   cases b,
   cases c,
   refl,
end

theorem R.mul_comm (a b : R): a * b = b * a :=
begin
   cases a,
   cases b,
   refl,
end

theorem R.eq_zero_or_eq_zero_of_mul_eq_zero (a b : R) (h: a * b = 0): a = 0 ∨ b = 0:=
begin
  cases a,
  cases b,
  left,
  refl,
end

end ex7b

lemma ex8a_eric_wieser {S: Type*} [CR: comm_ring S]
        [NZD: no_zero_divisors S] (h : (0 : S) = 1) : S ≃+* unit :=
begin
  refine ring_equiv.symm _,
  refine {to_fun := _, inv_fun := _, left_inv := _, right_inv := _, map_mul' := _, map_add' := _},
  intro h,
  exact ring.one,
  intro h1,
  exact (),
  rw function.left_inverse,
  intro x,
  exact unit.ext,
  rw function.right_inverse,
  rw function.left_inverse,
  intro x,
  exact eq_of_zero_eq_one h ring.one x,
  intro u1,
  intro u2,
  ring,
  exact eq_of_zero_eq_one h ring.one (ring.one * ring.one),
  intro u1,
  intro u2,
  exact eq_of_zero_eq_one h ring.one (ring.one + ring.one),
end

def is_zero_ring (α : Type u) [ring α] : Prop := ∀ (x : α), x = 0

lemma ex8a_kyle_miller (S : Type u) [comm_ring S] [no_zero_divisors S] :
  is_integral_domain S ∨ is_zero_ring S :=
begin
  by_cases h: (1:S) ≠ (0:S),
  fconstructor,
  refine {exists_pair_ne := _, mul_comm := _, eq_zero_or_eq_zero_of_mul_eq_zero := _},
  use [0,1],
  refine ne_comm.mp _,
  assumption,
  exact mul_comm,
  exact λ {a b : S}, mul_eq_zero.mp,
  refine or.inr _,
  rw is_zero_ring,
  refine eq_zero_of_zero_eq_one _,
  finish,
end

--exercise 8b: No

-- exercise 9:

namespace ex9

structure M := Mk :: (x : ℤ)

open M

def M.add (a b : M) := Mk (a.x + b.x)
def M.mul (a b : M) := Mk 0
def M.neg (a : M) := Mk (-a.x)
def M.zero : M := Mk 0
def M.one : M := Mk 1

instance : has_add M := ⟨M.add⟩
instance : has_mul M := ⟨M.mul⟩
instance : has_zero M := ⟨M.zero⟩
instance : has_one M := ⟨M.one⟩
instance : has_neg M := ⟨M.neg⟩

@[ext] lemma ext (a b : M) : a.x = b.x → a = b := -- Yakov Pechersky
by cases a; cases b; simp

theorem M.zero_add (a : M): (0:M) + a = a :=
begin
  ext,
  unfold has_zero.zero,
  rw M.zero,
  unfold has_add.add,
  rw M.add,
  simp [int.zero_add],
end

theorem M.exists_pair_ne : ∃ (x y : M), x ≠ y :=
begin
   use [M.zero, M.one],
   rw [M.zero, M.one],
   simp,
end

theorem M.add_zero (a : M): a + 0 = a :=
begin
  ext,
  unfold has_zero.zero,
  rw M.zero,
  unfold has_add.add,
  rw M.add,
  simp [int.zero_add],
end

theorem M.add_assoc (a b c : M): a + b + c = a + (b + c) :=
begin
  ext,
  unfold has_add.add,
  repeat { rw M.add },
  finish,
end

theorem M.add_left_neg (a : M): -a + a = 0 :=
begin
  ext,
  unfold has_neg.neg,
  unfold has_add.add,
  rw M.neg,
  rw M.add,
  finish,
end

theorem M.add_comm (a b : M): a + b = b + a :=
begin
  ext,
  unfold has_add.add,
  repeat { rw M.add },
  finish,
end

theorem M.mul_assoc (a b c : M): a * b * c = a * (b * c) :=
begin
  ext,
  unfold has_mul.mul,
  repeat { rw M.mul },
end

theorem M.left_distrib (a b c : M): a * (b + c) = a * b + a * c :=
begin
  ext,
  unfold has_mul.mul,
  unfold has_add.add,
  repeat { rw M.add },
  repeat { rw M.mul },
  finish,
end

theorem M.right_distrib (a b c : M): (a + b) * c = a * c + b * c :=
begin
  ext,
  unfold has_mul.mul,
  unfold has_add.add,
  repeat { rw M.add },
  repeat { rw M.mul },
  finish,
end

theorem M.mul_comm (a b : M): a * b = b * a :=
begin
  ext,
  unfold has_mul.mul,
  repeat { rw M.mul },
end

lemma M.not_one_mul_or_mul_one: (1:M) * (1:M) ≠ (1:M):=
begin
  unfold has_one.one,
  unfold has_mul.mul,
  rw M.one,
  rw M.mul,
  finish,
end

lemma M.not_eq_zero_or_eq_zero_of_mul_eq_zero : ¬∀ (a b : M), a * b = (0:M) → (a = (0:M) ∨ b = (0:M)) :=
begin
  unfold has_mul.mul,
  unfold has_zero.zero,
  rw M.zero,
  simp at *,
  use (1:M),
  use (1:M),
  rw M.mul,
  split,
  simp,
  intro h,
  simp at *,
  unfold has_one.one at h,
  rw M.one at h,
  simp at h,
  assumption,
end

end ex9

namespace ex10

def g (x: ℤ ) := x / x
def f (x: ℤ ) := x - 1

lemma two_minus_one_eq_1 : (2:ℤ)-(1:ℤ) = (1:ℤ) :=
begin
  ring,
end

theorem f_ne_zero : ∃ x : ℤ, f x ≠ 0 :=
begin
  use (2:ℤ),
  rw f,
  rw two_minus_one_eq_1,
  finish,
end

theorem g_ne_zero : ∃ x : ℤ, g x ≠ 0 :=
begin
  use 1,
  rw g,
  simp,
end

theorem fg_zero (x : ℕ ) (h: x ≠ 0): (f ∘ g) x = 0 :=
begin
  rw function.comp,
  simp,
  rw g,
  rw f,
  finish,
end

end ex10

end ch1B

-- 1.3. Properties of Ordered Domains

-- Exercises for section 1.3

-- 1.4. Well-Ordering Principle

-- Exercises for section 1.4

-- 1.5. Finite Induction; Laws of Exponents

-- Exercises for section 1.5

-- 1.6. Divisibility

-- Exercises for section 1.6

-- 1.7. The Euclidean Algorithm

-- Exercises for section 1.7

-- 1.8. Fundamental Theorem of Arithmetic

-- Exercises for section 1.8

-- 1.9. Congruences

-- Exercises for section 1.9

-- 1.10. The Rings ℤn

-- Exercises for section 1.10

-- 1.11. Sets, Functions, and Relations

-- Exercises for section 1.11

-- 1.12. Isomorphisms and Automorphisms

-- Exercises for section 1.12


/-
Copyright (c) 2019 Chris Hughes All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Junyan Xu

! This file was ported from Lean 3 source module analysis.complex.polynomial
! leanprover-community/mathlib commit 17ef379e997badd73e5eabb4d38f11919ab3c4b3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Complex.Liouville
import Mathbin.FieldTheory.IsAlgClosed.Basic

/-!
# The fundamental theorem of algebra

This file proves that every nonconstant complex polynomial has a root using Liouville's theorem.

As a consequence, the complex numbers are algebraically closed.
-/

open Polynomial

open Polynomial

namespace Complex

/-- **Fundamental theorem of algebra**: every non constant complex polynomial
  has a root -/
theorem exists_root {f : ℂ[X]} (hf : 0 < degree f) : ∃ z : ℂ, IsRoot f z :=
  by
  contrapose! hf
  obtain ⟨c, hc⟩ := (f.differentiable.inv hf).exists_const_forall_eq_of_bounded _
  · obtain rfl : f = C c⁻¹ := Polynomial.funext fun z => by rw [eval_C, ← hc z, inv_inv]
    exact degree_C_le
  · obtain ⟨z₀, h₀⟩ := f.exists_forall_norm_le
    simp only [bounded_iff_forall_norm_le, Set.forall_range_iff, norm_inv]
    exact ⟨‖eval z₀ f‖⁻¹, fun z => inv_le_inv_of_le (norm_pos_iff.2 <| hf z₀) (h₀ z)⟩
#align complex.exists_root Complex.exists_root

instance isAlgClosed : IsAlgClosed ℂ :=
  IsAlgClosed.of_exists_root _ fun p _ hp => Complex.exists_root <| degree_pos_of_irreducible hp
#align complex.is_alg_closed Complex.isAlgClosed

end Complex


import tactic

/-
Making group theory in a theorem prover
-/

namespace mygroup

-- A group needs multiplication, inverse, identity
class group (G : Type) extends has_mul G, has_inv G, has_one G :=
-- axioms go here
(mul_assoc : ∀ (a b c : G), (a * b) * c = a * (b * c))
(one_mul : ∀ (a : G), 1 * a = a)
(mul_left_inv : ∀ (a : G), a⁻¹ * a = 1)

/-
non-example of a group: G is any non-empty set, 1 is any element,
and define g * h = h, g⁻¹ = 1 for all g

NOT A GROUP because mul_left_inv fails
-/

namespace group

attribute [simp] mul_left_inv one_mul

variables {G : Type} [group G]

-- Students at my uni also learn that mul_one : a * 1 = a and mul_right_inv are axioms
-- let's prove them!

-- let's start by showing you can cancel on the left

lemma mul_left_cancel (a b c : G) (H : a * b = a * c) : b = c :=
calc b = 1 * b         : by rw one_mul
...    = (a⁻¹ * a) * b : by rw mul_left_inv
...    = a⁻¹ * (a * b) : by rw mul_assoc
...    = a⁻¹ * (a * c) : by rw H
...    = (a⁻¹ * a) * c : by rw mul_assoc
...    = 1 * c         : by rw mul_left_inv
...    = c             : by rw one_mul

-- that proof is nice to look at

lemma mul_left_cancel' (a b c : G) (H : a * b = a * c) : b = c :=
by rw [←one_mul b, ←mul_left_inv a, mul_assoc, H, ←mul_assoc, mul_left_inv, one_mul]

lemma mul_eq_of_eq_inv_mul {a x y : G} (h : x = a⁻¹ * y) : a * x = y :=
begin
  apply mul_left_cancel a⁻¹,
  rw ←mul_assoc,
  -- ⊢ (a⁻¹ * a) * x = a⁻¹ * y
  -- know : x = a⁻¹ * y
  -- simplifier can now do the rest
  simp [h],
end

@[simp] lemma mul_one (a : G) : a * 1 = a :=
begin
  apply mul_eq_of_eq_inv_mul,
  simp,
end

-- term mode proof
lemma mul_one' (a : G) : a * 1 = a :=
mul_eq_of_eq_inv_mul $ by simp

@[simp] lemma mul_right_inv (a : G) : a * a⁻¹ = 1 :=
begin
  apply mul_eq_of_eq_inv_mul,
  simp,
end

@[simp] lemma inv_mul_right_cancel (a b : G) : (b * a⁻¹) * a = b := by simp [mul_assoc]
@[simp] lemma mul_inv_right_cancel (a b : G) : (b * a) * a⁻¹ = b := by simp [mul_assoc]
@[simp] lemma inv_mul_left_cancel (a b : G) : a⁻¹ * (a * b) = b := by simp [←mul_assoc]

example (a b c : G) : a * a⁻¹ * a⁻¹ * a = 1 := by simp
example (a b c : G) : a * a⁻¹ * b * a * a⁻¹ = b := by simp
example (a b c : G) : a * a⁻¹ * b * c * c⁻¹ * b⁻¹ = 1 := by simp
example (a b c : G) : b * c * c⁻¹ * b⁻¹ * a * a⁻¹ = 1 := by simp

@[simp] lemma mul_eq_iff_eq_inv_mul {a x y : G} : x = a⁻¹ * y ↔ a * x = y :=
begin
  split,
  { apply mul_eq_of_eq_inv_mul},
  { intro h,
    simp [h.symm]}
end

@[simp] lemma mul_eq_iff_eq_inv_mul' {a x y : G} : a⁻¹ * y = x ↔ y = a * x :=
by simp [eq_comm]

@[simp] lemma mul_left_cancel_iff (a b c : G) : a * b = a * c ↔ b = c :=
begin
  split,
  { apply mul_left_cancel},
  { rintro rfl, refl}
end

example (a b c : G) : a * b * c * (c⁻¹ * a * a⁻¹) = a * c * c⁻¹ * b := by simp

-- this is exactly what the simplifier is good at

end group

structure subgroup (G : Type) [group G] :=
-- carrier is the name of the subset
(carrier : set G)
(one_mem' : (1 : G) ∈ carrier)
(inv_mem' {x} : x ∈ carrier → x⁻¹ ∈ carrier)
(mul_mem' {x y} : x ∈ carrier → y ∈ carrier → x * y ∈ carrier)

namespace subgroup

variables {G : Type} [group G] (H J K : subgroup G) (a b c : G)

-- want to be able to say a ∈ H

instance : has_mem G (subgroup G) := ⟨λ g H, g ∈ H.carrier⟩

-- want to talk about H₁ ≤ H₂ (meanning H₁ ⊆ H₂)

-- "subgroups of a group form a lattice"

instance : has_le (subgroup G) := ⟨λ S T, S.carrier ⊆ T.carrier⟩

lemma le_def (H J : subgroup G) : H.carrier ≤ J.carrier ↔ H ≤ J := iff.rfl

@[ext] theorem ext {H J : subgroup G} (h : ∀ (x : G), x ∈ H ↔ x ∈ J) : H = J :=
begin
  cases H,
  cases J,
  suffices : H_carrier = J_carrier,
    simpa,
  ext x,
  exact h x,
end

lemma mem_coe {g : G} : g ∈ H.carrier ↔ g ∈ H := iff.rfl

theorem one_mem : (1 : G) ∈ H := H.one_mem'
theorem mul_mem {x y : G} : x ∈ H → y ∈ H → x * y ∈ H := subgroup.mul_mem' H
theorem inv_mem {x : G} : x ∈ H → x⁻¹ ∈ H := subgroup.inv_mem' H

-- definition in Lean because `subgroup` contains data
/-- "Theorem" : intersection of two subgroups is a subgroup -/
def inf (H K : subgroup G) : subgroup G :=
{ carrier := H.carrier ∩ K.carrier,
  one_mem' := ⟨H.one_mem', K.one_mem'⟩,
  inv_mem' := λ x ⟨hH, hK⟩, ⟨H.inv_mem' hH, K.inv_mem' hK⟩,
  mul_mem' := λ x y ⟨hxH, hxK⟩ ⟨hyH, hyK⟩, ⟨H.mul_mem' hxH hyH, K.mul_mem' hxK hyK⟩ }

open set

-- intersection of any number of subgroups is a subgroup
def Infi (ι : Type) (H : ι → subgroup G) : subgroup G :=
{ carrier := ⋂(i : ι), (H i).carrier,
  one_mem' := begin
    rw mem_Inter,
    intro i,
    apply subgroup.one_mem',
  end,
  inv_mem' := begin
    intro x,
    intro hx,
    rw mem_Inter at hx ⊢,
    intro i,
    apply subgroup.inv_mem',
    tauto!,
  end,
  mul_mem' := begin
    intros x y hx hy,
    rw mem_Inter at *,
    intro i,
    apply subgroup.mul_mem';
    tauto!,
  end }

-- why is H bug not fixed?

def Inf (S : set (subgroup G)) : subgroup G :=
{ carrier := -- ⋂₀ {H.carrier | H ∈ S},
             -- ⋂₀ {T : set G | ∃ J ∈ S, T = subgroup.carrier J},
             Inf (subgroup.carrier '' S),
  one_mem' := begin
    rw mem_sInter,
    rintro t ⟨⟨H_w_carrier, H_w_one_mem', H_w_inv_mem', H_w_mul_mem'⟩, H_h_w, rfl⟩,
    apply subgroup.one_mem',
  end,
  inv_mem' := begin
    intros x hx,
    rw mem_sInter at hx ⊢,
    rintro t ⟨H, H_h_w, rfl⟩,
    apply H.inv_mem',
    apply hx,
    use H,
    tauto!,
  end,
  mul_mem' :=  begin
    intros x y hx hy,
    rw mem_sInter at hx hy ⊢,
    rintro t ⟨H, hH, rfl⟩,
    apply H.mul_mem',
    apply hx, use H, tauto,
    apply hy, use H, tauto,
  end }

instance : has_Inf (subgroup G) := ⟨Inf⟩

-- goal -- make subgroups of a group into a complete lattice
/-
complete_lattice_of_Inf :
  Π (α : Type u_1) [H1 : partial_order α] [H2 : has_Inf α],
    (∀ (s : set α), is_glb s (Inf s)) → complete_lattice α
-/

instance : partial_order (subgroup G) :=
{ le := (≤),
  le_refl := by tidy,
  le_trans := by tidy,
  le_antisymm := by tidy }

instance : complete_lattice (subgroup G) := complete_lattice_of_Inf _ begin
  intro S,
    apply @is_glb.of_image _ _ _ _ subgroup.carrier,
  intros, refl,
  apply is_glb_Inf,
end

-- adjoint functor to carrier functor is the span functor
-- from subsets to subgroups
def span (S : set G) : subgroup G := Inf {H : subgroup G | S ⊆ H.carrier}

lemma monotone_carrier : monotone (subgroup.carrier : subgroup G → set G) :=
λ H J, id

lemma monotone_span : monotone (span : set G → subgroup G) :=
λ S T h, Inf_le_Inf $ λ H hH x hx, hH $ h hx

lemma subset_span (S : set G) : S ≤ (span S).carrier :=
begin
  rintro x hx _ ⟨H, hH, rfl⟩,
  exact hH hx,
end

lemma span_subgroup (H : subgroup G) : span H.carrier = H :=
begin
  ext,
  split,
  { intro hx,
    unfold span at hx,
    replace hx := mem_sInter.1 hx,
    apply hx,
    use H,
    simp,
    tauto! },
  { intro h,
    apply subset_span,
    exact h},
end

-- the functors are adjoint
def gi_subgroup : galois_insertion span (@subgroup.carrier G _) :=
galois_insertion.monotone_intro monotone_carrier monotone_span subset_span span_subgroup

-- claim : if g ∈ G then the map ℤ → G, n ↦ g^n is a group hom. Duh.

/-- definition of map sending g, n to gⁿ , n ∈ ℕ -/
def pow (g : G) : ℕ → G
| 0 := 1
| (n+1) := pow n * g -- $6,000,000 : do I do that or g * pow n ??

-- #check nat.iterate

--example {α : Type} (h : α ≃ α) : ℤ → α ≃ α := by hint

def pow' (g : G) (n : ℕ) := ((*) g)^[n] 1

open int

def int.iterate {α : Type} (h : α ≃ α) : ℤ → α → α
| (of_nat n) := h^[n]
| (neg_succ_of_nat n) := h.symm^[n+1]

notation f`^⦃`:91 n`⦄`:91 := int.iterate f n

namespace int.iterate

variables {α : Type} (h : α ≃ α)

--example (a b : ℕ) : h^[a+b] = (h^[a]) ∘ (h^[b]) := sorry -- brackets needed

@[simp] lemma zero : h^⦃0⦄ = id := rfl
@[simp] lemma one : h^⦃1⦄ = h := by funext; refl  --rfl --funext $ λ x, rfl
@[simp] lemma neg_one : h^⦃-1⦄ = h.symm := funext $ λ x, rfl -- :-)

lemma neg (a : ℤ) : h^⦃-a⦄ = h.symm^⦃a⦄ :=
begin
  cases a,
  cases a,
  ext, refl,
  ext, refl,
  ext, refl,
end

example (i : ℕ) : -[1+ i] = -((i : ℤ) + 1) := by exact neg_succ_of_nat_eq i

lemma add_one (a : ℤ) : h^⦃a+1⦄ = h^⦃a⦄ ∘ h :=
begin
  cases a with i i,
  { refl},
  { suffices :  h^⦃(-↑i)⦄ = h^⦃-(i + 1)⦄ ∘ h,
      convert this, rw neg_succ_of_nat_eq, ring,
    rw neg,
    rw neg,
    ext,
    norm_cast,
    have : h.symm^⦃↑i⦄ ∘ h.symm = h.symm^⦃↑(i + 1)⦄,
      refl,
    rw ←this,
    simp},
end

lemma sub_one (a : ℤ) : h^⦃a-1⦄ = h^⦃a⦄ ∘ h.symm :=
begin
  rw ←neg_one,
  rw ←h.symm_symm,
  rw ←neg,
  rw (show -(a-1)=-a+1, by ring),
  rw add_one,
  simp [neg],
end

lemma add (a b : ℤ) : h^⦃a + b⦄ = h^⦃a⦄ ∘ h^⦃b⦄ :=
begin
  apply int.induction_on b,
  {simp},
  { intro i,
    intro useful,
    rw ←add_assoc,
    rw add_one,
    rw useful,
    rw add_one,
  },
  { intro i,
    intro useful,
    rw ←add_sub_assoc,
    rw sub_one,
    rw useful,
    rw sub_one,
  },
end

end int.iterate

-- def pow_hom (g : G) (a b : ℕ) : pow g a * pow g b = pow g (a + b) :=
-- begin

--   sorry
-- end

-- /-- definition of map sending g, n to gⁿ , n ∈ ℤ -/
-- def zpow (g : G) : ℤ → G
-- | (of_nat n) := pow g n
-- | (neg_succ_of_nat n) := pow g⁻¹ (n+1)

--example (g : G) : G ≃ G := by suggest

def thing (g : G) : G ≃ G :=
{ to_fun := (* g),
  inv_fun := (* g⁻¹),
  left_inv := by intro x; simp,
  right_inv := by intro x; simp }

  open int.iterate

lemma foo (g j : G) (a : ℤ) : j * (thing g^⦃a⦄ 1) = thing g^⦃a⦄ j :=
begin
  revert j,
  apply int.induction_on a,
  { simp},
  { intro i,
    intro hi,
    intro j,
    rw int.iterate.add_one,
    unfold function.comp,
    rw ←hi (thing _ j),
    rw ←hi,
    unfold thing, simp [mygroup.group.mul_assoc],
  },
  { intro i,
    intro hi,
    intro j,
    rw int.iterate.sub_one,
    unfold function.comp,
    conv_rhs begin
      rw ←hi,
    end,
    rw ←hi,
    unfold thing, simp [mygroup.group.mul_assoc],
  }
end

def zpow' (g : G) : ℤ → G := λ z, (thing g)^⦃z⦄ 1

instance : has_pow G ℤ := ⟨zpow'⟩

lemma zpow_hom (g : G) (a b : ℤ) : g^a * g^b = g^(a + b) :=
begin
  unfold has_pow.pow,
  unfold zpow',
  rw add_comm,
  rw int.iterate.add,
  unfold function.comp,
  rw foo,
end

/-- The subgroup generated by an element of a group equals the set of integer number powers of
    the element. -/
lemma mem_span_singleton {x y : G} : y ∈ span ({x} : set G) ↔ ∃ n : ℤ, x ^ n = y :=
begin
  sorry
end

end subgroup

end mygroup


-- El tipo de los números naturales
-- ================================

import tactic

-- ----------------------------------------------------
-- Ejercicio 1. Definir el tipo Nat de los números
-- naturales con los constructores Cero (para el número
-- 0) y Suc (para la función sucesor).
-- ----------------------------------------------------

inductive Nat : Type
| Cero : Nat
| Suc  : Nat → Nat

-- #print prefix Nat

-- ----------------------------------------------------
-- Ejercicio 2. Abrir el espacio de nimbre de Nat
-- ----------------------------------------------------

namespace Nat

-- ----------------------------------------------------
-- Ejercicio 3. Definir la función
--    repr : Nat → string
-- tal que (repr n) es la cadena que representa al
-- número natural. Por ejemplo,
--     repr (Suc (Cero)) = "Suc (Cero)"
-- ----------------------------------------------------

def repr : Nat → string
| Cero    := "Cero"
| (Suc n) := "Suc (" ++ repr n ++ ")"

-- #eval repr (Suc (Cero)) -- = "Suc (Cero)"

-- ----------------------------------------------------
-- Ejercicio 4. Declarar repr la función para
-- representar números naturales. Por ejemplo,
--    #eval Suc (Cero) = Suc (Cero)
-- ----------------------------------------------------

instance : has_repr Nat := ⟨repr⟩

-- #eval Suc (Cero) -- = Suc (Cero)

-- ----------------------------------------------------
-- Ejercicio 5. Definir la función
--    nat2int : Nat → ℕ
-- tal que (nat2int n) es el número entero
-- correspondiente al número natural n. Por ejemplo,
--    nat2int (Suc (Suc (Suc Cero))) =  3
-- ----------------------------------------------------

def nat2int : Nat → ℕ
| Cero    := 0
| (Suc n) := 1 + nat2int n

-- #eval nat2int (Suc (Suc (Suc Cero)))

-- ----------------------------------------------------
-- Ejercicio 6. Definir la función
--    int2nat : ℕ -> Nat
-- tal que (int2nat n) es el número natural
-- correspondiente al número entero n. Por ejemplo,
--    int2nat 3 = Suc (Suc (Suc (Cero)))
-- ----------------------------------------------------

def int2nat : ℕ -> Nat
| 0     := Cero
| (n+1) := Suc (int2nat n)

-- #eval int2nat 3 -- ==  Suc (Suc (Suc (Cero)))

-- ----------------------------------------------------
-- Ejercicio 7. Definir la función
--    suma : Nat → Nat → Nat
-- tal que (suma m n) es la suma de los número
-- naturales m y n. Por ejemplo,
--    #eval suma (Suc (Suc Cero)) (Suc Cero)
--    Da: Suc (Suc (Suc (Cero)))
-- ----------------------------------------------------

def suma : Nat → Nat → Nat
| Cero    n := n
| (Suc m) n := Suc (suma m n)

-- #eval suma (Suc (Suc Cero)) (Suc Cero)
-- Da: Suc (Suc (Suc (Cero)))

-- ----------------------------------------------------
-- Ejercicio 8. Declarar lar variables m y n sobre Nat.
-- ----------------------------------------------------

variables (m n : Nat)

-- ----------------------------------------------------
-- Ejercicio 9. Demostrar los siguientes lemas:
-- + suma_1 :
--      suma Cero n = n :=
-- + suma_2 :
--      suma (Suc m) n = Suc (suma m n) :=
-- ----------------------------------------------------

@[simp]
lemma suma_1 :
  suma Cero n = n :=
rfl

@[simp]
lemma suma_2 :
  suma (Suc m) n = Suc (suma m n) :=
rfl

-- ----------------------------------------------------
-- Ejercicio 10. Demostrar que
--    suma n Cero = n
-- ----------------------------------------------------

-- 1ª demostración
example :
  suma n Cero = n :=
begin
  induction n with m HI,
  { rw suma_1, },
  { rw suma_2,
    rw HI, },
end

-- 2ª demostración
example :
  suma n Cero = n :=
begin
  induction n with m HI,
  { show suma Cero Cero = Cero,
      by rw suma_1, },
  { calc suma (Suc m) Cero
         = Suc (suma m Cero) :by rw suma_2
     ... = Suc m             :by rw congr_arg Suc HI, },
end

-- 3ª demostración
example :
  suma n Cero = n :=
begin
  induction n with m HI,
  { show suma Cero Cero = Cero,
      by simp, },
  { calc suma (Suc m) Cero
         = Suc (suma m Cero) :by simp
     ... = Suc m             :by simp [HI], },
end

-- 4ª demostración
example :
  suma n Cero = n :=
begin
  induction n with m HI,
  { simp, },
  { simp [HI], },
end

-- 5ª demostración
example :
  suma n Cero = n :=
by induction n ; simp [*]

-- 6ª demostración
example :
  suma n Cero = n :=
Nat.rec_on n
  ( show suma Cero Cero = Cero,
      by rw suma_1)
  ( assume m,
    assume HI: suma m Cero = m,
    show suma (Suc m) Cero = Suc m, from
      calc suma (Suc m) Cero
           = Suc (suma m Cero) :by rw suma_2
       ... = Suc m             :by rw congr_arg Suc HI)

-- 7ª demostración
example :
  suma n Cero = n :=
Nat.rec_on n
  ( show suma Cero Cero = Cero,
      by simp)
  ( assume m,
    assume HI: suma m Cero = m,
    show suma (Suc m) Cero = Suc m, from
      calc suma (Suc m) Cero
           = Suc (suma m Cero) :by simp
       ... = Suc m             :by simp [HI])

-- 8ª demostración
example :
  suma n Cero = n :=
Nat.rec_on n
  ( by simp)
  ( assume m,
    assume HI: suma m Cero = m,
    by simp [HI])

-- 9ª demostración
example :
  suma n Cero = n :=
Nat.rec_on n
  (by simp)
  (λ m HI, by simp [HI])

-- 10ª demostración
lemma suma_Cero :
  ∀ n, suma n Cero = n
| Cero    := by simp
| (Suc m) := by simp [suma_Cero m]

-- ----------------------------------------------------
-- Ejercicio 11. Cerrar el espacio de nombre Nat.
-- ----------------------------------------------------

end Nat


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

/-!
# Vieta's Formula

The main result is `vieta.prod_X_add_C_eq_sum_esymm`, which shows that the product of linear terms
`λ + X i` is equal to a linear combination of the symmetric polynomials `esymm σ R j`.

## Implementation Notes:

We first take the viewpoint where the "roots" `X i` are variables. This means we work over
`polynomial (mv_polynomial σ R)`, which enables us to talk about linear combinations of
`esymm σ R j`. We then derive Vieta's formula in `polynomial R` by giving a
valuation from each `X i` to `r i`.

-/

universes u
open_locale big_operators polynomial

open finset polynomial fintype

namespace mv_polynomial

variables {R : Type u} [comm_semiring R]
variables (σ : Type u) [fintype σ]

/-- A sum version of Vieta's formula. Viewing `X i` as variables,
the product of linear terms `λ + X i` is equal to a linear combination of
the symmetric polynomials `esymm σ R j`. -/
lemma prod_X_add_C_eq_sum_esymm :
  (∏ i : σ, (polynomial.C (X i) + polynomial.X) : polynomial (mv_polynomial σ R) )=
  ∑ j in range (card σ + 1),
    (polynomial.C (esymm σ R j) * polynomial.X ^ (card σ - j)) :=
begin
  classical,
  rw [prod_add, sum_powerset],
  refine sum_congr begin congr end (λ j hj, _),
  rw [esymm, map_sum, sum_mul],
  refine sum_congr rfl (λ t ht, _),
  have h : (univ \ t).card = card σ - j :=
  by { rw card_sdiff (mem_powerset_len.mp ht).1, congr, exact (mem_powerset_len.mp ht).2 },
  rw [map_prod, prod_const, ← h],
  congr,
end

/-- A fully expanded sum version of Vieta's formula, evaluated at the roots.
The product of linear terms `X + r i` is equal to `∑ j in range (n + 1), e_j * X ^ (n - j)`,
where `e_j` is the `j`th symmetric polynomial of the constant terms `r i`. -/
lemma prod_X_add_C_eval (r : σ → R) : ∏ i : σ, (polynomial.C (r i) + polynomial.X) =
  ∑ i in range (card σ + 1), (∑ t in powerset_len i (univ : finset σ),
    ∏ i in t, polynomial.C (r i)) * polynomial.X ^ (card σ - i) :=
begin
  classical,
  have h := @prod_X_add_C_eq_sum_esymm _ _ σ _,
  apply_fun (polynomial.map (eval r)) at h,
  rw [polynomial.map_prod, polynomial.map_sum] at h,
  convert h,
  simp only [eval_X, polynomial.map_add, polynomial.map_C, polynomial.map_X, eq_self_iff_true],
  funext,
  simp only [function.funext_iff, esymm, polynomial.map_C, polynomial.map_sum, map_sum,
    polynomial.map_C, polynomial.map_pow, polynomial.map_X, polynomial.map_mul],
  congr,
  funext,
  simp only [eval_prod, eval_X, map_prod],
end

lemma esymm_to_sum (r : σ → R) (j : ℕ) : polynomial.C (eval r (esymm σ R j)) =
  ∑ t in powerset_len j (univ : finset σ), ∏ i in t, polynomial.C (r i) :=
by simp only [esymm, eval_sum, eval_prod, eval_X, map_sum, map_prod]

/-- Vieta's formula for the coefficients of the product of linear terms `X + r i`,
The `k`th coefficient is `∑ t in powerset_len (card σ - k) (univ : finset σ), ∏ i in t, r i`,
i.e. the symmetric polynomial `esymm σ R (card σ - k)` of the constant terms `r i`. -/

end mv_polynomial


-- Imagen_de_la_diferencia_de_conjuntos.lean
-- Imagen de la diferencia de conjuntos
-- José A. Alonso Jiménez
-- Sevilla, 17 de junio de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que
--    f '' s \ f '' t ⊆ f '' (s \ t)
-- ----------------------------------------------------------------------

import data.set.basic
import tactic

open set

variables {α : Type*} {β : Type*}
variable  f : α → β
variables s t : set α

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

example : f '' s \ f '' t ⊆ f '' (s \ t) :=
begin
  intros y hy,
  cases hy with yfs ynft,
  cases yfs with x hx,
  cases hx with xs fxy,
  use x,
  split,
  { split,
    { exact xs, },
    { intro xt,
      apply ynft,
      rw ← fxy,
      apply mem_image_of_mem,
      exact xt, }},
  { exact fxy, },
end

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

example : f '' s \ f '' t ⊆ f '' (s \ t) :=
begin
  rintros y ⟨⟨x, xs, fxy⟩, ynft⟩,
  use x,
  split,
  { split,
    { exact xs, },
    { intro xt,
      apply ynft,
      use [x, xt, fxy], }},
  { exact fxy, },
end

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

example : f '' s \ f '' t ⊆ f '' (s \ t) :=
begin
  rintros y ⟨⟨x, xs, fxy⟩, ynft⟩,
  use x,
  finish,
end

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

example : f '' s \ f '' t ⊆ f '' (s \ t) :=
subset_image_diff f s t


import data.real.basic

/-!

# Q3

Take bounded, nonempty `S, T ⊆ ℝ`.
Define `S + T := { s + t : s ∈ S, t ∈ T}`.
Prove `sup(S + T) = sup(S) + sup(T)`

-/

-- useful for rewriting
theorem is_lub_def {S : set ℝ} {a : ℝ} :
  is_lub S a ↔ a ∈ upper_bounds S ∧ ∀ x, x ∈ upper_bounds S → a ≤ x :=
begin
  refl
end

#check mem_upper_bounds -- a ∈ upper_bounds S ↔ ∀ x, x ∈ S → x ≤ a

/-
Useful tactics for this one: push_neg, specialize, have
-/
theorem useful_lemma {S : set ℝ} {a : ℝ} (haS : is_lub S a) (t : ℝ)
  (ht : t < a) : ∃ s, s ∈ S ∧ t < s :=
begin
  by_contradiction,
  push_neg at h,
  rw is_lub_def at haS,
  rw ← mem_upper_bounds at h,
  cases haS with h1 h2,
  specialize h2 t h,
  linarith,
end

/-
Useful tactics for this one:
`rcases h with ⟨s, t, hsS, htT, rfl⟩` if h : x ∈ S + T
`linarith`
`by_contra`
`set ε := a + b - x with hε`
-/
theorem Q3 (S T : set ℝ) (a b : ℝ) :
  is_lub S a → is_lub T b → is_lub (S + T) (a + b) :=
begin
  intros h1 h2,
  have h1':=h1,
  have h2':=h2,
  cases h1 with h3 h4,
  cases h2 with h5 h6,
  rw is_lub_def,
  rw mem_lower_bounds at *,
  rw mem_upper_bounds at *,
  split;
  intros x h8,
  rcases h8 with ⟨ s,t,hsS,htT,rfl⟩,
  specialize h5 t,
  specialize h3 s,
  have htb:= h5 htT,
  have hsa:= h3 hsS,
  linarith,

  rw mem_upper_bounds at *,
  by_contradiction,
  push_neg at h,
  set ε := a + b - x with hε,
  have h9: a - ε / 100 <a,
  linarith,
  have hb: b - ε / 100<b,
  linarith,
  have h10:= useful_lemma h1' (a-ε/100) _,
  rcases h10 with ⟨s, hs1, hs2⟩,
  have h11:= useful_lemma h2' (b-ε/100) _,
  rcases h11 with ⟨t, ht1, ht2⟩,
  specialize h5 t,
  specialize h3 s,
  have htb:= h5 ht1,
  have hsa:= h3 hs1,
  specialize h8 (s+t),
  have hst: s + t ∈ S + T,
  split,
  use t,
  split,
  assumption,
  split,
  assumption,
  refl,
  have h11:= h8 hst,
  linarith,
  linarith,
  linarith,
end

/-!

# Q6

-/

-- We introduce the usual mathematical notation for absolute value
local notation `|` x `|` := abs x

/-
Useful for this one: `unfold`, `split_ifs` if you want to prove
from first principles, or guessing the name of the library function
if you want to use the library.
-/
theorem Q6a (x y : ℝ) : | x + y | ≤ | x | + | y | :=
begin
  exact abs_add x y,
end

-- all the rest you're supposed to do using Q6a somehow:
-- `simp` and `linarith` are useful.

theorem Q6b (x y : ℝ) : |x + y| ≥ |x| - |y| :=
begin
  have h:= Q6a,
  rw ge_iff_le,
  specialize h (x+y) (-y),
  simp at h,
  linarith,
end

theorem Q6c (x y : ℝ) : |x + y| ≥ |y| - |x| :=
begin
  have h:= Q6a,
  rw ge_iff_le,
  specialize h (-x) (x+y),
  simp at h,
  linarith,
end

theorem Q6d (x y : ℝ) : |x - y| ≥ | |x| - |y| | :=
begin
  rw ge_iff_le,
  have h: |x| -|y|<0 ∨ 0≤ |x| - |y|,
  exact lt_or_ge _ 0,
  cases h,
  rw abs_of_neg h,
  simp,
  have h2:= Q6c,
  specialize h2 x (-y),
  simp at h2,
  have h3: x+-y = x-y,
  ring,
  rwa h3 at h2,
  rw abs_of_nonneg h,
  have h2:= Q6c,
  specialize h2 y (-x),
  simp at h2,
  ring at h2,
  exact abs_sub_abs_le_abs_sub x y,
end

theorem Q6e (x y : ℝ) : |x| ≤ |y| + |x - y| :=
begin
  have h2:= Q6a,
  specialize h2 (x-y) (y),
  ring at h2,
  linarith,
end

theorem Q6f (x y : ℝ) : |x| ≥ |y| - |x - y| :=
begin
  have h2:= Q6a,
  rw ge_iff_le,
  specialize h2 x (y-x),
  ring at h2,
  have h3: abs(x-y) = abs(y-x),
  apply abs_sub x y,
  rw h3,
  linarith,
end

theorem Q6g (x y z : ℝ) : |x - y| ≤ |x - z| + |y - z| :=
begin
  have h2:=Q6a,
  specialize h2 (x-z) (z-y),
  ring at h2,
  have h3: abs(y-z) = abs(z-y),
  apply abs_sub y z,
  rwa h3,
end

/-!

# Q4

NOTE: I have not done this one myself -- some lemmas could be wrong!
I just copied directly from the problem sheet and you know how
sloppy mathematicians are...

Fix `a ∈ (0,∞)` and `n : ℕ`. We will prove
`∃ x : ℝ, x^n = a`.

-/

section Q4

noncomputable theory

parameters {a : ℝ} (ha : 0 < a) {n : ℕ} (hn : 0 < n)

/-
1) Set `Sₐ := {s ∈ [0,∞) : s^n < a}` and show `Sₐ` is nonempty and
bounded above, so we may define `x := sup Sₐ`.
-/

def S := {s : ℝ | 0 ≤ s ∧ s ^ n < a}

include ha hn

theorem part1 : (∃ s : ℝ, s ∈ S) ∧ (∃ B : ℝ, ∀ s ∈ S, s ≤ B ) :=
sorry

def x := Sup S

-- the sup is the least upper bound
theorem is_lub_x : is_lub S x :=
begin
  cases part1 with nonempty bdd,
  cases nonempty with x hx,
  cases bdd with y hy,
  exact real.is_lub_Sup hx hy,
end

/-
2) For `ε ∈ (0,1)` show `(x+ε)ⁿ ≤ x^n + ε[(x + 1)ⁿ − xⁿ].`
(Hint: multiply out.)
-/

-- I'm pretty sure this is needed
lemma x_nonneg : 0 ≤ x :=
begin
  rcases is_lub_x with ⟨h, -⟩,
  apply h,
  split, refl,
  convert ha,
  simp [hn],
end

theorem part2 (ε : ℝ) (hε0 : 0 < ε) (hε1 : ε < 1) : (x + ε)^n ≤ x^n + ε*((x+1)^n - x^n) :=
begin
  sorry
end

/-
3) Hence show that if `xⁿ < a` then
`∃ ε ∈ (0,1)` such that `(x+ε)ⁿ < a.` (*)
-/

theorem part3 (h : x ^ n < a) : ∃ ε : ℝ, 0 < ε ∧ ε < 1 ∧ (x+ε)^n < a :=
begin
  sorry
end

/-
4) If `xⁿ > a`, deduce from (∗) that
`∃ ε ∈ (0,1)` such that `(1/x+ε)ⁿ < 1/a`. (∗∗)
-/

-- part 4 doesn't quite make sense because we didn't show x ≠ 0 yet

lemma easy (h : a < x^n) : x ≠ 0 :=
begin
  intro hx,
  rw hx at h,
  suffices : a < 0,
    linarith,
  convert h,
  symmetry, -- ??
  simp [hn],
end

theorem part4 (h : a < x^n) : ∃ ε : ℝ, 0 < ε ∧ ε < 1 ∧ (1/x + ε)^n < 1/a :=
begin
  sorry
end

/-
5) Deduce contradictions from (∗) and (∗∗) to show that `xⁿ = a`.
-/

theorem part5 : x^n = a :=
begin
  sorry
end

end Q4


import .list
import algebra.geom_sum
import analysis.specific_limits

lemma geom_sum_of_sum_of_range_map {α} [semiring α] (x: α) (n: ℕ):
  list.sum (list.map (pow x) (list.range n)) = geom_sum x n :=
begin
  induction n with d hd,
  { simp only [list.sum_nil, geom_sum_zero, list.range_zero, list.map] },
  { simp [geom_sum, finset.range, list.range_succ, add_comm, hd] },
end

lemma geom_sum_of_sum_of_map_with_index {α} [semiring α] (x: α) (l: list α):
  list.sum (l.map_with_index (λ i a, x ^ i)) = geom_sum x (l.length) :=
by simp [← geom_sum_of_sum_of_range_map x (l.length), list.map_with_index_eq_range_map (λ i a, x ^ i) (λ i, x ^ i)]

lemma real.finite_geom_sum_le_infinite_geom_sum_of_abs_lt_1
  {x: ℝ} (n: ℕ) (x_nonneg: 0 ≤ x) (h: abs x < 1):
  geom_sum x n ≤ ∑' k: ℕ, x ^ k :=
begin
  apply sum_le_tsum,
  simp,
  intros m hm,
  exact pow_nonneg x_nonneg m,
  exact summable_geometric_of_abs_lt_1 h,
end

lemma real.finite_geom_sum_le_infinite_geom_sum_of_lt_1
  {x: ℝ} (n: ℕ) (x_nonneg: 0 ≤ x) (h: x < 1):
  geom_sum x n ≤ ∑' k: ℕ, x ^ k :=
begin
  rw ← abs_eq_self.2 x_nonneg at h,
  exact real.finite_geom_sum_le_infinite_geom_sum_of_abs_lt_1 n x_nonneg h,
end

-- can be generalized to 'semifield', but we do not have them.
lemma geom_sum_eq_factor_inv_geom_sum
  {α} [field α]
  {x: α} (n: ℕ) (hx_ne_0: x ≠ 0) (hx_ne_1: x ≠ 1):
  geom_sum x (n + 1) = (x ^ n) * geom_sum (x⁻¹) (n + 1) :=
begin
  rw [geom_sum_eq hx_ne_1, geom_sum_inv hx_ne_1 hx_ne_0],
  rw [← mul_assoc, div_eq_mul_inv],
  exact calc (x ^ (n + 1) - 1) * (x - 1)⁻¹ = (x - 1)⁻¹ * (x ^ (n + 1) - 1) : mul_comm _ _
  ... = (x - 1)⁻¹ * (x ^ n * x - 1) : by rw pow_succ' x n
  ... = (x - 1)⁻¹ * (x ^ n * x - x ^ (-n: ℤ) * x ^ (n: ℤ)) : by rw [fpow_neg_mul_fpow_self n hx_ne_0]
  ... = (x - 1)⁻¹ * (x ^ n * x - x ^ n * x ^ (-n: ℤ)) : by norm_cast; ring_nf
  ... = (x - 1)⁻¹ * x ^ n * (x - x⁻¹ ^ n) : by rw [← mul_sub_left_distrib _ _ _, ← mul_assoc]; simp [inv_fpow]
  ... = (x - 1)⁻¹ * x ^ n * (x - x⁻¹ ^ n * 1) : by rw mul_one (x⁻¹ ^ n)
  ... = (x - 1)⁻¹ * x ^ n * (x - x⁻¹ ^ n * (x⁻¹ * x)) : by rw inv_mul_cancel hx_ne_0
  ... = (x - 1)⁻¹ * x ^ n * (x - x⁻¹ ^ (n + 1) * x)  : by rw [← mul_assoc, pow_succ' x⁻¹ n]
  ... = x ^ n * (x - 1)⁻¹ * (x - x⁻¹ ^ (n + 1) * x) : by ac_refl,
end


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

import tactic
import analysis.calculus.parametric_integral

/-

# Basic calculus

Let's figure out how to do differentiability in Lean together (because as I'm writing this
I have very little clue :-/

section differentiability_in_general

-- OK so this seems to be how to say a function is differentiable:

-- these variables will only live in this section
-- Let 𝕜 be a field equipped with a non-trivial norm (e.g. ℝ)
variables (𝕜 : Type) [nontrivially_normed_field 𝕜]

-- Let `E` be a 𝕜-vector space with a norm (e.g. ℝ or ℝ²)
variables (E : Type) [normed_add_comm_group E] [normed_space 𝕜 E]

-- and let `F` be another one
variables (F : Type) [normed_add_comm_group F] [normed_space 𝕜 F]

-- Then it makes sense to say that a function `f : E → F` is differentiable
variable (f : E → F)

-- This is the true-false statement that `f` is differentiable.
example : Prop := differentiable 𝕜 f

-- You can also ask that `f` is differentiable at `e : E`

example (e : E) : Prop := differentiable_at 𝕜 f e

-- Here's how you say "`f` is continuously differentiable 37 times"
-- (i.e. you can differentiate f 37 times and when you're done the answer is continuous
-- but might not be differentiable)

example : Prop := cont_diff 𝕜 37 f

-- Here's how you say "`f` is smooth, i.e. infinitely differentiable"

example : Prop := cont_diff 𝕜 ⊤ f

-- That's `⊤` as in "the top element of a lattice" as in `+∞`, not `T` as in "the letter T".
-- Indeed, `cont_diff 𝕜` takes an element of `ℕ∞`.

end differentiability_in_general

-- Let's now just assume `𝕜 = ℝ`; then `E` and `F` can be `ℝ` or `ℂ` or `ℝ × ℝ` or `fin n → ℝ` (the
-- way we say `ℝⁿ` in mathlib) or ...

open real -- because there is `real.cos` and `complex.cos`,

-- This says "the cos(sin(x))*exp(x) is differentiable"
-- Hint: the theorems are called theorems like `differentiable.mul` etc.
-- Try proving it by hand.

example : differentiable ℝ (λ x, cos (sin x) * exp x) :=
begin
  sorry,
end

-- Now see what `hint` has to say!
example : differentiable ℝ (λ x, cos (sin x) * exp x) :=
begin
  sorry,
end

-- The simplifier can even do this sort of thing:
example (x : ℝ) : deriv (λ x, cos (sin x) * exp x) x = (cos(sin(x))-sin(sin(x))*cos(x))*exp(x) :=
by { simp, ring }

-- Try this one:
example (a : ℝ) (x : ℝ) : differentiable_at ℝ (λ (y : ℝ), exp (-(a * y ^ 2))) x :=
begin
  sorry,
end


-- 4.6

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

    example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
    iff.intro
        (assume h : ∀ x, p x ∧ q x,
        have r1 : (∀ x, p x), from (λ x, and.elim_left (h x)),
        have r2 : (∀ x, q x), from (λ x, and.elim_right (h x)),
        show (∀ x, p x) ∧ (∀ x, q x), from ⟨ r1, r2 ⟩
        )
        (assume h : (∀ x, p x) ∧ (∀ x, q x),
        have h1 : (∀ x, p x), from and.elim_left h,
        have h2 : (∀ x, q x), from and.elim_right h,
        λ x, and.intro (h1 x) (h2 x)
        )
    example :
    (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) :=
    begin
        assume h,
        assume pu,
        assume x,
        from h x (pu x)
    end
    example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x :=
    begin
        assume h,
        assume x,
        from (or.elim h
        (assume pu, or.intro_left _ (pu x))
        (assume qu, or.intro_right _ (qu x))
        )
    end
end section_4_6_1

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

    example : α → ((∀ x : α, r) ↔ r) :=
      assume x,
      iff.intro
        (λ rp, rp x)
        (λ r x, r)
    example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r :=
      iff.intro
        (λ h, classical.by_contradiction
          (assume nh2,
          nh2 (or.intro_left _
          (assume x,
          or.elim (h x)
            (λ x, x)
            (λ r, false.elim (nh2 (or.intro_right _ r)))
          ))
          ))
        (λ h,
        or.elim h
          (λ pu x, or.intro_left _ (pu x))
          (λ r x, or.intro_right _ r))
    example : (∀ x, r → p x) ↔ (r → ∀ x, p x) :=
        iff.intro
            (λ h r x, h x r)
            (λ h r x, h x r)
end section_4_6_2

namespace section_4_6_3
    variables (men : Type) (barber : men)
    variable  (shaves : men → men → Prop)

    example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) :
    false := (
        let weird := h barber in
        let A := shaves barber barber in
        let o : ¬ A := (λ s, weird.mp s s) in
        o (weird.mpr o)
    )
end section_4_6_3

namespace section_4_6_4
    namespace hidden

    def divides (m n : ℕ) : Prop := ∃ k, m * k = n

    instance : has_dvd nat := ⟨divides⟩

    def even (n : ℕ) : Prop := 2 ∣ n

    section
    variables m n : ℕ

    #check m ∣ n
    #check m^n
    #check even (m^n +3)
    end

    end hidden

    def prime (n : ℕ) : Prop :=
        (¬ n = 1) ∧ (∀ d, d ∣ n → d = 1 ∨ d = n)

    def infinitely_many_primes : Prop :=
        ∀ t, ∃ n, n > t ∧ prime n

    def Fermat_prime (n : ℕ) : Prop :=
        (∃ (k : ℕ), n = 2 ^ (2 ^ k)) ∧ prime n

    def infinitely_many_Fermat_primes : Prop :=
        ∀ t, ∃ n, n > t ∧ Fermat_prime n

    def goldbach_conjecture : Prop :=
        ∀ x, x > 2 → ∃ a b, prime a ∧ prime b ∧ x = a + b

    def Goldbach's_weak_conjecture : Prop :=
        ∀ x, x > 5 → (¬ hidden.even x)
        → ∃ a b c, prime a ∧ prime b ∧ prime c ∧ x = a + b + c

    def Fermat's_last_theorem : Prop :=
        ¬ ∃ (a b c n : ℕ), n > 2 ∧ a ^ n + b ^ n = c ^ n

end section_4_6_4

namespace section_4_6_5
    variables (α : Type) (p q : α → Prop)
    variable a : α
    variable r : Prop

    example : (∃ x : α, r) → r :=
        λ ex, exists.elim ex (λ _ r, r)
    example : r → (∃ x : α, r) :=
        λ r, exists.intro a r
    example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r :=
        iff.intro
            (λ ex, exists.elim ex (λ x ⟨ px, r ⟩,
                and.intro
                    (exists.intro x px)
                    r
            ))
            (λ ⟨ px, r ⟩,
                exists.elim px (λ x px,
                    exists.intro x ⟨ px, r ⟩
                )
            )
    example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
        iff.intro
            (assume ⟨ x, pqx ⟩,
                or.elim pqx
                    (λ px,
                        or.intro_left _
                            (exists.intro _ px))
                    (λ qx,
                        or.intro_right _
                            (exists.intro _ qx))
                    )
            (λ x, or.elim x
                (λ ⟨ x , px ⟩, ⟨ x, or.intro_left _ px ⟩)
                (λ ⟨ x , qx ⟩, ⟨ x, or.intro_right _ qx ⟩)
            )

    example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) := iff.intro
        (λ pu enp,
            exists.elim enp
                (λ x npx, npx (pu x)))
        (λ nenp x,
            classical.by_contradiction
                (λ npx,
                    nenp ⟨ x, npx ⟩)
        )

    example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) := iff.intro
        (λ ⟨ x , px ⟩ unpx, unpx x px)
        (λ nunp,
            classical.by_contradiction (λ nep,
                nunp (λ x px, nep ⟨ x, px ⟩)))
    example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) := iff.intro
        (λ nep x px, nep ⟨ x, px ⟩)
        (λ unp ⟨ x , px ⟩, unp x px)
    example : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) := iff.intro
        (λ nup,
            classical.by_contradiction (λ nenp,
                nup (λ x,
                    classical.by_contradiction (
                        λ np,
                            nenp ⟨ x , np ⟩
                    )
                )
            ))
         (λ ⟨ x , npx ⟩ pu, npx (pu x))

    example : (∀ x, p x → r) ↔ (∃ x, p x) → r :=
        iff.intro
            (λ upxr ⟨ x, px ⟩, upxr x px)
            (λ epxr x px, epxr ⟨ x, px ⟩)

    lemma univ_or_counterexample : (∀ x, p x) ∨ (∃ x, ¬ p x) :=
        or.elim (classical.em (∃ x, ¬ p x))
            (λ ex, or.intro_right _ ex)
            (λ nex, or.intro_left _ (λ x,
                classical.by_contradiction (λ np, nex ⟨ _ , np ⟩)))

    example : (∃ x, p x → r) ↔ (∀ x, p x) → r :=
        iff.intro
            (λ ⟨ x , pxr ⟩ pu, pxr (pu x))
            (λ pur,
                or.elim
                    (univ_or_counterexample _ p)
                    (λ univ, ⟨ a, λ _, pur univ ⟩)
                    (λ ⟨ x , np ⟩, ⟨ x, λ px, false.elim (np px) ⟩)
                )
    example : (∃ x, r → p x) ↔ (r → ∃ x, p x) :=
        iff.intro
            (λ ⟨ x, rpx ⟩ r, ⟨ x , rpx r ⟩)
            (λ rex,
                or.elim (classical.em r)
                    (λ r,
                        let ⟨ x, px ⟩ := rex r in
                        ⟨ x, λ _, px ⟩
                        )
                    (λ nr,
                        ⟨ a, λ r, false.elim (nr r) ⟩
                    )
                )
end section_4_6_5

namespace section_4_6_6
    variables (real : Type) [ordered_ring real]
    variables (log exp : real → real)
    variable  log_exp_eq : ∀ x, log (exp x) = x
    variable  exp_log_eq : ∀ {x}, x > 0 → exp (log x) = x
    variable  exp_pos    : ∀ x, exp x > 0
    variable  exp_add    : ∀ x y, exp (x + y) = exp x * exp y

    -- this ensures the assumptions are available in tactic proofs
    include log_exp_eq exp_log_eq exp_pos exp_add

    example (x y z : real) :
    exp (x + y + z) = exp x * exp y * exp z :=
    by rw [exp_add, exp_add]

    example (y : real) (h : y > 0)  : exp (log y) = y :=
    exp_log_eq h

    theorem log_mul {x y : real} (hx : x > 0) (hy : y > 0) :
    log (x * y) = log x + log y :=
    calc
        log (x * y) = log (x * y) : rfl
        ... = log (exp (log x) * exp (log y)) : by rw [exp_log_eq hx, exp_log_eq hy]
        ... = log (exp (log x + log y)) : by rw exp_add
        ... = log x + log y : log_exp_eq _

end section_4_6_6

namespace section_4_6_7
    #check sub_self

    example (x : ℤ) : x * 0 = 0 :=
    calc
        x * 0
            = x * (0 - 0) : eq.refl _
        ... = x * 0 - x * 0 : by rewrite mul_sub
        ... = 0 : by rewrite sub_self

end section_4_6_7

namespace section_5_8
  example (p q : Prop) (hp : p) (hq : q) : p ∧ q :=
  begin
    split;
    assumption
  end
  example (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p :=
  begin
    split;
    try { split };
    assumption
  end

  meta def search : tactic unit :=
    (tactic.assumption <|> (tactic.left >> search) <|> (tactic.right >> search))

  example (p q r : Prop) (hp : p) :
    (p ∨ q ∨ r) ∧ (q ∨ p ∨ r) ∧ (q ∨ r ∨ p) :=
    begin
      repeat { split }; search
    end
end section_5_8

namespace section_6
section
  variables x y : ℕ

  def double := x + x

  #check double y
  #check double (2 * x)

  theorem t1 : double (x + y) = double x + double y :=
  by simp [double]

  #check t1 y
  #check t1 (2 * x)

  theorem t2 : double (x * y) = double x * y :=
  by simp [double, add_mul]
end
end section_6

section

  def t : Type := nat
  def nat.dvd (m n : ℕ) : Prop := ∃ k, n = m * k

  def has_dvd_t : has_dvd t := ⟨nat.dvd⟩

  def f : t := (5 : nat)

end

set_option pp.beta true


-- begin header
import tactic.linarith
import data.real.basic

noncomputable theory
local attribute [instance, priority 0] classical.prop_decidable

local notation `|` x `|` := abs x
-- end header

/- Section
Sequences, subsequences, and monotonic subsequences.
-/

/- Sub-section
Definitions
-/

/-
We model a sequence $a₀, a₁, a₂, \dots$ of real numbers as a function
from $ℕ := \{0,1,2,\dots\}$ to $ℝ$, sending $n$ to $a_n$. We sometimes write such
a sequence as $(a_n)_{n≥0}$ or just $(a_n)$.
-/

/- Definition
A sequence $(a_n)$ is *increasing* if forall $n∈ℕ$ we have $a_n≤a_{n+1}$. Note that equality
is allowed here -- so for example the sequence $3, 3, 3, 3, …$ is increasing. A sequence is
*strictly increasing* if for all $n∈ℕ$ we have $a_n<a_{n+1}$; constant sequences
are not strictly increasing.
-/
def is_increasing {X : Type*} [has_le X] (a : ℕ → X) : Prop :=
∀ n : ℕ, a n ≤ a (n + 1)
def is_strictly_increasing {X : Type*} [has_lt X] (a : ℕ → X) : Prop :=
∀ n : ℕ, a n < a (n + 1)
/- Definition
Similarly a sequence $(a_n)$ is *decreasing* if $∀ n∈ℕ, a_{n+1}≤ a_n$ and is
*strictly decreasing* if $∀ n∈ℕ, a_{n+1}<a_n$.
-/
def is_decreasing {X : Type*} [has_le X] (a : ℕ → X) : Prop :=
∀ n : ℕ, a (n + 1) ≤ a n
def is_strictly_decreasing {X : Type*} [has_lt X] (a : ℕ → X) : Prop :=
∀ n : ℕ, a (n + 1) < a n
/-
A *subsequence* of a sequence $(a_n)$ is a sequence $(b_m)$ of the form
$a_{k_0}$, $a_{k_1}$, $a_{k_2}$, where the indices $0≤ k_0<k_1<k_2<…$ are strictly increasing.
-/
def is_subsequence {X : Type*} (a : ℕ → X) (b : ℕ → X) :=
∃ k : ℕ → ℕ, is_strictly_increasing k ∧ ∀ n, a (k n) = b n
/-
We are going to show that any sequence contains either a strictly increasing subsequence,
or a decreasing sequence [Does this have a name?]. The strategy of the proof is to
consider so-called peaks of the sequence. A *peak* of a sequence $(a_n)$ is an index
$i∈ℕ$ such that $a_i$ is at least as large as subsequent members of the sequence.
-/
/- Definition
A *peak* of a sequence $(a_n)$ is $i∈ℕ$ such that $∀ j≥ i, $a_j≤ a_i$.
-/
def is_peak (a : ℕ → ℝ) (i : ℕ) : Prop :=
∀ j, i ≤ j → a j ≤ a i
/-
For any sequence, consider the set of peaks. It is clearly either finite or infinite.
Let us formally state this in a more convenient form.
-/
/- Lemma
If $(a_n)$ is a sequence, then either there exists $N∈ℕ$ such that all peak $i$
of $(a_n)$ satisfy $i≤N$, or for all $N∈ℕ$ there exists a peak $i$ of $(a_n)$ with $i>N$.
-/
lemma finite_or_infinite_peaks (a : ℕ → ℝ) :
(∃ N, ∀ i, is_peak a i → i ≤ N) ∨ (∀ N, ∃ i, is_peak a i ∧ i > N) :=
by simpa [not_forall] using classical.em (∃ N, ∀ i, is_peak a i → i ≤ N)

/- Lemma
If there are infinitely many peaks for a sequence $(a_n)$, then the peaks
form a decreasing subsequence.
-/
lemma decreasing_subsequence_of_infinite_peaks (a : ℕ → ℝ)
(h : ∀ N, ∃ i, is_peak a i ∧ i > N) :
∃ b : ℕ → ℝ, is_subsequence a b ∧ is_strictly_decreasing b :=
begin
  choose f hf using h,
  let k : ℕ → ℕ := λ n, nat.rec_on n (f 0) (λ n kn, f kn),
  use (λ n, a (k n)),
  split,
  { use k,
    split,swap,intro,refl,
    sorry },
  {
    sorry },
end


/-
Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel

! This file was ported from Lean 3 source module measure_theory.covering.one_dim
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Covering.DensityTheorem
import Mathbin.MeasureTheory.Measure.HaarLebesgue

/-!
# Covering theorems for Lebesgue measure in one dimension

We have a general theory of covering theorems for doubling measures, developed notably
in `density_theorems.lean`. In this file, we expand the API for this theory in one dimension,
by showing that intervals belong to the relevant Vitali family.
-/

open Set MeasureTheory IsDoublingMeasure Filter

open Topology

namespace Real

theorem Icc_mem_vitaliFamily_at_right {x y : ℝ} (hxy : x < y) :
    Icc x y ∈ (VitaliFamily (volume : Measure ℝ) 1).setsAt x :=
  by
  rw [Icc_eq_closed_ball]
  refine' closed_ball_mem_vitali_family_of_dist_le_mul _ _ (by linarith)
  rw [dist_comm, Real.dist_eq, abs_of_nonneg] <;> linarith
#align real.Icc_mem_vitali_family_at_right Real.Icc_mem_vitaliFamily_at_right

theorem tendsto_Icc_vitaliFamily_right (x : ℝ) :
    Tendsto (fun y => Icc x y) (𝓝[>] x) ((VitaliFamily (volume : Measure ℝ) 1).filterAt x) :=
  by
  refine' (VitaliFamily.tendsto_filterAt_iff _).2 ⟨_, _⟩
  · filter_upwards [self_mem_nhdsWithin]with y hy using Icc_mem_vitali_family_at_right hy
  · intro ε εpos
    have : x ∈ Ico x (x + ε) := ⟨le_refl _, by linarith⟩
    filter_upwards [Icc_mem_nhdsWithin_Ioi this]with y hy
    rw [closed_ball_eq_Icc]
    exact Icc_subset_Icc (by linarith) hy.2
#align real.tendsto_Icc_vitali_family_right Real.tendsto_Icc_vitaliFamily_right

theorem Icc_mem_vitaliFamily_at_left {x y : ℝ} (hxy : x < y) :
    Icc x y ∈ (VitaliFamily (volume : Measure ℝ) 1).setsAt y :=
  by
  rw [Icc_eq_closed_ball]
  refine' closed_ball_mem_vitali_family_of_dist_le_mul _ _ (by linarith)
  rw [Real.dist_eq, abs_of_nonneg] <;> linarith
#align real.Icc_mem_vitali_family_at_left Real.Icc_mem_vitaliFamily_at_left

theorem tendsto_Icc_vitaliFamily_left (x : ℝ) :
    Tendsto (fun y => Icc y x) (𝓝[<] x) ((VitaliFamily (volume : Measure ℝ) 1).filterAt x) :=
  by
  refine' (VitaliFamily.tendsto_filterAt_iff _).2 ⟨_, _⟩
  · filter_upwards [self_mem_nhdsWithin]with y hy using Icc_mem_vitali_family_at_left hy
  · intro ε εpos
    have : x ∈ Ioc (x - ε) x := ⟨by linarith, le_refl _⟩
    filter_upwards [Icc_mem_nhdsWithin_Iio this]with y hy
    rw [closed_ball_eq_Icc]
    exact Icc_subset_Icc hy.1 (by linarith)
#align real.tendsto_Icc_vitali_family_left Real.tendsto_Icc_vitaliFamily_left

end Real


/-
Copyright (c) 2022 John Nicol. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: John Nicol
-/
import number_theory.legendre_symbol.gauss_eisenstein_lemmas

/-!
# Wilson's theorem.

This file contains a proof of Wilson's theorem.

The heavy lifting is mostly done by the previous `wilsons_lemma`,
but here we also prove the other logical direction.

This could be generalized to similar results about finite abelian groups.

## References

* [Wilson's Theorem](https://en.wikipedia.org/wiki/Wilson%27s_theorem)

## TODO

* Move `wilsons_lemma` into this file, and give it a descriptive name.
-/

open_locale nat

namespace nat
variable {n : ℕ}

/-- For `n > 1`, `(n-1)!` is congruent to `-1` modulo `n` only if n is prime. --/
lemma prime_of_fac_equiv_neg_one
  (h : ((n - 1)! : zmod n) = -1) (h1 : 1 < n) : prime n :=
begin
  by_contradiction h2,
  obtain ⟨m, hm1, hm2 : 1 < m, hm3⟩ := exists_dvd_of_not_prime2 h1 h2,
  have hm : m ∣ (n - 1)! := nat.dvd_factorial (pos_of_gt hm2) (le_pred_of_lt hm3),
  refine hm2.ne' (nat.dvd_one.mp ((nat.dvd_add_right hm).mp (hm1.trans _))),
  rw [←zmod.nat_coe_zmod_eq_zero_iff_dvd, cast_add, cast_one, h, add_left_neg],
end

/-- **Wilson's Theorem**: For `n > 1`, `(n-1)!` is congruent to `-1` modulo `n` iff n is prime. --/
theorem prime_iff_fac_equiv_neg_one (h : 1 < n) :
  prime n ↔ ((n - 1)! : zmod n) = -1 :=
begin
  refine ⟨λ h1, _, λ h2, prime_of_fac_equiv_neg_one h2 h⟩,
  haveI := fact.mk h1,
  exact zmod.wilsons_lemma n,
end

end nat