/-
This is a sorry-free file covering the material on Wednesday afternoon
at LFTCM2020. It's how to build some algebraic structures in Lean
-/

import data.rat.defs -- we'll need the rationals at the end of this file

/-
As a mathematician I essentially always start my Lean files with the following line:
-/
import tactic

/- That gives me access to all Lean's tactics
(see https://leanprover-community.github.io/mathlib_docs/tactics.html)
-/

/-

## The point of this file

The idea of this file is to show how to build in Lean what the computer scientists call
"an algebraic heirarchy", and what mathematicians call "groups, rings, fields, modules etc".

Firstly, we will define groups, and develop a basic interface for groups.

Then we will define rings, fields, modules, vector spaces, and just demonstrate
that they are usable, rather than making a complete interface for all of them.

Let's start with the theory of groups. Unfortunately Lean has groups already,
so we will have to do everything in a namespace
-/

namespace lftcm

/-

... which means that now when we define `group`, it will actually be called `lftcm.group`.

## Notation typeclasses

To make a term of type `has_mul G`, you need to give a map G^2 → G (or
more precisely, a map `has_mul.mul : G → G → G`. Lean's notation `g * h`
is notation for `has_mul.mul g h`. Furthermore, `has_mul` is a class.

In short, this means that if you write `[has_mul G]` then `G` will
magically have a multiplication called `*` (satisfying no axioms).

Similarly `[has_one G]` gives you `has_one.one : G` with notation `1 : G`,
and `[has_inv G]` gives you `has_inv.inv : G → G` with notation `g⁻¹ : G`

## Definition of a group

If `G` is a type, equipped with `* : G^2 → G`, `1 : G` and `⁻¹ : G → G`
then it's a group if it satisfies the group axioms.

-/

-- `group G` is the type of group structures on a type `G`.
-- first we ask for the structure
class group (G : Type) extends has_mul G, has_one G, has_inv G :=
-- and then we ask for the axioms
(mul_assoc : ∀ (a b c : G), a * b * c = a * (b * c))
(one_mul : ∀ (a : G), 1 * a = a)
(mul_left_inv : ∀ (a : G), a⁻¹ * a = 1)

/-

Advantages of this approach: axioms look lovely.

Disadvantage: what if I want the group law to be `+`?? I have embedded `has_mul`
in the definition.

Lean's solution: develop a `to_additive` metaprogram which translates all theorems about
`group`s (with group law `*`) to theorems about `add_group`s (with group law `+`). We will
not go into details here.

-/

namespace group

-- let G be a group

variables {G : Type} [group G]

/-
Lemmas about groups are proved in this namespace. We already have some!
All the group axioms are theorems in this namespace. Indeed we have just defined

`group.mul_assoc : ∀ (a b c : G), a * b * c = a * (b * c)`
`group.one_mul : ∀ (a : G), 1 * a = a`
`group.mul_left_inv : ∀ (a : G), a⁻¹ * a = 1`

Because we are in the `group` namespace, we don't need to write `group.`
everywhere.

Let's put some more theorems into the `group` namespace.

We definitely need `mul_one` and `mul_right_inv`, and it's a fun exercise to
get them. Here is a route:

`mul_left_cancel : ∀ (a b c : G), a * b = a * c → b = c`
`mul_eq_of_eq_inv_mul {a x y : G} : x = a⁻¹ * y → a * x = y`
`mul_one (a : G) : a * 1 = a`
`mul_right_inv (a : G) : a * a⁻¹ = 1`
-/

lemma mul_left_cancel (a b c : G) (Habac : a * b = a * c) : b = c :=
 calc b = 1 * b         : by rw one_mul
    ... = (a⁻¹ * a) * b : sorry
    ... = a⁻¹ * (a * b) : sorry
    ... = a⁻¹ * (a * c) : sorry
    ... = (a⁻¹ * a) * c : sorry
    ... = 1 * c         : sorry
    ... = c             : sorry

-- more mathlib-ish proof:
lemma mul_left_cancel' (a b c : G) (Habac : a * b = a * c) : b = c :=
begin
  rw [←one_mul b, ←mul_left_inv a, mul_assoc, Habac, ←mul_assoc, mul_left_inv, one_mul],
end

lemma mul_eq_of_eq_inv_mul {a x y : G} (h : x = a⁻¹ * y) : a * x = y :=
begin
  apply mul_left_cancel a⁻¹,
  -- ⊢ a⁻¹ * (a * x) = a⁻¹ * y
  sorry
end

-- The same proof
lemma mul_eq_of_eq_inv_mul' {a x y : G} (h : x = a⁻¹ * y) : a * x = y :=
mul_left_cancel a⁻¹ _ _ $ by rwa [←mul_assoc, mul_left_inv, one_mul]

/-

So now we can finally prove `mul_one` and `mul_right_inv`.

But before we start, let's learn a little bit about the simplifier.

## The `simp` tactic -- Lean's simplifier

We have the theorems (axioms) `one_mul g : 1 * g = g` and
`mul_left_inv g : g⁻¹ * g = 1`. Both of these theorems are of
the form `A = B`, with `A` more complicated than `B`. This means
that they are *perfect* theorems for the simplifier. Let's teach
those theorems to the simplifier, by adding the `@[simp]` attribute to them.
An "attribute" is just a tag which we attach to a theorem (or definition).
-/

attribute [simp] one_mul mul_left_inv

/-

Now let's prove `mul_one` using the simplifier. This also a perfect
`simp` lemma, so let's also add the `simp` tag to it.

-/

@[simp] theorem mul_one (a : G) : a * 1 = a :=
begin
  apply mul_eq_of_eq_inv_mul,
  -- ⊢ 1 = a⁻¹ * a
  simp,
end

/-
The simplifier solved `1 = a⁻¹ * a` because it knew `mul_left_inv`.
Feel free to comment out the `attribute [simp] one_mul mul_left_inv` line
above, and observe that the proof breaks.

-/

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

-- see if you can get the simplifier to do this one too
@[simp] theorem mul_right_inv (a : G) : a * a⁻¹ = 1 :=
begin
  sorry
end

-- Now here's a question. Can we train the simplifier to solve the following problem:

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

-- Remove the --'s and see that it fails. Let's see if we can get it to work.

-- We start with two very natural `simp` lemmas.

@[simp] lemma one_inv : (1 : G)⁻¹ = 1 :=
begin
  sorry
end

@[simp] lemma inv_inv (a : G) : a⁻¹⁻¹ = a :=
begin
  sorry
end

-- Here is a riskier looking `[simp]` lemma.

attribute [simp] mul_assoc -- recall this says (a * b) * c = a * (b * c)

-- The simplifier will now push all brackets to the right, which means
-- that it's worth proving the following two lemmas and tagging
-- them `[simp]`, so that we can still cancel a with a⁻¹ in these situations.

@[simp] lemma inv_mul_cancel_left (a b : G) : a⁻¹ * (a * b) = b :=
begin
  sorry
end

@[simp] lemma mul_inv_cancel_left (a b : G) : a * (a⁻¹ * b) = b :=
begin
  sorry
end

-- Finally, let's make a `simp` lemma which enables us to
-- reduce all inverses to inverses of variables
@[simp] lemma mul_inv_rev (a b : G) : (a * b)⁻¹ = b⁻¹ * a⁻¹ :=
begin
  sorry
end

/-

If you solved them all -- congratulations!
You have just turned Lean's simplifier into a normalising confluent
rewriting system for groups, following Knuth-Bendix.

https://en.wikipedia.org/wiki/Confluence_(abstract_rewriting)#Motivating_examples

In other words, the simplifier will now put any element of a free group
into a canonical normal form, and can hence solve the word problem
for free groups.

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

-- Abstract example of the power of classes: we can define products of groups with instances

instance (G : Type) [group G] (H : Type) [group H] : group (G × H) :=
{ mul := λ k l, (k.1*l.1, k.2*l.2),
  one := (1,1),
  inv := λ k, (k.1⁻¹, k.2⁻¹),
  mul_assoc := begin
    intros a b c,
    cases a, cases b, cases c,
    ext;
    simp,
  end,
  one_mul := begin
    sorry
  end,
  mul_left_inv := begin
    sorry
  end }

-- the type class inference system now knows that products of groups are groups
example (G H K : Type) [group G] [group H] [group K] : group (G × H × K) :=
by apply_instance

end group

-- let's make a group of order two.

-- First the elements {+1, -1}
inductive mu2
| p1 : mu2
| m1 : mu2

namespace mu2

-- Now let's do some CS stuff:

-- 1) prove it has decidable equality
attribute [derive decidable_eq] mu2

-- 2) prove it is finite
instance : fintype mu2 := ⟨⟨[mu2.p1, mu2.m1], by simp⟩, λ x, by cases x; simp⟩

-- now back to the maths.

-- Define multiplication by doing all cases
def mul : mu2 → mu2 → mu2
| p1 p1 := p1
| p1 m1 := m1
| m1 p1 := m1
| m1 m1 := p1

instance : has_mul mu2 := ⟨mul⟩

-- identity
def one : mu2 := p1

-- notation
instance : has_one mu2 := ⟨one⟩

-- inverse
def inv : mu2 → mu2 := id

-- notation
instance : has_inv mu2 := ⟨inv⟩

-- currently we have notation but no axioms

example : p1 * m1 * m1 = p1⁻¹ * p1 := rfl -- all true by definition

-- now let's make it a group
instance : group mu2 :=
begin
  -- first define the structure
  refine_struct { mul := mul, one := one, inv := inv },
  -- now we have three goals (the axioms)
  all_goals {exact dec_trivial}
end

end mu2

-- Now let's build rings and modules and stuff (via monoids and add_comm_groups)

-- a monoid is a group without inverses
class monoid (M : Type) extends has_mul M, has_one M :=
(mul_assoc : ∀ (a b c : M), a * b * c = a * (b * c))
(one_mul : ∀ (a : M), 1 * a = a)
(mul_one : ∀ (a : M), a * 1 = a)

-- additive commutative groups from first principles
class add_comm_group (A : Type) extends has_add A, has_zero A, has_neg A :=
(add_assoc : ∀ (a b c : A), a + b + c = a + (b + c))
(zero_add : ∀ (a : A), 0 + a = a)
(add_left_neg : ∀ (a : A), -a + a = 0)
(add_comm : ∀ a b : A, a + b = b + a)

-- Notation for subtraction is handy to have; define a - b to be a + (-b)
instance (A : Type) [add_comm_group A] : has_sub A := ⟨λ a b, a + -b⟩

-- rings are additive abelian groups and multiplicative monoids,
-- with distributivity
class ring (R : Type) extends monoid R, add_comm_group R :=
(mul_add : ∀ (a b c : R), a * (b + c) = a * b + a * c)
(add_mul : ∀ (a b c : R), (a + b) * c = a * c + b * c)

-- for commutative rings, add commutativity of multiplication
class comm_ring (R : Type) extends ring R :=
(mul_comm : ∀ a b : R, a * b = b * a)

/-- Typeclass for types with a scalar multiplication operation, denoted `•` (`\bu`) -/
class has_scalar (R : Type) (M : Type) := (smul : R → M → M)

infixr (name:=lftcm_smul) ` • `:73 := has_scalar.smul

-- modules for a ring
class module (R : Type) [ring R] (M : Type) [add_comm_group M]
extends has_scalar R M :=
(smul_add : ∀(r : R) (x y : M), r • (x + y) = r • x + r • y)
(add_smul : ∀(r s : R) (x : M), (r + s) • x = r • x + s • x)
(mul_smul : ∀ (r s : R) (x : M), (r * s) • x = r • s • x)
(one_smul : ∀ x : M, (1 : R) • x = x)

-- for fields we let ⁻¹ be defined on the entire field, and demand 0⁻¹ = 0
-- and that a⁻¹ * a = 1 for non-zero a. This is merely for convenience;
-- one can easily check that it's mathematically equivalent to the usual
-- definition of a field.
class field (K : Type) extends comm_ring K, has_inv K :=
(zero_ne_one : (0 : K) ≠ 1)
(mul_inv_cancel : ∀ {a : K}, a ≠ 0 → a * a⁻¹ = 1)
(inv_zero : (0 : K)⁻¹ = 0)

-- the type of vector spaces
def vector_space (K : Type) [field K] (V : Type) [add_comm_group V] := module K V

/-
Exercise for the reader: define manifolds, schemes, perfectoid spaces in Lean.
All have been done! As you can see, it is clearly *feasible*, although it does
sometimes take time to get it right. It is all very much work in progress.

The extraordinary thing is that although these computer theorem
provers have been around for about 50 years, there has never been a serious
effort to make the standard definitions used all over modern mathematics in
one of them, and this is why these systems are rarely used in mathematics departments.
Changing this is one of the goals of the Leanprover community.
-/

/-

Let's check that we can make the rational numbers into a field. Of course
they are already a field in Lean, but remember that when we say `field`
below, we mean our just-defined structure `lftcm.field`.

-/

-- the rationals are a field (easy because all the work is done in the import)
instance : field ℚ :=
{ mul := (*),
  one := 1,
  mul_assoc := rat.mul_assoc,
  one_mul := rat.one_mul,
  mul_one := rat.mul_one,
  add := (+),
  zero := 0,
  neg := has_neg.neg, -- no () trickery for unary operators
  add_assoc := rat.add_assoc,
  zero_add := rat.zero_add,
  add_left_neg := rat.add_left_neg,
  add_comm := rat.add_comm,
  mul_add := rat.mul_add,
  add_mul := rat.add_mul,
  mul_comm := rat.mul_comm,
  inv := has_inv.inv, -- see neg
  zero_ne_one := rat.zero_ne_one,
  mul_inv_cancel := rat.mul_inv_cancel,
  inv_zero := inv_zero -- I don't know why rat.inv_zero was never explicitly defined
  }

/-
Below is evidence that we can prove basic theorems about these structures.
Note however that it is a *complete pain* because we are *re-implementing*
everything; `add_comm` defaults to Lean's version for Lean's `add_comm_group`s, so we
have to explicitly write `add_comm_group.add_comm` to use our own version.
The mathlib versions of these proofs are less ugly.
-/

variables {A : Type} [add_comm_group A]

lemma add_comm_group.add_left_cancel (a b c : A) (Habac : a + b = a + c) : b = c :=
begin
  rw ←add_comm_group.zero_add b,
  rw ←add_comm_group.add_left_neg a,
  rw add_comm_group.add_assoc,
  rw Habac,
  rw ←add_comm_group.add_assoc,
  rw add_comm_group.add_left_neg,
  rw add_comm_group.zero_add,
end

lemma add_comm_group.add_right_neg (a : A) : a + -a = 0 :=
begin
  rw add_comm_group.add_comm,
  rw add_comm_group.add_left_neg,
end

lemma add_comm_group.sub_eq_add_neg (a b : A) :
  a - b = a + -b :=
begin
  -- this is just our definition of subtraction
  refl
end

lemma add_comm_group.sub_self (a : A) : a - a = 0 :=
begin
  rw add_comm_group.sub_eq_add_neg,
  rw add_comm_group.add_comm,
  rw add_comm_group.add_left_neg,
end

lemma add_comm_group.neg_eq_of_add_eq_zero (a b : A) (h : a + b = 0) : -a = b :=
begin
  apply add_comm_group.add_left_cancel a,
  rw h,
  rw add_comm_group.add_right_neg,
end

lemma add_comm_group.add_zero (a : A) : a + 0 = a :=
begin
  rw add_comm_group.add_comm,
  rw add_comm_group.zero_add,
end

variables {R : Type} [ring R]

lemma ring.mul_zero (r : R) : r * 0 = 0 :=
begin
  apply add_comm_group.add_left_cancel (r * 0),
  rw ←ring.mul_add,
  rw add_comm_group.add_zero,
  rw add_comm_group.add_zero,
end

lemma ring.mul_neg (a b : R) : a * -b = -(a * b) :=
begin
  sorry
end

lemma ring.mul_sub (R : Type) [comm_ring R] (r a b : R) : r * (a - b) = r * a - r * b :=
begin
  sorry
end

lemma comm_ring.sub_mul (R : Type) [comm_ring R] (r a b : R) : (a - b) * r = a * r - b * r :=
begin
  sorry
end

-- etc etc, for thousands of lines of mathlib, which develop the interface
-- abelian groups, rings, commutative rings, modules, fields, vector spaces etc.

end lftcm

/-

## Advertisement

Finished the natural number game? Have Lean installed? Want more games/exercises?
Take a look at the following projects, many of which are ongoing but
the first three of which are pretty much ready:

*) The complex number game (complete, needs to be played within VS Code)

https://github.com/ImperialCollegeLondon/complex-number-game

To install, type
`leanproject get ImperialCollegeLondon/complex-number-game`
and then just open the levels in `src/complex`.

*) Undergraduate level mathematics Lean puzzles (plenty of stuff here,
and more appearing over the summer):

https://github.com/ImperialCollegeLondon/Example-Lean-Projects

`leanproject get ImperialCollegeLondon/Example-Lean-Projects`

*) The max mini-game (a simple browser game like the natural number game)

http://wwwf.imperial.ac.uk/~buzzard/xena/max_minigame/

(this is part of what will become the real number game, a game to teach
series, sequences and limits etc like the natural number game):

`leanproject get ImperialCollegeLondon/real-number-game`

*) Some commutative algebra experiments (ongoing work to prove the Nullstellensatz,
going slowly because I'm busy):

https://github.com/ImperialCollegeLondon/M4P33/blob/1a179372db71ad6802d11eacbc1f02f327d55f8f/src/for_mathlib/commutative_algebra/Zariski_lemma.lean#L80-L81

`leanproject get ImperialCollegeLondon/M4P33`

*) The group theory game (work in progress, expect more progress over the summer,
as a couple of undergraduates are working on it)

https://github.com/ImperialCollegeLondon/group-theory-game

`leanproject get ImperialCollegeLondon/group-theory-game`

*) Galois theory experiments

https://github.com/ImperialCollegeLondon/P11-Galois-Theory

`leanproject get ImperialCollegeLondon/P11-Galois-Theory`

*) Beginnings of the theory of condensed sets (currently on hold because
we need a good interface for abelian categories in mathlib)

https://github.com/ImperialCollegeLondon/condensed-sets

`leanproject get ImperialCollegeLondon/condensed-sets`

## The Xena Project

Why do these projects exist? I (Kevin Buzzard) am interested in teaching
undergraduates how to use Lean. I have been running a club at Imperial College London
called the Xena Project for the last three years, I am proud that many Imperial
mathematics undegraduates have contributed to Lean's maths library, and three of them
(Chris Hughes, Kenny Lau, Amelia Livingston) have each contributed over 5,000 lines of
code. It is non-trivial to get your work into such a polished state that it
is acceptable to the mathlib maintainers. It is also very good practice.

I am running Lean summer projects this summer, on a Discord server. If you
know of any undergraduates who you think might be interested in Lean, please
direct them to the Xena Project Discord!

https://discord.gg/BgyVYgJ

Undergraduates use Discord for lots of things, and seem to be more likely
to use a Discord server than the Zulip chat. The Discord server is chaotic and
full of off-topic material -- quite unlike the Lean Zulip server, which is
professional and focussed. If you have a serious question about Lean,
ask it on the Zulip chat! But if you know an undergraduate who is interested
in Lean, they might be interested in the Discord server. We have meetings
every Thursday evening (UK time), with live Lean coding and streaming, speedruns,
there is music, people posting pictures of cats, Haikus, and so on. To a large
extent it is run by undergraduates and PhD students. Over the summer (July
and August 2020) there are also live Twitch talks at https://www.twitch.tv/kbuzzard ,
on Tuesdays 10am and Thursdays 4pm UK time (UTC+1), aimed at mathematics
undergraduates. It is an informal place for undergraduates to hang out and
meet other undergraduates who are interested in Lean.

I believe that it is crucial to make undergraduates aware of computer proof
verification systems, because one day (possibly a long time in the future,
but one day) these things will cause a paradigm shift in the way mathematics
is done, and the sooner young mathematicians learn about them, the sooner it will happen.

Prove a theorem. Write a function. @XenaProject

https://twitter.com/XenaProject

-/


import data.list.basic
import tactic
import old.extras

open list

universe u
variables {α : Type u} {L L₁ L₂ : list (α)}

namespace list
/-

lemma append_singleton_iff {x : α} :
L ++ L₁ = [x] ↔ (L = [] ∧ L₁ = [x]) ∨ (L₁ = [] ∧ L = [x]) :=
begin
  split,
  { intro h,
    induction L,
    left,
    simp at *,
    exact h,
    simp at *,
    exact ⟨h.2.2, h.1, h.2.1⟩ },
  { intro h,
    induction h,
    { rw [h.1, h.2], tauto },
    { rw [h.1, h.2], tauto } }
end
-/

lemma singleton_eq_append_iff {x : α}:
[x] = L ++ L₁ ↔  (L = [] ∧ L₁ = [x]) ∨ (L₁ = [] ∧ L = [x])  :=
begin
  split,
  intro h,
  exact append_singleton_iff.mp h.symm,
  intro h,
  exact (append_singleton_iff.mpr h).symm,
end

lemma last_split (H : L ≠ []): ∃ L₁, L = L₁ ++ [(L.last H)] :=
begin
  have h₁ := mem_split (last_mem H),
  rcases h₁ with ⟨s, t, h₁⟩,
  use s,
  have h₂ : t = [], {
    cases t,
    refl,
    simp at *,
    have h₂ : s ++ L.last H :: t_hd :: t_tl ≠ [] := by simp,
    have h₃ := last_congr H h₂ h₁,
    have h₄ : L.last H :: t_hd :: t_tl ≠ [] := by simp,
    rw last_append (s) (L.last H :: t_hd :: t_tl) h₄ at *,
    simp at *,
    sorry,
  },
  subst_vars,
  exact h₁,
end

lemma append_singleton_eq_append_singleton {x y : α} :
L ++ [x] = L₁ ++ [y] → x = y :=
begin
  intro h,
  rw append_eq_append_iff at h,
  cases h,
  {
    rcases h with ⟨a', hl, hr⟩,
    rw singleton_eq_append_iff at hr,
    cases hr,
    {
      cases hr with hrl hrr,
      simp at *,
      exact hrr.symm,
    },
    {
      cases hr,
      subst_vars,
      contradiction,
    }
  },
  {
    rcases h with ⟨c', hl, hr⟩,
    rw singleton_eq_append_iff at hr,
    cases hr,
    {
      cases hr,
      simp at *,
      exact hr_right,
    },
    {
      cases hr,
      subst_vars,
      contradiction,
    }
  }
end

lemma prefix_append_singleton_iff {x} :
L₁ <+: L ++ [x] ↔ L₁ <+: L ∨ L₁ = L ++ [x] :=
begin
  split,
  { intro h,
    rcases h with ⟨t, ht⟩,
    rw append_eq_append_iff at ht,
    cases ht,
    { rcases ht with ⟨a, hl, hr⟩,
      subst_vars,
      left,
      exact prefix_append L₁ a },
    { rcases ht with ⟨c, hl, hr⟩,
      have h₁ := append_singleton_iff.mp hr.symm,
      cases h₁,
      { cases h₁ with hll hlr,
        subst_vars,
        left,
        simp },
      { cases h₁ with hll hlr,
        subst_vars,
        right,
        simp } } },
  { intro h,
    cases h,
    { rcases h with ⟨t, ht⟩,
      use (t ++ [x]),
      rw ← ht,
      simp },
    { rw h } }
end

lemma max_prefix {p : list α → Prop} :
L₁ <+: L → p L₁ → ∃ L₂, L₂ <+: L ∧ p L₂ ∧ (∀ L₃, L₃ <+: L → p L₃ → L₃.length ≤ L₂.length) :=
begin
  apply L.reverse_rec_on,
  { intro h,
    simp at *,
    intro h₁,
    subst_vars,
    exact h₁ },
  { intros l a ih h h₁,
    rw prefix_append_singleton_iff at *,
    cases h,
    { by_cases h' : p (l ++ [a]),
      use (l ++ [a]),
      split,
      { refl },
      { split,
        exact h',
        { intros L₃ h₂ h₃,
          exact is_prefix.length_le h₂ } },
      specialize ih h h₁,
      rcases ih with ⟨L₂, h₂, h₃, h₄⟩,
      use L₂,
      split,
      { rw prefix_append_singleton_iff,
        left,
        exact h₂ },
      { split,
        { exact h₃ },
        { intros L₃ h₅ h₆,
          rw prefix_append_singleton_iff at *,
          cases h₅,
          { specialize h₄ L₃ h₅ h₆,
            exact h₄ },
          { subst_vars,
            simp at *,
            contradiction } } } },
    { use (l ++ [a]),
      split,
      { refl },
      split,
      { rw ← h, exact h₁ },
      { intros L₃ h₂ h₃,
        rw prefix_append_singleton_iff at *,
        cases h₂,
        simp,
        exact le_add_right (is_prefix.length_le h₂),
        rw h₂ } } }
end

lemma min_prefix {p : list α → Prop} :
L₁ <+: L → p L₁ → ∃ L₂, L₂ <+: L ∧ p L₂ ∧ (∀ L₃, L₃ <+: L → p L₃ → L₂.length ≤ L₃.length) :=
begin
  apply L.reverse_rec_on,
  {
    intros h,
    simp at *,
    subst_vars,
    simp,
  },
  {
    intros l a ih h h₁,
    rw prefix_append_singleton_iff at *,
    cases h,
    {
      specialize ih h h₁,
      rcases ih with ⟨L₂, h₁, h₂, h₃⟩,
      use L₂,
      split,
      rw prefix_append_singleton_iff,
      left,
      exact h₁,
      split,
      exact h₂,
      intros L₃ h₄ h₅,
      rw prefix_append_singleton_iff at h₄,
      cases h₄,
      {
        specialize h₃ L₃ h₄ h₅,
        exact h₃,
      } ,
      {
        subst_vars,
      }
    },
    {

    }
  }
end

lemma reduce_option_nil_iff {L : list (option α)} : (∀ x : option α, x ∈ L → x = none) ↔ reduce_option L = [] :=
begin
  induction L,
  simp,
  cases L_hd,
  simp,
  exact L_ih,
  simp,
end

end list


/- Propositional tableaux prover from Jeremy Avigad's lecture notes. -/

open expr tactic classical

variables {p q r s : Prop}
variables {a b c d e : Prop}

section

local attribute [instance] classical.prop_decidable

  theorem not_or_of_imp (h : a → b) : ¬ a ∨ b :=
  if ha : a then or.inr (h ha) else or.inl ha

  theorem imp_iff_not_or : (a → b) ↔ (¬ a ∨ b) :=
  ⟨not_or_of_imp, or.neg_resolve_left⟩

  theorem iff_def : (a ↔ b) ↔ (a → b) ∧ (b → a) :=
  iff_iff_implies_and_implies _ _

  theorem not_not : ¬¬a ↔ a :=
  iff.intro by_contradiction not_not_intro

  theorem not_or_distrib : ¬ (a ∨ b) ↔ ¬ a ∧ ¬ b :=
  ⟨λ h, ⟨λ ha, h (or.inl ha), λ hb, h (or.inr hb)⟩,
   λ ⟨h₁, h₂⟩ h, or.elim h h₁ h₂⟩

  theorem not_and_of_not_or_not (h : ¬ a ∨ ¬ b) : ¬ (a ∧ b)
  | ⟨ha, hb⟩ := or.elim h (absurd ha) (absurd hb)

  theorem not_and_distrib : ¬ (a ∧ b) ↔ ¬a ∨ ¬b :=
  ⟨λ h, if ha : a then or.inr (λ hb, h ⟨ha, hb⟩) else or.inl ha, not_and_of_not_or_not⟩

end

meta def normalize : tactic unit :=
`[ try { simp only
   [ not_or_distrib,
     not_and_distrib,
     not_not,
     imp_iff_not_or,
     not_true_iff,
     not_false_iff,
     iff_def ] at *} ]

meta def find_conj : list expr → tactic expr
| []        := failed
| (e :: es) := do t ← infer_type e,
                  match t with
                  | `(%%a ∧ %%b) := return e
                  | _            := find_conj es
                  end

meta def find_disj : list expr → tactic expr
| []        := failed
| (e :: es) := do t ← infer_type e,
                  match t with
                  | `(%%a ∨ %%b) := return e
                  | _            := find_disj es
                  end

meta def split_conj : tactic unit :=
do l ← local_context,
   e ← find_conj l,
   cases e,
   skip

meta def split_conjs : tactic unit :=
repeat split_conj

meta def split_disj : tactic unit :=
do l ← local_context,
   e ← find_disj l,
   cases e,
   skip

meta def proof_by_contradiction : tactic unit :=
do refine ``(classical.by_contradiction _),
   intro `_,
   skip

meta def tab_aux : tactic unit :=
do split_conjs,
   contradiction <|>
     (split_disj >> tab_aux >> tab_aux)

meta def tab : tactic unit :=
do proof_by_contradiction,
   normalize,
   tab_aux

example : a ∧ b → b ∧ a := by tab
example : a ∧ (a → b) → b := by tab

-- commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p := by tab
example : p ∨ q ↔ q ∨ p := by tab

-- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) := by tab
example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) := by tab

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := by tab
example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) := by tab

-- other properties
example : (p → (q → r)) ↔ (p ∧ q → r) := by tab
example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) := by tab
example : ¬(p ∨ q) ↔ ¬p ∧ ¬q := by tab
example : ¬p ∨ ¬q → ¬(p ∧ q) := by tab
example : ¬(p ∧ ¬p) := by tab
example : p ∧ ¬q → ¬(p → q) := by tab
example : ¬p → (p → q) := by tab
example : (¬p ∨ q) → (p → q) := by tab
example : p ∨ false ↔ p := by tab
example : p ∧ false ↔ false := by tab
example : ¬(p ↔ ¬p) := by tab
example : (p → q) → (¬q → ¬p) := by tab

example : (p → r ∨ s) → ((p → r) ∨ (p → s)) := by tab
example : ¬(p ∧ q) → ¬p ∨ ¬q := by tab
example : ¬(p → q) → p ∧ ¬q := by tab
example : (p → q) → (¬p ∨ q) := by tab
example : (¬q → ¬p) → (p → q) := by tab
example : p ∨ ¬p := by tab
example : (((p → q) → p) → p) := by tab

example (h₁ : a ∧ b) (h₂ : b ∧ ¬ c) : a ∨ c := by tab

example (h₁ : a ∧ b) (h₂ : b ∧ ¬ c) : a ∧ ¬ c := by tab

example : ((a → b) → a) → a := by tab

example : (a → b) ∧ (b → c) → a → c := by tab

example (α : Type) (x y z w : α) :
  x = y ∧ (x = y → z = w) → z = w := by tab

example : ¬ (a ↔ ¬ a) := by tab


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

example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
  ⟨λ h, ⟨λ x, (h x).left, λ x, (h x).right⟩, λ ⟨hup, huq⟩ x, ⟨hup x, huq x⟩⟩
example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) :=
  assume hpq hp x,
  hpq x (hp x)
example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x :=
  assume : (∀ x, p x) ∨ (∀ x, q x),
  this.elim
    (assume : ∀ x, p x,
      assume : α,
      or.inl (‹∀ x, p x› (by assumption)))
    (assume : ∀ x, q x,
      assume : α,
      or.inr (‹∀ x, q x› (by assumption)))


import data.polynomial
import analysis.complex.polynomial -- just a sanity check, probably shouldn't be imported

open polynomial

class algebraically_closed_field (k : Type*) extends discrete_field k :=
(exists_root' : ∀ (f : polynomial k) (hf : 0 < degree f),
   ∃ z : k, is_root f z)

namespace algebraically_closed_field

variables {k : Type*} [algebraically_closed_field k]

def exists_root {f : polynomial k} (hf : 0 < degree f) := ∃ z : k, is_root f z

-- sanity check
noncomputable example : algebraically_closed_field ℂ :=
{exists_root' := λ f hf, complex.exists_root hf,
..complex.discrete_field}

end algebraically_closed_field

def is_algebraically_closed (k : Type*) [discrete_field k] : Prop :=
  ∀ {f : polynomial k} (hf : 0 < degree f), ∃ z : k, is_root f z

-- sanity check
example : is_algebraically_closed ℂ := λ hf, complex.exists_root


/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers, Yury Kudryashov
-/
import algebra.group.prod
import algebra.group.type_tags
import algebra.group.pi
import algebra.pointwise
import data.equiv.basic
import data.set.finite

/-!
# Torsors of additive group actions

This file defines torsors of additive group actions.

## Notations

The group elements are referred to as acting on points.  This file
defines the notation `+ᵥ` for adding a group element to a point and
`-ᵥ` for subtracting two points to produce a group element.

## Implementation notes

Affine spaces are the motivating example of torsors of additive group actions. It may be appropriate
to refactor in terms of the general definition of group actions, via `to_additive`, when there is a
use for multiplicative torsors (currently mathlib only develops the theory of group actions for
multiplicative group actions).

## Notations

* `v +ᵥ p` is a notation for `has_vadd.vadd`, the left action of an additive monoid;

* `p₁ -ᵥ p₂` is a notation for `has_vsub.vsub`, difference between two points in an additive torsor
  as an element of the corresponding additive group;

## References

* https://en.wikipedia.org/wiki/Principal_homogeneous_space
* https://en.wikipedia.org/wiki/Affine_space

-/

/-- An `add_torsor G P` gives a structure to the nonempty type `P`,
acted on by an `add_group G` with a transitive and free action given
by the `+ᵥ` operation and a corresponding subtraction given by the
`-ᵥ` operation. In the case of a vector space, it is an affine
space. -/
class add_torsor (G : out_param Type*) (P : Type*) [out_param $ add_group G]
  extends add_action G P, has_vsub G P :=
[nonempty : nonempty P]
(vsub_vadd' : ∀ (p1 p2 : P), (p1 -ᵥ p2 : G) +ᵥ p2 = p1)
(vadd_vsub' : ∀ (g : G) (p : P), g +ᵥ p -ᵥ p = g)

attribute [instance, priority 100, nolint dangerous_instance] add_torsor.nonempty
attribute [nolint dangerous_instance] add_torsor.to_has_vsub

/-- An `add_group G` is a torsor for itself. -/
@[nolint instance_priority]
instance add_group_is_add_torsor (G : Type*) [add_group G] :
  add_torsor G G :=
{ vsub := has_sub.sub,
  vsub_vadd' := sub_add_cancel,
  vadd_vsub' := add_sub_cancel }

/-- Simplify subtraction for a torsor for an `add_group G` over
itself. -/
@[simp] lemma vsub_eq_sub {G : Type*} [add_group G] (g1 g2 : G) : g1 -ᵥ g2 = g1 - g2 :=
rfl

section general

variables {G : Type*} {P : Type*} [add_group G] [T : add_torsor G P]
include T

/-- Adding the result of subtracting from another point produces that
point. -/
@[simp] lemma vsub_vadd (p1 p2 : P) : p1 -ᵥ p2 +ᵥ p2 = p1 :=
add_torsor.vsub_vadd' p1 p2

/-- Adding a group element then subtracting the original point
produces that group element. -/
@[simp] lemma vadd_vsub (g : G) (p : P) : g +ᵥ p -ᵥ p = g :=
add_torsor.vadd_vsub' g p

/-- If the same point added to two group elements produces equal
results, those group elements are equal. -/
lemma vadd_right_cancel {g1 g2 : G} (p : P) (h : g1 +ᵥ p = g2 +ᵥ p) : g1 = g2 :=
by rw [←vadd_vsub g1, h, vadd_vsub]

@[simp] lemma vadd_right_cancel_iff {g1 g2 : G} (p : P) :  g1 +ᵥ p = g2 +ᵥ p ↔ g1 = g2 :=
⟨vadd_right_cancel p, λ h, h ▸ rfl⟩

/-- Adding a group element to the point `p` is an injective
function. -/
lemma vadd_right_injective (p : P) : function.injective ((+ᵥ p) : G → P) :=
λ g1 g2, vadd_right_cancel p

/-- Adding a group element to a point, then subtracting another point,
produces the same result as subtracting the points then adding the
group element. -/
lemma vadd_vsub_assoc (g : G) (p1 p2 : P) : g +ᵥ p1 -ᵥ p2 = g + (p1 -ᵥ p2) :=
begin
  apply vadd_right_cancel p2,
  rw [vsub_vadd, add_vadd, vsub_vadd]
end

/-- Subtracting a point from itself produces 0. -/
@[simp] lemma vsub_self (p : P) : p -ᵥ p = (0 : G) :=
by rw [←zero_add (p -ᵥ p), ←vadd_vsub_assoc, vadd_vsub]

/-- If subtracting two points produces 0, they are equal. -/
lemma eq_of_vsub_eq_zero {p1 p2 : P} (h : p1 -ᵥ p2 = (0 : G)) : p1 = p2 :=
by rw [←vsub_vadd p1 p2, h, zero_vadd]

/-- Subtracting two points produces 0 if and only if they are
equal. -/
@[simp] lemma vsub_eq_zero_iff_eq {p1 p2 : P} : p1 -ᵥ p2 = (0 : G) ↔ p1 = p2 :=
iff.intro eq_of_vsub_eq_zero (λ h, h ▸ vsub_self _)

/-- Cancellation adding the results of two subtractions. -/
@[simp] lemma vsub_add_vsub_cancel (p1 p2 p3 : P) : p1 -ᵥ p2 + (p2 -ᵥ p3) = (p1 -ᵥ p3) :=
begin
  apply vadd_right_cancel p3,
  rw [add_vadd, vsub_vadd, vsub_vadd, vsub_vadd]
end

/-- Subtracting two points in the reverse order produces the negation
of subtracting them. -/
@[simp] lemma neg_vsub_eq_vsub_rev (p1 p2 : P) : -(p1 -ᵥ p2) = (p2 -ᵥ p1) :=
begin
  refine neg_eq_of_add_eq_zero (vadd_right_cancel p1 _),
  rw [vsub_add_vsub_cancel, vsub_self],
end

/-- Subtracting the result of adding a group element produces the same result
as subtracting the points and subtracting that group element. -/
lemma vsub_vadd_eq_vsub_sub (p1 p2 : P) (g : G) : p1 -ᵥ (g +ᵥ p2) = (p1 -ᵥ p2) - g :=
by rw [←add_right_inj (p2 -ᵥ p1 : G), vsub_add_vsub_cancel, ←neg_vsub_eq_vsub_rev, vadd_vsub,
       ←add_sub_assoc, ←neg_vsub_eq_vsub_rev, neg_add_self, zero_sub]

/-- Cancellation subtracting the results of two subtractions. -/
@[simp] lemma vsub_sub_vsub_cancel_right (p1 p2 p3 : P) :
  (p1 -ᵥ p3) - (p2 -ᵥ p3) = (p1 -ᵥ p2) :=
by rw [←vsub_vadd_eq_vsub_sub, vsub_vadd]

/-- Convert between an equality with adding a group element to a point
and an equality of a subtraction of two points with a group
element. -/
lemma eq_vadd_iff_vsub_eq (p1 : P) (g : G) (p2 : P) : p1 = g +ᵥ p2 ↔ p1 -ᵥ p2 = g :=
⟨λ h, h.symm ▸ vadd_vsub _ _, λ h, h ▸ (vsub_vadd _ _).symm⟩

lemma vadd_eq_vadd_iff_neg_add_eq_vsub {v₁ v₂ : G} {p₁ p₂ : P} :
  v₁ +ᵥ p₁ = v₂ +ᵥ p₂ ↔ - v₁ + v₂ = p₁ -ᵥ p₂ :=
by rw [eq_vadd_iff_vsub_eq, vadd_vsub_assoc, ← add_right_inj (-v₁), neg_add_cancel_left, eq_comm]

namespace set
open_locale pointwise

@[simp] lemma singleton_vsub_self (p : P) : ({p} : set P) -ᵥ {p} = {(0:G)} :=
by rw [set.singleton_vsub_singleton, vsub_self]

instance add_action : add_action (set G) (set P) :=
{ zero_vadd := λ s, by simp [has_vadd.vadd, ←singleton_zero, image2_singleton_left],
  add_vadd := λ s t p, by { apply image2_assoc, intros, apply add_vadd },
  ..(show has_vadd (set G) (set P), by apply_instance) }

end set

@[simp] lemma vadd_vsub_vadd_cancel_right (v₁ v₂ : G) (p : P) :
  (v₁ +ᵥ p) -ᵥ (v₂ +ᵥ p) = v₁ - v₂ :=
by rw [vsub_vadd_eq_vsub_sub, vadd_vsub_assoc, vsub_self, add_zero]

/-- If the same point subtracted from two points produces equal
results, those points are equal. -/
lemma vsub_left_cancel {p1 p2 p : P} (h : p1 -ᵥ p = p2 -ᵥ p) : p1 = p2 :=
by rwa [←sub_eq_zero, vsub_sub_vsub_cancel_right, vsub_eq_zero_iff_eq] at h

/-- The same point subtracted from two points produces equal results
if and only if those points are equal. -/
@[simp] lemma vsub_left_cancel_iff {p1 p2 p : P} : (p1 -ᵥ p) = p2 -ᵥ p ↔ p1 = p2 :=
⟨vsub_left_cancel, λ h, h ▸ rfl⟩

/-- Subtracting the point `p` is an injective function. -/
lemma vsub_left_injective (p : P) : function.injective ((-ᵥ p) : P → G) :=
λ p2 p3, vsub_left_cancel

/-- If subtracting two points from the same point produces equal
results, those points are equal. -/
lemma vsub_right_cancel {p1 p2 p : P} (h : p -ᵥ p1 = p -ᵥ p2) : p1 = p2 :=
begin
  refine vadd_left_cancel (p -ᵥ p2) _,
  rw [vsub_vadd, ← h, vsub_vadd]
end

/-- Subtracting two points from the same point produces equal results
if and only if those points are equal. -/
@[simp] lemma vsub_right_cancel_iff {p1 p2 p : P} : p -ᵥ p1 = p -ᵥ p2 ↔ p1 = p2 :=
⟨vsub_right_cancel, λ h, h ▸ rfl⟩

/-- Subtracting a point from the point `p` is an injective
function. -/
lemma vsub_right_injective (p : P) : function.injective ((-ᵥ) p : P → G) :=
λ p2 p3, vsub_right_cancel

end general

section comm

variables {G : Type*} {P : Type*} [add_comm_group G] [add_torsor G P]

include G

/-- Cancellation subtracting the results of two subtractions. -/
@[simp] lemma vsub_sub_vsub_cancel_left (p1 p2 p3 : P) :
  (p3 -ᵥ p2) - (p3 -ᵥ p1) = (p1 -ᵥ p2) :=
by rw [sub_eq_add_neg, neg_vsub_eq_vsub_rev, add_comm, vsub_add_vsub_cancel]

@[simp] lemma vadd_vsub_vadd_cancel_left (v : G) (p1 p2 : P) :
  (v +ᵥ p1) -ᵥ (v +ᵥ p2) = p1 -ᵥ p2 :=
by rw [vsub_vadd_eq_vsub_sub, vadd_vsub_assoc, add_sub_cancel']

lemma vsub_vadd_comm (p1 p2 p3 : P) : (p1 -ᵥ p2 : G) +ᵥ p3 = p3 -ᵥ p2 +ᵥ p1 :=
begin
  rw [←@vsub_eq_zero_iff_eq G, vadd_vsub_assoc, vsub_vadd_eq_vsub_sub],
  simp
end

lemma vadd_eq_vadd_iff_sub_eq_vsub {v₁ v₂ : G} {p₁ p₂ : P} :
  v₁ +ᵥ p₁ = v₂ +ᵥ p₂ ↔ v₂ - v₁ = p₁ -ᵥ p₂ :=
by rw [vadd_eq_vadd_iff_neg_add_eq_vsub, neg_add_eq_sub]

lemma vsub_sub_vsub_comm (p₁ p₂ p₃ p₄ : P) :
  (p₁ -ᵥ p₂) - (p₃ -ᵥ p₄) = (p₁ -ᵥ p₃) - (p₂ -ᵥ p₄) :=
by rw [← vsub_vadd_eq_vsub_sub, vsub_vadd_comm, vsub_vadd_eq_vsub_sub]

end comm

namespace prod

variables {G : Type*} {P : Type*} {G' : Type*} {P' : Type*} [add_group G] [add_group G']
  [add_torsor G P] [add_torsor G' P']

instance : add_torsor (G × G') (P × P') :=
{ vadd := λ v p, (v.1 +ᵥ p.1, v.2 +ᵥ p.2),
  zero_vadd := λ p, by simp,
  add_vadd := by simp [add_vadd],
  vsub := λ p₁ p₂, (p₁.1 -ᵥ p₂.1, p₁.2 -ᵥ p₂.2),
  nonempty := prod.nonempty,
  vsub_vadd' := λ p₁ p₂, show (p₁.1 -ᵥ p₂.1 +ᵥ p₂.1, _) = p₁, by simp,
  vadd_vsub' := λ v p, show (v.1 +ᵥ p.1 -ᵥ p.1, v.2 +ᵥ p.2 -ᵥ p.2)  =v, by simp }

@[simp] lemma fst_vadd (v : G × G') (p : P × P') : (v +ᵥ p).1 = v.1 +ᵥ p.1 := rfl
@[simp] lemma snd_vadd (v : G × G') (p : P × P') : (v +ᵥ p).2 = v.2 +ᵥ p.2 := rfl
@[simp] lemma mk_vadd_mk (v : G) (v' : G') (p : P) (p' : P') :
  (v, v') +ᵥ (p, p') = (v +ᵥ p, v' +ᵥ p') := rfl

@[simp] lemma fst_vsub (p₁ p₂ : P × P') : (p₁ -ᵥ p₂ : G × G').1 = p₁.1 -ᵥ p₂.1 := rfl
@[simp] lemma snd_vsub (p₁ p₂ : P × P') : (p₁ -ᵥ p₂ : G × G').2 = p₁.2 -ᵥ p₂.2 := rfl
@[simp] lemma mk_vsub_mk (p₁ p₂ : P) (p₁' p₂' : P') :
  ((p₁, p₁') -ᵥ (p₂, p₂') : G × G') = (p₁ -ᵥ p₂, p₁' -ᵥ p₂') := rfl

end prod

namespace pi

universes u v w
variables {I : Type u} {fg : I → Type v} [∀ i, add_group (fg i)] {fp : I → Type w}

open add_action add_torsor

/-- A product of `add_torsor`s is an `add_torsor`. -/
instance [T : ∀ i, add_torsor (fg i) (fp i)] : add_torsor (Π i, fg i) (Π i, fp i) :=
{ vadd := λ g p, λ i, g i +ᵥ p i,
  zero_vadd := λ p, funext $ λ i, zero_vadd (fg i) (p i),
  add_vadd := λ g₁ g₂ p, funext $ λ i, add_vadd (g₁ i) (g₂ i) (p i),
  vsub := λ p₁ p₂, λ i, p₁ i -ᵥ p₂ i,
  nonempty := ⟨λ i, classical.choice (T i).nonempty⟩,
  vsub_vadd' := λ p₁ p₂, funext $ λ i, vsub_vadd (p₁ i) (p₂ i),
  vadd_vsub' := λ g p, funext $ λ i, vadd_vsub (g i) (p i) }

end pi

namespace equiv

variables {G : Type*} {P : Type*} [add_group G] [add_torsor G P]

include G

/-- `v ↦ v +ᵥ p` as an equivalence. -/
def vadd_const (p : P) : G ≃ P :=
{ to_fun := λ v, v +ᵥ p,
  inv_fun := λ p', p' -ᵥ p,
  left_inv := λ v, vadd_vsub _ _,
  right_inv := λ p', vsub_vadd _ _ }

@[simp] lemma coe_vadd_const (p : P) : ⇑(vadd_const p) = λ v, v+ᵥ p := rfl

@[simp] lemma coe_vadd_const_symm (p : P) : ⇑(vadd_const p).symm = λ p', p' -ᵥ p := rfl

/-- `p' ↦ p -ᵥ p'` as an equivalence. -/
def const_vsub (p : P) : P ≃ G :=
{ to_fun := (-ᵥ) p,
  inv_fun := λ v, -v +ᵥ p,
  left_inv := λ p', by simp,
  right_inv := λ v, by simp [vsub_vadd_eq_vsub_sub] }

@[simp] lemma coe_const_vsub (p : P) : ⇑(const_vsub p) = (-ᵥ) p := rfl

@[simp] lemma coe_const_vsub_symm (p : P) : ⇑(const_vsub p).symm = λ v, -v +ᵥ p := rfl

variables (P)

/-- The permutation given by `p ↦ v +ᵥ p`. -/
def const_vadd (v : G) : equiv.perm P :=
{ to_fun := (+ᵥ) v,
  inv_fun := (+ᵥ) (-v),
  left_inv := λ p, by simp [vadd_vadd],
  right_inv := λ p, by simp [vadd_vadd] }

@[simp] lemma coe_const_vadd (v : G) : ⇑(const_vadd P v) = (+ᵥ) v := rfl

variable (G)

@[simp] lemma const_vadd_zero : const_vadd P (0:G) = 1 := ext $ zero_vadd G

variable {G}

@[simp] lemma const_vadd_add (v₁ v₂ : G) :
  const_vadd P (v₁ + v₂) = const_vadd P v₁ * const_vadd P v₂ :=
ext $ add_vadd v₁ v₂

/-- `equiv.const_vadd` as a homomorphism from `multiplicative G` to `equiv.perm P` -/
def const_vadd_hom : multiplicative G →* equiv.perm P :=
{ to_fun := λ v, const_vadd P v.to_add,
  map_one' := const_vadd_zero G P,
  map_mul' := const_vadd_add P }

variable {P}

open function

/-- Point reflection in `x` as a permutation. -/
def point_reflection (x : P) : perm P := (const_vsub x).trans (vadd_const x)

lemma point_reflection_apply (x y : P) : point_reflection x y = x -ᵥ y +ᵥ x := rfl

@[simp] lemma point_reflection_symm (x : P) : (point_reflection x).symm = point_reflection x :=
ext $ by simp [point_reflection]

@[simp] lemma point_reflection_self (x : P) : point_reflection x x = x := vsub_vadd _ _

lemma point_reflection_involutive (x : P) : involutive (point_reflection x : P → P) :=
λ y, (equiv.apply_eq_iff_eq_symm_apply _).2 $ by rw point_reflection_symm

/-- `x` is the only fixed point of `point_reflection x`. This lemma requires
`x + x = y + y ↔ x = y`. There is no typeclass to use here, so we add it as an explicit argument. -/
lemma point_reflection_fixed_iff_of_injective_bit0 {x y : P} (h : injective (bit0 : G → G)) :
  point_reflection x y = y ↔ y = x :=
by rw [point_reflection_apply, eq_comm, eq_vadd_iff_vsub_eq, ← neg_vsub_eq_vsub_rev,
  neg_eq_iff_add_eq_zero, ← bit0, ← bit0_zero, h.eq_iff, vsub_eq_zero_iff_eq, eq_comm]

omit G

lemma injective_point_reflection_left_of_injective_bit0 {G P : Type*} [add_comm_group G]
  [add_torsor G P] (h : injective (bit0 : G → G)) (y : P) :
  injective (λ x : P, point_reflection x y) :=
λ x₁ x₂ (hy : point_reflection x₁ y = point_reflection x₂ y),
  by rwa [point_reflection_apply, point_reflection_apply, vadd_eq_vadd_iff_sub_eq_vsub,
    vsub_sub_vsub_cancel_right, ← neg_vsub_eq_vsub_rev, neg_eq_iff_add_eq_zero, ← bit0, ← bit0_zero,
    h.eq_iff, vsub_eq_zero_iff_eq] at hy

end equiv

lemma add_torsor.subsingleton_iff (G P : Type*) [add_group G] [add_torsor G P] :
  subsingleton G ↔ subsingleton P :=
begin
  inhabit P,
  exact (equiv.vadd_const default).subsingleton_congr,
end


import MyNat.Definition
namespace MyNat
open MyNat

/-!
# Function world.

## Level 9: a big maze.

In [Proposition World](../PropositionWorld.lean.md) you will see a variant of this example
which can be solved by a tactic. It would be an interesting project to make a tactic
which could automatically solve this sort of level in Lean.

You can of course work both forwards and backwards, or you could crack and draw a picture.

## Definition
Given a bunch of functions, we can define another one.
-/
example (A B C D E F G H I J K L : Type)
(f1 : A → B) (f2 : B → E) (f3 : E → D) (f4 : D → A) (f5 : E → F)
(f6 : F → C) (f7 : B → C) (f8 : F → G) (f9 : G → J) (f10 : I → J)
(f11 : J → I) (f12 : I → H) (f13 : E → H) (f14 : H → K) (f15 : I → L)
 : A → L := by
  intro a
  apply f15
  apply f11
  apply f9
  apply f8
  apply f5
  apply f2
  apply f1
  assumption

/-!
Here we finish this proof with a new tactic `assumption` instead of `exact a`.
The [`assumption` tactic](../Tactics/assumption.lean.md) tries to solve the goal using a
hypothesis of compatible type.  Since we have the hypothesis named `a` it finds
it and completes the proof.

That's the end of Function World! Next it's [Proposition World](../PropositionWorld.lean.md), and
the tactics you've learnt in Function World are enough to solve all nine levels! In fact, the levels
in [Proposition World](../PropositionWorld.lean.md) might look strangely familiar...
-/


/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn, Leonardo de Moura

! This file was ported from Lean 3 source module init.data.nat.basic
! leanprover-community/mathlib commit 4a03bdeb31b3688c31d02d7ff8e0ff2e5d6174db
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
prelude
import Leanbin.Init.Logic

namespace Nat

#print Nat.le /-
inductive le (a : ℕ) : ℕ → Prop
  | refl : less_than_or_equal a
  | step : ∀ {b}, less_than_or_equal b → less_than_or_equal (succ b)
#align nat.less_than_or_equal Nat.le
-/

instance : LE ℕ :=
  ⟨Nat.le⟩

/- warning: nat.le clashes with nat.less_than_or_equal -> Nat.le
Case conversion may be inaccurate. Consider using '#align nat.le Nat.leₓ'. -/
#print Nat.le /-
@[reducible]
protected def le (n m : ℕ) :=
  Nat.le n m
#align nat.le Nat.le
-/

#print Nat.lt /-
@[reducible]
protected def lt (n m : ℕ) :=
  Nat.le (succ n) m
#align nat.lt Nat.lt
-/

instance : LT ℕ :=
  ⟨Nat.lt⟩

#print Nat.pred /-
def pred : ℕ → ℕ
  | 0 => 0
  | a + 1 => a
#align nat.pred Nat.pred
-/

#print Nat.sub /-
protected def sub : ℕ → ℕ → ℕ
  | a, 0 => a
  | a, b + 1 => pred (sub a b)
#align nat.sub Nat.sub
-/

#print Nat.mul /-
protected def mul : Nat → Nat → Nat
  | a, 0 => 0
  | a, b + 1 => mul a b + a
#align nat.mul Nat.mul
-/

instance : Sub ℕ :=
  ⟨Nat.sub⟩

instance : Mul ℕ :=
  ⟨Nat.mul⟩

-- defeq to the instance provided by comm_semiring
instance : Dvd ℕ :=
  Dvd.mk fun a b => ∃ c, b = a * c

instance : DecidableEq ℕ
  | zero, zero => isTrue rfl
  | succ x, zero => isFalse fun h => Nat.noConfusion h
  | zero, succ y => isFalse fun h => Nat.noConfusion h
  | succ x, succ y =>
    match DecidableEq x y with
    | is_true xeqy => isTrue (xeqy ▸ Eq.refl (succ x))
    | is_false xney => isFalse fun h => Nat.noConfusion h fun xeqy => absurd xeqy xney

def repeat.{u} {α : Type u} (f : ℕ → α → α) : ℕ → α → α
  | 0, a => a
  | succ n, a => f n (repeat n a)
#align nat.repeat Nat.repeatₓ

instance : Inhabited ℕ :=
  ⟨Nat.zero⟩

#print Nat.zero_eq /-
@[simp]
theorem zero_eq : Nat.zero = 0 :=
  rfl
#align nat.nat_zero_eq_zero Nat.zero_eq
-/

/-! properties of inequality -/

#print Nat.le_refl /-
@[refl]
protected theorem le_refl (a : ℕ) : a ≤ a :=
  le.refl
#align nat.le_refl Nat.le_refl
-/

#print Nat.le_succ /-
theorem le_succ (n : ℕ) : n ≤ succ n :=
  le.step (Nat.le_refl n)
#align nat.le_succ Nat.le_succ
-/

#print Nat.succ_le_succ /-
theorem succ_le_succ {n m : ℕ} : n ≤ m → succ n ≤ succ m := fun h =>
  le.ndrec (Nat.le_refl (succ n)) (fun a b => le.step) h
#align nat.succ_le_succ Nat.succ_le_succ
-/

#print Nat.zero_le /-
protected theorem zero_le : ∀ n : ℕ, 0 ≤ n
  | 0 => Nat.le_refl 0
  | n + 1 => le.step (zero_le n)
#align nat.zero_le Nat.zero_le
-/

#print Nat.zero_lt_succ /-
theorem zero_lt_succ (n : ℕ) : 0 < succ n :=
  succ_le_succ n.zero_le
#align nat.zero_lt_succ Nat.zero_lt_succ
-/

#print Nat.succ_pos /-
theorem succ_pos (n : ℕ) : 0 < succ n :=
  zero_lt_succ n
#align nat.succ_pos Nat.succ_pos
-/

#print Nat.not_succ_le_zero /-
theorem not_succ_le_zero : ∀ n : ℕ, succ n ≤ 0 → False :=
  fun.
#align nat.not_succ_le_zero Nat.not_succ_le_zero
-/

#print Nat.not_lt_zero /-
protected theorem not_lt_zero (a : ℕ) : ¬a < 0 :=
  not_succ_le_zero a
#align nat.not_lt_zero Nat.not_lt_zero
-/

#print Nat.pred_le_pred /-
theorem pred_le_pred {n m : ℕ} : n ≤ m → pred n ≤ pred m := fun h =>
  le.rec_on h (Nat.le_refl (pred n)) fun n => Nat.rec (fun a b => b) (fun a b c => le.step) n
#align nat.pred_le_pred Nat.pred_le_pred
-/

#print Nat.le_of_succ_le_succ /-
theorem le_of_succ_le_succ {n m : ℕ} : succ n ≤ succ m → n ≤ m :=
  pred_le_pred
#align nat.le_of_succ_le_succ Nat.le_of_succ_le_succ
-/

instance decidableLe : ∀ a b : ℕ, Decidable (a ≤ b)
  | 0, b => isTrue b.zero_le
  | a + 1, 0 => isFalse (not_succ_le_zero a)
  | a + 1, b + 1 =>
    match decidable_le a b with
    | is_true h => isTrue (succ_le_succ h)
    | is_false h => isFalse fun a => h (le_of_succ_le_succ a)
#align nat.decidable_le Nat.decidableLe

instance decidableLt : ∀ a b : ℕ, Decidable (a < b) := fun a b => Nat.decidableLe (succ a) b
#align nat.decidable_lt Nat.decidableLt

#print Nat.eq_or_lt_of_le /-
protected theorem eq_or_lt_of_le {a b : ℕ} (h : a ≤ b) : a = b ∨ a < b :=
  le.cases_on h (Or.inl rfl) fun n h => Or.inr (succ_le_succ h)
#align nat.eq_or_lt_of_le Nat.eq_or_lt_of_le
-/

#print Nat.lt_succ_of_le /-
theorem lt_succ_of_le {a b : ℕ} : a ≤ b → a < succ b :=
  succ_le_succ
#align nat.lt_succ_of_le Nat.lt_succ_of_le
-/

#print Nat.succ_sub_succ_eq_sub /-
@[simp]
theorem succ_sub_succ_eq_sub (a b : ℕ) : succ a - succ b = a - b :=
  Nat.recOn b (show succ a - succ zero = a - zero from Eq.refl (succ a - succ zero)) fun b =>
    congr_arg pred
#align nat.succ_sub_succ_eq_sub Nat.succ_sub_succ_eq_sub
-/

#print Nat.not_succ_le_self /-
theorem not_succ_le_self : ∀ n : ℕ, ¬succ n ≤ n := fun n =>
  Nat.rec (not_succ_le_zero 0) (fun a b c => b (le_of_succ_le_succ c)) n
#align nat.not_succ_le_self Nat.not_succ_le_self
-/

#print Nat.lt_irrefl /-
protected theorem lt_irrefl (n : ℕ) : ¬n < n :=
  not_succ_le_self n
#align nat.lt_irrefl Nat.lt_irrefl
-/

#print Nat.le_trans /-
protected theorem le_trans {n m k : ℕ} (h1 : n ≤ m) : m ≤ k → n ≤ k :=
  le.ndrec h1 fun p h2 => le.step
#align nat.le_trans Nat.le_trans
-/

#print Nat.pred_le /-
theorem pred_le : ∀ n : ℕ, pred n ≤ n
  | 0 => le.refl
  | succ a => le.step le.refl
#align nat.pred_le Nat.pred_le
-/

#print Nat.pred_lt /-
theorem pred_lt : ∀ {n : ℕ}, n ≠ 0 → pred n < n
  | 0, h => absurd rfl h
  | succ a, h => lt_succ_of_le le.refl
#align nat.pred_lt Nat.pred_lt
-/

#print Nat.sub_le /-
protected theorem sub_le (a b : ℕ) : a - b ≤ a :=
  Nat.recOn b (Nat.le_refl (a - 0)) fun b₁ => Nat.le_trans (pred_le (a - b₁))
#align nat.sub_le Nat.sub_le
-/

#print Nat.sub_lt /-
protected theorem sub_lt : ∀ {a b : ℕ}, 0 < a → 0 < b → a - b < a
  | 0, b, h1, h2 => absurd h1 (Nat.lt_irrefl 0)
  | a + 1, 0, h1, h2 => absurd h2 (Nat.lt_irrefl 0)
  | a + 1, b + 1, h1, h2 =>
    Eq.symm (succ_sub_succ_eq_sub a b) ▸ show a - b < succ a from lt_succ_of_le (a.sub_le b)
#align nat.sub_lt Nat.sub_lt
-/

#print Nat.lt_of_lt_of_le /-
protected theorem lt_of_lt_of_le {n m k : ℕ} : n < m → m ≤ k → n < k :=
  Nat.le_trans
#align nat.lt_of_lt_of_le Nat.lt_of_lt_of_le
-/

/-! Basic nat.add lemmas -/

#print Nat.zero_add /-
protected theorem zero_add : ∀ n : ℕ, 0 + n = n
  | 0 => rfl
  | n + 1 => congr_arg succ (zero_add n)
#align nat.zero_add Nat.zero_add
-/

#print Nat.succ_add /-
theorem succ_add : ∀ n m : ℕ, succ n + m = succ (n + m)
  | n, 0 => rfl
  | n, m + 1 => congr_arg succ (succ_add n m)
#align nat.succ_add Nat.succ_add
-/

#print Nat.add_succ /-
theorem add_succ (n m : ℕ) : n + succ m = succ (n + m) :=
  rfl
#align nat.add_succ Nat.add_succ
-/

/- warning: nat.add_zero clashes with nat_add_zero -> Nat.add_zero
Case conversion may be inaccurate. Consider using '#align nat.add_zero Nat.add_zeroₓ'. -/
#print Nat.add_zero /-
protected theorem add_zero (n : ℕ) : n + 0 = n :=
  rfl
#align nat.add_zero Nat.add_zero
-/

#print Nat.add_one /-
theorem add_one (n : ℕ) : n + 1 = succ n :=
  rfl
#align nat.add_one Nat.add_one
-/

#print Nat.succ_eq_add_one /-
theorem succ_eq_add_one (n : ℕ) : succ n = n + 1 :=
  rfl
#align nat.succ_eq_add_one Nat.succ_eq_add_one
-/

/-! Basic lemmas for comparing numerals -/

#print Nat.bit0_succ_eq /-
protected theorem bit0_succ_eq (n : ℕ) : bit0 (succ n) = succ (succ (bit0 n)) :=
  show succ (succ n + n) = succ (succ (n + n)) from congr_arg succ (succ_add n n)
#align nat.bit0_succ_eq Nat.bit0_succ_eq
-/

#print Nat.zero_lt_bit0 /-
protected theorem zero_lt_bit0 : ∀ {n : Nat}, n ≠ 0 → 0 < bit0 n
  | 0, h => absurd rfl h
  | succ n, h =>
    calc
      0 < succ (succ (bit0 n)) := zero_lt_succ _
      _ = bit0 (succ n) := (Nat.bit0_succ_eq n).symm

#align nat.zero_lt_bit0 Nat.zero_lt_bit0
-/

#print Nat.zero_lt_bit1 /-
protected theorem zero_lt_bit1 (n : Nat) : 0 < bit1 n :=
  zero_lt_succ _
#align nat.zero_lt_bit1 Nat.zero_lt_bit1
-/

#print Nat.bit0_ne_zero /-
protected theorem bit0_ne_zero : ∀ {n : ℕ}, n ≠ 0 → bit0 n ≠ 0
  | 0, h => absurd rfl h
  | n + 1, h =>
    suffices n + 1 + (n + 1) ≠ 0 from this
    suffices succ (n + 1 + n) ≠ 0 from this
    fun h => Nat.noConfusion h
#align nat.bit0_ne_zero Nat.bit0_ne_zero
-/

#print Nat.bit1_ne_zero /-
protected theorem bit1_ne_zero (n : ℕ) : bit1 n ≠ 0 :=
  show succ (n + n) ≠ 0 from fun h => Nat.noConfusion h
#align nat.bit1_ne_zero Nat.bit1_ne_zero
-/

end Nat


import .love01_definitions_and_statements_demo

/-! # LoVe Demo 3: Forward Proofs

When developing a proof, often it makes sense to work __forward__: to start with
what we already know and proceed step by step towards our goal. Lean's
structured proofs and raw proof terms are two style that support forward
reasoning. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

namespace forward_proofs

/-! ## Structured Constructs

Structured proofs are syntactic sugar sprinkled on top of Lean's
__proof terms__.

The simplest kind of structured proof is the name of a lemma, possibly with
arguments. -/

lemma add_comm (m n : ℕ) :
  add m n = add n m :=
sorry

lemma add_comm_zero_left (n : ℕ) :
  add 0 n = add n 0 :=
add_comm 0 n

lemma add_comm_zero_left₂ (n : ℕ) :
  add 0 n = add n 0 :=
by exact add_comm 0 n

/-! `fix` and `assume` move `∀`-quantified variables and assumptions from the
goal into the local context. They can be seen as structured versions of the
`intros` tactic.

`show` repeats the goal to prove. It is useful as documentation or to rephrase
the goal (up to computation). -/

lemma fst_of_two_props :
  ∀a b : Prop, a → b → a :=
fix a b : Prop,
assume ha : a,
assume hb : b,
show a, from
  ha

lemma fst_of_two_props₂ (a b : Prop) (ha : a) (hb : b) :
  a :=
show a, from
  begin
    exact ha
  end

lemma fst_of_two_props₃ (a b : Prop) (ha : a) (hb : b) :
  a :=
ha

/-! `have` proves an intermediate lemma, which can refer to the local context. -/

lemma prop_comp (a b c : Prop) (hab : a → b) (hbc : b → c) :
  a → c :=
assume ha : a,
have hb : b :=
  hab ha,
have hc : c :=
  hbc hb,
show c, from
  hc

lemma prop_comp₂ (a b c : Prop) (hab : a → b) (hbc : b → c) :
  a → c :=
assume ha : a,
show c, from
  hbc (hab ha)

/-! ## Forward Reasoning about Connectives and Quantifiers -/

lemma and_swap (a b : Prop) :
  a ∧ b → b ∧ a :=
assume hab : a ∧ b,
have ha : a :=
  and.elim_left hab,
have hb : b :=
  and.elim_right hab,
show b ∧ a, from
  and.intro hb ha

lemma or_swap (a b : Prop) :
  a ∨ b → b ∨ a :=
assume hab : a ∨ b,
show b ∨ a, from
  or.elim hab
    (assume ha : a,
     show b ∨ a, from
       or.intro_right b ha)
    (assume hb : b,
     show b ∨ a, from
       or.intro_left a hb)

def double (n : ℕ) : ℕ :=
n + n

lemma nat_exists_double_iden :
  ∃n : ℕ, double n = n :=
exists.intro 0
  (show double 0 = 0, from
     by refl)

lemma nat_exists_double_iden₂ :
  ∃n : ℕ, double n = n :=
exists.intro 0 (by refl)

lemma modus_ponens (a b : Prop) :
  (a → b) → a → b :=
assume hab : a → b,
assume ha : a,
show b, from
  hab ha

lemma not_not_intro (a : Prop) :
  a → ¬¬ a :=
assume ha : a,
assume hna : ¬ a,
show false, from
  hna ha

lemma forall.one_point {α : Type} (t : α) (p : α → Prop) :
  (∀x, x = t → p x) ↔ p t :=
iff.intro
  (assume hall : ∀x, x = t → p x,
   show p t, from
     begin
       apply hall t,
       refl
     end)
  (assume hp : p t,
   fix x,
   assume heq : x = t,
   show p x, from
     begin
       rw heq,
       exact hp
     end)

lemma beast_666 (beast : ℕ) :
  (∀n, n = 666 → beast ≥ n) ↔ beast ≥ 666 :=
forall.one_point _ _

#print beast_666

lemma exists.one_point {α : Type} (t : α) (p : α → Prop) :
  (∃x : α, x = t ∧ p x) ↔ p t :=
iff.intro
  (assume hex : ∃x, x = t ∧ p x,
   show p t, from
     exists.elim hex
       (fix x,
        assume hand : x = t ∧ p x,
        show p t, from
          by cc))
  (assume hp : p t,
   show ∃x : α, x = t ∧ p x, from
     exists.intro t
       (show t = t ∧ p t, from
          by cc))

/-! ## Calculational Proofs

In informal mathematics, we often use transitive chains of equalities,
inequalities, or equivalences (e.g., `a ≥ b ≥ c`). In Lean, such calculational
proofs are supported by `calc`.

Syntax:

    calc      _term₀_
        _op₁_ _term₁_ :
      _proof₁_
    ... _op₂_ _term₂_ :
      _proof₂_
     ⋮
    ... _opN_ _termN_ :
      _proofN_ -/

lemma two_mul_example (m n : ℕ) :
  2 * m + n = m + n + m :=
calc  2 * m + n
    = (m + m) + n :
  by rw two_mul
... = m + n + m :
  by cc

/-! `calc` saves some repetition, some `have` labels, and some transitive
reasoning: -/

lemma two_mul_example₂ (m n : ℕ) :
  2 * m + n = m + n + m :=
have h₁ : 2 * m + n = (m + m) + n :=
  by rw two_mul,
have h₂ : (m + m) + n = m + n + m :=
  by cc,
show _, from
  eq.trans h₁ h₂

/-! ## Forward Reasoning with Tactics

The `have`, `let`, and `calc` structured proof commands are also available as a
tactic. Even in tactic mode, it can be useful to state intermediate results and
definitions in a forward fashion.

Observe that the syntax for the tactic `let` is slightly different than for the
structured proof command `let`, with `,` instead of `in`. -/

lemma prop_comp₃ (a b c : Prop) (hab : a → b) (hbc : b → c) :
  a → c :=
begin
  intro ha,
  have hb : b :=
    hab ha,
  let c' := c,
  have hc : c' :=
    hbc hb,
  exact hc
end

/-! ## Dependent Types

Dependent types are the defining feature of the dependent type theory family of
logics.

Consider a function `pick` that take a number `n : ℕ` and that returns a number
between 0 and `n`. Conceptually, `pick` has a dependent type, namely

    `(n : ℕ) → {i : ℕ // i ≤ n}`

We can think of this type as a `ℕ`-indexed family, where each member's type may
depend on the index:

    `pick n : {i : ℕ // i ≤ n}`

But a type may also depend on another type, e.g., `list` (or `λα, list α`) and
`λα, α → α`.

A term may depend on a type, e.g., `λα, λx : α, x` (a polymorphic identity
function).

Of course, a term may also depend on a term.

Unless otherwise specified, a __dependent type__ means a type depending on a
term. This is what we mean when we say that simple type theory does not support
dependent types.

In summary, there are four cases for `λx, t` in the calculus of inductive
constructions (cf. Barendregt's `λ`-cube):

Body (`t`) |              | Argument (`x`) | Description
---------- | ------------ | -------------- | ------------------------------
A term     | depending on | a term         | Simply typed `λ`-expression
A type     | depending on | a term         | Dependent type (strictly speaking)
A term     | depending on | a type         | Polymorphic term
A type     | depending on | a type         | Type constructor

Revised typing rules:

    C ⊢ t : (x : σ) → τ[x]    C ⊢ u : σ
    ———————————————————————————————————— App'
    C ⊢ t u : τ[u]

    C, x : σ ⊢ t : τ[x]
    ———————————————————————————————— Lam'
    C ⊢ (λx : σ, t) : (x : σ) → τ[x]

These two rules degenerate to `App` and `Lam` if `x` does not occur in `τ[x]`

Example of `App'`:

    ⊢ pick : (x : ℕ) → {y : ℕ // y ≤ x}    ⊢ 5 : ℕ
    ——————————————————————————————————————————————— App'
    ⊢ pick 5 : {y : ℕ // y ≤ 5}

Example of `Lam'`:

    α : Type, x : α ⊢ x : α
    ——————————————————————————————— Lam or Lam'
    α : Type ⊢ (λx : α, x) : α → α
    ————————————————————————————————————————————— Lam'
    ⊢ (λα : Type, λx : α, x) : (α : Type) → α → α

Regrettably, the intuitive syntax `(x : σ) → τ` is not available in Lean.
Instead, we must write `∀x : σ, τ` to specify a dependent type.

Aliases:

    `σ → τ` := `∀_ : σ, τ`
    `Π`     := `∀`

## The PAT Principle

`→` is used both as the implication symbol and as the type constructor of
functions. Similarly, `∀` is used both as a quantifier and in dependent types.

The two pairs of concepts not only look the same, they are the same, by the PAT
principle:

* PAT = propositions as types;
* PAT = proofs as terms.

Types:

* `σ → τ` is the type of total functions from `σ` to `τ`;
* `∀x : σ, τ[x]` is the dependent function type from `x : σ` to `τ[x]`.

Propositions:

* `P → Q` can be read as "`P` implies `Q`", or as the type of functions mapping
  proofs of `P` to proofs of `Q`.
* `∀x : σ, Q[x]` can be read as "for all `x`, `Q[x]`", or as the type of
  functions mapping values `x` of type `σ` to proofs of `Q[x]`.

Terms:

* A constant is a term.
* A variable is a term.
* `t u` is the application of function `t` to value `u`.
* `λx, t[x]` is a function mapping `x` to `t[x]`.

Proofs:

* A lemma or hypothesis name is a proof.
* `H t`, which instantiates the leading parameter or quantifier of proof `H`'
  statement with term `t`, is a proof.
* `H G`, which discharges the leading assumption of `H`'s statement with
  proof `G`, is a proof.
* `λh : P, H[h]` is a proof of `P → Q`, assuming `H[h]` is a proof of `Q`
  for `h : P`.
* `λx : σ, H[x]` is a proof of `∀x : σ, Q[x]`, assuming `H[x]` is a proof of
  `Q[x]` for `x : σ`. -/

lemma and_swap₃ (a b : Prop) :
  a ∧ b → b ∧ a :=
λhab : a ∧ b, and.intro (and.elim_right hab) (and.elim_left hab)

lemma and_swap₄ (a b : Prop) :
  a ∧ b → b ∧ a :=
begin
  intro hab,
  apply and.intro,
  apply and.elim_right,
  exact hab,
  apply and.elim_left,
  exact hab
end

/-! Tactical proofs are reduced to proof terms. -/

#print and_swap₃
#print and_swap₄

end forward_proofs

/-! ## Induction by Pattern Matching

By the PAT principle, a proof by induction is the same as a recursively
specified proof term. Thus, as alternative to the `induction'` tactic, induction
can also be done by pattern matching:

 * the induction hypothesis is then available under the name of the lemma we are
   proving;

 * well-foundedness of the argument is often proved automatically. -/

#check reverse

lemma reverse_append {α : Type} :
  ∀xs ys : list α,
    reverse (xs ++ ys) = reverse ys ++ reverse xs
| []        ys := by simp [reverse]
| (x :: xs) ys := by simp [reverse, reverse_append xs]

lemma reverse_append₂ {α : Type} (xs ys : list α) :
  reverse (xs ++ ys) = reverse ys ++ reverse xs :=
begin
  induction' xs,
  { simp [reverse] },
  { simp [reverse, ih] }
end

lemma reverse_reverse {α : Type} :
  ∀xs : list α, reverse (reverse xs) = xs
| []        := by refl
| (x :: xs) :=
  by simp [reverse, reverse_append, reverse_reverse xs]

end LoVe


import data.set.intervals data.nat.parity
import tactic

universes u v w
open_locale classical

/-! Some simple additions to the api -/

open set

namespace int

lemma le_sub_one_of_le_of_ne {x y : ℤ} :
  x ≤ y → x ≠ y → x ≤ y - 1 :=
  λ h h', int.le_sub_one_of_lt (lt_of_le_of_ne h h')

lemma le_of_not_gt' {x y : ℤ} :
  ¬ (y < x) → x ≤ y :=
  not_lt.mp

lemma nonneg_le_one_iff {x : ℤ} (h0 : 0 ≤ x) (h1 : x ≤ 1) :
  x = 0 ∨ x = 1 :=
by {by_cases h : x ≤ 0, left, apply le_antisymm h h0,
    push_neg at h, rw int.le_sub_one_iff.symm at h,
    right, linarith, }

lemma nat_le_two_iff {x : ℕ} (h2 : x ≤ 2) :
  x = 0 ∨ x = 1 ∨ x = 2 :=
by {cases x, tauto, cases x, tauto, cases x, tauto, repeat {rw nat.succ_eq_add_one at h2}, linarith}

lemma nonneg_le_two_iff {x : ℤ} (h0 : 0 ≤ x) (h2 : x ≤ 2) :
  x = 0 ∨ x = 1 ∨ x = 2 :=
begin
  by_cases h2' : 2 ≤ x, right, right, apply le_antisymm h2 h2',
  push_neg at h2', rw int.le_sub_one_iff.symm at h2',
  cases nonneg_le_one_iff h0 h2', {left, exact h}, {right, left, exact h},
end

lemma to_nat_zero_of_nonpos {x : ℤ} (hx : x ≤ 0):
  x.to_nat = 0 :=
by {rcases em (x = 0) with (rfl | hx'), simp, apply to_nat_zero_of_neg (lt_of_le_of_ne hx hx'), }

end int

namespace nat

lemma lt_iff_succ_le {a b : ℕ} :
  a < b ↔ a.succ ≤ b :=
⟨λ h, succ_le_of_lt h, λ h, lt_of_succ_le h⟩

end nat

section order

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

lemma squeeze_le_trans_left (hab : a ≤ b) (hbc : b ≤ c) (hac : a = c):
  a = b :=
le_antisymm hab (hbc.trans hac.symm.le)

lemma squeeze_le_trans_right (hab : a ≤ b) (hbc : b ≤ c) (hac : a = c):
  b = c :=
le_antisymm hbc (hac.symm.le.trans hab)

lemma squeeze_le_trans (hab : a ≤ b) (hbc : b ≤ c) (hac : a = c):
  a = b ∧ b = c :=
⟨squeeze_le_trans_left hab hbc hac, squeeze_le_trans_right hab hbc hac⟩

end order

section neg_one_pow

lemma nat.neg_one_pow_sum_eq_zero_of_sum_odd {n m : ℕ} (h : odd (n+m)) :
  (-1 :ℤ)^m + (-1)^n = 0 :=
begin
  obtain ⟨ (⟨k,rfl⟩ | ⟨k,rfl⟩), (⟨j,rfl⟩ | ⟨j,rfl⟩)⟩ := ⟨nat.even_or_odd n, nat.even_or_odd m⟩,
  { exfalso, apply nat.odd_iff_not_even.mp h ⟨k+j, by {rw mul_add}⟩, },
  { simp [nat.neg_one_pow_of_odd ⟨j,rfl⟩, nat.neg_one_pow_of_even ⟨k,rfl⟩]},
  { simp [nat.neg_one_pow_of_even ⟨j,rfl⟩, nat.neg_one_pow_of_odd ⟨k,rfl⟩]},
  { exfalso, apply nat.odd_iff_not_even.mp h ⟨j+k+1, by linarith⟩},
end

def int.neg_one_pow (n : ℤ) : ℤ := @gpow (units ℤ) _ (-1) n

lemma int.neg_one_pow_eq_neg_one_pow_neg (n : ℤ) :
  int.neg_one_pow n = int.neg_one_pow (-n) :=
begin
  unfold int.neg_one_pow,
  simp only [gpow_neg, group.gpow_eq_has_pow],
  rw [eq_comm],
  apply units.inv_eq_of_mul_eq_one,
  simp,
end

lemma int.neg_one_pow_eq_abs (n : ℤ):
  int.neg_one_pow n = (-1)^(n.nat_abs) :=
begin
  unfold int.neg_one_pow,
  rcases int.nat_abs_eq n with (h | h), rw h, simp,
  rw h,
  simp only [int.nat_abs_of_nat, gpow_neg, int.nat_abs_neg, group.gpow_eq_has_pow, gpow_coe_nat],
  apply units.inv_eq_of_mul_eq_one,
  simp only [units.coe_neg_one, units.coe_pow, ← pow_add, ← two_mul],
  apply nat.neg_one_pow_of_even,
  exact ⟨_, rfl⟩,
end

lemma int.neg_one_pow_coe {n : ℕ}: int.neg_one_pow n = (-1)^n :=
by {rw int.neg_one_pow_eq_abs, congr', }

lemma neg_one_pow_of_even {n : ℤ} (hn : even n) : int.neg_one_pow n = 1 :=
begin
  obtain ⟨k,rfl⟩ := hn,
  obtain ⟨a, (rfl | rfl)⟩ := k.eq_coe_or_neg, swap,
  rw [(by simp : ((2 : ℤ) * - (a : ℤ) = - (2*a ))), int.neg_one_pow_eq_neg_one_pow_neg, neg_neg],
  all_goals
  { rw [← (by simp: ((2 * a : ℕ) : ℤ) = ((2 : ℤ)* (a : ℤ))), int.neg_one_pow_coe,
    nat.neg_one_pow_of_even ⟨_, rfl⟩]},
end
/-
lemma neg_one_pow_of_odd {n : ℤ} (hn : odd n) : int.neg_one_pow n = -1 :=
begin
  obtain ⟨k,rfl⟩ := hn,
  rw [int.neg_one_pow], convert gpow_add_one (-1 : units ℤ) (2*k),
end
-/
end neg_one_pow


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

! This file was ported from Lean 3 source module geometry.euclidean.sphere.basic
! leanprover-community/mathlib commit 46b633fd842bef9469441c0209906f6dddd2b4f5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Convex.StrictConvexBetween
import Mathbin.Geometry.Euclidean.Basic

/-!
# Spheres

This file defines and proves basic results about spheres and cospherical sets of points in
Euclidean affine spaces.

## Main definitions

* `euclidean_geometry.sphere` bundles a `center` and a `radius`.

* `euclidean_geometry.cospherical` is the property of a set of points being equidistant from some
  point.

* `euclidean_geometry.concyclic` is the property of a set of points being cospherical and
  coplanar.

-/

noncomputable section

open RealInnerProductSpace

namespace EuclideanGeometry

variable {V : Type _} (P : Type _)

open FiniteDimensional

/-- A `sphere P` bundles a `center` and `radius`. This definition does not require the radius to
be positive; that should be given as a hypothesis to lemmas that require it. -/
@[ext]
structure Sphere [MetricSpace P] where
  center : P
  radius : ℝ
#align euclidean_geometry.sphere EuclideanGeometry.Sphere

variable {P}

section MetricSpace

variable [MetricSpace P]

instance [Nonempty P] : Nonempty (Sphere P) :=
  ⟨⟨Classical.arbitrary P, 0⟩⟩

instance : Coe (Sphere P) (Set P) :=
  ⟨fun s => Metric.sphere s.center s.radius⟩

instance : Membership P (Sphere P) :=
  ⟨fun p s => p ∈ (s : Set P)⟩

theorem Sphere.mk_center (c : P) (r : ℝ) : (⟨c, r⟩ : Sphere P).center = c :=
  rfl
#align euclidean_geometry.sphere.mk_center EuclideanGeometry.Sphere.mk_center

theorem Sphere.mk_radius (c : P) (r : ℝ) : (⟨c, r⟩ : Sphere P).radius = r :=
  rfl
#align euclidean_geometry.sphere.mk_radius EuclideanGeometry.Sphere.mk_radius

@[simp]
theorem Sphere.mk_center_radius (s : Sphere P) : (⟨s.center, s.radius⟩ : Sphere P) = s := by
  ext <;> rfl
#align euclidean_geometry.sphere.mk_center_radius EuclideanGeometry.Sphere.mk_center_radius

theorem Sphere.coe_def (s : Sphere P) : (s : Set P) = Metric.sphere s.center s.radius :=
  rfl
#align euclidean_geometry.sphere.coe_def EuclideanGeometry.Sphere.coe_def

@[simp]
theorem Sphere.coe_mk (c : P) (r : ℝ) : ↑(⟨c, r⟩ : Sphere P) = Metric.sphere c r :=
  rfl
#align euclidean_geometry.sphere.coe_mk EuclideanGeometry.Sphere.coe_mk

@[simp]
theorem Sphere.mem_coe {p : P} {s : Sphere P} : p ∈ (s : Set P) ↔ p ∈ s :=
  Iff.rfl
#align euclidean_geometry.sphere.mem_coe EuclideanGeometry.Sphere.mem_coe

theorem mem_sphere {p : P} {s : Sphere P} : p ∈ s ↔ dist p s.center = s.radius :=
  Iff.rfl
#align euclidean_geometry.mem_sphere EuclideanGeometry.mem_sphere

theorem mem_sphere' {p : P} {s : Sphere P} : p ∈ s ↔ dist s.center p = s.radius :=
  Metric.mem_sphere'
#align euclidean_geometry.mem_sphere' EuclideanGeometry.mem_sphere'

theorem subset_sphere {ps : Set P} {s : Sphere P} : ps ⊆ s ↔ ∀ p ∈ ps, p ∈ s :=
  Iff.rfl
#align euclidean_geometry.subset_sphere EuclideanGeometry.subset_sphere

theorem dist_of_mem_subset_sphere {p : P} {ps : Set P} {s : Sphere P} (hp : p ∈ ps)
    (hps : ps ⊆ (s : Set P)) : dist p s.center = s.radius :=
  mem_sphere.1 (Sphere.mem_coe.1 (Set.mem_of_mem_of_subset hp hps))
#align euclidean_geometry.dist_of_mem_subset_sphere EuclideanGeometry.dist_of_mem_subset_sphere

theorem dist_of_mem_subset_mk_sphere {p c : P} {ps : Set P} {r : ℝ} (hp : p ∈ ps)
    (hps : ps ⊆ ↑(⟨c, r⟩ : Sphere P)) : dist p c = r :=
  dist_of_mem_subset_sphere hp hps
#align euclidean_geometry.dist_of_mem_subset_mk_sphere EuclideanGeometry.dist_of_mem_subset_mk_sphere

theorem Sphere.ne_iff {s₁ s₂ : Sphere P} :
    s₁ ≠ s₂ ↔ s₁.center ≠ s₂.center ∨ s₁.radius ≠ s₂.radius := by
  rw [← not_and_or, ← sphere.ext_iff]
#align euclidean_geometry.sphere.ne_iff EuclideanGeometry.Sphere.ne_iff

theorem Sphere.center_eq_iff_eq_of_mem {s₁ s₂ : Sphere P} {p : P} (hs₁ : p ∈ s₁) (hs₂ : p ∈ s₂) :
    s₁.center = s₂.center ↔ s₁ = s₂ :=
  by
  refine' ⟨fun h => sphere.ext _ _ h _, fun h => h ▸ rfl⟩
  rw [mem_sphere] at hs₁ hs₂
  rw [← hs₁, ← hs₂, h]
#align euclidean_geometry.sphere.center_eq_iff_eq_of_mem EuclideanGeometry.Sphere.center_eq_iff_eq_of_mem

theorem Sphere.center_ne_iff_ne_of_mem {s₁ s₂ : Sphere P} {p : P} (hs₁ : p ∈ s₁) (hs₂ : p ∈ s₂) :
    s₁.center ≠ s₂.center ↔ s₁ ≠ s₂ :=
  (Sphere.center_eq_iff_eq_of_mem hs₁ hs₂).Not
#align euclidean_geometry.sphere.center_ne_iff_ne_of_mem EuclideanGeometry.Sphere.center_ne_iff_ne_of_mem

theorem dist_center_eq_dist_center_of_mem_sphere {p₁ p₂ : P} {s : Sphere P} (hp₁ : p₁ ∈ s)
    (hp₂ : p₂ ∈ s) : dist p₁ s.center = dist p₂ s.center := by
  rw [mem_sphere.1 hp₁, mem_sphere.1 hp₂]
#align euclidean_geometry.dist_center_eq_dist_center_of_mem_sphere EuclideanGeometry.dist_center_eq_dist_center_of_mem_sphere

theorem dist_center_eq_dist_center_of_mem_sphere' {p₁ p₂ : P} {s : Sphere P} (hp₁ : p₁ ∈ s)
    (hp₂ : p₂ ∈ s) : dist s.center p₁ = dist s.center p₂ := by
  rw [mem_sphere'.1 hp₁, mem_sphere'.1 hp₂]
#align euclidean_geometry.dist_center_eq_dist_center_of_mem_sphere' EuclideanGeometry.dist_center_eq_dist_center_of_mem_sphere'

/-- A set of points is cospherical if they are equidistant from some
point.  In two dimensions, this is the same thing as being
concyclic. -/
def Cospherical (ps : Set P) : Prop :=
  ∃ (center : P)(radius : ℝ), ∀ p ∈ ps, dist p center = radius
#align euclidean_geometry.cospherical EuclideanGeometry.Cospherical

/-- The definition of `cospherical`. -/
theorem cospherical_def (ps : Set P) :
    Cospherical ps ↔ ∃ (center : P)(radius : ℝ), ∀ p ∈ ps, dist p center = radius :=
  Iff.rfl
#align euclidean_geometry.cospherical_def EuclideanGeometry.cospherical_def

/-- A set of points is cospherical if and only if they lie in some sphere. -/
theorem cospherical_iff_exists_sphere {ps : Set P} :
    Cospherical ps ↔ ∃ s : Sphere P, ps ⊆ (s : Set P) :=
  by
  refine' ⟨fun h => _, fun h => _⟩
  · rcases h with ⟨c, r, h⟩
    exact ⟨⟨c, r⟩, h⟩
  · rcases h with ⟨s, h⟩
    exact ⟨s.center, s.radius, h⟩
#align euclidean_geometry.cospherical_iff_exists_sphere EuclideanGeometry.cospherical_iff_exists_sphere

/-- The set of points in a sphere is cospherical. -/
theorem Sphere.cospherical (s : Sphere P) : Cospherical (s : Set P) :=
  cospherical_iff_exists_sphere.2 ⟨s, Set.Subset.rfl⟩
#align euclidean_geometry.sphere.cospherical EuclideanGeometry.Sphere.cospherical

/-- A subset of a cospherical set is cospherical. -/
theorem Cospherical.subset {ps₁ ps₂ : Set P} (hs : ps₁ ⊆ ps₂) (hc : Cospherical ps₂) :
    Cospherical ps₁ := by
  rcases hc with ⟨c, r, hcr⟩
  exact ⟨c, r, fun p hp => hcr p (hs hp)⟩
#align euclidean_geometry.cospherical.subset EuclideanGeometry.Cospherical.subset

/-- The empty set is cospherical. -/
theorem cospherical_empty [Nonempty P] : Cospherical (∅ : Set P) :=
  let ⟨p⟩ := ‹Nonempty P›
  ⟨p, 0, fun p => False.elim⟩
#align euclidean_geometry.cospherical_empty EuclideanGeometry.cospherical_empty

/-- A single point is cospherical. -/
theorem cospherical_singleton (p : P) : Cospherical ({p} : Set P) :=
  by
  use p
  simp
#align euclidean_geometry.cospherical_singleton EuclideanGeometry.cospherical_singleton

end MetricSpace

section NormedSpace

variable [NormedAddCommGroup V] [NormedSpace ℝ V] [MetricSpace P] [NormedAddTorsor V P]

include V

/-- Two points are cospherical. -/
theorem cospherical_pair (p₁ p₂ : P) : Cospherical ({p₁, p₂} : Set P) :=
  ⟨midpoint ℝ p₁ p₂, ‖(2 : ℝ)‖⁻¹ * dist p₁ p₂,
    by
    rintro p (rfl | rfl | _)
    · rw [dist_comm, dist_midpoint_left]
    · rw [dist_comm, dist_midpoint_right]⟩
#align euclidean_geometry.cospherical_pair EuclideanGeometry.cospherical_pair

/-- A set of points is concyclic if it is cospherical and coplanar. (Most results are stated
directly in terms of `cospherical` instead of using `concyclic`.) -/
structure Concyclic (ps : Set P) : Prop where
  Cospherical : Cospherical ps
  Coplanar : Coplanar ℝ ps
#align euclidean_geometry.concyclic EuclideanGeometry.Concyclic

/-- A subset of a concyclic set is concyclic. -/
theorem Concyclic.subset {ps₁ ps₂ : Set P} (hs : ps₁ ⊆ ps₂) (h : Concyclic ps₂) : Concyclic ps₁ :=
  ⟨h.1.Subset hs, h.2.Subset hs⟩
#align euclidean_geometry.concyclic.subset EuclideanGeometry.Concyclic.subset

/-- The empty set is concyclic. -/
theorem concyclic_empty : Concyclic (∅ : Set P) :=
  ⟨cospherical_empty, coplanar_empty ℝ P⟩
#align euclidean_geometry.concyclic_empty EuclideanGeometry.concyclic_empty

/-- A single point is concyclic. -/
theorem concyclic_singleton (p : P) : Concyclic ({p} : Set P) :=
  ⟨cospherical_singleton p, coplanar_singleton ℝ p⟩
#align euclidean_geometry.concyclic_singleton EuclideanGeometry.concyclic_singleton

/-- Two points are concyclic. -/
theorem concyclic_pair (p₁ p₂ : P) : Concyclic ({p₁, p₂} : Set P) :=
  ⟨cospherical_pair p₁ p₂, coplanar_pair ℝ p₁ p₂⟩
#align euclidean_geometry.concyclic_pair EuclideanGeometry.concyclic_pair

end NormedSpace

section EuclideanSpace

variable [NormedAddCommGroup V] [InnerProductSpace ℝ V] [MetricSpace P] [NormedAddTorsor V P]

include V

/-- Any three points in a cospherical set are affinely independent. -/
theorem Cospherical.affineIndependent {s : Set P} (hs : Cospherical s) {p : Fin 3 → P}
    (hps : Set.range p ⊆ s) (hpi : Function.Injective p) : AffineIndependent ℝ p :=
  by
  rw [affineIndependent_iff_not_collinear]
  intro hc
  rw [collinear_iff_of_mem (Set.mem_range_self (0 : Fin 3))] at hc
  rcases hc with ⟨v, hv⟩
  rw [Set.forall_range_iff] at hv
  have hv0 : v ≠ 0 := by
    intro h
    have he : p 1 = p 0 := by simpa [h] using hv 1
    exact (by decide : (1 : Fin 3) ≠ 0) (hpi he)
  rcases hs with ⟨c, r, hs⟩
  have hs' := fun i => hs (p i) (Set.mem_of_mem_of_subset (Set.mem_range_self _) hps)
  choose f hf using hv
  have hsd : ∀ i, dist (f i • v +ᵥ p 0) c = r :=
    by
    intro i
    rw [← hf]
    exact hs' i
  have hf0 : f 0 = 0 := by
    have hf0' := hf 0
    rw [eq_comm, ← @vsub_eq_zero_iff_eq V, vadd_vsub, smul_eq_zero] at hf0'
    simpa [hv0] using hf0'
  have hfi : Function.Injective f := by
    intro i j h
    have hi := hf i
    rw [h, ← hf j] at hi
    exact hpi hi
  simp_rw [← hsd 0, hf0, zero_smul, zero_vadd, dist_smul_vadd_eq_dist (p 0) c hv0] at hsd
  have hfn0 : ∀ i, i ≠ 0 → f i ≠ 0 := fun i => (hfi.ne_iff' hf0).2
  have hfn0' : ∀ i, i ≠ 0 → f i = -2 * ⟪v, p 0 -ᵥ c⟫ / ⟪v, v⟫ :=
    by
    intro i hi
    have hsdi := hsd i
    simpa [hfn0, hi] using hsdi
  have hf12 : f 1 = f 2 := by rw [hfn0' 1 (by decide), hfn0' 2 (by decide)]
  exact (by decide : (1 : Fin 3) ≠ 2) (hfi hf12)
#align euclidean_geometry.cospherical.affine_independent EuclideanGeometry.Cospherical.affineIndependent

/-- Any three points in a cospherical set are affinely independent. -/
theorem Cospherical.affineIndependent_of_mem_of_ne {s : Set P} (hs : Cospherical s) {p₁ p₂ p₃ : P}
    (h₁ : p₁ ∈ s) (h₂ : p₂ ∈ s) (h₃ : p₃ ∈ s) (h₁₂ : p₁ ≠ p₂) (h₁₃ : p₁ ≠ p₃) (h₂₃ : p₂ ≠ p₃) :
    AffineIndependent ℝ ![p₁, p₂, p₃] :=
  by
  refine' hs.affine_independent _ _
  · simp [h₁, h₂, h₃, Set.insert_subset]
  · erw [Fin.cons_injective_iff, Fin.cons_injective_iff]
    simp [h₁₂, h₁₃, h₂₃, Function.Injective]
#align euclidean_geometry.cospherical.affine_independent_of_mem_of_ne EuclideanGeometry.Cospherical.affineIndependent_of_mem_of_ne

/-- The three points of a cospherical set are affinely independent. -/
theorem Cospherical.affineIndependent_of_ne {p₁ p₂ p₃ : P} (hs : Cospherical ({p₁, p₂, p₃} : Set P))
    (h₁₂ : p₁ ≠ p₂) (h₁₃ : p₁ ≠ p₃) (h₂₃ : p₂ ≠ p₃) : AffineIndependent ℝ ![p₁, p₂, p₃] :=
  hs.affineIndependent_of_mem_of_ne (Set.mem_insert _ _)
    (Set.mem_insert_of_mem _ (Set.mem_insert _ _))
    (Set.mem_insert_of_mem _ (Set.mem_insert_of_mem _ (Set.mem_singleton _))) h₁₂ h₁₃ h₂₃
#align euclidean_geometry.cospherical.affine_independent_of_ne EuclideanGeometry.Cospherical.affineIndependent_of_ne

/-- Suppose that `p₁` and `p₂` lie in spheres `s₁` and `s₂`.  Then the vector between the centers
of those spheres is orthogonal to that between `p₁` and `p₂`; this is a version of
`inner_vsub_vsub_of_dist_eq_of_dist_eq` for bundled spheres.  (In two dimensions, this says that
the diagonals of a kite are orthogonal.) -/
theorem inner_vsub_vsub_of_mem_sphere_of_mem_sphere {p₁ p₂ : P} {s₁ s₂ : Sphere P} (hp₁s₁ : p₁ ∈ s₁)
    (hp₂s₁ : p₂ ∈ s₁) (hp₁s₂ : p₁ ∈ s₂) (hp₂s₂ : p₂ ∈ s₂) :
    ⟪s₂.center -ᵥ s₁.center, p₂ -ᵥ p₁⟫ = 0 :=
  inner_vsub_vsub_of_dist_eq_of_dist_eq (dist_center_eq_dist_center_of_mem_sphere hp₁s₁ hp₂s₁)
    (dist_center_eq_dist_center_of_mem_sphere hp₁s₂ hp₂s₂)
#align euclidean_geometry.inner_vsub_vsub_of_mem_sphere_of_mem_sphere EuclideanGeometry.inner_vsub_vsub_of_mem_sphere_of_mem_sphere

/-- Two spheres intersect in at most two points in a two-dimensional subspace containing their
centers; this is a version of `eq_of_dist_eq_of_dist_eq_of_mem_of_finrank_eq_two` for bundled
spheres. -/
theorem eq_of_mem_sphere_of_mem_sphere_of_mem_of_finrank_eq_two {s : AffineSubspace ℝ P}
    [FiniteDimensional ℝ s.direction] (hd : finrank ℝ s.direction = 2) {s₁ s₂ : Sphere P}
    {p₁ p₂ p : P} (hs₁ : s₁.center ∈ s) (hs₂ : s₂.center ∈ s) (hp₁s : p₁ ∈ s) (hp₂s : p₂ ∈ s)
    (hps : p ∈ s) (hs : s₁ ≠ s₂) (hp : p₁ ≠ p₂) (hp₁s₁ : p₁ ∈ s₁) (hp₂s₁ : p₂ ∈ s₁) (hps₁ : p ∈ s₁)
    (hp₁s₂ : p₁ ∈ s₂) (hp₂s₂ : p₂ ∈ s₂) (hps₂ : p ∈ s₂) : p = p₁ ∨ p = p₂ :=
  eq_of_dist_eq_of_dist_eq_of_mem_of_finrank_eq_two hd hs₁ hs₂ hp₁s hp₂s hps
    ((Sphere.center_ne_iff_ne_of_mem hps₁ hps₂).2 hs) hp hp₁s₁ hp₂s₁ hps₁ hp₁s₂ hp₂s₂ hps₂
#align euclidean_geometry.eq_of_mem_sphere_of_mem_sphere_of_mem_of_finrank_eq_two EuclideanGeometry.eq_of_mem_sphere_of_mem_sphere_of_mem_of_finrank_eq_two

/-- Two spheres intersect in at most two points in two-dimensional space; this is a version of
`eq_of_dist_eq_of_dist_eq_of_finrank_eq_two` for bundled spheres. -/
theorem eq_of_mem_sphere_of_mem_sphere_of_finrank_eq_two [FiniteDimensional ℝ V]
    (hd : finrank ℝ V = 2) {s₁ s₂ : Sphere P} {p₁ p₂ p : P} (hs : s₁ ≠ s₂) (hp : p₁ ≠ p₂)
    (hp₁s₁ : p₁ ∈ s₁) (hp₂s₁ : p₂ ∈ s₁) (hps₁ : p ∈ s₁) (hp₁s₂ : p₁ ∈ s₂) (hp₂s₂ : p₂ ∈ s₂)
    (hps₂ : p ∈ s₂) : p = p₁ ∨ p = p₂ :=
  eq_of_dist_eq_of_dist_eq_of_finrank_eq_two hd ((Sphere.center_ne_iff_ne_of_mem hps₁ hps₂).2 hs) hp
    hp₁s₁ hp₂s₁ hps₁ hp₁s₂ hp₂s₂ hps₂
#align euclidean_geometry.eq_of_mem_sphere_of_mem_sphere_of_finrank_eq_two EuclideanGeometry.eq_of_mem_sphere_of_mem_sphere_of_finrank_eq_two

/-- Given a point on a sphere and a point not outside it, the inner product between the
difference of those points and the radius vector is positive unless the points are equal. -/
theorem inner_pos_or_eq_of_dist_le_radius {s : Sphere P} {p₁ p₂ : P} (hp₁ : p₁ ∈ s)
    (hp₂ : dist p₂ s.center ≤ s.radius) : 0 < ⟪p₁ -ᵥ p₂, p₁ -ᵥ s.center⟫ ∨ p₁ = p₂ :=
  by
  by_cases h : p₁ = p₂; · exact Or.inr h
  refine' Or.inl _
  rw [mem_sphere] at hp₁
  rw [← vsub_sub_vsub_cancel_right p₁ p₂ s.center, inner_sub_left,
    real_inner_self_eq_norm_mul_norm,--, ←dist_eq_norm_vsub, hp₁
    sub_pos]
  refine'
    lt_of_le_of_ne ((real_inner_le_norm _ _).trans (mul_le_mul_of_nonneg_right _ (norm_nonneg _))) _
  · rwa [← dist_eq_norm_vsub, ← dist_eq_norm_vsub, hp₁]
  · rcases hp₂.lt_or_eq with (hp₂' | hp₂')
    · refine' ((real_inner_le_norm _ _).trans_lt (mul_lt_mul_of_pos_right _ _)).Ne
      · rwa [← hp₁, @dist_eq_norm_vsub V, @dist_eq_norm_vsub V] at hp₂'
      · rw [norm_pos_iff, vsub_ne_zero]
        rintro rfl
        rw [← hp₁] at hp₂'
        refine' (dist_nonneg.not_lt : ¬dist p₂ s.center < 0) _
        simpa using hp₂'
    · rw [← hp₁, @dist_eq_norm_vsub V, @dist_eq_norm_vsub V] at hp₂'
      nth_rw 1 [← hp₂']
      rw [Ne.def, inner_eq_norm_mul_iff_real, hp₂', ← sub_eq_zero, ← smul_sub,
        vsub_sub_vsub_cancel_right, ← Ne.def, smul_ne_zero_iff, vsub_ne_zero,
        and_iff_left (Ne.symm h), norm_ne_zero_iff, vsub_ne_zero]
      rintro rfl
      refine' h (Eq.symm _)
      simpa using hp₂'
#align euclidean_geometry.inner_pos_or_eq_of_dist_le_radius EuclideanGeometry.inner_pos_or_eq_of_dist_le_radius

/-- Given a point on a sphere and a point not outside it, the inner product between the
difference of those points and the radius vector is nonnegative. -/
theorem inner_nonneg_of_dist_le_radius {s : Sphere P} {p₁ p₂ : P} (hp₁ : p₁ ∈ s)
    (hp₂ : dist p₂ s.center ≤ s.radius) : 0 ≤ ⟪p₁ -ᵥ p₂, p₁ -ᵥ s.center⟫ :=
  by
  rcases inner_pos_or_eq_of_dist_le_radius hp₁ hp₂ with (h | rfl)
  · exact h.le
  · simp
#align euclidean_geometry.inner_nonneg_of_dist_le_radius EuclideanGeometry.inner_nonneg_of_dist_le_radius

/-- Given a point on a sphere and a point inside it, the inner product between the difference of
those points and the radius vector is positive. -/
theorem inner_pos_of_dist_lt_radius {s : Sphere P} {p₁ p₂ : P} (hp₁ : p₁ ∈ s)
    (hp₂ : dist p₂ s.center < s.radius) : 0 < ⟪p₁ -ᵥ p₂, p₁ -ᵥ s.center⟫ :=
  by
  by_cases h : p₁ = p₂
  · rw [h, mem_sphere] at hp₁
    exact False.elim (hp₂.ne hp₁)
  exact (inner_pos_or_eq_of_dist_le_radius hp₁ hp₂.le).resolve_right h
#align euclidean_geometry.inner_pos_of_dist_lt_radius EuclideanGeometry.inner_pos_of_dist_lt_radius

/-- Given three collinear points, two on a sphere and one not outside it, the one not outside it
is weakly between the other two points. -/
theorem wbtw_of_collinear_of_dist_center_le_radius {s : Sphere P} {p₁ p₂ p₃ : P}
    (h : Collinear ℝ ({p₁, p₂, p₃} : Set P)) (hp₁ : p₁ ∈ s) (hp₂ : dist p₂ s.center ≤ s.radius)
    (hp₃ : p₃ ∈ s) (hp₁p₃ : p₁ ≠ p₃) : Wbtw ℝ p₁ p₂ p₃ :=
  h.wbtw_of_dist_eq_of_dist_le hp₁ hp₂ hp₃ hp₁p₃
#align euclidean_geometry.wbtw_of_collinear_of_dist_center_le_radius EuclideanGeometry.wbtw_of_collinear_of_dist_center_le_radius

/-- Given three collinear points, two on a sphere and one inside it, the one inside it is
strictly between the other two points. -/
theorem sbtw_of_collinear_of_dist_center_lt_radius {s : Sphere P} {p₁ p₂ p₃ : P}
    (h : Collinear ℝ ({p₁, p₂, p₃} : Set P)) (hp₁ : p₁ ∈ s) (hp₂ : dist p₂ s.center < s.radius)
    (hp₃ : p₃ ∈ s) (hp₁p₃ : p₁ ≠ p₃) : Sbtw ℝ p₁ p₂ p₃ :=
  h.sbtw_of_dist_eq_of_dist_lt hp₁ hp₂ hp₃ hp₁p₃
#align euclidean_geometry.sbtw_of_collinear_of_dist_center_lt_radius EuclideanGeometry.sbtw_of_collinear_of_dist_center_lt_radius

end EuclideanSpace

end EuclideanGeometry


/-
Copyright (c) 2022 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang
-/
import algebra.gcd_monoid.basic
import ring_theory.integrally_closed
import ring_theory.polynomial.eisenstein.basic

/-!

# GCD domains are integrally closed

-/

open_locale big_operators polynomial

variables {R A : Type*} [comm_ring R] [is_domain R] [gcd_monoid R] [comm_ring A] [algebra R A]

lemma is_localization.surj_of_gcd_domain (M : submonoid R) [is_localization M A] (z : A) :
  ∃ a b : R, is_unit (gcd a b) ∧ z * algebra_map R A b = algebra_map R A a :=
begin
  obtain ⟨x, ⟨y, hy⟩, rfl⟩ := is_localization.mk'_surjective M z,
  obtain ⟨x', y', hx', hy', hu⟩ := extract_gcd x y,
  use [x', y', hu],
  rw [mul_comm, is_localization.mul_mk'_eq_mk'_of_mul],
  convert is_localization.mk'_mul_cancel_left _ _ using 2,
  { rw [subtype.coe_mk, hy', ← mul_comm y', mul_assoc], conv_lhs { rw hx' } },
  { apply_instance },
end

@[priority 100]
instance gcd_monoid.to_is_integrally_closed : is_integrally_closed R :=
⟨λ X ⟨p, hp₁, hp₂⟩, begin
  obtain ⟨x, y, hg, he⟩ := is_localization.surj_of_gcd_domain (non_zero_divisors R) X,
  have := polynomial.dvd_pow_nat_degree_of_eval₂_eq_zero
    (is_fraction_ring.injective R $ fraction_ring R) hp₁ y x _ hp₂ (by rw [mul_comm, he]),
  have : is_unit y,
  { rw [is_unit_iff_dvd_one, ← one_pow],
    exact (dvd_gcd this $ dvd_refl y).trans (gcd_pow_left_dvd_pow_gcd.trans $
      pow_dvd_pow_of_dvd (is_unit_iff_dvd_one.1 hg) _) },
  use x * (this.unit⁻¹ : _),
  erw [map_mul, ← units.coe_map_inv, eq_comm, units.eq_mul_inv_iff_mul_eq],
  exact he,
end⟩


import tactic.norm_num chris_hughes_various.zmod data.nat.prime data.nat.basic data.int.modeq algebra.group_power group_theory.subgroup algebra.group data.set.basic group_theory.order_of_element
open nat

universes u v w x
variables m p : ℕ
variables {G : Type u} {H : Type v}
variables [group G] [group H] [group (zmod 11)] [add_group (zmod m)] [group (zmod p)]

definition is_cyclic (G : Type*) [group G] := ∃ x : G, gpowers x = set.univ
-- *1. Suppose that G is a finite group which contains elements of each of the orders 1, 2, . . . , 10. What is the smallest possible value of |G|? Find a group of this size which does have elements of each of these orders.
--theorem sheet07_q1 (G : Type*) (g : group) : := sorry

-- 2. What is the largest order of an element of S₈?
    -- Ans: 15
-- theorem sheet07_q2:

-- 3. Let G be a cyclic group of order n, and g a generator. Show that gk is a generator for G if and only if hcf(k, n) = 1.
-- theorem sheet07_q3:

-- 4. Let G and H be finite groups. Let G×H be the set {(g,h)|g∈G,h∈H} with the binary operation (g1, h1) ∗ (g2, h2) = (g1g2, h1h2).
definition Cart_prod := prod G H
--definition bin_op (G : Type*) (H : Type*) (g₁ g₂ : prod G H) := prod (g₁.1 * g₂.1) (g1.2 * g2.2)

-- (a) Show that (G×H,∗) is a group.
-- theorem sheet07_q4a:

-- (b) Show that if g ∈ G and h ∈ H have orders a, b respectively, then the order of (g,h) in G×H is the lowest common multiple of a and b.
-- theorem sheet07_q4b:

-- (c) Show that G × H is cyclic if and only if G and H are both cyclic, and hcf(|G|,|H|) = 1.
-- theorem sheet07_q4c:

-- 5. Say whether each of the following statements is true or false, giving a counterexample or a brief proof.
    -- all these are true lmao

-- (a) For any positive integer m, the group (ℤ_m,+) is cyclic.
--theorem sheet07_q5a (m : ℕ) : is_cyclic (zmod m) → true := sorry

-- (b) ℤ_11 is a cyclic group.
theorem sheet07_q5b : is_cyclic (zmod 11) → true := sorry

-- (c) If p is an odd prime, then ℤ_p has exactly one element of order 2.
--theorem sheet07_q5c (p : ℕ) (hp : prime p) (x : zmod p) : ∃! x ∈ zmod p := sorry

-- (d) If p is a prime number with p ≡ 4 mod 5,then the inverse of [5] in ℤ_p is 􏰀p+1􏰁.
theorem sheet07_q5d (p x : ℕ) (hp : prime p) (hq : p ≡ 4 [MOD 5]) : 5*x ≡ 1 [MOD p] → x = p+1 := sorry

theorem flittle_thm (n p : ℕ) (hp : prime p) : n ^ (p-1) ≡ 1 [MOD p] := sorry
-- 6. (a) Find the remainder when 5^110 is divided by 13.
    -- Ans: 12.

instance (n : ℕ) : pos_nat (succ n) := ⟨succ_pos _ ⟩

theorem sheet07_q6a: 5^110 ≡ 12 [MOD 13] := sorry
--begin
--rw ← @zmod.cast_val_of_lt 5 13 dec_trivial,
--rw ← @zmod.cast_val_of_lt 12 13 dec_trivial,
--end

-- (b) Find the inverses of [2] and of [120] in ℤ_9871. (The number 9871 is prime.)
    -- Ans: 4936, 7321 respectively
theorem sheet07_q6bi (x : ℕ) : 2*x ≡ 1 [MOD 9871] → x = 4936 := sorry
theorem sheet07_q6bii (x : ℕ) : 120*x ≡ 1 [MOD 9871] → x = 7321 := sorry

-- (c) Use Fermat’s Little Theorem to show that n^17 ≡ n mod 255 for all n ∈ ℤ.
theorem sheet07_q6c (n : ℕ) : n^17 ≡ n [MOD 255] := sorry

-- (d) Prove that if p and q are distinct prime numbers then p^(q-1) + q^(p−1) ≡ 1 mod pq.
theorem sheet07_q6d (p q : ℕ) (hp: prime p) (hq: prime q) : p^(q-1) + q^(p-1) ≡ 1 [MOD p*q] := sorry

-- 7. Let p be an odd prime.

-- (a) Prove that (p − 1)! ≡ −1 mod p (Wilson’s Theorem).
theorem sheet07_q7a (p : ℕ) (hp : prime p) : fact (p-1) ≡ -1 [ZMOD p] := sorry

-- (b) Show that if p ≡ 1 mod 4,then there is x ∈ Z with x^2 ≡ −1 (mod p).
theorem sheet07_q7b (p : ℕ) (hp : prime p) (x : ℤ): p ≡ 1 [ZMOD 4] → x^2 ≡ -1 [ZMOD p] := sorry

-- (c) Show that if p ≠ 2 and there is x∈Z with x^2 ≡−1 modp,then p ≡ 1 mod 4.
theorem sheet07_q7c (p : ℕ) (hp : prime p) (x : ℤ) : p ≠ 2 ∧ x^2 ≡ -1 [ZMOD p] → p ≡ 1 [ZMOD 4] := sorry


/-
Copyright (c) 2020 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Anatole Dedecker
-/
import topology.separation

/-!
# Extending a function from a subset

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

The main definition of this file is `extend_from A f` where `f : X → Y`
and `A : set X`. This defines a new function `g : X → Y` which maps any
`x₀ : X` to the limit of `f` as `x` tends to `x₀`, if such a limit exists.

This is analoguous to the way `dense_inducing.extend` "extends" a function
`f : X → Z` to a function `g : Y → Z` along a dense inducing `i : X → Y`.

The main theorem we prove about this definition is `continuous_on_extend_from`
which states that, for `extend_from A f` to be continuous on a set `B ⊆ closure A`,
it suffices that `f` converges within `A` at any point of `B`, provided that
`f` is a function to a T₃ space.

-/

noncomputable theory

open_locale topology
open filter set

variables {X Y : Type*} [topological_space X] [topological_space Y]

/-- Extend a function from a set `A`. The resulting function `g` is such that
at any `x₀`, if `f` converges to some `y` as `x` tends to `x₀` within `A`,
then `g x₀` is defined to be one of these `y`. Else, `g x₀` could be anything. -/
def extend_from (A : set X) (f : X → Y) : X → Y :=
λ x, @@lim _ ⟨f x⟩ (𝓝[A] x) f

/-- If `f` converges to some `y` as `x` tends to `x₀` within `A`,
then `f` tends to `extend_from A f x` as `x` tends to `x₀`. -/
lemma tendsto_extend_from {A : set X} {f : X → Y} {x : X}
  (h : ∃ y, tendsto f (𝓝[A] x) (𝓝 y)) : tendsto f (𝓝[A] x) (𝓝 $ extend_from A f x) :=
tendsto_nhds_lim h

lemma extend_from_eq [t2_space Y] {A : set X} {f : X → Y} {x : X} {y : Y} (hx : x ∈ closure A)
  (hf : tendsto f (𝓝[A] x) (𝓝 y)) : extend_from A f x = y :=
begin
  haveI := mem_closure_iff_nhds_within_ne_bot.mp hx,
  exact tendsto_nhds_unique (tendsto_nhds_lim ⟨y, hf⟩) hf,
end

lemma extend_from_extends [t2_space Y] {f : X → Y} {A : set X} (hf : continuous_on f A) :
  ∀ x ∈ A, extend_from A f x = f x :=
λ x x_in, extend_from_eq (subset_closure x_in) (hf x x_in)

/-- If `f` is a function to a T₃ space `Y` which has a limit within `A` at any
point of a set `B ⊆ closure A`, then `extend_from A f` is continuous on `B`. -/
lemma continuous_on_extend_from [regular_space Y] {f : X → Y} {A B : set X} (hB : B ⊆ closure A)
  (hf : ∀ x ∈ B, ∃ y, tendsto f (𝓝[A] x) (𝓝 y)) : continuous_on (extend_from A f) B :=
begin
  set φ := extend_from A f,
  intros x x_in,
  suffices : ∀ V' ∈ 𝓝 (φ x), is_closed V' → φ ⁻¹' V' ∈ 𝓝[B] x,
    by simpa [continuous_within_at, (closed_nhds_basis _).tendsto_right_iff],
  intros V' V'_in V'_closed,
  obtain ⟨V, V_in, V_op, hV⟩ : ∃ V ∈ 𝓝 x, is_open V ∧ V ∩ A ⊆ f ⁻¹' V',
  { have := tendsto_extend_from (hf x x_in),
    rcases (nhds_within_basis_open x A).tendsto_left_iff.mp this V' V'_in with ⟨V, ⟨hxV, V_op⟩, hV⟩,
    use [V, is_open.mem_nhds V_op hxV, V_op, hV] },
  suffices : ∀ y ∈ V ∩ B, φ y ∈ V',
    from mem_of_superset (inter_mem_inf V_in $ mem_principal_self B) this,
  rintros y ⟨hyV, hyB⟩,
  haveI := mem_closure_iff_nhds_within_ne_bot.mp (hB hyB),
  have limy : tendsto f (𝓝[A] y) (𝓝 $ φ y) := tendsto_extend_from (hf y hyB),
  have hVy : V ∈ 𝓝 y := is_open.mem_nhds V_op hyV,
  have : V ∩ A ∈ (𝓝[A] y),
    by simpa [inter_comm] using inter_mem_nhds_within _ hVy,
  exact V'_closed.mem_of_tendsto limy (mem_of_superset this hV)
end

/-- If a function `f` to a T₃ space `Y` has a limit within a
dense set `A` for any `x`, then `extend_from A f` is continuous. -/
lemma continuous_extend_from [regular_space Y] {f : X → Y} {A : set X} (hA : dense A)
  (hf : ∀ x, ∃ y, tendsto f (𝓝[A] x) (𝓝 y)) : continuous (extend_from A f) :=
begin
  rw continuous_iff_continuous_on_univ,
  exact continuous_on_extend_from (λ x _, hA x) (by simpa using hf)
end


def f ( x : ℕ ) := x + 1

lemma p : f 3 = 4 := begin unfold f, trivial end

structure X ( n : ℕ ) :=
  ( m : ℕ )

@[reducible] def g ( x : X (f 3) ) : X 4 :=
begin
  pose y := @X.mk (f 3) x.m,
  refine (cast _ x),
  rewrite p
end

lemma h ( x : X (f 3) ) ( h : x.m = 0 ) : (g x).m = 0 :=
begin
-- https://groups.google.com/d/msg/lean-user/HVHlA4eXtxw/G0GUtjPGDAAJ
-- Jeremy suggests using:
  rewrite -h,
  reflexivity,

  -- I had tried:
--   dsimp,
--   unfold g._proof_1,
  -- What can I do with this?
  --   ⊢ (eq.rec x (eq.rec (eq.refl (X 4)) (eq.symm _root_.p))).m = 0
end


import algebra.ordered_ring

import tactic

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

-- Ex 1
variables (α : Type) (p q : α → Prop)

example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) := iff.intro
(λ h,
  have h' : (∀ x : α, p x), from (assume y : α, (h y).1),
  have h'' : (∀ x : α, q x), from (assume y : α, (h y).2),
  and.intro h' h'')
(λ h y, and.intro (h.1 y) (h.2 y))

example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) :=
(λ x y, assume s : α, ((x s) (y s)))

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

-- Ex 2
variable r : Prop

example : α → ((∀ x : α, r) ↔ r) := (λ t, iff.intro
  (λ f, f t)
  (λ s _, s)
)

section LEM
open classical -- Need LEM for half of this

example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r := iff.intro
  (by_cases
    (assume s : r, λ _, or.inr s)
    (assume s: ¬r, λ h, or.inl (assume z : α, (h z).elim
      (λ w, w)
      (λ h', absurd h' s)
    ))
  )
  (λ h, assume y : α, h.elim (λ t, or.inl (t y)) (or.inr))

end LEM

example : (∀ x, r → p x) ↔ (r → ∀ x, p x) := iff.intro
  (λ h a, assume s : α, (h s a))
  (λ h, assume s:α, λ t, (h t s))

-- Ex 3
variables (men : Type) (barber : men)
variable  (shaves : men → men → Prop)

-- Used the solver because I already solved this essentially
example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) :
  false :=  have p: (shaves barber barber ↔ ¬shaves barber barber), from h barber,
  (not_iff_self (shaves barber barber)).mp (iff.symm (h barber))

-- Ex 4
namespace hidden

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

instance : has_dvd nat := ⟨divides⟩

def even (n : ℕ) : Prop := 2 ∣ n -- You can enter the '∣' character by typing \mid

section
  variables m n : ℕ

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

end hidden

def prime (n : ℕ) : Prop := ∀ a b : ℕ, (hidden.divides n (a*b) → (hidden.divides n a ∨ hidden.divides n b))

def infinitely_many_primes : Prop := (∀ p : ℕ, (prime p) → (∃ m : ℕ, (p < m) ∧ prime m))

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

def infinitely_many_Fermat_primes : Prop := (∀ p : ℕ, (Fermat_prime p) → (∃ m : ℕ, (p < m) ∧ Fermat_prime m))

def goldbach_conjecture : Prop := ∀ n : ℕ, (3 ≤ n) → (∃ p q :ℕ, (prime p) ∧ (prime q) ∧ (n = p + q))

def Goldbach's_weak_conjecture : Prop := ∀ k, (2≤ k) → (∃ p q r : ℕ, (prime p) ∧ (prime q) ∧ (prime r) ∧ (2*k+1=p+q+r))

def Fermat's_last_theorem : Prop := ∀ n : ℕ, 3 ≤ n → ¬∃ a b c :ℕ, a^n+b^n=c^n

-- Ex 5

section EX5
open classical

variable a : α

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

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

example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r := iff.intro
(λ h, exists.elim h (λ a b, and.intro ⟨a, b.1⟩  b.2))
(λ h, exists.elim h.1 (λ b h', ⟨b,and.intro h' h.2⟩))

example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) := sorry

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

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

end EX5

-- Ex 6

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

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

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

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

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

-- Ex 7
#check sub_self

example (x : ℤ) : x * 0 = 0 := calc
  x * 0 = x * (1 - 1)   : by rw sub_self
   ...  = x * 1 - x * 1 : by rw mul_sub
   ...  = x - x         : by rw mul_one
   ...  = 0             : by rw sub_self