/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_numbertheory_188 :
  nat.gcd 180 168 = 12 :=
begin
  norm_num,
end


import data.nat.basic
import algebra.group_power.basic
import tactic

-- ℚ LHS suggestion by Eric Wieser on the Xena Project Discord
theorem osk2002_1 : (((2^4)^8) / ((4^8)^2) : ℚ) = 1 :=
begin
  norm_num, -- suggestion by Marco Dos Santos on the Xena Project Discord
end

lemma four_eq_two_pow_two : (4: ℕ) = (2^2 : ℕ) := rfl

-- l1, l2, l3 helper lemmas
-- credit: Kevin Buzzard on the Xena Project Discord
lemma l1 : ((2^4)^8) = ((4^8)^2) :=
begin
  nth_rewrite 2 four_eq_two_pow_two, -- now always raising powers of 2 to powers
  simp only [← pow_mul],
  -- goal is now 2^X = 2^Y
  apply congr_arg, -- goal is now X=Y
  norm_num, -- would have worked earlier but arguably not in spirit of problem
end

lemma l2 (a b : ℕ) (h : (a / b : ℚ) = 1) : a = b :=
begin
  rw div_eq_one_iff_eq at h,
  { assumption_mod_cast, },
  { intro hb,
    rw hb at h,
    simpa using h,
  },
end

lemma l3 {a b : ℕ} (h : a = b) (hb : b ≠ 0) : (a / b : ℚ) = 1 :=
begin
  rw h,
  rw div_eq_one_iff_eq,
  assumption_mod_cast,
end

theorem osk2002_1_alt : (((2^4)^8) / ((4^8)^2) : ℚ) = 1 :=
begin
  have h : (4^8)^2 ≠ 0,
  { norm_num, },
  -- recursion error
  -- exact l3 l1 h,
  sorry,
end


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Simon Hudon, Mario Carneiro
-/
import algebra.group.to_additive
import tactic.basic

/-!
# Typeclasses for (semi)groups and monoids

In this file we define typeclasses for algebraic structures with one binary operation.
The classes are named `(add_)?(comm_)?(semigroup|monoid|group)`, where `add_` means that
the class uses additive notation and `comm_` means that the class assumes that the binary
operation is commutative.

The file does not contain any lemmas except for

* axioms of typeclasses restated in the root namespace;
* lemmas required for instances.

For basic lemmas about these classes see `algebra.group.basic`.

We also introduce notation classes `has_scalar` and `has_vadd` for multiplicative and additive
actions and register the following instances:

- `has_pow M ℕ`, for monoids `M`, and `has_pow G ℤ` for groups `G`;
- `has_scalar ℕ M` for additive monoids `M`, and `has_scalar ℤ G` for additive groups `G`.

## Notation

- `+`, `-`, `*`, `/`, `^` : the usual arithmetic operations; the underlying functions are
  `has_add.add`, `has_neg.neg`/`has_sub.sub`, `has_mul.mul`, `has_div.div`, and `has_pow.pow`.
- `a • b` is used as notation for `has_scalar.smul a b`.
- `a +ᵥ b` is used as notation for `has_vadd.vadd a b`.

-/

/-- Type class for the `+ᵥ` notation. -/
class has_vadd (G : Type*) (P : Type*) := (vadd : G → P → P)

/-- Type class for the `-ᵥ` notation. -/
class has_vsub (G : out_param Type*) (P : Type*) := (vsub : P → P → G)

/-- Typeclass for types with a scalar multiplication operation, denoted `•` (`\bu`) -/
@[to_additive has_vadd]
class has_scalar (M : Type*) (α : Type*) := (smul : M → α → α)

infix ` +ᵥ `:65 := has_vadd.vadd
infix ` -ᵥ `:65 := has_vsub.vsub
infixr ` • `:73 := has_scalar.smul

attribute [to_additive_reorder 1] has_pow
attribute [to_additive_reorder 1 4] has_pow.pow
attribute [to_additive has_scalar] has_pow
attribute [to_additive has_scalar.smul] has_pow.pow

set_option old_structure_cmd true

universe u

/- Additive "sister" structures.
   Example, add_semigroup mirrors semigroup.
   These structures exist just to help automation.
   In an alternative design, we could have the binary operation as an
   extra argument for semigroup, monoid, group, etc. However, the lemmas
   would be hard to index since they would not contain any constant.
   For example, mul_assoc would be

   lemma mul_assoc {α : Type u} {op : α → α → α} [semigroup α op] :
                   ∀ a b c : α, op (op a b) c = op a (op b c) :=
    semigroup.mul_assoc

   The simplifier cannot effectively use this lemma since the pattern for
   the left-hand-side would be

        ?op (?op ?a ?b) ?c

   Remark: we use a tactic for transporting theorems from the multiplicative fragment
   to the additive one.
-/

section has_mul

variables {G : Type u} [has_mul G]

/-- `left_mul g` denotes left multiplication by `g` -/
@[to_additive "`left_add g` denotes left addition by `g`"]
def left_mul : G → G → G := λ g : G, λ x : G, g * x

/-- `right_mul g` denotes right multiplication by `g` -/
@[to_additive "`right_add g` denotes right addition by `g`"]
def right_mul : G → G → G := λ g : G, λ x : G, x * g

end has_mul

/-- A semigroup is a type with an associative `(*)`. -/
@[protect_proj, ancestor has_mul, ext] class semigroup (G : Type u) extends has_mul G :=
(mul_assoc : ∀ a b c : G, a * b * c = a * (b * c))
/-- An additive semigroup is a type with an associative `(+)`. -/
@[protect_proj, ancestor has_add, ext] class add_semigroup (G : Type u) extends has_add G :=
(add_assoc : ∀ a b c : G, a + b + c = a + (b + c))
attribute [to_additive] semigroup

section semigroup
variables {G : Type u} [semigroup G]

@[no_rsimp, to_additive]
lemma mul_assoc : ∀ a b c : G, a * b * c = a * (b * c) :=
semigroup.mul_assoc

@[to_additive]
instance semigroup.to_is_associative : is_associative G (*) :=
⟨mul_assoc⟩

end semigroup

/-- A commutative semigroup is a type with an associative commutative `(*)`. -/
@[protect_proj, ancestor semigroup, ext]
class comm_semigroup (G : Type u) extends semigroup G :=
(mul_comm : ∀ a b : G, a * b = b * a)

/-- A commutative additive semigroup is a type with an associative commutative `(+)`. -/
@[protect_proj, ancestor add_semigroup, ext]
class add_comm_semigroup (G : Type u) extends add_semigroup G :=
(add_comm : ∀ a b : G, a + b = b + a)
attribute [to_additive] comm_semigroup

section comm_semigroup
variables {G : Type u} [comm_semigroup G]

@[no_rsimp, to_additive]
lemma mul_comm : ∀ a b : G, a * b = b * a :=
comm_semigroup.mul_comm

@[to_additive]
instance comm_semigroup.to_is_commutative : is_commutative G (*) :=
⟨mul_comm⟩

end comm_semigroup

/-- A `left_cancel_semigroup` is a semigroup such that `a * b = a * c` implies `b = c`. -/
@[protect_proj, ancestor semigroup, ext]
class left_cancel_semigroup (G : Type u) extends semigroup G :=
(mul_left_cancel : ∀ a b c : G, a * b = a * c → b = c)
/-- An `add_left_cancel_semigroup` is an additive semigroup such that
`a + b = a + c` implies `b = c`. -/
@[protect_proj, ancestor add_semigroup, ext]
class add_left_cancel_semigroup (G : Type u) extends add_semigroup G :=
(add_left_cancel : ∀ a b c : G, a + b = a + c → b = c)
attribute [to_additive add_left_cancel_semigroup] left_cancel_semigroup

section left_cancel_semigroup
variables {G : Type u} [left_cancel_semigroup G] {a b c : G}

@[to_additive]
lemma mul_left_cancel : a * b = a * c → b = c :=
left_cancel_semigroup.mul_left_cancel a b c

@[to_additive]
lemma mul_left_cancel_iff : a * b = a * c ↔ b = c :=
⟨mul_left_cancel, congr_arg _⟩

@[to_additive]
theorem mul_right_injective (a : G) : function.injective ((*) a) :=
λ b c, mul_left_cancel

@[simp, to_additive]
theorem mul_right_inj (a : G) {b c : G} : a * b = a * c ↔ b = c :=
(mul_right_injective a).eq_iff

@[to_additive]
theorem mul_ne_mul_right (a : G) {b c : G} : a * b ≠ a * c ↔ b ≠ c :=
(mul_right_injective a).ne_iff

end left_cancel_semigroup

/-- A `right_cancel_semigroup` is a semigroup such that `a * b = c * b` implies `a = c`. -/
@[protect_proj, ancestor semigroup, ext]
class right_cancel_semigroup (G : Type u) extends semigroup G :=
(mul_right_cancel : ∀ a b c : G, a * b = c * b → a = c)

/-- An `add_right_cancel_semigroup` is an additive semigroup such that
`a + b = c + b` implies `a = c`. -/
@[protect_proj, ancestor add_semigroup, ext]
class add_right_cancel_semigroup (G : Type u) extends add_semigroup G :=
(add_right_cancel : ∀ a b c : G, a + b = c + b → a = c)
attribute [to_additive add_right_cancel_semigroup] right_cancel_semigroup

section right_cancel_semigroup
variables {G : Type u} [right_cancel_semigroup G] {a b c : G}

@[to_additive]
lemma mul_right_cancel : a * b = c * b → a = c :=
right_cancel_semigroup.mul_right_cancel a b c

@[to_additive]
lemma mul_right_cancel_iff : b * a = c * a ↔ b = c :=
⟨mul_right_cancel, congr_arg _⟩

@[to_additive]
theorem mul_left_injective (a : G) : function.injective (λ x, x * a) :=
λ b c, mul_right_cancel

@[simp, to_additive]
theorem mul_left_inj (a : G) {b c : G} : b * a = c * a ↔ b = c :=
(mul_left_injective a).eq_iff

@[to_additive]
theorem mul_ne_mul_left (a : G) {b c : G} : b * a ≠ c * a ↔ b ≠ c :=
(mul_left_injective a).ne_iff

end right_cancel_semigroup

/-- Typeclass for expressing that a type `M` with multiplication and a one satisfies
`1 * a = a` and `a * 1 = a` for all `a : M`. -/
@[ancestor has_one has_mul]
class mul_one_class (M : Type u) extends has_one M, has_mul M :=
(one_mul : ∀ (a : M), 1 * a = a)
(mul_one : ∀ (a : M), a * 1 = a)

/-- Typeclass for expressing that a type `M` with addition and a zero satisfies
`0 + a = a` and `a + 0 = a` for all `a : M`. -/
@[ancestor has_zero has_add]
class add_zero_class (M : Type u) extends has_zero M, has_add M :=
(zero_add : ∀ (a : M), 0 + a = a)
(add_zero : ∀ (a : M), a + 0 = a)

attribute [to_additive] mul_one_class

@[ext, to_additive]
lemma mul_one_class.ext {M : Type u} : ∀ ⦃m₁ m₂ : mul_one_class M⦄, m₁.mul = m₂.mul → m₁ = m₂ :=
begin
  rintros ⟨one₁, mul₁, one_mul₁, mul_one₁⟩ ⟨one₂, mul₂, one_mul₂, mul_one₂⟩ (rfl : mul₁ = mul₂),
  congr,
  exact (one_mul₂ one₁).symm.trans (mul_one₁ one₂),
end

section mul_one_class
variables {M : Type u} [mul_one_class M]

@[ematch, simp, to_additive]
lemma one_mul : ∀ a : M, 1 * a = a :=
mul_one_class.one_mul

@[ematch, simp, to_additive]
lemma mul_one : ∀ a : M, a * 1 = a :=
mul_one_class.mul_one

@[to_additive]
instance mul_one_class.to_is_left_id : is_left_id M (*) 1 :=
⟨ mul_one_class.one_mul ⟩

@[to_additive]
instance mul_one_class.to_is_right_id : is_right_id M (*) 1 :=
⟨ mul_one_class.mul_one ⟩

end mul_one_class

section
variables {M : Type u}

-- use `x * npow_rec n x` and not `npow_rec n x * x` in the definition to make sure that
-- definitional unfolding of `npow_rec` is blocked, to avoid deep recursion issues.
/-- The fundamental power operation in a monoid. `npow_rec n a = a*a*...*a` n times.
Use instead `a ^ n`,  which has better definitional behavior. -/
def npow_rec [has_one M] [has_mul M] : ℕ → M → M
| 0     a := 1
| (n+1) a := a * npow_rec n a

/-- The fundamental scalar multiplication in an additive monoid. `nsmul_rec n a = a+a+...+a` n
times. Use instead `n • a`, which has better definitional behavior. -/
def nsmul_rec [has_zero M] [has_add M] : ℕ → M → M
| 0     a := 0
| (n+1) a := a + nsmul_rec n a

attribute [to_additive] npow_rec

end

/-- Suppose that one can put two mathematical structures on a type, a rich one `R` and a poor one
`P`, and that one can deduce the poor structure from the rich structure through a map `F` (called a
forgetful functor) (think `R = metric_space` and `P = topological_space`). A possible
implementation would be to have a type class `rich` containing a field `R`, a type class `poor`
containing a field `P`, and an instance from `rich` to `poor`. However, this creates diamond
problems, and a better approach is to let `rich` extend `poor` and have a field saying that
`F R = P`.

To illustrate this, consider the pair `metric_space` / `topological_space`. Consider the topology
on a product of two metric spaces. With the first approach, it could be obtained by going first from
each metric space to its topology, and then taking the product topology. But it could also be
obtained by considering the product metric space (with its sup distance) and then the topology
coming from this distance. These would be the same topology, but not definitionally, which means
that from the point of view of Lean's kernel, there would be two different `topological_space`
instances on the product. This is not compatible with the way instances are designed and used:
there should be at most one instance of a kind on each type. This approach has created an instance
diamond that does not commute definitionally.

The second approach solves this issue. Now, a metric space contains both a distance, a topology, and
a proof that the topology coincides with the one coming from the distance. When one defines the
product of two metric spaces, one uses the sup distance and the product topology, and one has to
give the proof that the sup distance induces the product topology. Following both sides of the
instance diamond then gives rise (definitionally) to the product topology on the product space.

Another approach would be to have the rich type class take the poor type class as an instance
parameter. It would solve the diamond problem, but it would lead to a blow up of the number
of type classes one would need to declare to work with complicated classes, say a real inner
product space, and would create exponential complexity when working with products of
such complicated spaces, that are avoided by bundling things carefully as above.

Note that this description of this specific case of the product of metric spaces is oversimplified
compared to mathlib, as there is an intermediate typeclass between `metric_space` and
`topological_space` called `uniform_space`. The above scheme is used at both levels, embedding a
topology in the uniform space structure, and a uniform structure in the metric space structure.

Note also that, when `P` is a proposition, there is no such issue as any two proofs of `P` are
definitionally equivalent in Lean.

To avoid boilerplate, there are some designs that can automatically fill the poor fields when
creating a rich structure if one doesn't want to do something special about them. For instance,
in the definition of metric spaces, default tactics fill the uniform space fields if they are
not given explicitly. One can also have a helper function creating the rich structure from a
structure with fewer fields, where the helper function fills the remaining fields. See for instance
`uniform_space.of_core` or `real_inner_product.of_core`.

For more details on this question, called the forgetful inheritance pattern, see [Competing
inheritance paths in dependent type theory: a case study in functional
analysis](https://hal.inria.fr/hal-02463336).
-/
library_note "forgetful inheritance"

/-- `try_refl_tac` solves goals of the form `∀ a b, f a b = g a b`,
if they hold by definition. -/
meta def try_refl_tac : tactic unit := `[intros; refl]

/-!
### Design note on `add_monoid` and `monoid`

An `add_monoid` has a natural `ℕ`-action, defined by `n • a = a + ... + a`, that we want to declare
as an instance as it makes it possible to use the language of linear algebra. However, there are
often other natural `ℕ`-actions. For instance, for any semiring `R`, the space of polynomials
`polynomial R` has a natural `R`-action defined by multiplication on the coefficients. This means
that `polynomial ℕ` would have two natural `ℕ`-actions, which are equal but not defeq. The same
goes for linear maps, tensor products, and so on (and even for `ℕ` itself).

To solve this issue, we embed an `ℕ`-action in the definition of an `add_monoid` (which is by
default equal to the naive action `a + ... + a`, but can be adjusted when needed), and declare
a `has_scalar ℕ α` instance using this action. See Note [forgetful inheritance] for more
explanations on this pattern.

For example, when we define `polynomial R`, then we declare the `ℕ`-action to be by multiplication
on each coefficient (using the `ℕ`-action on `R` that comes from the fact that `R` is
an `add_monoid`). In this way, the two natural `has_scalar ℕ (polynomial ℕ)` instances are defeq.

The tactic `to_additive` transfers definitions and results from multiplicative monoids to additive
monoids. To work, it has to map fields to fields. This means that we should also add corresponding
fields to the multiplicative structure `monoid`, which could solve defeq problems for powers if
needed. These problems do not come up in practice, so most of the time we will not need to adjust
the `npow` field when defining multiplicative objects.

A basic theory for the power function on monoids and the `ℕ`-action on additive monoids is built in
the file `algebra.group_power.basic`. For now, we only register the most basic properties that we
need right away.

In the definition, we use `n.succ` instead of `n + 1` in the `nsmul_succ'` and `npow_succ'` fields
to make sure that `to_additive` is not confused (otherwise, it would try to convert `1 : ℕ`
to `0 : ℕ`).
-/

/-- An `add_monoid` is an `add_semigroup` with an element `0` such that `0 + a = a + 0 = a`. -/
@[ancestor add_semigroup add_zero_class]
class add_monoid (M : Type u) extends add_semigroup M, add_zero_class M :=
(nsmul : ℕ → M → M := nsmul_rec)
(nsmul_zero' : ∀ x, nsmul 0 x = 0 . try_refl_tac)
(nsmul_succ' : ∀ (n : ℕ) x, nsmul n.succ x = x + nsmul n x . try_refl_tac)

/-- A `monoid` is a `semigroup` with an element `1` such that `1 * a = a * 1 = a`. -/
@[ancestor semigroup mul_one_class, to_additive]
class monoid (M : Type u) extends semigroup M, mul_one_class M :=
(npow : ℕ → M → M := npow_rec)
(npow_zero' : ∀ x, npow 0 x = 1 . try_refl_tac)
(npow_succ' : ∀ (n : ℕ) x, npow n.succ x = x * npow n x . try_refl_tac)

instance monoid.has_pow {M : Type*} [monoid M] : has_pow M ℕ := ⟨λ x n, monoid.npow n x⟩

instance add_monoid.has_scalar_nat {M : Type*} [add_monoid M] : has_scalar ℕ M :=
⟨add_monoid.nsmul⟩

attribute [to_additive add_monoid.has_scalar_nat] monoid.has_pow

section

variables {M : Type*} [monoid M]

@[simp, to_additive nsmul_eq_smul]
lemma npow_eq_pow (n : ℕ) (x : M) : monoid.npow n x = x^n := rfl

-- the attributes are intentionally out of order. `zero_smul` proves `zero_nsmul`.
@[to_additive zero_nsmul, simp]
theorem pow_zero (a : M) : a^0 = 1 := monoid.npow_zero' _

@[to_additive succ_nsmul]
theorem pow_succ (a : M) (n : ℕ) : a^(n+1) = a * a^n := monoid.npow_succ' n a

end

section monoid
variables {M : Type u} [monoid M]

@[to_additive]
lemma left_inv_eq_right_inv {a b c : M} (hba : b * a = 1) (hac : a * c = 1) : b = c :=
by rw [←one_mul c, ←hba, mul_assoc, hac, mul_one b]

end monoid

/-- An additive commutative monoid is an additive monoid with commutative `(+)`. -/
@[protect_proj, ancestor add_monoid add_comm_semigroup]
class add_comm_monoid (M : Type u) extends add_monoid M, add_comm_semigroup M

/-- A commutative monoid is a monoid with commutative `(*)`. -/
@[protect_proj, ancestor monoid comm_semigroup, to_additive]
class comm_monoid (M : Type u) extends monoid M, comm_semigroup M

section left_cancel_monoid

/-- An additive monoid in which addition is left-cancellative.
Main examples are `ℕ` and groups. This is the right typeclass for many sum lemmas, as having a zero
is useful to define the sum over the empty set, so `add_left_cancel_semigroup` is not enough. -/
@[protect_proj, ancestor add_left_cancel_semigroup add_monoid]
class add_left_cancel_monoid (M : Type u) extends add_left_cancel_semigroup M, add_monoid M

/-- A monoid in which multiplication is left-cancellative. -/
@[protect_proj, ancestor left_cancel_semigroup monoid, to_additive add_left_cancel_monoid]
class left_cancel_monoid (M : Type u) extends left_cancel_semigroup M, monoid M

end left_cancel_monoid

section right_cancel_monoid

/-- An additive monoid in which addition is right-cancellative.
Main examples are `ℕ` and groups. This is the right typeclass for many sum lemmas, as having a zero
is useful to define the sum over the empty set, so `add_right_cancel_semigroup` is not enough. -/
@[protect_proj, ancestor add_right_cancel_semigroup add_monoid]
class add_right_cancel_monoid (M : Type u) extends add_right_cancel_semigroup M, add_monoid M

/-- A monoid in which multiplication is right-cancellative. -/
@[protect_proj, ancestor right_cancel_semigroup monoid, to_additive add_right_cancel_monoid]
class right_cancel_monoid (M : Type u) extends right_cancel_semigroup M, monoid M

end right_cancel_monoid

section cancel_monoid

/-- An additive monoid in which addition is cancellative on both sides.
Main examples are `ℕ` and groups. This is the right typeclass for many sum lemmas, as having a zero
is useful to define the sum over the empty set, so `add_right_cancel_semigroup` is not enough. -/
@[protect_proj, ancestor add_left_cancel_monoid add_right_cancel_monoid]
class add_cancel_monoid (M : Type u)
  extends add_left_cancel_monoid M, add_right_cancel_monoid M

/-- A monoid in which multiplication is cancellative. -/
@[protect_proj, ancestor left_cancel_monoid right_cancel_monoid, to_additive add_cancel_monoid]
class cancel_monoid (M : Type u) extends left_cancel_monoid M, right_cancel_monoid M

/-- Commutative version of add_cancel_monoid. -/
@[protect_proj, ancestor add_left_cancel_monoid add_comm_monoid]
class add_cancel_comm_monoid (M : Type u) extends add_left_cancel_monoid M, add_comm_monoid M

/-- Commutative version of cancel_monoid. -/
@[protect_proj, ancestor left_cancel_monoid comm_monoid, to_additive add_cancel_comm_monoid]
class cancel_comm_monoid (M : Type u) extends left_cancel_monoid M, comm_monoid M

@[priority 100, to_additive] -- see Note [lower instance priority]
instance cancel_comm_monoid.to_cancel_monoid (M : Type u) [cancel_comm_monoid M] :
  cancel_monoid M :=
{ mul_right_cancel := λ a b c h, mul_left_cancel $ by rw [mul_comm, h, mul_comm],
  .. ‹cancel_comm_monoid M› }

end cancel_monoid

/-- The fundamental power operation in a group. `zpow_rec n a = a*a*...*a` n times, for integer `n`.
Use instead `a ^ n`,  which has better definitional behavior. -/
def zpow_rec {M : Type*} [has_one M] [has_mul M] [has_inv M] : ℤ → M → M
| (int.of_nat n) a := npow_rec n a
| -[1+ n]    a := (npow_rec n.succ a) ⁻¹

/-- The fundamental scalar multiplication in an additive group. `zsmul_rec n a = a+a+...+a` n
times, for integer `n`. Use instead `n • a`, which has better definitional behavior. -/
def zsmul_rec {M : Type*} [has_zero M] [has_add M] [has_neg M]: ℤ → M → M
| (int.of_nat n) a := nsmul_rec n a
| -[1+ n]    a := - (nsmul_rec n.succ a)

attribute [to_additive] zpow_rec

/-- A `div_inv_monoid` is a `monoid` with operations `/` and `⁻¹` satisfying
`div_eq_mul_inv : ∀ a b, a / b = a * b⁻¹`.

This is the immediate common ancestor of `group` and `group_with_zero`,
in order to deduplicate the name `div_eq_mul_inv`.
The default for `div` is such that `a / b = a * b⁻¹` holds by definition.

Adding `div` as a field rather than defining `a / b := a * b⁻¹` allows us to
avoid certain classes of unification failures, for example:
Let `foo X` be a type with a `∀ X, has_div (foo X)` instance but no
`∀ X, has_inv (foo X)`, e.g. when `foo X` is a `euclidean_domain`. Suppose we
also have an instance `∀ X [cromulent X], group_with_zero (foo X)`. Then the
`(/)` coming from `group_with_zero_has_div` cannot be definitionally equal to
the `(/)` coming from `foo.has_div`.

In the same way, adding a `zpow` field makes it possible to avoid definitional failures
in diamonds. See the definition of `monoid` and Note [forgetful inheritance] for more
explanations on this.
-/
@[protect_proj, ancestor monoid has_inv has_div]
class div_inv_monoid (G : Type u) extends monoid G, has_inv G, has_div G :=
(div := λ a b, a * b⁻¹)
(div_eq_mul_inv : ∀ a b : G, a / b = a * b⁻¹ . try_refl_tac)
(zpow : ℤ → G → G := zpow_rec)
(zpow_zero' : ∀ (a : G), zpow 0 a = 1 . try_refl_tac)
(zpow_succ' :
  ∀ (n : ℕ) (a : G), zpow (int.of_nat n.succ) a = a * zpow (int.of_nat n) a . try_refl_tac)
(zpow_neg' :
  ∀ (n : ℕ) (a : G), zpow (-[1+ n]) a = (zpow n.succ a)⁻¹ . try_refl_tac)

/-- A `sub_neg_monoid` is an `add_monoid` with unary `-` and binary `-` operations
satisfying `sub_eq_add_neg : ∀ a b, a - b = a + -b`.

The default for `sub` is such that `a - b = a + -b` holds by definition.

Adding `sub` as a field rather than defining `a - b := a + -b` allows us to
avoid certain classes of unification failures, for example:
Let `foo X` be a type with a `∀ X, has_sub (foo X)` instance but no
`∀ X, has_neg (foo X)`. Suppose we also have an instance
`∀ X [cromulent X], add_group (foo X)`. Then the `(-)` coming from
`add_group.has_sub` cannot be definitionally equal to the `(-)` coming from
`foo.has_sub`.

In the same way, adding a `zsmul` field makes it possible to avoid definitional failures
in diamonds. See the definition of `add_monoid` and Note [forgetful inheritance] for more
explanations on this.
-/
@[protect_proj, ancestor add_monoid has_neg has_sub]
class sub_neg_monoid (G : Type u) extends add_monoid G, has_neg G, has_sub G :=
(sub := λ a b, a + -b)
(sub_eq_add_neg : ∀ a b : G, a - b = a + -b . try_refl_tac)
(zsmul : ℤ → G → G := zsmul_rec)
(zsmul_zero' : ∀ (a : G), zsmul 0 a = 0 . try_refl_tac)
(zsmul_succ' :
  ∀ (n : ℕ) (a : G), zsmul (int.of_nat n.succ) a = a + zsmul (int.of_nat n) a . try_refl_tac)
(zsmul_neg' :
  ∀ (n : ℕ) (a : G), zsmul (-[1+ n]) a = - (zsmul n.succ a) . try_refl_tac)

attribute [to_additive sub_neg_monoid] div_inv_monoid

instance div_inv_monoid.has_pow {M} [div_inv_monoid M] : has_pow M ℤ :=
⟨λ x n, div_inv_monoid.zpow n x⟩

instance sub_neg_monoid.has_scalar_int {M} [sub_neg_monoid M] : has_scalar ℤ M :=
⟨sub_neg_monoid.zsmul⟩

attribute [to_additive sub_neg_monoid.has_scalar_int] div_inv_monoid.has_pow

section

variables {G : Type*} [div_inv_monoid G]

@[simp, to_additive zsmul_eq_smul]
lemma zpow_eq_pow (n : ℤ) (x : G) : div_inv_monoid.zpow n x = x^n := rfl

@[simp, to_additive zero_zsmul]
theorem zpow_zero (a : G) : a ^ (0:ℤ) = 1 := div_inv_monoid.zpow_zero' a

@[simp, norm_cast, to_additive coe_nat_zsmul]
theorem zpow_coe_nat (a : G) : ∀ n : ℕ, a ^ (n:ℤ) = a ^ n
| 0 := (zpow_zero _).trans (pow_zero _).symm
| (n + 1) :=
  calc a ^ (↑(n + 1) : ℤ) = a * a ^ (n : ℤ) : div_inv_monoid.zpow_succ' _ _
                      ... = a * a ^ n       : congr_arg ((*) a) (zpow_coe_nat n)
                      ... = a ^ (n + 1)     : (pow_succ _ _).symm

@[to_additive of_nat_zsmul]
theorem zpow_of_nat (a : G) (n : ℕ) : a ^ (int.of_nat n) = a ^ n :=
zpow_coe_nat a n

@[simp, to_additive]
theorem zpow_neg_succ_of_nat (a : G) (n : ℕ) : a ^ -[1+n] = (a ^ (n + 1))⁻¹ :=
by { rw ← zpow_coe_nat, exact div_inv_monoid.zpow_neg' n a }

end

@[to_additive]
lemma div_eq_mul_inv {G : Type u} [div_inv_monoid G] :
  ∀ a b : G, a / b = a * b⁻¹ :=
div_inv_monoid.div_eq_mul_inv

/-- A `group` is a `monoid` with an operation `⁻¹` satisfying `a⁻¹ * a = 1`.

There is also a division operation `/` such that `a / b = a * b⁻¹`,
with a default so that `a / b = a * b⁻¹` holds by definition.
-/
@[protect_proj, ancestor div_inv_monoid]
class group (G : Type u) extends div_inv_monoid G :=
(mul_left_inv : ∀ a : G, a⁻¹ * a = 1)

/-- An `add_group` is an `add_monoid` with a unary `-` satisfying `-a + a = 0`.

There is also a binary operation `-` such that `a - b = a + -b`,
with a default so that `a - b = a + -b` holds by definition.
-/
@[protect_proj, ancestor sub_neg_monoid]
class add_group (A : Type u) extends sub_neg_monoid A :=
(add_left_neg : ∀ a : A, -a + a = 0)

attribute [to_additive] group

/-- Abbreviation for `@div_inv_monoid.to_monoid _ (@group.to_div_inv_monoid _ _)`.

Useful because it corresponds to the fact that `Grp` is a subcategory of `Mon`.
Not an instance since it duplicates `@div_inv_monoid.to_monoid _ (@group.to_div_inv_monoid _ _)`.
See note [reducible non-instances]. -/
@[reducible, to_additive
"Abbreviation for `@sub_neg_monoid.to_add_monoid _ (@add_group.to_sub_neg_monoid _ _)`.

Useful because it corresponds to the fact that `AddGroup` is a subcategory of `AddMon`.
Not an instance since it duplicates
`@sub_neg_monoid.to_add_monoid _ (@add_group.to_sub_neg_monoid _ _)`."]
def group.to_monoid (G : Type u) [group G] : monoid G :=
@div_inv_monoid.to_monoid _ (@group.to_div_inv_monoid _ _)

section group
variables {G : Type u} [group G] {a b c : G}

@[simp, to_additive]
lemma mul_left_inv : ∀ a : G, a⁻¹ * a = 1 :=
group.mul_left_inv

@[to_additive] lemma inv_mul_self (a : G) : a⁻¹ * a = 1 := mul_left_inv a

@[simp, to_additive]
lemma inv_mul_cancel_left (a b : G) : a⁻¹ * (a * b) = b :=
by rw [← mul_assoc, mul_left_inv, one_mul]

@[simp, to_additive]
lemma inv_eq_of_mul_eq_one (h : a * b = 1) : a⁻¹ = b :=
left_inv_eq_right_inv (inv_mul_self a) h

@[simp, to_additive]
lemma inv_inv (a : G) : (a⁻¹)⁻¹ = a :=
inv_eq_of_mul_eq_one (mul_left_inv a)

@[simp, to_additive]
lemma mul_right_inv (a : G) : a * a⁻¹ = 1 :=
have a⁻¹⁻¹ * a⁻¹ = 1 := mul_left_inv a⁻¹,
by rwa [inv_inv] at this

@[to_additive] lemma mul_inv_self (a : G) : a * a⁻¹ = 1 := mul_right_inv a

@[simp, to_additive]
lemma mul_inv_cancel_right (a b : G) : a * b * b⁻¹ = a :=
by rw [mul_assoc, mul_right_inv, mul_one]

@[priority 100, to_additive]    -- see Note [lower instance priority]
instance group.to_cancel_monoid : cancel_monoid G :=
{ mul_right_cancel := λ a b c h, by rw [← mul_inv_cancel_right a b, h, mul_inv_cancel_right],
  mul_left_cancel := λ a b c h, by rw [← inv_mul_cancel_left a b, h, inv_mul_cancel_left],
  ..‹group G› }

end group

@[to_additive]
lemma group.to_div_inv_monoid_injective {G : Type*} :
  function.injective (@group.to_div_inv_monoid G) :=
begin
  rintros ⟨⟩ ⟨⟩ h,
  replace h := div_inv_monoid.mk.inj h,
  dsimp at h,
  rcases h with ⟨rfl, rfl, rfl, rfl, rfl, rfl⟩,
  refl
end

/-- A commutative group is a group with commutative `(*)`. -/
@[protect_proj, ancestor group comm_monoid]
class comm_group (G : Type u) extends group G, comm_monoid G
/-- An additive commutative group is an additive group with commutative `(+)`. -/
@[protect_proj, ancestor add_group add_comm_monoid]
class add_comm_group (G : Type u) extends add_group G, add_comm_monoid G
attribute [to_additive] comm_group
attribute [instance, priority 300] add_comm_group.to_add_comm_monoid

@[to_additive]
lemma comm_group.to_group_injective {G : Type u} :
  function.injective (@comm_group.to_group G) :=
begin
  rintros ⟨⟩ ⟨⟩ h,
  replace h := group.mk.inj h,
  dsimp at h,
  rcases h with ⟨rfl, rfl, rfl, rfl, rfl, rfl⟩,
  refl
end

section comm_group

variables {G : Type u} [comm_group G]

@[priority 100, to_additive]    -- see Note [lower instance priority]
instance comm_group.to_cancel_comm_monoid : cancel_comm_monoid G :=
{ ..‹comm_group G›,
  ..group.to_cancel_monoid }

end comm_group


/-
Copyright (c) 2022 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import ring_theory.algebraic_independent
import field_theory.is_alg_closed.basic
import data.polynomial.cardinal
import data.mv_polynomial.cardinal
import data.zmod.algebra
/-!
# Classification of Algebraically closed fields

This file contains results related to classifying algebraically closed fields.

## Main statements

* `is_alg_closed.equiv_of_transcendence_basis` Two fields with the same characteristic and the same
  cardinality of transcendence basis are isomorphic.
* `is_alg_closed.ring_equiv_of_cardinal_eq_of_char_eq` Two uncountable algebraically closed fields
  are isomorphic if they have the same characteristic and the same cardinality.
-/
universe u

open_locale cardinal polynomial
open cardinal

section algebraic_closure

namespace algebra.is_algebraic

variables (R L : Type u) [comm_ring R] [comm_ring L] [is_domain L] [algebra R L]
variables [no_zero_smul_divisors R L] (halg : algebra.is_algebraic R L)

lemma cardinal_mk_le_sigma_polynomial :
  #L ≤ #(Σ p : R[X], { x : L // x ∈ (p.map (algebra_map R L)).roots }) :=
@mk_le_of_injective L (Σ p : R[X], { x : L | x ∈ (p.map (algebra_map R L)).roots })
  (λ x : L, let p := classical.indefinite_description _ (halg x) in
    ⟨p.1, x,
      begin
      dsimp,
      have h : p.1.map (algebra_map R L) ≠ 0,
      { rw [ne.def, ← polynomial.degree_eq_bot, polynomial.degree_map_eq_of_injective
          (no_zero_smul_divisors.algebra_map_injective R L), polynomial.degree_eq_bot],
        exact p.2.1 },
      erw [polynomial.mem_roots h, polynomial.is_root, polynomial.eval_map,
        ← polynomial.aeval_def, p.2.2],
      end⟩) (λ x y, begin
    intro h,
    simp only at h,
    refine (subtype.heq_iff_coe_eq _).1 h.2,
    simp only [h.1, iff_self, forall_true_iff]
  end)

/--The cardinality of an algebraic extension is at most the maximum of the cardinality
of the base ring or `ℵ₀` -/
lemma cardinal_mk_le_max : #L ≤ max (#R) ℵ₀ :=
calc #L ≤ #(Σ p : R[X], { x : L // x ∈ (p.map (algebra_map R L)).roots }) :
  cardinal_mk_le_sigma_polynomial R L halg
... = cardinal.sum (λ p : R[X], #{ x : L | x ∈ (p.map (algebra_map R L)).roots }) :
  by rw ← mk_sigma; refl
... ≤ cardinal.sum.{u u} (λ p : R[X], ℵ₀) :
  sum_le_sum _ _ $ λ p, (multiset.finite_to_set _).lt_aleph_0.le
... = #R[X] * ℵ₀ : sum_const' _ _
... ≤ max (max (#R[X]) ℵ₀) ℵ₀ : mul_le_max _ _
... ≤ max (max (max (#R) ℵ₀) ℵ₀) ℵ₀ :
  max_le_max (max_le_max polynomial.cardinal_mk_le_max le_rfl) le_rfl
... = max (#R) ℵ₀ : by simp only [max_assoc, max_comm ℵ₀, max_left_comm ℵ₀, max_self]

end algebra.is_algebraic

end algebraic_closure

namespace is_alg_closed

section classification

noncomputable theory

variables {R L K : Type*} [comm_ring R]
variables [field K] [algebra R K]
variables [field L] [algebra R L]
variables {ι : Type*} (v : ι → K)
variables {κ : Type*} (w : κ → L)

variables (hv : algebraic_independent R v)

lemma is_alg_closure_of_transcendence_basis [is_alg_closed K] (hv : is_transcendence_basis R v) :
  is_alg_closure (algebra.adjoin R (set.range v)) K :=
by letI := ring_hom.domain_nontrivial (algebra_map R K); exact
{ alg_closed := by apply_instance,
  algebraic := hv.is_algebraic }

variables (hw : algebraic_independent R w)

/-- setting `R` to be `zmod (ring_char R)` this result shows that if two algebraically
closed fields have equipotent transcendence bases and the same characteristic then they are
isomorphic. -/
def equiv_of_transcendence_basis [is_alg_closed K] [is_alg_closed L] (e : ι ≃ κ)
  (hv : is_transcendence_basis R v) (hw : is_transcendence_basis R w) : K ≃+* L :=
begin
  letI := is_alg_closure_of_transcendence_basis v hv;
  letI := is_alg_closure_of_transcendence_basis w hw;
  have e : algebra.adjoin R (set.range v) ≃+* algebra.adjoin R (set.range w),
  { refine hv.1.aeval_equiv.symm.to_ring_equiv.trans _,
    refine (alg_equiv.of_alg_hom
      (mv_polynomial.rename e)
      (mv_polynomial.rename e.symm)
      _ _).to_ring_equiv.trans _,
    { ext, simp },
    { ext, simp },
    exact hw.1.aeval_equiv.to_ring_equiv },
  exact is_alg_closure.equiv_of_equiv K L e
end

end classification

section cardinal

variables {R L K : Type u} [comm_ring R]
variables [field K] [algebra R K] [is_alg_closed K]
variables {ι : Type u} (v : ι → K)
variable (hv : is_transcendence_basis R v)

lemma cardinal_le_max_transcendence_basis (hv : is_transcendence_basis R v) :
  #K ≤ max (max (#R) (#ι)) ℵ₀ :=
calc #K ≤ max (#(algebra.adjoin R (set.range v))) ℵ₀ :
  by letI := is_alg_closure_of_transcendence_basis v hv;
   exact algebra.is_algebraic.cardinal_mk_le_max _ _ is_alg_closure.algebraic
... = max (#(mv_polynomial ι R)) ℵ₀ : by rw [cardinal.eq.2 ⟨(hv.1.aeval_equiv).to_equiv⟩]
... ≤ max (max (max (#R) (#ι)) ℵ₀) ℵ₀ : max_le_max mv_polynomial.cardinal_mk_le_max le_rfl
... = _ : by simp [max_assoc]

/-- If `K` is an uncountable algebraically closed field, then its
cardinality is the same as that of a transcendence basis. -/
lemma cardinal_eq_cardinal_transcendence_basis_of_aleph_0_lt [nontrivial R]
  (hv : is_transcendence_basis R v) (hR : #R ≤ ℵ₀) (hK : ℵ₀ < #K) : #K = #ι :=
have ℵ₀ ≤ #ι,
  from le_of_not_lt (λ h,
    not_le_of_gt hK $ calc
      #K ≤ max (max (#R) (#ι)) ℵ₀ : cardinal_le_max_transcendence_basis v hv
     ... ≤ _ : max_le (max_le hR (le_of_lt h)) le_rfl),
le_antisymm
  (calc #K ≤ max (max (#R) (#ι)) ℵ₀ : cardinal_le_max_transcendence_basis v hv
       ... = #ι : begin
         rw [max_eq_left, max_eq_right],
         { exact le_trans hR this },
         { exact le_max_of_le_right this }
       end)
  (mk_le_of_injective (show function.injective v, from hv.1.injective))

end cardinal

variables {K L : Type} [field K] [field L] [is_alg_closed K] [is_alg_closed L]

/-- Two uncountable algebraically closed fields of characteristic zero are isomorphic
if they have the same cardinality. -/
@[nolint def_lemma] lemma ring_equiv_of_cardinal_eq_of_char_zero [char_zero K] [char_zero L]
  (hK : ℵ₀ < #K) (hKL : #K = #L) : K ≃+* L :=
begin
  apply classical.choice,
  cases exists_is_transcendence_basis ℤ
    (show function.injective (algebra_map ℤ K),
      from int.cast_injective) with s hs,
  cases exists_is_transcendence_basis ℤ
    (show function.injective (algebra_map ℤ L),
      from int.cast_injective) with t ht,
  have : #s = #t,
  { rw [← cardinal_eq_cardinal_transcendence_basis_of_aleph_0_lt _ hs (le_of_eq mk_int) hK,
        ← cardinal_eq_cardinal_transcendence_basis_of_aleph_0_lt _ ht (le_of_eq mk_int), hKL],
    rwa ← hKL },
  cases cardinal.eq.1 this with e,
  exact ⟨equiv_of_transcendence_basis _ _ e hs ht⟩
end

private lemma ring_equiv_of_cardinal_eq_of_char_p (p : ℕ) [fact p.prime]
  [char_p K p] [char_p L p] (hK : ℵ₀ < #K) (hKL : #K = #L) : K ≃+* L :=
begin
  apply classical.choice,
  cases exists_is_transcendence_basis (zmod p)
    (show function.injective (algebra_map (zmod p) K),
      from ring_hom.injective _) with s hs,
  cases exists_is_transcendence_basis (zmod p)
    (show function.injective (algebra_map (zmod p) L),
      from ring_hom.injective _) with t ht,
  have : #s = #t,
  { rw [← cardinal_eq_cardinal_transcendence_basis_of_aleph_0_lt _ hs
      (lt_aleph_0_of_finite (zmod p)).le hK,
        ← cardinal_eq_cardinal_transcendence_basis_of_aleph_0_lt _ ht
      (lt_aleph_0_of_finite (zmod p)).le, hKL],
    rwa ← hKL },
  cases cardinal.eq.1 this with e,
  exact ⟨equiv_of_transcendence_basis _ _ e hs ht⟩
end

/-- Two uncountable algebraically closed fields are isomorphic
if they have the same cardinality and the same characteristic. -/
@[nolint def_lemma] lemma ring_equiv_of_cardinal_eq_of_char_eq (p : ℕ) [char_p K p] [char_p L p]
  (hK : ℵ₀ < #K) (hKL : #K = #L) : K ≃+* L :=
begin
  apply classical.choice,
  rcases char_p.char_is_prime_or_zero K p with hp | hp,
  { haveI : fact p.prime := ⟨hp⟩,
    exact ⟨ring_equiv_of_cardinal_eq_of_char_p p hK hKL⟩ },
  { rw [hp] at *,
    resetI,
    letI : char_zero K := char_p.char_p_to_char_zero K,
    letI : char_zero L := char_p.char_p_to_char_zero L,
    exact ⟨ring_equiv_of_cardinal_eq_of_char_zero hK hKL⟩ }
end

end is_alg_closed


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

import data.nat.fib
import tactic.linarith

/-!
# IMO 1981 Q3

Determine the maximum value of `m ^ 2 + n ^ 2`, where `m` and `n` are integers in
`{1, 2, ..., 1981}` and `(n ^ 2 - m * n - m ^ 2) ^ 2 = 1`.

The trick to this problem is that `m` and `n` have to be consecutive Fibonacci numbers,
because you can reduce any solution to a smaller one using the Fibonacci recurrence.
-/

/-
First, define the problem in terms of finding the maximum of a set.

We first generalize the problem to `{1, 2, ..., N}` and specialize to `N = 1981` at the very end.
-/

open int nat set
namespace imo1981_q3
variable (N : ℕ) -- N = 1981

@[mk_iff] structure problem_predicate (m n : ℤ) : Prop :=
(m_range : m ∈ Ioc 0 (N : ℤ))
(n_range : n ∈ Ioc 0 (N : ℤ))
(eq_one : (n ^ 2 - m * n - m ^ 2) ^ 2 = 1)

def specified_set : set ℤ :=
{k : ℤ | ∃ m : ℤ, ∃ n : ℤ, k = m ^ 2 + n ^ 2 ∧ problem_predicate N m n}

/-
We want to reduce every solution to a smaller solution. Specifically,
we show that when `(m, n)` is a solution, `(n - m, m)` is also a solution,
except for the base case of `(1, 1)`.
-/
namespace problem_predicate
variable {N}

lemma m_le_n {m n : ℤ} (h1 : problem_predicate N m n) : m ≤ n :=
begin
  by_contradiction h2,
  have h3 : 1 = (n * (n - m) - m ^ 2) ^ 2,
  { calc 1 = (n ^ 2 - m * n - m ^ 2) ^ 2 : h1.eq_one.symm
       ... = (n * (n - m) - m ^ 2) ^ 2   : by ring },
  have h4 : n * (n - m) - m ^ 2 < -1, by nlinarith [h1.n_range.left],
  have h5 : 1 < (n * (n - m) - m ^ 2) ^ 2, by nlinarith,
  exact h5.ne h3
end

lemma eq_imp_1 {n : ℤ} (h1 : problem_predicate N n n) : n = 1 :=
begin
  have : n * (n * (n * n)) = 1,
  { calc _ = (n ^ 2 - n * n - n ^ 2) ^ 2 : by simp [sq, mul_assoc]
       ... = 1                           : h1.eq_one },
  exact eq_one_of_mul_eq_one_right h1.m_range.left.le this,
end

lemma reduction {m n : ℤ} (h1 : problem_predicate N m n) (h2 : 1 < n) :
problem_predicate N (n - m) m :=
begin
  obtain (rfl : m = n) | (h3 : m < n) := h1.m_le_n.eq_or_lt,
  { have h4 : m = 1, from h1.eq_imp_1,
    exact absurd h4.symm h2.ne },
  refine_struct { n_range := h1.m_range, .. },
  -- m_range:
  { have h5 : 0 < n - m, from sub_pos.mpr h3,
    have h6 : n - m < N,
    { calc _ < n : sub_lt_self n h1.m_range.left
         ... ≤ N : h1.n_range.right },
    exact ⟨h5, h6.le⟩ },
  -- eq_one:
  { calc _ = (n ^ 2 - m * n - m ^ 2) ^ 2 : by ring
       ... = 1                           : h1.eq_one },
end

end problem_predicate

/-
It will be convenient to have the lemmas above in their natural number form.
Most of these can be proved with the `norm_cast` family of tactics.
-/

def nat_predicate (m n : ℕ) : Prop := problem_predicate N ↑m ↑n

namespace nat_predicate
variable {N}

lemma m_le_n {m n : ℕ} (h1 : nat_predicate N m n) : m ≤ n :=
by exact_mod_cast h1.m_le_n

lemma eq_imp_1 {n : ℕ} (h1 : nat_predicate N n n) : n = 1 :=
by exact_mod_cast h1.eq_imp_1

lemma reduction {m n : ℕ} (h1 : nat_predicate N m n) (h2 : 1 < n) :
  nat_predicate N (n - m) m :=
have m ≤ n, from h1.m_le_n,
by exact_mod_cast h1.reduction (by exact_mod_cast h2)

lemma n_pos {m n : ℕ} (h1 : nat_predicate N m n) : 0 < n :=
by exact_mod_cast h1.n_range.left

lemma m_pos {m n : ℕ} (h1 : nat_predicate N m n) : 0 < m :=
by exact_mod_cast h1.m_range.left

lemma n_le_N {m n : ℕ} (h1 : nat_predicate N m n) : n ≤ N :=
by exact_mod_cast h1.n_range.right

/-
Now we can use induction to show that solutions must be Fibonacci numbers.
-/
lemma imp_fib {n : ℕ} : ∀ m : ℕ, nat_predicate N m n →
  ∃ k : ℕ, m = fib k ∧ n = fib (k + 1) :=
begin
  apply nat.strong_induction_on n _,
  intros n h1 m h2,
  have h3 : m ≤ n, from h2.m_le_n,
  obtain (rfl : 1 = n) | (h4 : 1 < n) := (succ_le_iff.mpr h2.n_pos).eq_or_lt,
  { use 1,
    have h5 : 1 ≤ m, from succ_le_iff.mpr h2.m_pos,
    simpa [fib_one, fib_two] using (h3.antisymm h5 : m = 1) },
  { obtain (rfl : m = n) | (h6 : m < n) := h3.eq_or_lt,
    { exact absurd h2.eq_imp_1 (ne_of_gt h4) },
    { have h7 : nat_predicate N (n - m) m, from h2.reduction h4,
      obtain ⟨k : ℕ, hnm : n - m = fib k, rfl : m = fib (k+1)⟩ := h1 m h6 (n - m) h7,
      use [k + 1, rfl],
      rw [fib_add_two, ← hnm, tsub_add_cancel_of_le h3] } }
end

end nat_predicate

/-
Next, we prove that if `N < fib K + fib (K+1)`, then the largest `m` and `n`
satisfying `nat_predicate m n N` are `fib K` and `fib (K+1)`, respectively.
-/

variables {K : ℕ} (HK : N < fib K + fib (K+1)) {N}
include HK

lemma m_n_bounds {m n : ℕ} (h1 : nat_predicate N m n) : m ≤ fib K ∧ n ≤ fib (K+1) :=
begin
  obtain ⟨k : ℕ, hm : m = fib k, hn : n = fib (k+1)⟩ := h1.imp_fib m,
  by_cases h2 : k < K + 1,
  { have h3 : k ≤ K, from lt_succ_iff.mp h2,
    split,
    { calc m = fib k : hm
         ... ≤ fib K : fib_mono h3, },
    { have h6 : k + 1 ≤ K + 1, from succ_le_succ h3,
      calc n = fib (k+1) : hn
         ... ≤ fib (K+1) : fib_mono h6 } },
  { have h7 : N < n,
    { have h8 : K + 2 ≤ k + 1, from succ_le_succ (not_lt.mp h2),
      rw ← fib_add_two at HK,
      calc N < fib (K+2) : HK
         ... ≤ fib (k+1) : fib_mono h8
         ... = n         : hn.symm, },
    have h9 : n ≤ N, from h1.n_le_N,
    exact absurd h7 h9.not_lt }
end

/-
We spell out the consequences of this result for `specified_set N` here.
-/

variables {M : ℕ} (HM : M = (fib K) ^ 2 + (fib (K+1)) ^ 2)
include HM

lemma k_bound {m n : ℤ} (h1 : problem_predicate N m n) : m ^ 2 + n ^ 2 ≤ M :=
begin
  have h2 : 0 ≤ m, from h1.m_range.left.le,
  have h3 : 0 ≤ n, from h1.n_range.left.le,
  rw [← nat_abs_of_nonneg h2, ← nat_abs_of_nonneg h3] at h1, clear h2 h3,
  obtain ⟨h4 : m.nat_abs ≤ fib K, h5 : n.nat_abs ≤ fib (K+1)⟩ := m_n_bounds HK h1,
  have h6 : m ^ 2 ≤ (fib K) ^ 2, from nat_abs_le_iff_sq_le.mp h4,
  have h7 : n ^ 2 ≤ (fib (K+1)) ^ 2, from nat_abs_le_iff_sq_le.mp h5,
  linarith
end

lemma solution_bound : ∀ {k : ℤ}, k ∈ specified_set N → k ≤ M
| _ ⟨_, _, rfl, h⟩ := k_bound HK HM h

theorem solution_greatest (H : problem_predicate N (fib K) (fib (K + 1))) :
  is_greatest (specified_set N) M :=
⟨⟨fib K, fib (K+1), by simp [HM], H⟩, λ k h, solution_bound HK HM h⟩

end imo1981_q3

open imo1981_q3

/-
Now we just have to demonstrate that 987 and 1597 are in fact the largest Fibonacci
numbers in this range, and thus provide the maximum of `specified_set`.
-/

theorem imo1981_q3 : is_greatest (specified_set 1981) 3524578 :=
begin
  have := λ h, @solution_greatest 1981 16 h 3524578,
  simp only [show fib (16:ℕ) = 987 ∧ fib (16+1:ℕ) = 1597,
    by norm_num [fib_add_two]] at this,
  apply_mod_cast this; norm_num [problem_predicate_iff],
end


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

! This file was ported from Lean 3 source module linear_algebra.affine_space.basis
! leanprover-community/mathlib commit 2de9c37fa71dde2f1c6feff19876dd6a7b1519f0
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.AffineSpace.Independent
import Mathbin.LinearAlgebra.Basis

/-!
# Affine bases and barycentric coordinates

Suppose `P` is an affine space modelled on the module `V` over the ring `k`, and `p : ι → P` is an
affine-independent family of points spanning `P`. Given this data, each point `q : P` may be written
uniquely as an affine combination: `q = w₀ p₀ + w₁ p₁ + ⋯` for some (finitely-supported) weights
`wᵢ`. For each `i : ι`, we thus have an affine map `P →ᵃ[k] k`, namely `q ↦ wᵢ`. This family of
maps is known as the family of barycentric coordinates. It is defined in this file.

## The construction

Fixing `i : ι`, and allowing `j : ι` to range over the values `j ≠ i`, we obtain a basis `bᵢ` of `V`
defined by `bᵢ j = p j -ᵥ p i`. Let `fᵢ j : V →ₗ[k] k` be the corresponding dual basis and let
`fᵢ = ∑ j, fᵢ j : V →ₗ[k] k` be the corresponding "sum of all coordinates" form. Then the `i`th
barycentric coordinate of `q : P` is `1 - fᵢ (q -ᵥ p i)`.

## Main definitions

 * `affine_basis`: a structure representing an affine basis of an affine space.
 * `affine_basis.coord`: the map `P →ᵃ[k] k` corresponding to `i : ι`.
 * `affine_basis.coord_apply_eq`: the behaviour of `affine_basis.coord i` on `p i`.
 * `affine_basis.coord_apply_ne`: the behaviour of `affine_basis.coord i` on `p j` when `j ≠ i`.
 * `affine_basis.coord_apply`: the behaviour of `affine_basis.coord i` on `p j` for general `j`.
 * `affine_basis.coord_apply_combination`: the characterisation of `affine_basis.coord i` in terms
    of affine combinations, i.e., `affine_basis.coord i (w₀ p₀ + w₁ p₁ + ⋯) = wᵢ`.

## TODO

 * Construct the affine equivalence between `P` and `{ f : ι →₀ k | f.sum = 1 }`.

-/

open Affine BigOperators

open Set

universe u₁ u₂ u₃ u₄

/-- An affine basis is a family of affine-independent points whose span is the top subspace. -/
@[protect_proj]
structure AffineBasis (ι : Type u₁) (k : Type u₂) {V : Type u₃} (P : Type u₄) [AddCommGroup V]
  [affine_space V P] [Ring k] [Module k V] where
  toFun : ι → P
  ind' : AffineIndependent k to_fun
  tot' : affineSpan k (range to_fun) = ⊤
#align affine_basis AffineBasis

variable {ι ι' k V P : Type _} [AddCommGroup V] [affine_space V P]

namespace AffineBasis

section Ring

variable [Ring k] [Module k V] (b : AffineBasis ι k P) {s : Finset ι} {i j : ι} (e : ι ≃ ι')

/-- The unique point in a single-point space is the simplest example of an affine basis. -/
instance : Inhabited (AffineBasis PUnit k PUnit) :=
  ⟨⟨id, affineIndependent_of_subsingleton k id, by simp⟩⟩

include V

instance funLike : FunLike (AffineBasis ι k P) ι fun _ => P
    where
  coe := AffineBasis.toFun
  coe_injective' f g h := by cases f <;> cases g <;> congr
#align affine_basis.fun_like AffineBasis.funLike

@[ext]
theorem ext {b₁ b₂ : AffineBasis ι k P} (h : (b₁ : ι → P) = b₂) : b₁ = b₂ :=
  FunLike.coe_injective h
#align affine_basis.ext AffineBasis.ext

theorem ind : AffineIndependent k b :=
  b.ind'
#align affine_basis.ind AffineBasis.ind

theorem tot : affineSpan k (range b) = ⊤ :=
  b.tot'
#align affine_basis.tot AffineBasis.tot

include b

protected theorem nonempty : Nonempty ι :=
  not_isEmpty_iff.mp fun hι => by
    simpa only [@range_eq_empty _ _ hι, AffineSubspace.span_empty, bot_ne_top] using b.tot
#align affine_basis.nonempty AffineBasis.nonempty

/-- Composition of an affine basis and an equivalence of index types. -/
def reindex (e : ι ≃ ι') : AffineBasis ι' k P :=
  ⟨b ∘ e.symm, b.ind.comp_embedding e.symm.toEmbedding,
    by
    rw [e.symm.surjective.range_comp]
    exact b.3⟩
#align affine_basis.reindex AffineBasis.reindex

@[simp, norm_cast]
theorem coe_reindex : ⇑(b.reindex e) = b ∘ e.symm :=
  rfl
#align affine_basis.coe_reindex AffineBasis.coe_reindex

@[simp]
theorem reindex_apply (i' : ι') : b.reindex e i' = b (e.symm i') :=
  rfl
#align affine_basis.reindex_apply AffineBasis.reindex_apply

@[simp]
theorem reindex_refl : b.reindex (Equiv.refl _) = b :=
  ext rfl
#align affine_basis.reindex_refl AffineBasis.reindex_refl

/-- Given an affine basis for an affine space `P`, if we single out one member of the family, we
obtain a linear basis for the model space `V`.

The linear basis corresponding to the singled-out member `i : ι` is indexed by `{j : ι // j ≠ i}`
and its `j`th element is `b j -ᵥ b i`. (See `basis_of_apply`.) -/
noncomputable def basisOf (i : ι) : Basis { j : ι // j ≠ i } k V :=
  Basis.mk ((affineIndependent_iff_linearIndependent_vsub k b i).mp b.ind)
    (by
      suffices
        Submodule.span k (range fun j : { x // x ≠ i } => b ↑j -ᵥ b i) = vectorSpan k (range b)
        by
        rw [this, ← direction_affineSpan, b.tot, AffineSubspace.direction_top]
        exact le_rfl
      conv_rhs => rw [← image_univ]
      rw [vectorSpan_image_eq_span_vsub_set_right_ne k b (mem_univ i)]
      congr
      ext v
      simp)
#align affine_basis.basis_of AffineBasis.basisOf

@[simp]
theorem basisOf_apply (i : ι) (j : { j : ι // j ≠ i }) : b.basisOf i j = b ↑j -ᵥ b i := by
  simp [basis_of]
#align affine_basis.basis_of_apply AffineBasis.basisOf_apply

@[simp]
theorem basisOf_reindex (i : ι') :
    (b.reindex e).basisOf i =
      (b.basisOf <| e.symm i).reindex (e.subtypeEquiv fun _ => e.eq_symm_apply.Not) :=
  by
  ext j
  simp
#align affine_basis.basis_of_reindex AffineBasis.basisOf_reindex

/-- The `i`th barycentric coordinate of a point. -/
noncomputable def coord (i : ι) : P →ᵃ[k] k
    where
  toFun q := 1 - (b.basisOf i).sumCoords (q -ᵥ b i)
  linear := -(b.basisOf i).sumCoords
  map_vadd' q v := by
    rw [vadd_vsub_assoc, LinearMap.map_add, vadd_eq_add, LinearMap.neg_apply,
      sub_add_eq_sub_sub_swap, add_comm, sub_eq_add_neg]
#align affine_basis.coord AffineBasis.coord

@[simp]
theorem linear_eq_sumCoords (i : ι) : (b.Coord i).linear = -(b.basisOf i).sumCoords :=
  rfl
#align affine_basis.linear_eq_sum_coords AffineBasis.linear_eq_sumCoords

@[simp]
theorem coord_reindex (i : ι') : (b.reindex e).Coord i = b.Coord (e.symm i) :=
  by
  ext
  classical simp [AffineBasis.coord]
#align affine_basis.coord_reindex AffineBasis.coord_reindex

@[simp]
theorem coord_apply_eq (i : ι) : b.Coord i (b i) = 1 := by
  simp only [coord, Basis.coe_sumCoords, LinearEquiv.map_zero, LinearEquiv.coe_coe, sub_zero,
    AffineMap.coe_mk, Finsupp.sum_zero_index, vsub_self]
#align affine_basis.coord_apply_eq AffineBasis.coord_apply_eq

@[simp]
theorem coord_apply_ne (h : i ≠ j) : b.Coord i (b j) = 0 := by
  rw [coord, AffineMap.coe_mk, ← Subtype.coe_mk j h.symm, ← b.basis_of_apply,
    Basis.sumCoords_self_apply, sub_self]
#align affine_basis.coord_apply_ne AffineBasis.coord_apply_ne

theorem coord_apply [DecidableEq ι] (i j : ι) : b.Coord i (b j) = if i = j then 1 else 0 := by
  cases eq_or_ne i j <;> simp [h]
#align affine_basis.coord_apply AffineBasis.coord_apply

@[simp]
theorem coord_apply_combination_of_mem (hi : i ∈ s) {w : ι → k} (hw : s.Sum w = 1) :
    b.Coord i (s.affineCombination k b w) = w i := by
  classical simp only [coord_apply, hi, Finset.affineCombination_eq_linear_combination, if_true,
      mul_boole, hw, Function.comp_apply, smul_eq_mul, s.sum_ite_eq,
      s.map_affine_combination b w hw]
#align affine_basis.coord_apply_combination_of_mem AffineBasis.coord_apply_combination_of_mem

@[simp]
theorem coord_apply_combination_of_not_mem (hi : i ∉ s) {w : ι → k} (hw : s.Sum w = 1) :
    b.Coord i (s.affineCombination k b w) = 0 := by
  classical simp only [coord_apply, hi, Finset.affineCombination_eq_linear_combination, if_false,
      mul_boole, hw, Function.comp_apply, smul_eq_mul, s.sum_ite_eq,
      s.map_affine_combination b w hw]
#align affine_basis.coord_apply_combination_of_not_mem AffineBasis.coord_apply_combination_of_not_mem

@[simp]
theorem sum_coord_apply_eq_one [Fintype ι] (q : P) : (∑ i, b.Coord i q) = 1 :=
  by
  have hq : q ∈ affineSpan k (range b) := by
    rw [b.tot]
    exact AffineSubspace.mem_top k V q
  obtain ⟨w, hw, rfl⟩ := eq_affineCombination_of_mem_affineSpan_of_fintype hq
  convert hw
  ext i
  exact b.coord_apply_combination_of_mem (Finset.mem_univ i) hw
#align affine_basis.sum_coord_apply_eq_one AffineBasis.sum_coord_apply_eq_one

@[simp]
theorem affineCombination_coord_eq_self [Fintype ι] (q : P) :
    (Finset.univ.affineCombination k b fun i => b.Coord i q) = q :=
  by
  have hq : q ∈ affineSpan k (range b) := by
    rw [b.tot]
    exact AffineSubspace.mem_top k V q
  obtain ⟨w, hw, rfl⟩ := eq_affineCombination_of_mem_affineSpan_of_fintype hq
  congr
  ext i
  exact b.coord_apply_combination_of_mem (Finset.mem_univ i) hw
#align affine_basis.affine_combination_coord_eq_self AffineBasis.affineCombination_coord_eq_self

/-- A variant of `affine_basis.affine_combination_coord_eq_self` for the special case when the
affine space is a module so we can talk about linear combinations. -/
@[simp]
theorem linear_combination_coord_eq_self [Fintype ι] (b : AffineBasis ι k V) (v : V) :
    (∑ i, b.Coord i v • b i) = v :=
  by
  have hb := b.affine_combination_coord_eq_self v
  rwa [finset.univ.affine_combination_eq_linear_combination _ _ (b.sum_coord_apply_eq_one v)] at hb
#align affine_basis.linear_combination_coord_eq_self AffineBasis.linear_combination_coord_eq_self

theorem ext_elem [Finite ι] {q₁ q₂ : P} (h : ∀ i, b.Coord i q₁ = b.Coord i q₂) : q₁ = q₂ :=
  by
  cases nonempty_fintype ι
  rw [← b.affine_combination_coord_eq_self q₁, ← b.affine_combination_coord_eq_self q₂]
  simp only [h]
#align affine_basis.ext_elem AffineBasis.ext_elem

@[simp]
theorem coe_coord_of_subsingleton_eq_one [Subsingleton ι] (i : ι) : (b.Coord i : P → k) = 1 :=
  by
  ext q
  have hp : (range b).Subsingleton := by
    rw [← image_univ]
    apply subsingleton.image
    apply subsingleton_of_subsingleton
  haveI := AffineSubspace.subsingleton_of_subsingleton_span_eq_top hp b.tot
  let s : Finset ι := {i}
  have hi : i ∈ s := by simp
  have hw : s.sum (Function.const ι (1 : k)) = 1 := by simp
  have hq : q = s.affine_combination k b (Function.const ι (1 : k)) := by simp
  rw [Pi.one_apply, hq, b.coord_apply_combination_of_mem hi hw]
#align affine_basis.coe_coord_of_subsingleton_eq_one AffineBasis.coe_coord_of_subsingleton_eq_one

theorem surjective_coord [Nontrivial ι] (i : ι) : Function.Surjective <| b.Coord i := by
  classical
    intro x
    obtain ⟨j, hij⟩ := exists_ne i
    let s : Finset ι := {i, j}
    have hi : i ∈ s := by simp
    have hj : j ∈ s := by simp
    let w : ι → k := fun j' => if j' = i then x else 1 - x
    have hw : s.sum w = 1 := by simp [hij, Finset.sum_ite, Finset.filter_insert, Finset.filter_eq']
    use s.affine_combination k b w
    simp [b.coord_apply_combination_of_mem hi hw]
#align affine_basis.surjective_coord AffineBasis.surjective_coord

/-- Barycentric coordinates as an affine map. -/
noncomputable def coords : P →ᵃ[k] ι → k
    where
  toFun q i := b.Coord i q
  linear :=
    { toFun := fun v i => -(b.basisOf i).sumCoords v
      map_add' := fun v w => by
        ext i
        simp only [LinearMap.map_add, Pi.add_apply, neg_add]
      map_smul' := fun t v => by
        ext i
        simpa only [LinearMap.map_smul, Pi.smul_apply, smul_neg] }
  map_vadd' p v := by
    ext i
    simp only [linear_eq_sum_coords, LinearMap.coe_mk, LinearMap.neg_apply, Pi.vadd_apply',
      AffineMap.map_vadd]
#align affine_basis.coords AffineBasis.coords

@[simp]
theorem coords_apply (q : P) (i : ι) : b.coords q i = b.Coord i q :=
  rfl
#align affine_basis.coords_apply AffineBasis.coords_apply

end Ring

section DivisionRing

variable [DivisionRing k] [Module k V]

include V

@[simp]
theorem coord_apply_centroid [CharZero k] (b : AffineBasis ι k P) {s : Finset ι} {i : ι}
    (hi : i ∈ s) : b.Coord i (s.centroid k b) = (s.card : k)⁻¹ := by
  rw [Finset.centroid,
    b.coord_apply_combination_of_mem hi (s.sum_centroid_weights_eq_one_of_nonempty _ ⟨i, hi⟩),
    Finset.centroidWeights]
#align affine_basis.coord_apply_centroid AffineBasis.coord_apply_centroid

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (s «expr ⊆ » t) -/
theorem exists_affine_subbasis {t : Set P} (ht : affineSpan k t = ⊤) :
    ∃ (s : _)(_ : s ⊆ t)(b : AffineBasis (↥s) k P), ⇑b = coe :=
  by
  obtain ⟨s, hst, h_tot, h_ind⟩ := exists_affineIndependent k V t
  refine' ⟨s, hst, ⟨coe, h_ind, _⟩, rfl⟩
  rw [Subtype.range_coe, h_tot, ht]
#align affine_basis.exists_affine_subbasis AffineBasis.exists_affine_subbasis

variable (k V P)

theorem exists_affineBasis : ∃ (s : Set P)(b : AffineBasis (↥s) k P), ⇑b = coe :=
  let ⟨s, _, hs⟩ := exists_affine_subbasis (AffineSubspace.span_univ k V P)
  ⟨s, hs⟩
#align affine_basis.exists_affine_basis AffineBasis.exists_affineBasis

end DivisionRing

end AffineBasis


/-
Copyright (c) 2019 The Flypitch Project. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.

Authors: Jesse Han, Floris van Doorn
-/
import fol tactic.abel tactic.ring completeness abel

open fol

local notation h :: t  := dvector.cons h t
local notation `[]` := dvector.nil
local notation `[` l:(foldr `, ` (h t, dvector.cons h t) dvector.nil `]`) := l

namespace reflection
section

/- rephrasing of soundness -/
def by_reflection {L} (T : Theory L) {S : Structure L} [h_nonempty : nonempty S]
  {hS : S ⊨ T} (p : Prop) (ψ : sentence L) (h_p : realize_sentence S ψ ↔ p) : T ⊢' ψ → p :=
by {intro P, cases P, apply h_p.mp, apply soundness, repeat{assumption}}

open abel

/- every abelian group satisfies ∀ x ∀ y, x + (y + y) = y + (y + x) -/
def T_ab_proves_x_y_y : T_ab ⊢' ∀' ∀' (&1 +' (&0 +' &0) ≃ &0 +' (&0 +' &1)) :=
begin
  apply (completeness _ _).mpr, intros M h_nonempty hM,
  intros x y, unfold T_ab at hM,
  have  hM' : M ⊨ a_comm ∧ M ⊨ a_inv ∧ M ⊨ a_zero_left ∧ M ⊨ a_zero_right ∧ M ⊨ a_assoc,
  by {simp at hM, assumption}, rcases hM' with ⟨uno,dos,tres,cuatro,cinco⟩,
  have this1 := cinco x y y, have this2 := uno y x, have this3 := uno (realize_bounded_term ([x,y]) (&0 +' &1) []) y, dsimp at *,
  conv {to_lhs, change realize_bounded_term ([y, y, x]) (&2 +' (&1 +' &0)) [], rw[<-this1]},
  conv {to_lhs, change realize_bounded_term ([y, (realize_bounded_term ([x, y]) (&0 +' &1) [])]) (&1 +' &0) [], rw[this3, <-(this2)]}, refl
end

example : ∀ x y : ℤ, x + (y + y) = y + (y + x) :=
begin
  apply @by_reflection L_abel T_ab ℤ' (by apply_instance) (ℤ'_is_abelian_group) _ _ _ _,
  exact ∀' ∀' (&1 +' (&0 +' &0) ≃ &0 +' (&0 +' &1)), {refl}, exact T_ab_proves_x_y_y
end

example : ∀ x y : ℤ, x + (y + y) = y + (y + x) :=
by {intros, rw[add_comm,add_assoc]}

example : ∀ x y : ℤ, x + (y + y) = y + (y + x) :=
by {intros, ring}

example : ∀ x y : ℤ, x + (y + y) = y + (y + x) :=
by {simp}

example : ∀ x y : ℤ, x + (y + y) = y + (y + x) :=
by {tidy}

def L_abel_structure_of_add_comm_group (α : Type) [add_comm_group α] : Structure L_abel :=
begin
  refine ⟨α, λn f, _, λn r, by {cases r}⟩,
  {induction f, intro xs, exact 0,
    intro xs,
    exact (xs.nth 0 dec_trivial) + (xs.nth 1 dec_trivial)}
end

variables (α : Type) [add_comm_group α]

local notation `α'` := L_abel_structure_of_add_comm_group α

@[simp]lemma α'_α : ↥(α') = α := by refl

@[reducible]instance has_zero_α' : has_zero α' := ⟨(0 : α)⟩

@[reducible]instance has_add_α' : has_add α' := ⟨λx y, (x + y : α)⟩

@[reducible]instance nonempty_α' : nonempty α' := ⟨0⟩

@[reducible]instance has_neg_α' : has_neg α' := ⟨λ x, (-x : α)⟩

@[simp]lemma zero_is_zero : @realize_bounded_term L_abel α' _ [] _ zero [] = (0 : α) := by refl

@[simp]lemma plus_is_plus_l : ∀ x y : α', realize_bounded_term ([x,y]) (&0 +' &1) [] = x + y := by {intros, refl}

@[simp]lemma plus_is_plus_r : ∀ x y : α', realize_bounded_term ([x,y]) (&1 +' &0) [] = y + x := by {intros, refl}

example {α} [add_comm_group α] {x y : α} : x + y = y + x := by simp

theorem add_comm_group_is_abelian_group {α : Type} [add_comm_group α] : T_ab ⊆ Th(L_abel_structure_of_add_comm_group α) :=
begin
  intros a H, repeat{cases H},
  {intros x y, change x + y = y + x, simp},
  {intro x,
  simp only [realize_bounded_formula_ex, realize_bounded_formula,realize_bounded_formula_and],
  use -x, change (x + -x = 0 ∧ -x + x = 0), simp},
  {intro x, change 0 + x = x, simp},
  {intro x, change x + 0 = x, simp},
  {intros x y z, change x + y + z = x + (y + z), simp}
end

example : ∀ x y : α, x + (y + y) = y + (y + x) :=
begin
  refine by_reflection (T_ab) (∀ x y, x + (y + y) = y + (y + x)) (∀' ∀' (&1 +' (&0 +' &0) ≃ &0 +' (&0 +' &1))) _ _,
  from L_abel_structure_of_add_comm_group α, from ⟨0⟩,
  from add_comm_group_is_abelian_group, by refl,
  from T_ab_proves_x_y_y
end

end
end reflection


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

import linear_algebra.direct_sum.finsupp
import logic.small.basic
import linear_algebra.std_basis
import linear_algebra.finsupp_vector_space
import linear_algebra.tensor_product_basis

/-!

# Free modules

We introduce a class `module.free R M`, for `R` a `semiring` and `M` an `R`-module and we provide
several basic instances for this class.

Use `finsupp.total_id_surjective` to prove that any module is the quotient of a free module.

## Main definition

* `module.free R M` : the class of free `R`-modules.

-/

universes u v w z

variables {ι : Type*} (R : Type u) (M : Type v) (N : Type z)

open_locale tensor_product direct_sum big_operators

section basic

variables [semiring R] [add_comm_monoid M] [module R M]

/-- `module.free R M` is the statement that the `R`-module `M` is free.-/
class module.free : Prop :=
(exists_basis [] : nonempty (Σ (I : Type v), basis I R M))

/- If `M` fits in universe `w`, then freeness is equivalent to existence of a basis in that
universe.

Note that if `M` does not fit in `w`, the reverse direction of this implication is still true as
`module.free.of_basis`. -/
lemma module.free_def [small.{w} M] : module.free R M ↔ ∃ (I : Type w), nonempty (basis I R M) :=
⟨ λ h, ⟨shrink (set.range h.exists_basis.some.2),
    ⟨(basis.reindex_range h.exists_basis.some.2).reindex (equiv_shrink _)⟩⟩,
  λ h, ⟨(nonempty_sigma.2 h).map $ λ ⟨i, b⟩, ⟨set.range b, b.reindex_range⟩⟩⟩

lemma module.free_iff_set : module.free R M ↔ ∃ (S : set M), nonempty (basis S R M) :=
⟨λ h, ⟨set.range h.exists_basis.some.2, ⟨basis.reindex_range h.exists_basis.some.2⟩⟩,
    λ ⟨S, hS⟩, ⟨nonempty_sigma.2 ⟨S, hS⟩⟩⟩

variables {R M}

lemma module.free.of_basis {ι : Type w} (b : basis ι R M) : module.free R M :=
(module.free_def R M).2 ⟨set.range b, ⟨b.reindex_range⟩⟩

end basic

namespace module.free

section semiring

variables (R M) [semiring R] [add_comm_monoid M] [module R M] [module.free R M]
variables [add_comm_monoid N] [module R N]

/-- If `module.free R M` then `choose_basis_index R M` is the `ι` which indexes the basis
  `ι → M`. -/
def choose_basis_index := (exists_basis R M).some.1

/-- If `module.free R M` then `choose_basis : ι → M` is the basis.
Here `ι = choose_basis_index R M`. -/
noncomputable def choose_basis : basis (choose_basis_index R M) R M := (exists_basis R M).some.2

/-- The isomorphism `M ≃ₗ[R] (choose_basis_index R M →₀ R)`. -/
noncomputable def repr : M ≃ₗ[R] (choose_basis_index R M →₀ R) := (choose_basis R M).repr

/-- The universal property of free modules: giving a functon `(choose_basis_index R M) → N`, for `N`
an `R`-module, is the same as giving an `R`-linear map `M →ₗ[R] N`.

This definition is parameterized over an extra `semiring S`,
such that `smul_comm_class R S M'` holds.
If `R` is commutative, you can set `S := R`; if `R` is not commutative,
you can recover an `add_equiv` by setting `S := ℕ`.
See library note [bundled maps over different rings]. -/
noncomputable def constr {S : Type z} [semiring S] [module S N] [smul_comm_class R S N] :
  ((choose_basis_index R M) → N) ≃ₗ[S] M →ₗ[R] N := basis.constr (choose_basis R M) S

@[priority 100]
instance no_zero_smul_divisors [no_zero_divisors R] : no_zero_smul_divisors R M :=
let ⟨⟨_, b⟩⟩ := exists_basis R M in b.no_zero_smul_divisors

instance [nontrivial M] : nonempty (module.free.choose_basis_index R M) :=
(module.free.choose_basis R M).index_nonempty

variables {R M N}

lemma of_equiv (e : M ≃ₗ[R] N) : module.free R N :=
of_basis $ (choose_basis R M).map e

/-- A variation of `of_equiv`: the assumption `module.free R P` here is explicit rather than an
instance. -/
lemma of_equiv' {P : Type v} [add_comm_monoid P] [module R P] (h : module.free R P)
  (e : P ≃ₗ[R] N) : module.free R N :=
of_equiv e

variables (R M N)

/-- The module structure provided by `semiring.to_module` is free. -/
instance self : module.free R R := of_basis (basis.singleton unit R)

instance prod [module.free R N] : module.free R (M × N) :=
of_basis $ (choose_basis R M).prod (choose_basis R N)

/-- The product of finitely many free modules is free. -/
instance pi (M : ι → Type*) [finite ι] [Π (i : ι), add_comm_monoid (M i)]
  [Π (i : ι), module R (M i)] [Π (i : ι), module.free R (M i)] : module.free R (Π i, M i) :=
let ⟨_⟩ := nonempty_fintype ι in by exactI (of_basis $ pi.basis $ λ i, choose_basis R (M i))

/-- The module of finite matrices is free. -/
instance matrix {m n : Type*} [finite m] [finite n] : module.free R (matrix m n M) :=
module.free.pi R _

variables (ι)

/-- The product of finitely many free modules is free (non-dependent version to help with typeclass
search). -/
instance function [finite ι] : module.free R (ι → M) := free.pi _ _

instance finsupp : module.free R (ι →₀ M) :=
of_basis (finsupp.basis $ λ i, choose_basis R M)

variables {ι}

@[priority 100]
instance of_subsingleton [subsingleton N] : module.free R N :=
of_basis (basis.empty N : basis pempty R N)

@[priority 100]
instance of_subsingleton' [subsingleton R] : module.free R N :=
by letI := module.subsingleton R N; exact module.free.of_subsingleton R N

instance dfinsupp {ι : Type*} (M : ι → Type*) [Π (i : ι), add_comm_monoid (M i)]
  [Π (i : ι), module R (M i)] [Π (i : ι), module.free R (M i)] : module.free R (Π₀ i, M i) :=
of_basis $ dfinsupp.basis $ λ i, choose_basis R (M i)

instance direct_sum {ι : Type*} (M : ι → Type*) [Π (i : ι), add_comm_monoid (M i)]
  [Π (i : ι), module R (M i)] [Π (i : ι), module.free R (M i)] : module.free R (⨁ i, M i) :=
module.free.dfinsupp R M

end semiring

section comm_ring

variables [comm_ring R] [add_comm_group M] [module R M] [module.free R M]
variables [add_comm_group N] [module R N] [module.free R N]

instance tensor : module.free R (M ⊗[R] N) :=
let ⟨bM⟩ := exists_basis R M, ⟨bN⟩ := exists_basis R N in of_basis (bM.2.tensor_product bN.2)

end comm_ring

section division_ring

variables [division_ring R] [add_comm_group M] [module R M]

@[priority 100]
instance of_division_ring : module.free R M :=
of_basis (basis.of_vector_space R M)

end division_ring

end module.free


/-
Copyright (c) 2021 Yourong Zang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yourong Zang
-/
import analysis.complex.isometry
import analysis.normed_space.conformal_linear_map

/-!
# Conformal maps between complex vector spaces

We prove the sufficient and necessary conditions for a real-linear map between complex vector spaces
to be conformal.

## Main results

* `is_conformal_map_complex_linear`: a nonzero complex linear map into an arbitrary complex
                                     normed space is conformal.
* `is_conformal_map_complex_linear_conj`: the composition of a nonzero complex linear map with
                                          `conj` is complex linear.
* `is_conformal_map_iff_is_complex_or_conj_linear`: a real linear map between the complex
                                                            plane is conformal iff it's complex
                                                            linear or the composition of
                                                            some complex linear map and `conj`.

## Warning

Antiholomorphic functions such as the complex conjugate are considered as conformal functions in
this file.
-/

noncomputable theory

open complex continuous_linear_map
open_locale complex_conjugate

lemma is_conformal_map_conj : is_conformal_map (conj_lie : ℂ →L[ℝ] ℂ) :=
conj_lie.to_linear_isometry.is_conformal_map

section conformal_into_complex_normed

variables {E : Type*} [normed_group E] [normed_space ℝ E] [normed_space ℂ E]
  {z : ℂ} {g : ℂ →L[ℝ] E} {f : ℂ → E}

lemma is_conformal_map_complex_linear {map : ℂ →L[ℂ] E} (nonzero : map ≠ 0) :
  is_conformal_map (map.restrict_scalars ℝ) :=
begin
  have minor₁ : ∥map 1∥ ≠ 0,
  { simpa [ext_ring_iff] using nonzero },
  refine ⟨∥map 1∥, minor₁, ⟨∥map 1∥⁻¹ • map, _⟩, _⟩,
  { intros x,
    simp only [linear_map.smul_apply],
    have : x = x • 1 := by rw [smul_eq_mul, mul_one],
    nth_rewrite 0 [this],
    rw [_root_.coe_coe map, linear_map.coe_coe_is_scalar_tower],
    simp only [map.coe_coe, map.map_smul, norm_smul, norm_inv, norm_norm],
    field_simp [minor₁], },
  { ext1,
    simp [minor₁] },
end

lemma is_conformal_map_complex_linear_conj
  {map : ℂ →L[ℂ] E} (nonzero : map ≠ 0) :
  is_conformal_map ((map.restrict_scalars ℝ).comp (conj_cle : ℂ →L[ℝ] ℂ)) :=
(is_conformal_map_complex_linear nonzero).comp is_conformal_map_conj

end conformal_into_complex_normed

section conformal_into_complex_plane

open continuous_linear_map

variables {f : ℂ → ℂ} {z : ℂ} {g : ℂ →L[ℝ] ℂ}

lemma is_conformal_map.is_complex_or_conj_linear (h : is_conformal_map g) :
  (∃ (map : ℂ →L[ℂ] ℂ), map.restrict_scalars ℝ = g) ∨
  (∃ (map : ℂ →L[ℂ] ℂ), map.restrict_scalars ℝ = g ∘L ↑conj_cle) :=
begin
  rcases h with ⟨c, hc, li, rfl⟩,
  obtain ⟨li, rfl⟩ : ∃ li' : ℂ ≃ₗᵢ[ℝ] ℂ, li'.to_linear_isometry = li,
    from ⟨li.to_linear_isometry_equiv rfl, by { ext1, refl }⟩,
  rcases linear_isometry_complex li with ⟨a, rfl|rfl⟩,
  -- let rot := c • (a : ℂ) • continuous_linear_map.id ℂ ℂ,
  { refine or.inl ⟨c • (a : ℂ) • continuous_linear_map.id ℂ ℂ, _⟩,
    ext1,
    simp only [coe_restrict_scalars', smul_apply, linear_isometry.coe_to_continuous_linear_map,
      linear_isometry_equiv.coe_to_linear_isometry, rotation_apply, id_apply, smul_eq_mul] },
  { refine or.inr ⟨c • (a : ℂ) • continuous_linear_map.id ℂ ℂ, _⟩,
    ext1,
    simp only [coe_restrict_scalars', smul_apply, linear_isometry.coe_to_continuous_linear_map,
      linear_isometry_equiv.coe_to_linear_isometry, rotation_apply, id_apply, smul_eq_mul,
      comp_apply, linear_isometry_equiv.trans_apply, continuous_linear_equiv.coe_coe,
      conj_cle_apply, conj_lie_apply, conj_conj] },
end

/-- A real continuous linear map on the complex plane is conformal if and only if the map or its
    conjugate is complex linear, and the map is nonvanishing. -/
lemma is_conformal_map_iff_is_complex_or_conj_linear:
  is_conformal_map g ↔
  ((∃ (map : ℂ →L[ℂ] ℂ), map.restrict_scalars ℝ = g) ∨
   (∃ (map : ℂ →L[ℂ] ℂ), map.restrict_scalars ℝ = g ∘L ↑conj_cle)) ∧ g ≠ 0 :=
begin
  split,
  { exact λ h, ⟨h.is_complex_or_conj_linear, h.ne_zero⟩, },
  { rintros ⟨⟨map, rfl⟩ | ⟨map, hmap⟩, h₂⟩,
    { refine is_conformal_map_complex_linear _,
      contrapose! h₂ with w,
      simp [w] },
    { have minor₁ : g = (map.restrict_scalars ℝ) ∘L ↑conj_cle,
      { ext1,
        simp [hmap] },
      rw minor₁ at ⊢ h₂,
      refine is_conformal_map_complex_linear_conj _,
      contrapose! h₂ with w,
      simp [w] } }
end

end conformal_into_complex_plane


/-
We define a simple example of a shape library
of the kind that might be used in a computer
graphics or gaming application.
-/

/-
Each pixel on the screen is represented by a
set of 2-D coordinates, which are rerally just
ordered pairs of natural numbers. (0,0) is the
pixel in the upper left of the screen. The "x"
axis of the coordinate system appears in the
first element of a pair, with x increasing as
one moves to the right. The position of a pixel
on the "y" axis is represented by the second
element of a pair, with y increasing as one
moves down the screen. (Yep, that is generally
how one addresses pixels on a screen.)
-/
structure coords : Type :=
mk :: (x : ℕ) (y : ℕ)
/-
Note that by using "structure" here, we get
coords.x and coords.y as projection funtions
(accessors/getters) for free.
-/

/-
Now we specific "shape" as a sum type, that is
as a variant type, with point, segment, triangle,
and rectangle as the variants. Each variant has
a constructor. Each constsructor takes the right
number of coordinates (pairs) to specific a shape
of that kind. A point is constructed with one pair
of coords, a segment with two pairs, triangle with
three, etc.
-/
inductive shape : Type
| point : coords → shape
| segment: coords → coords → shape
| triangle : coords → coords → coords → shape
| rectangle : coords → coords → coords → coords → shape

/-
It would be accurate to describe this type as
a sum of product types. There is a different kind
of tuple/record/structure for each variant. A point
is built with one pair, a segment with two, etc.
-/

/-
Now when we want to define a function that
operates on values of this type (that takes
a shape as an argument), we have to define
the result of the function for each possible
value of the type, which means describing how
the function computes a result for each form,
or variant, of shape.

To distinguish different forms we use --- no
real surprises here -- pattern matching. We
give one example: a function that when given
any of the four shapes, returns a string that
describes that shape: "point" for points, etc.
This result of this function doesn't depend on
the specific coordinates of the "vertices" in
each shape, so we use underscores to match but
not to name the coord arguments to each of the
constructors.
-/

def toString (s : shape) :=
match s with
| (shape.point _) := "point"
| (shape.segment _ _) := "segment"
| (shape.triangle _ _ _) := "triangle"
| (shape.rectangle _ _ _ _) := "rectangle"
end

def toString' : shape → string :=
λ (s : shape),
match s with
| (shape.point _) := "point"
| (shape.segment _ _) := "segment"
| (shape.triangle _ _ _) := "triangle"
| (shape.rectangle _ _ _ _) := "rectangle"
end

def toString'' : shape → string
| (shape.point _) := "point"
| (shape.segment _ _) := "segment"
| (shape.triangle _ _ _) := "triangle"
| (shape.rectangle _ _ _ _) := "rectangle"

def toString' : shape → string :=
λ s,
match s with
| (shape.point _) := "point"
| (shape.segment _ _) := "segment"
| (shape.triangle _ _ _) := "triangle"
| (shape.rectangle _ _ _ _) := "rectangle"
end

def toString'' : shape → string
| (shape.point _) := "point"
| (shape.segment _ _) := "segment"
| (shape.triangle _ _ _) := "triangle"
| (shape.rectangle _ _ _ _) := "rectangle"

#eval toString (shape.segment (coords.mk 3 4) (coords.mk 2 9))
/-
In summary, what you have here is a new kind of
example of an inductive type: one with multiple
constructors, each taking one or more arguments:
a "sum of products" type. And you've seen how we
use pattern matching to decide what variant form
of value a function is being applied to, in order
to produce an appropriate return value.
-/

/-
Testing. We define three coords objects, called
c1, c2, and c3, and then use them to build three
shape objects p1, a point; s1, a segment; and t1,
a triangle.
-/
def c1 := coords.mk 2 3
def c2 := coords.mk 5 11
def c3 := coords.mk 4 8

def p1 := shape.point c1
def s1 := shape.segment c1 c2
def t1 := shape.triangle c1 c2 c3

#reduce s1

#eval toString p1
#eval toString s1


import field_definition
import field_results

def two (f : Type) [myfld f] : f := (myfld.one .+ myfld.one)
def four (f : Type) [myfld f] : f := ((two f) .+ (two f))

/- We have to add an additional stipulation that our fields are not of characteristic 2.-/
/- The quadratic formula is not defined for fields where 1 + 1 = 0.-/
class fld_not_char_two (f : Type _) [myfld f] :=
(not_char_two : myfld.one .+ myfld.one ≠ (myfld.zero : f))

lemma two_ne_zero (f : Type) [myfld f] [fld_not_char_two f] : (two f) ≠ myfld.zero :=
begin
  unfold two, exact fld_not_char_two.not_char_two,
end

lemma two_plus_two (f : Type) [myfld f] : (two f) .+ (two f) = (two f) .* (two f) :=
begin
  unfold two, rw distrib_simp f _ _ _, rw myfld.mul_comm myfld.one _, rw <- myfld.mul_one (myfld.one .+ myfld.one),
end

lemma four_ne_zero (f : Type) [myfld f] [fld_not_char_two f] : (four f) ≠ myfld.zero :=
begin
  unfold four, rw two_plus_two, exact mul_nonzero f (two f) (two f) (two_ne_zero f) (two_ne_zero f),
end

lemma add_two_halves (f : Type) [myfld f] [fld_not_char_two f] :
          (myfld.reciprocal (two f) (two_ne_zero f)) .+ (myfld.reciprocal (two f) (two_ne_zero f)) = myfld.one :=
begin
  unfold two,
  have h1 : (two f) .* (myfld.reciprocal (two f) (two_ne_zero f)) = myfld.one,
    exact myfld.mul_reciprocal (two f) (two_ne_zero f),
  unfold two at h1, rw distrib_simp f _ _ _ at h1,
  rw myfld.mul_comm (myfld.one) _ at h1,
  rw <- myfld.mul_one (myfld.reciprocal (myfld.one .+ myfld.one) (fld_not_char_two.not_char_two)) at h1,
  exact h1,
end

/- Now we can move on to the preliminary work for the cubic formula.-/

/- We have to add an additional stipulation that our fields are not of characteristic 3.-/
/- The cubic formula is not defined for fields where 1 + 1 + 1 = 0.-/
def three (f : Type) [myfld f] : f := myfld.one .+ (myfld.one .+ myfld.one)

class fld_not_char_three (f : Type _) [myfld f] :=
(not_char_three : (three f) ≠ (myfld.zero : f))

def six (f : Type) [myfld f] : f := (two f) .* (three f)

lemma six_ne_zero (f : Type) [myfld f] [fld_not_char_two f] [fld_not_char_three f] : (six f) ≠ myfld.zero :=
begin
  unfold six, unfold two, exact mul_nonzero f (myfld.one .+ myfld.one) (three f)
                                             fld_not_char_two.not_char_two fld_not_char_three.not_char_three,
end

def nine (f : Type) [myfld f] : f := ((three f) .* (three f))

lemma nine_ne_zero (f : Type) [myfld f] [fld_not_char_three f] : (nine f) ≠ myfld.zero :=
begin
  unfold nine, exact mul_nonzero f (three f) (three f) fld_not_char_three.not_char_three fld_not_char_three.not_char_three,
end

def twenty_seven (f : Type) [myfld f] : f := (three f) .* (nine f)

lemma twenty_seven_ne_zero (f : Type) [myfld f] [fld_not_char_three f] : (twenty_seven f) ≠ myfld.zero :=
begin
  unfold twenty_seven, exact mul_nonzero f (three f) (nine f) fld_not_char_three.not_char_three (nine_ne_zero f),
end

lemma three_cubed (f : Type) [myfld f] : (cubed f (three f)) = (twenty_seven f) :=
begin
  unfold cubed, unfold twenty_seven, unfold nine,
end

def nine_minus_one (f : Type) [myfld f] : (((three f) .* (three f)) .+ (.- myfld.one)) =
                                          (cubed f (two f)) :=
begin
  unfold three, unfold two, unfold cubed, simp,
end

def one_plus_three (f : Type) [myfld f] : myfld.one .+ (three f) = (two f) .* (two f) :=
begin
  unfold two, unfold three, simp,
end

lemma two_x_div_two (f : Type) [myfld f] [fld_not_char_two f] (a : f) :
  (myfld.reciprocal (two f) fld_not_char_two.not_char_two) .* (a .+ a) = a :=
begin
  unfold two,
  rw [myfld.mul_one a] {occs := occurrences.pos [1, 2]},
  rw <- distrib_simp_alt f a, rw myfld.mul_comm a, rw myfld.mul_assoc, rw myfld.mul_comm (myfld.reciprocal _ _) _,
  rw myfld.mul_reciprocal, rw one_mul_simp,
end


/-
This file is intended for Lean beginners. The goal is to demonstrate what it
feels like to prove things using Lean and mathlib. Complicated definitions
and theory building are not covered.
-/

-- We want real numbers and their basic properties
import data.real.basic

-- We want to be able to define functions using the law of excluded middle
noncomputable theory
open_locale classical

/-
Our first goal is to define the set of upper bounds of a set of real numbers.
This is already defined in mathlib (in a more general context), but we repeat
it for the sake of exposition. Right-click "upper_bounds" below to get offered
to jump to mathlib's version
-/
#check upper_bounds

/-
A = [1, 2, 3]
is_max 3 A -> True
-/

/-- The set of upper bounds of a set of real numbers ℝ -/
def up_bounds (A : set ℝ) := { x : ℝ | ∀ a ∈ A, a ≤ x}

/-- Predicate `is_max a A` means `a` is a maximum of `A` -/
def is_max (a : ℝ) (A : set ℝ) := a ∈ A ∧ a ∈ up_bounds A

/-
In the above definition, the symbol `∧` means "and". We also see the most
visible difference between set theoretic foundations and type theoretic ones
(used by almost all proof assistants). In set theory, everything is a set,
and the only relation you get from foundations are `=` and `∈`. In type
theory, there is a meta-theoretic relation of "typing": `a : ℝ` reads "`a` is
a real number" or, more precisely, "the type of `a` is `ℝ`". Here
"meta-theoretic" means this is not a statement you can prove or disprove
inside the theory, it's a fact that is true or not. Here we impose this fact,
in other circumstances, it would be checked by the Lean kernel. By contrast,
`a ∈ A` is a statement inside the theory. Here it's part of the definition,
in other circumstances it could be something proven inside Lean.
-/

/-
For illustrative purposes, we now define an infix version of the above
predicate. It will allow us to write `a is_a_max_of A`, which is closer to a
sentence.
-/
infix `is_a_max_of`:55 := is_max

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

/-
The above proof is too long, even if you remove comments. We don't really
need the unpacking steps at the beginning, we can access both parts of the
assumption `hx : x is_a_max_of A` using shortcuts `h.1` and `h.2`. We can
also improve readability without assistance from the tactic state display,
clearly announcing intermediate goals using `have`. This way we get to the
following version of the same proof.
-/

example (A : set ℝ) (x y : ℝ) (hx : x is_a_max_of A)
        (hy : y is_a_max_of A) : x = y :=
begin
  have : x ≤ y, from hy.2 x hx.1,
  have : y ≤ x, from hx.2 y hy.1,
  linarith,
end

/-
Notice how mathematics based on type theory treats the assumption
`∀ a ∈ A, a ≤ y` as a function turning an element `a` of `A` into the statement
`a ≤ y`. More precisely, this assumption is the abbreviation of
`∀ a : ℝ, a ∈ A → a ≤ y`. The expression `hy.2 x` appearing in the above proof
is then the statement `x ∈ A → x ≤ y`, which itself is a function turning a
statement `x ∈ A` into `x ≤ y` so that the full expression `hy.2 x hx.1` is
indeed a proof of `x ≤ y`.

One could argue a three line long proof of this lemma is still two lines too
long. This is debatable, but mathlib's style is to write very short proofs
for trivial lemmas. Those proofs are not easy to read but they are meant to
indicate that the proof is probably not worth reading.

In order to reach this stage, we need to know what linarith did for us. It
invoked the lemma `le_antisymm` which says: `x ≤ y → y ≤ x → x = y`. This
arrow, which is used both for function and implication, is right associative.
So the statement is `x ≤ y → (y ≤ x → x = y)` which reads: I will send a
proof `p` of `x ≤ y` to a function sending a proof `p'` of `y ≤ x` to a proof
of `x = y`. Hence `le_antisymm p p'` is a proof of `x = y`.

Using this we can get our one-line proof:
-/

example (A : set ℝ) (x y : ℝ) (hx : x is_a_max_of A)
         (hy : y is_a_max_of A) : x = y :=
le_antisymm (hy.2 x hx.1) (hx.2 y hy.1)

/-
Such a proof is called a proof term (or a "term mode" proof). Notice it has no
`begin` and `end`. It is directly the kind of low level proof that the Lean
kernel is consuming. Commands like `cases`, `specialize` or `linarith` are
called tactics, they help users constructing proof terms that could be very
tedious to write directly. The most efficient proof style combines tactics
with proof terms like our previous `have : x ≤ y, from hy.2 x hx.1` where
`hy.2 x hx.1` is a proof term embeded inside a tactic mode proof.

In the remaining of this file, we'll be characterizing infima of sets of real
numbers in term of sequences. -/

/-- The set of lower bounds of a set of real numbers ℝ -/
def low_bounds (A : set ℝ) := { x : ℝ | ∀ a ∈ A, x ≤ a}

/-
We now define `a` is an infimum of `A`. Again there is already a more general
version
in mathlib.
-/
def is_inf (x : ℝ) (A : set ℝ) := x is_a_max_of (low_bounds A)
infix `is_an_inf_of`:55 := is_inf

/-
We need to prove that any number which is greater than the infimum of A is
greater than some element of A.
-/

lemma inf_lt {A : set ℝ} {x : ℝ} (hx : x is_an_inf_of A) :
  ∀ y, x < y → ∃ a ∈ A, a < y :=
begin
  -- Let `y` be any real number.
  intro y,
  -- Let's prove the contrapositive
  contrapose,
  -- The symbol `¬` means negation. Let's ask Lean to rewrite the goal without
  -- negation, pushing negation through quantifiers and inequalities
  push_neg,
  -- Let's assume the premise, calling the assumption `h`
  intro h,
  -- `h` is exactly saying `y` is a lower bound of `A` so the second part of the
  -- infimum assumption `hx` applied to `y` and `h` is exactly what we want.
  exact hx.2 y h end

/-
In the above proof, the sequence `contrapose, push_neg` is so common it
can be abbreviated to `contrapose!`. With these commands, we enter the gray
zone between proof checking and proof finding. Practical computer proof
checking crucially needs the computer to handle tedious proof steps. In the
next proof, we'll start using `linarith` a bit more seriously, going one step
further into automation.
Our next real goal is to prove inequalities for limits of sequences. We
extract the following lemma: if `y ≤ x + ε` for all positive `ε` then `y ≤ x`.
-/

lemma le_of_le_add_eps {x y : ℝ} : (∀ ε > 0, y ≤ x + ε) →  y ≤ x :=
begin
  -- Let's prove the contrapositive, asking Lean to push negations right away.
  contrapose!,
  -- Assume `h : x < y`.
  intro h,
  -- We need to find `ε` such that `ε` is positive and `x + ε < y`.
  -- Let's use `(y-x)/2`
  use ((y-x)/2),
  -- we now have two properties to prove. Let's do both in turn, using `linarith`
  split,
  linarith,
  linarith,
end

/-
Note how `linarith` was used for both sub-goals at the end of the above proof.
We could have shortened that using the semi-colon combinator instead of comma,
writing `split ; linarith`.

Next we will study a compressed version of that proof:
-/

example {x y : ℝ} : (∀ ε > 0, y ≤ x + ε) →  y ≤ x :=
begin
  contrapose!,
  exact assume h, ⟨(y-x)/2, by linarith, by linarith⟩,
end

/-
The angle brackets `⟨` and `⟩` introduce compound data or proofs. A proof of
a `∃ z, P z` statemement is composed of a witness `z₀` and a proof `z` of `P
z₀`. The compound is denoted by `⟨z₀, h⟩`. In the example above, the
predicate is itself compound, it is a conjunction `P z ∧ Q z`. So the proof
term should read `⟨z₀, ⟨h₁, h₂⟩⟩` where `h₁` (resp. `h₂`) is a proof of `P
z₀` (resp. `Q z₀`). But these so-called "anonymous constructor" brackets are
right-associative, so we can get rid of the nested brackets.

The keyword `by` introduces tactic mode inside term mode, it is a shorter
version of the `begin`/`end` pair, which is more convenient for single tactic
blocks. In this example, `begin` enters tactic mode, `exact` leaves it, `by`
re-enters it.

Going all the way to a proof term would make the proof much longer, because
we crucially use automation with `contrapose!` and `linarith`. We can still
get a one-line proof using curly braces to gather several tactic invocation,
and the `by` abbreviation instead of `begin`/`end`:
-/

example {x y : ℝ} : (∀ ε > 0, y ≤ x + ε) →  y ≤ x :=
by { contrapose!, exact assume h, ⟨(y-x)/2, by linarith, by linarith⟩ }

/-
One could argue that the above proof is a bit too terse, and we are relying
too much on linarith. Let's have more `linarith` calls for smaller steps. For
the sake of (tiny) variation, we will also assume the premise and argue by
contradiction instead of contraposing. -/

example {x y : ℝ} : (∀ ε > 0, y ≤ x + ε) →  y ≤ x :=
begin
  intro h,
  -- Assume the conclusion is false, and call this assumption H.
  by_contradiction H,
  push_neg at H,
  -- Now let's compute.
  have key := calc
  -- Each line must end with a colon followed by a proof term
  -- We want to specialize our assumption `h` to `ε = (y-x)/2` but this is long
  -- to type, so let's put a hole `_` that Lean will fill in by comparing the
  -- statement we want to prove and our proof term with a hole. As usual,
  -- positivity of `(y-x)/2` is proved by `linarith`
    y   ≤ x + (y-x)/2 : h _ (by linarith)
    ... = x/2 + y/2   : by linarith
    ... < y           : by linarith,
  -- our key now says `y < y` (notice how the sequence `≤`, `=`, `<` was
  -- correctly merged into a `<`). Let `linarith` find the desired contradiction
  -- now.
  linarith,
  -- alternatively, we could have provided the proof term
  -- `exact lt_irrefl y key`
end

/-
Now we are ready for some analysis. Let's setup notation for absolute value
-/

local notation `|`x`|` := abs x

/-
And let's define convergence of sequences of real numbers (of course there is
a much more general definition in mathlib).
-/

/-- The sequence `u` tends to `l` -/
def limit (u : ℕ → ℝ) (l : ℝ) := ∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε

/-
In the above definition, `u n` denotes the n-th term of the sequence. We can
add parentheses to get `u(n)` but we try to avoid parentheses because they
pile up very quickly
-/

-- If y ≤ u n for all n and u n goes to x then y ≤ x
lemma le_lim {x y : ℝ} {u : ℕ → ℝ} (hu : limit u x) (ineq : ∀ n, y ≤ u n) : y ≤ x :=
begin
  -- Let's apply our previous lemma
  apply le_of_le_add_eps,
  -- We need to prove y ≤ x + ε for all positive ε.
  -- Let ε be any positive real
  intros ε ε_pos,
  -- we now specialize our limit assumption to this `ε`, and immediately
  -- fix a `N` as promised by the definition.
  cases hu ε ε_pos with N HN,
  -- Now we only need to compute until reaching the conclusion
  calc
  y ≤ u N             : ineq N
  ... = x + (u N - x) : by linarith
    -- We'll need `add_le_add` which says `a ≤ b` and `c ≤ d` implies `a + c ≤ b
    -- + d` We need a lemma saying `z ≤ |z|`. Because we don't know the name
    -- of this lemma, let's use `library_search`. Because searching thourgh
    -- the library is slow, Lean will write what it found in the Lean message
    -- window when cursor is on that line, so that we can replace it by the
    -- lemma. We see `le_max_left` which says `a ≤ max a b`. Actually there
    -- is a more specific lemma `le_abs_self`
  ... ≤ x + |u N - x| : add_le_add (by linarith) (by library_search)
  ... ≤ x + ε         : add_le_add (by linarith) (HN N (by linarith)),
end

/-
The next lemma has been extracted from the main proof in order to discuss
numbers. In ordinary maths, we know that ℕ is *not* contained in `ℝ`,
whatever the construction of real numbers that we use. For instance a natural
number is not an equivalence class of Cauchy sequences. But it's very easy to
pretend otherwise. Formal maths requires slightly more care. In the statement
below, the "type ascription" `(n + 1 : ℝ)` forces Lean to convert the natural
number `n+1` into a real number. The "inclusion" map will be displayed in
tactic state as `↑`. There are various lemmas asserting this map is
compatible with addition and monotone, but we don't want to bother writing
their names. The `norm_cast` tactic is designed to wisely apply those lemmas
for us.
-/

lemma inv_succ_pos : ∀ n : ℕ, 1/(n+1 : ℝ) > 0 :=
begin
  -- Let `n` be any integer
  intro n,
  -- Since we don't know the name of the relevant lemma, asserting that the
  -- inverse of a positive number is positive, let's state that is suffices
  -- to prove that `n+1`, seen as a real number, is positive, and ask
  -- `library_search`
suffices : (n + 1 : ℝ) > 0, { library_search },
-- Now we want to reduce to a statement about natural numbers, not real numbers
-- coming from natural numbers.
norm_cast,
-- and then get the usual help from `linarith`
linarith, end

/-
That was a pretty long proof for an obvious fact. And stating it as a lemma
feels stupid, so let's find a way to write it on one line in case we want to
include it in some other proof without stating a lemma. First the
`library_search` call above displays the name of the relevant lemma:
`one_div_pos_of_pos`. We can also replace the `linarith` call on the last
line by `library_search` to learn the name of the lemma `nat.succ_pos`
asserting that the successor of a natural number is positive. There is also a
variant on `norm_cast` that combines it with `exact`. The term mode analogue
of `intro` is `λ`. We get down to: -/

example : ∀ n : ℕ, 1/(n+1 : ℝ) > 0 :=
λ n, one_div_pos_of_pos (by exact_mod_cast nat.succ_pos n)

/-
The next proof uses mostly known things, so we will commment only new aspects.
-/

lemma limit_inv_succ : ∀ ε > 0, ∃ N : ℕ, ∀ n ≥ N, 1/(n + 1 : ℝ) ≤ ε :=
begin
  intros ε ε_pos,
  suffices : ∃ N : ℕ, 1/ε ≤ N,
  { -- Because we didn't provide a name for the above statement, Lean called
    -- it `this`. Let's fix an `N` that works.
    cases this with N HN,
    use N,
    intros n Hn,
    -- Now we want to rewrite the goal using lemmas
    -- `div_le_iff' : 0 < b →  (a / b ≤ c ↔ a ≤ b * c)`
    -- `div_le_iff : 0 < b →  (a / b ≤ c ↔ a ≤ c * b)`
    -- the second one will be rewritten from right to left, as indicated by `←`.
    -- Lean will create a side goal for the required positivity assumption that
    -- we don't provide for `div_le_iff'`.
    rw [div_le_iff', ← div_le_iff ε_pos],
    -- We want to replace assumption `Hn` by its real counter-part so that
    -- linarith can find what it needs.
    replace Hn : (N : ℝ) ≤ n, exact_mod_cast Hn,
    linarith,
    -- we are still left with the positivity assumption, but already discussed
    -- how to prove it in the precedining lemma
    exact_mod_cast nat.succ_pos n },
  -- Now we need to prove that sufficient statement.
  -- We want to use that `ℝ` is archimedean. So we start typing
  -- `exact archimedean_` and hit Ctrl-space to see what completion Lean
  -- proposes the lemma `archimedean_iff_nat_le` sounds promising. We select
  -- the left to right implication using `.1`. This a generic lemma for fields
  -- equiped with a linear (ie total) order. We need to provide a proof that `ℝ`
  -- is indeed archimedean. This is done using the `apply_instance` tactic
  -- that will be covered elsewhere.
  exact archimedean_iff_nat_le.1 (by apply_instance) (1/ε), end

/-
We can now put all pieces together, with almost no new things to explain.
-/

lemma inf_seq (A : set ℝ) (x : ℝ) :
  (x is_an_inf_of A) ↔ (x ∈ low_bounds A ∧ ∃ u : ℕ → ℝ,
                        limit u x ∧ ∀ n, u n ∈ A ) :=
begin
  split,
  { intro h,
    split,
    { exact h.1 },
    -- On the next line, we don't need to tell Lean to treat `n+1` as a real
    -- number because we add `x` to it, so Lean knows there is only one way to
    -- make sense of this expression.
    have key : ∀ n : ℕ, ∃ a ∈ A, a < x + 1/(n+1),
    { intro n,
      -- we can use the lemma we proved above
      apply inf_lt h,
      -- and another one we proved!
      have : 0 < 1/(n+1 : ℝ), from inv_succ_pos n,
      linarith },
    -- Now we need to use axiom of (countable) choice
    choose u hu using key,
    use u,
    split,
    { intros ε ε_pos,
      -- again we use a lemma we proved, specializing it to our fixed `ε`, and fixing a `N`
      cases limit_inv_succ ε ε_pos with N H,
      use N,
      intros n hn,
      have : x ≤ u n, from h.1 _ (hu n).1,
      have := calc
        u n < x + 1/(n + 1) : (hu n).2
        ... ≤ x + ε         : add_le_add (le_refl x) (H n hn),
      rw abs_of_nonneg ; linarith },
    { intro n,
      exact (hu n).1 } },
  { intro h,
    -- Assumption `h` is made of nested compound statements. We can use the
    -- recursive version of `cases` to unpack it in one go.
    rcases h with ⟨x_min, u, lim, huA⟩,
    split,
    exact x_min,
    intros y y_mino,
    apply le_lim lim,
    intro n,
    exact y_mino (u n) (huA n) },
end